      SUBROUTINE AMARET(BL,TRET,ERSTAT)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME- AMARET
C
C   LANGUAGE- FORTRAN 77  TYPE- SUBROUTINE       COMPUTER- CRAY
C
C   VERSION- 1.0   DATE- 04/05/99    PROGRAMMER- MITCH GOLDBERG 
C                  NOAA/NESDIS/ORA     
C
C   VERSION- 1.1   DATE- 10/14/99    PROGRAMMER- FRANK TILLEY (SES)
C   VERSION- 1.2   DATE- 10/09/01    PROGRAMMER- M.P.FERGUSON (RITSS)
C   VERSION- 1.3   DATE- 06/19/02    PROGRAMMER- R.ROLLINS (CSC)
C
C   FUNCTION- THIS SUBROUTINE GENERATES A 40-LEVEL RETRIEVAL FROM
C             AMSU-A LIMB-ADJUSTED BRIGHTNESS TEMPERATURES.  
C             COEFFICIENTS ARE BASED ON REGRESSION BETWEEN
C             SIMULATED AMSU-A AND ROCKETSONDE DATA.  THE
C             ALGORITHM IS INTENDED FOR RETRIEVALS ABOVE 10 MB -
C             TO BE USED AS AN EXTENSION ABOVE THE LAST LEVEL
C             REPORTED IN A RADIOSONDE. 
C
C   VERSION- 1.0 ORIGINAL VERSION FROM MITCH GOLDBERG
C
C   VERSION- 1.1 UPDATED CODE TO CONFORM TO OSDPD STANDARDS
C
C   VERSION- 1.2 UPDATED CODE TO READ DELTAS FROM A FILE.
C
C   VERSION- 1.3 PORTED - ADD STATUS 'OLD' to FORCE FAILURE IF FILE    
C                is not LINKED to unit 26
C
C   FILES-
C    DSN OR DESCRIPTIVE TITLE  I/O   UNIT     FUNCTIONAL DESCRIPTION
C    ------------------------  ---   ----     ----------------------
C    /FLS/.../RETCOEFS          I     59      RETRIEVAL COEFFICIENTS
C
C  CALLING SEQUENCE PARAMETERS-
C  NAME    TYPE   I/O   DESCRIPTION
C  ----    ----   ---   -----------
C  BL      REAL    I    15 AMSU-A LIMB ADJUSTED BRIGHTNESS TEMPERATURES  
C  TRET    REAL    O    40-LEVEL TEMPERATURE RETRIEVAL
C  ERSTAT  INT     O    I/O ERROR STATUS
C
C  COMMON AREA PARAMETERS- SPVAL
C
C  LOCAL PARAMETERS-
C  NAME    TYPE   DESCRIPTION
C  ----    ----   -----------
C  COEFRG  REAL   ARRAY (40 X 15) OF COEFFICIENTS READ IN FROM THE
C                 RETRIEVAL COEFFICIENTS FILE
C  DELTA   REAL   VECTOR OF 15 DELTAS TO BE APPLIED TO ???
C  FIRST   LOG    FLAG USED TO KEEP THE FILE FROM BEING READ MORE THAN
C                 ONCE
C  ERROR   REAL
C  I,J,K   INT    LOOP CONTROL VARIABLES
C  INTERC  REAL   VECTOR OF 40 INTERCEPTS READ FROM THE FILE
C  IOERR   INT    STATUS FROM OPENING THE COEFFICIENTS FILE
C  IOSTAT  INT    I/O STATUS FROM OPEN STATEMENT
C  NCHNZR  INT    ARRAY (40 X 50) OF ???
C  NCHZR   INT    VECTOR OF 40 ??? READ FROM THE FILE
C  SUM     REAL   INTERIM COLLECTION VARIABLE USED IN CALCULATING
C                 THE TEMPERATURE AT EACH LEVEL.
C
C  SUBPROGRAMS CALLED- NONE
C
C  FUNCTIONS USED- NONE
C
C  EXIT STATES- IF AN ERROR OCCURS ACCESSING THE COEFFICIENTS FILE
C               THE SUBROUTINE ERSTAT CALLING ARGUMENT IS SET TO
C               THE IOERR VALUE RETURNED BY THE I/O CALL AND THE
C               VALUES IN THE TRET VECTOR ARE ALL RETURNED AS
C               MISSING VALUES (R4SPV).
C
C***********************************************************************
C
      INCLUDE "SPVAL"
C
C-- CALLING ARGUMENTS
C
      REAL     BL(15), TRET(40)
      INTEGER  ERSTAT, IOER1, MM
C
C-- LOCAL VARIABLES
C
      INTEGER  I, J, K, IOERR, IOSTAT, NCHNZR(40,15), NCHZR(40)
C
      LOGICAL  FIRST
C
      REAL     COEFRG(40,15), DELTA(15), ERROR, INTERC(40), SUM
C
      DATA     FIRST/.TRUE./
C     DATA     DELTA/4*0.0,1.1,-0.11,0.23,1.14,0.35,0.38,0.77,4*0.0/
C     DATA     DELTA/4*0.0,-.33,-.72,-1.0,-.63,-.55,-.42,-.05,.33,.34,
C    +         -.20,0./
C
      SAVE FIRST, DELTA, INTERC, NCHZR, COEFRG, NCHNZR 
C
      ERSTAT = 0
C
C-- READ IN RETRIEVAL COEFFICIENTS THE FIRST TIME THE SUBROUTINE IS
C   CALLED
C
      IF (FIRST) THEN
         IOERR = 0
         OPEN(59,ACCESS='SEQUENTIAL',FORM='FORMATTED',IOSTAT=IOERR)

C
C-- IF AN I/O ERROR OCCURS, SET THE RETRIEVAL VALUES TO MISSING
C   VALUES, SET THE ERROR STATUS TO THE I/O ERROR CODE, AND
C   RETURN TO THE CALLING ROUTINE
C
         IF (IOERR.NE.0) THEN
            IOSTAT = IOERR
            DO I = 1, 40
               TRET(I) = R4SPV
            END DO
            RETURN
         END IF
C
         DO I = 1, 40
            READ(59,*)
            READ(59,*)
            READ(59,*) NCHZR(I), (NCHNZR(I,K),K=1,NCHZR(I))
            READ(59,*) INTERC(I), (COEFRG(I,NCHNZR(I,J)),J=1,NCHZR(I)),
     +                 ERROR
         END DO
C
         CLOSE(59)
         OPEN(26,ACCESS='SEQUENTIAL',FORM='FORMATTED',
     +           STATUS='OLD',IOSTAT=IOER1)
C
C-- IF AN I/O ERROR OCCURS, SET THE RETRIEVAL VALUES TO MISSING
C   VALUES, SET THE ERROR STATUS TO THE I/O ERROR CODE, AND
C   RETURN TO THE CALLING ROUTINE
C
         IF (IOER1.NE.0) THEN
            IOSTAT = IOER1
            DO I = 1, 40
               TRET(I) = R4SPV
            END DO
            RETURN
         END IF
         READ(26,45)(DELTA(MM),MM=1,15)
         PRINT 46, 'AMARET: DELTAS ARE ',DELTA
 45      FORMAT(1X,15(F6.2))
 46      FORMAT(A,15(F6.2))
         CLOSE(26)
C
         FIRST = .FALSE.
      END IF
C
C-- APPLY RETRIEVAL COEFFICIENTS
C
      DO I = 1, 40
         SUM = INTERC(I)
         DO K = 1, NCHZR(I)
            SUM = SUM + COEFRG(I,NCHNZR(I,K)) *
     +            (BL(NCHNZR(I,K)) - DELTA(NCHNZR(I,K)))
         END DO
         TRET(I) = SUM
      END DO
C
      RETURN

      END
