      SUBROUTINE RETOD1(RETANC,ODFBUF,I,J,II,JJ,RETCLS,RDATCY,S,
     1                  GDDATA,LAYERS,AMASPT,AMALNE,CNFLIM,
     2                  SYNCTI,OBSQUL,GEOHGT,PRFLAG,HFLAG,AFLAG,
     3                  ERSTAT)
C
C**********************************************************************
C
C   NAME- RETOD1
C
C   LANGUAGE- FORTRAN 77      TYPE- SUBROUTINE      COMPUTER- CRAY    
C
C   VERSION- 1.0    DATE- 09/11/92   PROGRAMMER- DAVE MOREL (SMSRC)
C   VERSION- 2.0    DATE- 05/06/94   PROGRAMMER- FRANK TILLEY (SMSRC)
C          XATOV-3: REPLACE COMMON BLOCK /BUFFER/ WITH PARAMETER
C                   FILE INSPARM AND COMMON BLOCK /INSCOM/.
C   VERSION- 2.1    DATE- 05/18/94   PROGRAMMER- JEFF MANNING (SMSRC)
C          XATOV-5: REMOVE RNGRDP, RTOTLN, RDATEL, RNANC FROM CALLING
C                   ARGUMENTS.  INCLUDE PARAMETER FILE /RTVPARM/.
C                   CHANGE DIMENSION RDATCY(56) TO RDATCY(RDATEL).
C   VERSION- 2.2    DATE- 06/14/94   PROGRAMMER- JEFF MANNING (SMSRC)
C          XATOV-21 INCLUDED THE PARAMETER FILE /RETPARM/. CHANGED
C                   HARD-CODED DIMENSIONS FOR: S, WVMR, LAYERS, STDIDX,
C                   INVPRS, GEOHGT, GOHGKM, AND INVDAT.  CHANGED
C                   CORRESPONDING DO LOOPS FROM HARD-CODED VALUES TO
C                   THE APPROPRIATE PARAMETER.
C   VERSION- 2.3    DATE- 04/18/95   PROGRAMMER- LI LU (SMSRC)
C          ATOVS-96 REMOVE CALLS TO SPGSR4, SPGSI4, STGASG AND
C                   ASSOCIATED VARIABLES. REPLACE WITH CALLS TO
C                   SPGFAU. ADD CODE TO PACK SURFTEMP. REMOVE CODE
C                   TO COMPUTE GEOPOTENTIAL HEIGHTS AND REPLACE WITH
C                   CALL TO RTVHGT. VALUES FOR MSU CHANGED TO AMSU-A
C                   IN CHANNEL COMBINATION FLAG - 1ST 20 BITS REMAIN
C                   FOR HIRS, NEXT 15 FOR AMSU-A, NEXT 6 FOR AVHRR.
C   VERSION- 2.4    DATE- 08/02/95   PROGRAMMER- LI LU (SMSRC)
C         ATOVS-152 SOUNDING TIME, OBSERVATION QUALITY FLAG AND
C                   GEOPOTENTIAL HEIGHT ARE ADDED AS OUTPUT ARGUMENTS.
C                   A CHECK IS ADDED FOR MILTIM TO CHECK IF IT IS
C                   EXCEEDING THE TOTAL NUMBER OF MILLISECONDS IN A DAY.
C   VERSION- 2.5    DATE- 12/8/95    PROGRAMMER- CARLA NEIGH (SMSRC)
C         ATOVS-285 ADD ACCUMULATION OF STATS LNDRET, SEARET,
C                   CSTRET, ICERET AND SNORET.  INPUT ARGUMENT ADDED
C                   FOR CLASS ID.  ARGUMENT FOR PATH ADDED TO CALL
C                   TO CLIMTE. 
C   VERSION- 3.0    DATE- 05/14/96   PROGRAMMER- ALEX POZDNYAK, FDC
C      FOR REHOSTING TO THE CRAY, CHANGED ALL I*4 DECLARATIONS TO
C      INTEGER, ALL L*4 TO LOGICAL, AND ALL R*4 DECLARATIONS TO REAL.
C   VERSION- 4.0    DATE- 05/06/98   PROGRAMMER- LEAH WILSON, RSTX
C       ADD PRFLAG AND CHANGE DEFINITION OF OBSQUL.
C   VERSION- 4.1    DATE- 08/05/98   PROGRAMMER- LEAH WILSON, RSTX
C       FIRST 20 GEOPOTENTIAL HEIGHTS ARE IN DECAMETERS PER REQUEST
C       BY ATOVS SOUNDING PAL.
C   VERSION- 4.2    DATE- 09/22/98   PROGRAMMER- A. ALLEGRINO (RAYTHEON)
C       ADDED PARAMENTER SUPLVL TO THE CALL OF CHKSUP. WILL ADD SUPLVL TO ODF.
C   VERSION- 4.3    DATE- 02/26/99   PROGRAMMER- L. WILSON (RAYTHEON)
C       ADD 4-DIGIT RETRIEVAL YEAR TO SPARE.
C   VERSION- 4.4    DATE- 04/19/99   PROGRAMMER- A. ALLEGRINO (RAYTHEON)
C       ADDED THE PASSING OF THE GROSS TEMPERATURE LIMIT FLAGS FOR HIRS
C       AND AMSU-A. THESE WILL BE USED TO DETERMINE THE OBS QUALITY FLAG
C       AND PLACED IN THE ODF.
C   VERSION- 4.5    DATE- 04/20/99   PROGRAMMER- A. ALLEGRINO (RAYTHEON)
C       ADDED A CHECK OF THE RETRIEVAL FLAG TO DETERMINE OBSERVATIONAL
C       QUALITY. IF THE RETRIEVAL FLAG IS MISSING OR IF IT IS SET TO NO
C       HIRS THEN THE OBSERVATION QUALITY IS SET TO 2 (BAD)
C   VERSION- 4.6    DATE- 05/21/99   PROGRAMMER- A. ALLEGRINO (RAYTHEON)
C       CHANGED DEFINITION OF THE GROSS TEMPERATURE LIMIT FLAG
C           0 = ALL OK
C           1 = HIRS TEMPERATURE LIMITS EXCEEDED
C           2 = AMSU-A TEMPERATURE LIMITS EXCEEDED
C           3 = HIRS AND AMSU-A TEMPERATURE LIMITS EXCEEDED
C       CHANGED THE SUPER ADIABATIC FLAG TO BE A LAPSE RATE FLAG
C           0 = NOT SUPERADIABATIC OR AN INVERSION
C           1 = SUPER ADIABATIC
C           2 = INVERSION
C       THE NO-HIRS CONDITION NOW AFFECTS THE GROSS TEMPERATURE LIMIT 
C       FLAG, IF THERE IS A NO-HIRS CONDITION THEN THE GROSS TEMPERATURE
C       LIMIT FLAG IS SET TO 1.
C   VERSION- 4.7    DATE- 08/10/99   PROGRAMMER- A. ALLEGRINO (RAYTHEON)
C       ADDED STATEMENTS IN THE PROCESSING OF THE WATER VAPOR MIXING RATIO 
C       TO TAKE CARE OF MISSING DATA.
C   VERSION- 4.8    DATE- 05/24/00   PROGRAMMER- M. FERGUSON (RAYTHEON)
C       CHANGED HOW CHANNEL COMBINATION IS STORED.
C   VERSION- 4.9    DATE- 08/09/00   PROGRAMMER- M.P.FERGUSON (RITSS)/R.KELLEY
C       MODIFIED TO WRITE THE TARM PATH AS "NOHIRS" IF EITHER FLAG
C       HIROFF IS SET TO RETRIEVE WITH NO HIRS CHANNELS OR FLAG BADRET
C       IS AUTOMATICALLY SET INDICATING THAT ONE OR MORE HIRS CHANNELS
C       FAILED EITHER CALIBRATION COEFFICIENT PRESENCE CHECKS, AND/OR
C       THE RADIANCES OR BRIGHTNESS TEMPERATURES FAILED GROSS LIMITS
C       CHECKS. ALSO ADDED COMMON HIRSTAT (WR # 105).
C   VERSION- 4.10   DATE- 08/14/00   PROGRAMMER- A. ALLEGRINO (RITSS)  
C       CHANGED THE SCALING FACTOR FOR CLW FROM 1 TO 64.
C   VERSION- 4.11   DATE- 02/14/02   PROGRAMMER- A. ALLEGRINO (RITSS)  
C       ADDED A CHECK OF THE BADHIR FLAG TO DETERMINE THE OBSERVATIONAL
C       QUALITY FLAG.  IF BADHIRS FLAG IS SET, THIS WILL SET THE          
C       THE OBSERVATIONAL QUALITY FLAG TO "GOOD". (PR#58)
C   VERSION- 4.12   DATE- 03/13/03   PROGRAMMER- FRANK TILLEY (RAYTHEON)
C       SET THE BT GROSS ERROR FLAG TO 0 IN NO-HIRS MODE SO THE PRODUCT
C       FORMATTERS WILL DISTRIBUTE NO-HIRS RETRIEVALS (PR #71).
C   VERSION- 4.13   DATE- 03/13/03   PROGRAMMER- FRANK TILLEY (RAYTHEON)
C       REMOVED CODE THAT INVERTED THE PRESSURE AND TEMPERATURE PROFILES
C       AND CONVERTED TEMPERATURES TO CELSIUS BEFORE THE CALL TO CHKSUP
C       ADDED SURFACE MODEL LEVEL TO THE CALL TO CHKSUP AND
C       WROTE OUT NON-ZERO SUPER ADIABATIC LEVEL VALUES EVEN WHEN
C       THE DATA HAVE BEEN CORRECTED AND THE SUPERADIABATIC FLAG IS
C       NOT SET.(WR #215)
C   VERSION- 5.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C       Replaced R4SPV equivalence test with ISR4SPV function.
c   version- 5.1    date- 01/19/05   programmer- Frank Tilley (Raytheon)
C       SET OBSQUL to 2 (BAD) WHERE THE GDDATA FLAG INDICATES NO
C       RETRIEVAL WAS MADE.
C
C   FUNCTION-          THIS SUBROUTINE IS ONLY CALLED BY RETODB AND
C   TOGETHER WITH RETODB AND RETOD2 THIS SUBROUTINE PACKS RETRIEVAL
C   GRID DATA INTO THE ODF BUFFER FOR OUTPUT TO THE ORBITAL DATA 
C   FILE.  NOTE THAT SINCE SIMILAR PARAMETERS WERE GROUPED TOGETHER
C   ON THE ODF, THE INDICES FOR THE ODFBUF ARE NOT ALWAYS SEQUENTIAL.
C   ALSO, TO INCREASE PROCSSING SPEED, SINCE THIS ROUTINE IS CALLED
C   FOR EVERY RETRIEVAL, SEVERAL LOOPS WERE UNWOUND.
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE          TYPE I/O  DESCRIPTION
C     --------          ---- ---  ----------------------------------
C     RETANC            REAL I/O  ARRAY OF DIMENSION (RTVPARM:RNGRDP,
C                                 RTVPARM:RTOTLN, RTVPARM:RNANC) WHICH
C                                 HOLDS THE ANCILLARY RETRIEVAL GRID
C                                 INFORMATION.
C     ODFBUF            INT   I/O ODF BUFFER.
C     I                 INT    I  INDEX USED FOR CURRENT GRID POINT
C                                 NUMBER.
C     J                 INT    I  INDEX USED FOR CURRENT GRID LINE
C                                 NUMBER.
C     II                INT    I  INDEX USED FOR THE HIRS SPOT NUMBER.
C     JJ                INT    I  INDEX USED FOR THE HIRS LINE NUMBER.
C     RETCLS            INT    I  RETRIEVAL CLASS INDEX.
C     RDATCY            REAL  I/O VECTOR OF DIMENSION RTVPARM:RDATEL,
C                                 CONTAINING RETPARM:PRFTLV TOVS
C                                 TEMPERATURE PROFILE(K), RETPARM:PRFQLV
C                                 WATER VAPOR MIXING RATIOS ALOG(G/KG)
C                                 ONE SURFACE TEMPERATURE (K).
C     S                 INT    I  VECTOR OF RTVPARM:RNGRDP SORTED SPOT
C                                 NUMBERS.
C     GDDATA            LOG    I  LOGICAL SET TO TRUE IF GOOD RETRIEVAL
C                                 DATA IS PRESENT FOR A GRID POINT.
C     LAYERS            REAL   O  VECTOR OF LENGTH RETPARM:PRFTLV
C                                 CONTAINING LAYER THICKNESS AT THE
C                                 RETPARM:PRFTLV TOVS LEVELS.
C     AMASPT            INT    I  ARRAY OF DIMENSION (INSPARM:HNSPOT,
C                                 INSPARM:HTOTLN) CONTAINS AMSU-A
C                                 COLLOCATED SPOT NUMBERS.
C     AMALNE            INT    I  ARRAY OF DIMENSION (INSPARM:HNSPOT,
C                                 INSPARM:HTOTLN) CONTAINS AMSU-A
C                                 COLLOCATED LINE NUMBERS.
C     CNFLIM            INT    I  SPOT CONFIDENCE LIMIT.
C     SYNCTI            INT    O  ARRAY (DIM:3) CONTAINING SOUNDING TIME
C     OBSQUL            INT    O  0 = GOOD, DATA CAN BE DISTRIBUTED,
C                                 AND USED FOR TUNING AND EVALUATION, 
C                                 1 = SUPERADIABATIC CONDITION, USE
C                                 FOR TUNING AND EVALUATION, 
C                                 2 = FAILED GROSS TEMPERATURE LIMITS FOR HIRS
C                                 OR AMSU-A, OR POLAR REDUNDANT, 
C                                 OR PRECIP CONTAMINATED - DO NOT DISTRIBUTE
C                                 OR USE FOR TUNING OR EVALUATION
C     GEOHGT            REAL   O  VECTOR OF LENGTH RETPARM:PRFTLV
C                                 CONTAINING THE GEOPOTENTIAL HEIGHTS
C                                 AT THE RETPARM:PRFTLV TEMPERATURE
C                                 LEVELS RETRIEVED.
C     PRFLAG		LOG    I  ARRAY (DIM RNGRDP X RTOTLN) OF
C                                 POLAR REDUNDANT FLAGS.
C     ERSTAT            INT    O  ERROR STATUS CODE.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'MONSTA'
      INCLUDE 'RETPARM'
      INCLUDE 'RTVPARM'
      INCLUDE 'INSPARM'
      INCLUDE 'INSCOM'
      INCLUDE 'FRMINF'
      INCLUDE 'COLLOC'
      INCLUDE 'RMPARM'
      INCLUDE 'RTPLVL'
      INCLUDE 'OZONE'
      INCLUDE 'SPVAL' 
      INCLUDE 'SPGUNT'
      INCLUDE 'HIRSTAT'
      INCLUDE 'AMAFGBF'
C
C   LOCAL PARAMETERS-
C     VARIABLE          TYPE  DESCRIPTION
C     --------          ----  ----------------------------------------
C     CCLCND            INT   CLOUD-CLEARING CONDITION OBTAINED FROM
C                             THE RETRIEVAL FLAG, WHERE 0 = CLEAR,
C                             1 = CLOUD-CLEARED, 2 = CLOUDY AND 3 =
C                             NO-HIRS.
C     CHAVIL           CH*8   EQUIVALENCED TO THE CHANNEL AVAILABILITY
C                             FLAG CHFLAG.
C     CHCOMB           CH*6   CHANNEL COMBINATION FLAG.
C     CIPFLG           CH*1   PRECIP EDITING FLAG.
C     WVMR              REAL  VECTOR OF LENGTH RETPARM:PRFQLV HOLDS THE
C                             WATER VAPOR MIXING RATIOS.
C     CHFLAG            REAL  VECTOR OF LENGTH 2 HOLDING THE CHANNEL
C                             AVAILIBILITY FLAGS FROM THE RETANC
C                             BUFFER.
C     IFLAG             INT   VECTOR OF 2 EQUIVALENCE WITH CHFLAG.
C     SUPER             LOG   LOGICAL SET TO TRUE SUPERADIABATIC COND.
C     INVER             LOG   LOGICAL SET TO TRUE INVERSION COND.
C     K,KK,M,N          INT   LOOP CONTROL INDICES.
C     LL                INT   A BIT POSITION IN A WORD.
C     INVDAT            REAL  VECTOR OF RETPARM:PRFTLV INVERSE
C                             TEMPERATURE PROFILE(K).
C     INVPRS            REAL  VECTOR OF RETPARM:PRFTLV INVERSE PRESSURE
C                             LEVELS (MB).
C     MILTIM            INT   ENDING TIME IN MILLISECONDS.
C     RTFLAG            INT   INTEGER TO HOLD THE RETRIEVAL FLAG.
C     TERTYP            INT   INTEGER TO TERRAIN TYPE FLAG.
C     CTRTYP           CH*1   VECTOR OF 2 EQUIVALENCED TO TERTYP.
C     CHRFLG           CH*1   VECTOR OF 4 EQUIVALENCED TO RTFLAG.
C     TROTMP            REAL  TROPOPAUSE TEMPERATURE (K).
C     TROPRS            REAL  TROPOPAUSE PRESSURE (MB).
C     GOHGKM            REAL  VECTOR OF RETPARM:PRFTLV GEOMETRIC
C                             HEIGHTS (KM).
C     PATH              INT   RETRIEVAL PATH (1 = CLEAR/CLOUD-CLEARED,
C                             2 = CLOUDY, 3 = NO-HIRS).
C     DUMOBS            INT   DUMMY FOR STORING FLAGS.
C     SMODLV            INT   SURFACE MODEL LEVEL.
C     SUPLVL            INT   SUPERADIABATIC LEVEL
C     INVLVL            INT   INVERSION LEVEL
C     LAPRFLG           INT   LAPSE RATE FLAG (1= SUPERADIABATIC, 2 = 
C                             INVERION, 0 = NORMAL)
C
C   SUBPROGRAMS CALLED-  RTVHGT, ODBTIM, TROPLV, CHKSUP, CLIMTE, CHKINV
C
C   FUNCTIONS USED- ALOG, IEOR, ISHFT, NINT, IBSET
C
C   EXIT STATES-
C       ERSTAT =  0; INDICATING NO ERRORS FOUND.
C       ERSTAT >  0; INDICATING A FATAL ERROR WAS DETECTED.
C
C   COMMENTS-  THE HIRS TIME AND ANCILLARY BUFFERS WILL BE USED FOR
C              THE RETRIEVAL GRID DATA. THESE BUFFERS WILL CONTAIN
C              THE NECESSARY VALUES EVEN IF THE HIRS INSTRUMENT IS
C              NOT PRESENT.
C*********************************************************************
C
      INTEGER   BUFSIZE
      PARAMETER(BUFSIZE=500)
      INTEGER   I, J, II, JJ, S(RNGRDP),CNFLIM, SYNCTI(3), ERSTAT
      INTEGER   RETCLS, AMASPT(HNSPOT,HTOTLN), AMALNE(HNSPOT,HTOTLN)
      INTEGER   OBSQUL,LAPRFLG,HIR116,H17A12,A13AV6, MM 
      INTEGER*2 ODFBUF(BUFSIZE)
      INTEGER   HFLAG, AFLAG
      REAL      RDATCY(RDATEL)
      REAL      RETANC(RNGRDP,RTOTLN,RNANC), WVMR(PRFQLV)
      REAL      LAYERS(PRFTLV), GEOHGT(PRFTLV)
      LOGICAL   GDDATA
C
      CHARACTER*1  CHRFLG(4), CIPFLG, CTRTYP(2)
      CHARACTER*6  CHCOMB
      CHARACTER*8  CHAVIL
      INTEGER      TERTYP, DUMOBS, SUPLVL,INVLVL
      INTEGER      K, M, KK, LL, N, IFLAG(2), CCLCND, PATH
      INTEGER      MILTIM, RTFLAG, LEVEL, WORD
      INTEGER      ITEMP , HRAMFLG, SMODLV
      REAL         INVPRS(PRFTLV), CHFLAG(2)
      REAL         TROTMP, TROPRS, GOHGKM(PRFTLV), INVDAT(PRFTLV)
      LOGICAL      SUPER, PRFLAG(RNGRDP,RTOTLN),INVER
      LOGICAL      ISR4SPV
C
      EQUIVALENCE (TERTYP,CTRTYP(1))
C*FDC*EQUIVALENCE (CHAVIL,CHFLAG(1))
      EQUIVALENCE (CHAVIL,ITEMP)    
      EQUIVALENCE (CHFLAG(1),IFLAG(1))
      EQUIVALENCE (CHRFLG(1),RTFLAG)
C
C
C     INITIALIZE LOCAL VARIABLES
C
C     SUPADI(FRAMNO) = 0
      HRAMFLG = 0
C
C PACK THE LAPSE RATE  FLAG.
C
      M = 0
      SUPER = .FALSE.
      SUPLVL= I2SPV
C
C  CURRENTLY COMMENTED OUT UNTIL SOFTWARE DEVELOPED
C
      INVER = .FALSE.
C     INVLVL= I4SPV
C
      SMODLV = NINT(RETANC(S(I),J,7))
      CALL CHKSUP(PRFTLV,PROFLV,RDATCY,SUPER,SUPLVL,SMODLV)
C
C  CHECK TO SEE IF THERE IS AN INVERSION LAYER. 
C  CURRENTLY COMMENTED OUT UNTIL SOFTWARE IS DEVELOPED.
C
C     CALL CHKINV(PRFTLV,INVPRS,INVDAT,INVER,INVLVL)
C
C     LOGICAL SUPER IS TRUE WHEN A SUPERADIABATIC CONDITION IS
C     FOUND. STORE A 1 FOR TRUE.
C     LOGICAL INVER IS TRUE WHEN A INVERSION CONDITION IS
C     FOUND. STORE A 2 FOR TRUE.
C     IF BOTH ARE FALSE, STORE A 0.
C     IF A SUPERADIABATIC LAYER WAS FOUND, EVEN IF IT WAS
C     CORRECTED, STORE THE SUPERADIABATIC LEVEL ON THE ODF.
C
      RETANC(S(I),J,6) = 0.0
      LAPRFLG = 0
      ODFBUF(455) = I2SPV
      IF (SUPLVL.GT.0) ODFBUF(455) = SUPLVL
      IF(SUPER) THEN
         SUPADI(FRAMNO) = SUPADI(FRAMNO) + 1
         LAPRFLG = 1
         RETANC(S(I),J,6) = 1.0
      ENDIF
C
      ODFBUF(40) = LAPRFLG
C
C  PACK THE SPOT CONFIDENCE
C
      ODFBUF(22) = NINT(HIRANC(II,JJ,6))
C
C DO A CLIMATOLOGICAL LIMITS CHECK IF THE RETRIEVAL IS GOOD.
C
      RTFLAG = NINT(RETANC(S(I),J,4))
      CCLCND = RTFLAG / 16
      IF ((CCLCND .EQ. 0) .OR. (CCLCND .EQ. 1)) THEN
         PATH = 1
      ELSE
         PATH = CCLCND
      ENDIF
      IF(GDDATA) THEN
         CALL CLIMTE(RDATCY,HIRANC(II,JJ,1),HSCTIM,RETCLS,
     1               PATH,ERSTAT)
         IF(ERSTAT .EQ. 99) RETURN
      ENDIF
C
C PACK THE POLAR REDUNDANCY FLAG.
C
      ODFBUF(447) = -1
      IF(PRFLAG(S(I),J)) ODFBUF(447) = 1
C
C PACK THE OBSERVATION QUALITY FLAG, 0 = GOOD, DATA CAN BE DISTRIBUTED,
C AND USED FOR TUNING AND EVALUATION, 1 = SUPERADIABATIC CONDITION, USE
C FOR TUNING AND EVALUATION, 2 = FAILED GROSS TEMPERATURE LIMITS FOR HIRS
C OR AMSU-A, OR POLAR REDUNDANT, OR PRECIP CONTAMINATED - DO NOT DISTRIBUTE
C OR USE FOR TUNING OR EVALUATION
C
      OBSQUL = 0
C
C CHECK THE GROSS TEMPERATURE LIMIT HIRS AND AMSU-A FLAGS, AND
C ADJUST THE OBSERVATIONAL QUALITY ACCORDINGLY. ALSO SET HIRS/AMSU-A
C FLAG (0= ALL TEMPERATURE WITHIN LIMITS, 1 = HIRS GROSS TEMPERATURE
C LIMITS EXCEEDED, 2 = AMSU-A GROSS TEMPERATURE LIMITS EXCEEDED, 3 =
C BOTH HIRS AND AMSU-A GROSS TEMPERATURE LIMITS EXCEEDED).
C
      IF(HFLAG.EQ.1) THEN
         OBSQUL = 2
         HRAMFLG = 1
C
C CHECK THE BADHIR FLAG TO DETERMINE IF THE NOHIRS OPTION IS ON AND IF
C IT'S ON FOR ANY CHANNEL, THEN SET THE OBS QUALITY FLAG BACK TO GOOD
C AND CLEAR THE GROSS TEMPERATURE LIMITS FLAG FOR HIRS. (PR #71)
C
         DO MM=1,19
            IF(BADHIR(II,JJ,MM) .EQ. 1) THEN
               OBSQUL = 0
               HRAMFLG = 0
            END IF
         ENDDO
      ENDIF
      IF(AFLAG.EQ.1) THEN
       OBSQUL = 2
       HRAMFLG = 2
      ENDIF
      IF(HFLAG.EQ.1.AND.AFLAG.EQ.1) THEN
       OBSQUL = 2
       HRAMFLG = 3
      ENDIF
      ODFBUF(456) = HRAMFLG
C
C CHECK IF THE SPOT IS SUPERADIABATIC OR AN INVERSION
C
      IF(SUPER .OR. INVER) OBSQUL = 2
C
C CHECK IF THE SPOT IS PRECIPITATING
C
      IF(RETANC(S(I),J,8).EQ.1) OBSQUL = 2
C
C CHECK IF THE SPOT IS POLAR REDUNDANT
C     
      IF(ODFBUF(447).EQ.1) OBSQUL = 2
C
C IF RETRIEVAL FLAG IS MISSING OR NOHIRS SET OBSERVATIONAL QUALITY
C TO 2 (IT'S A BAD OBS). ALSO SET THE HIRS/AMSUA GROSS TEMPERATURE
C LIMIT FLAG TO 1.
C
      IF(ISR4SPV(RETANC(S(I),J,4)) .OR. RETANC(S(I),J,4) .EQ. 48)
     >THEN 
       OBSQUL =2
       HRAMFLG = 1
       ODFBUF(456) = HRAMFLG
      ENDIF
      
C
C KEEP COUNT OF GOOD RETRIEVALS

      IF(GDDATA .AND. OBSQUL .EQ. 0) TGRET = TGRET + 1
c     IF(GDDATA .AND. OBSQUL .EQ. 1) TRRET = TRRET + 1
C KEEP COUNT OF POLAR REDUNDANT RETRIEVALS

      IF(GDDATA .AND. ODFBUF(447).EQ.1) TRRET = TRRET + 1
C
C KEEP COUNT OF PRECIPITATION CONTAMINATED RETRIEVALS THAT
C ARE NOT POLAR REDUNDANT.

      IF(GDDATA .AND. ODFBUF(447).NE.1) THEN
         IF (RETANC(S(I),J,8).EQ. 1) RCTAIM = RCTAIM + 1
      END IF

      IF(GDDATA .AND. OBSQUL .EQ. 2) TQRET = TQRET + 1
ccft
      if (.not.(GDDATA)) OBSQUL = 2
      ODFBUF(41) = OBSQUL

      IF (OBSQUL.EQ.2) TBRET = TBRET + 1
C
C PACK THE PRECIPITATION EDIT FLAG.
C
      IF(.NOT. ISR4SPV(RETANC(S(I),J,8))) ODFBUF(29)=NINT(RETANC(S(I),J,8))
C
C PACK THE TERRAIN FLAG (0=SEA, 1=LAND, 2=COAST, 10=ICE, 11=SNOW).
C
      TERTYP = NINT(HIRANC(II,JJ,9))
      IF (GDDATA) THEN
         IF (TERTYP .EQ. 0) THEN
            SEARET = SEARET + 1
         ELSEIF (TERTYP .EQ. 1) THEN
            LNDRET = LNDRET + 1
         ELSEIF (TERTYP .EQ. 2) THEN
            CSTRET = CSTRET + 1
         ELSEIF (TERTYP .EQ. 10) THEN
            ICERET = ICERET + 1
         ELSE
            SNORET = SNORET + 1
         ENDIF
      ENDIF
      IF(.NOT. ISR4SPV(HIRANC(II,JJ,9))) ODFBUF(30) = TERTYP
C
C PACK THE DAY/NIGHT FLAG. (1=DAY, 0=NIGHT) BASED ON THE
C SOLAR ZENITH ANGLE
C
      DUMOBS = 1
      IF(HIRANC(II,JJ,3).GT.90.5) DUMOBS = 0
      ODFBUF(31) = DUMOBS
C
C PACK THE LATITUDE OF THE SPOT.
C
      IF(.NOT. ISR4SPV(HIRANC(II,JJ,1))) ODFBUF(24)= NINT(HIRANC(II,JJ,1)*128.0)
C
C PACK THE LONGITUDE OF THE SPOT.
C
      IF(.NOT. ISR4SPV(HIRANC(II,JJ,2))) ODFBUF(25)=NINT(HIRANC(II,JJ,2)*128.0)
C
C PACK THE SOUNDINGS TIME OF THIS RETRIEVAL.
C
      MILTIM = HSCTIM(2,JJ) + ((II-1)*HIRTIM(2)) + HIRTIM(1)
      IF (MILTIM.GT.86400000) THEN
         MILTIM = MILTIM - 86400000
         CALL ODBTIM(HSCTIM(1,JJ)+1,MILTIM,SYNCTI)
      ELSE
         CALL ODBTIM(HSCTIM(1,JJ),MILTIM,SYNCTI)
      END IF
      ODFBUF(26) = SYNCTI(1)
      ODFBUF(27) = SYNCTI(2)
      ODFBUF(28) = SYNCTI(3)
C 
C  STORE 4-DIGIT YEAR IN SPARE WORD 19.
C
      IDUMYR=ODFBUF(26)/100
      IF(IDUMYR.EQ.99) THEN
         ODFBUF(19) = 1900 + IDUMYR
      ELSE
         ODFBUF(19) = 2000 + IDUMYR
      ENDIF
C
C PACK THE RETRIEVAL FLAG.
C
      IF(((RETANC(S(I),J,5) / R4SPV) .GT. 1.01) .OR.
     1   ((RETANC(S(I),J,5) / R4SPV) .LT. 0.98)) THEN 
         IF(RETANC(S(I),J,5) .NE. 0.0) THEN
           IF(.NOT.HIROFF .AND. .NOT.BADRET(II,JJ))THEN
            IF (CCLCND .EQ. 0) TRCLER = TRCLER + 1
            IF (CCLCND .EQ. 1) TRNSTR = TRNSTR + 1
            IF (CCLCND .EQ. 2) TRCLDY = TRCLDY + 1
            IF (CCLCND .EQ. 3) TRNOHR = TRNOHR + 1
           ELSE
            TRNOHR = TRNOHR + 1
            CCLCND = 3
           ENDIF
         ELSE
            IF(HIROFF.OR.BADRET(II,JJ))CCLCND = 3
         ENDIF
      ELSE
         IF(HIROFF.OR.BADRET(II,JJ))CCLCND = 3
      ENDIF
      DUMOBS=I2SPV
      IF(CCLCND.EQ.0) DUMOBS = 0
      IF(CCLCND.EQ.1) DUMOBS = 16
      IF(CCLCND.EQ.2) DUMOBS = 32
      IF(CCLCND.EQ.3) DUMOBS = 48
      ODFBUF(42) = DUMOBS
C
C PACK THE CHANNEL COMBINATION FLAG, THE FIRST 20 BITS OF THE
C FLAG ARE FROM RETANC(X,X,2) REPRESENTING THE HIRS CHANNELS;
C BUT ONLY 16 OF THESE WILL FIT INTO THE FIRST WORD OF THIS FLAG
C BECAUSE EACH WORD MUST BE ONLY 2 BYTES (AS THIS IS THE SIZE OF 
C EACH WORD ON THE RRODF). THE FIRST CHANNEL FLAG WORD IS THEREFORE
C IFLAG(1) SHIFTED 32 BITS TO THE LEFT (ERASING EXTRANEROUS INFO)
C AND THEN ITS VALUE IS SHIFTED 48 BITS TO RIGHT SO THAT HIRS 1-16
C IS PLACED IN THE RIGHT-MOST 2 BYTES OF HIR116. THUS IFLAG(1) STILL
C HAS INFORMATION FOR HIRS 1-20 IN THE LEFT-MOST 32 BITS.
C THE NEXT 15 REPRESENTING AMSU-A CHANNELS, ARE FROM RETANC(X,X,3).
C IFLAG(2) CONTAINS THIS INFORMATION, AND IT IS SHIFTED 20 BITS TO
C THE RIGHT SO THAT THE INFORMATION FOR AMSU-A 1-12 IS IN BITS 11-0
C OF IFLAG(2).  IFLAG(1) IS THEN FIRST SHIFTED 16 MORE BITS TO LEFT
C TO REMOVE INFORMATION FOR HIRS 1-16 (ALREADY STORED IN HIR116),
C AND THEN 48 BITS TO THE RIGHT TO PUT INFORMATION FOR HIRS 17-20
C IN BITS 15-12 OF IFLAG(1). A LOGICAL OR OPERATION THEN SETS THE 
C BITS ON IN EITHER FLAG(1) OR FLAG(2) TO ON IN H17A12. IFLAG(2)
C IS THEN RESET WITH THE BIT INFORMATION FOR AMSU-A 1-15 AGAIN AS
C WE MUST STORE THE INFORMATION FOR AMSU-A 13-15 IN THE THIRD WORD
C A13AV6.  FLAG(2) IS SHIFTED 44 BITS TO THE LEFT TO REMOVE DATA
C FOR AMSU-A 1-12, THEN TO THE RIGHT 48 TO PUT THE DATA FOR AMSU-A
C 13-15 IN BITS 15-13 OF FLAG(2).  BITS 12-8 ARE RESERVED FOR 
C AMSU-B CHANNELS, AS THESE WILL BE USED IN THE RETRIEVAL IN THE
C FUTURE.  LOOP 50 THEN SETS BITS 7-2 WITH THE ON/OFF INFORMATION
C FOR AVHRR 1, 2, 3A, 3B, 4, AND 5, AND A13AV6 IS SET TO FLAG(2).
C AFTER THE PACKING, THE RIGHTMOST TWO BYTES OF THESE THREE WORDS 
C CONTAINS:
C    
C  HIR116              H17A12                    A13AV6
C
C HIRS 1-16   HIRS 17-20,(bits 15-12)   AMSU-A 13-15,(bits 15-13)
C             AMSU-A 1-12(bits 11-0)    AMSU-B 1-5,(bits 12-8)
C                                         AVHRR 1-5(bits 7-2)
C
C
C IFLAG(1) IS SET TO CHANNEL AVAILABILITIES FOR HIRS 1-20.
C IFLAG(2) IS SET TO CHANNEL AVAILABILITIES FOR AMSU-A 1-15.
C
      CHFLAG(1) = NINT(RETANC(S(I),J,2))
      CHFLAG(2) = NINT(RETANC(S(I),J,3))
C
C IFLAG(1) SHIFTED 32 BITS TO LEFT TO GET RID OF TRASH IN BITS 32-63.
C HIR116 BECOMES IFLAG(1) SHIFTED 48 BITS TO RIGHT, PUTTING CHAN-
C NEL USAGE INFO FOR HIRS 1-16 IN BITS 15-0 OF HIR116.
C
      IFLAG(1) = ISHFT(IFLAG(1),32)
      HIR116 = ISHFT(IFLAG(1),-48)
C
C IFLAG(2) SHIFTED 32 BITS TO LEFT TO GET RID OF TRASH IN BITS 32-63.   
C THEN IT IS SHIFTED 52 BITS RIGHT TO PUT INFO FOR AMSU 1-12 IN
C BITS 11-0 OF IFLAG(2).
C

      IFLAG(2) = ISHFT(IFLAG(2),32)
      IFLAG(2) = ISHFT(IFLAG(2),-52)
C
C IFLAG(1) SHIFTED ADDITIONAL 16 BITS TO LEFT TO GET RID OF HIRS
C 1-16 INFORMATION, THEN 48 BITS TO RIGHT TO PUT INFO. FOR HIRS
C 17-20 IN BITS 15-12 OF IFLAG(1).
C
      IFLAG(1) = ISHFT(IFLAG(1),16)
      IFLAG(1) = ISHFT(IFLAG(1),-48)
C
C LOGICAL 'OR' DONE ON IFLAG(1) AND IFLAG(2) OUTPUT TO H17A12
C COMBINES CHANNEL USAGE INFORMATION FOR HIRS 17-AMSU-A 12.
C
      H17A12 = IOR(IFLAG(1),IFLAG(2))
C
C IFLAG(2) IS RESET TO CHANNEL AVAILABILITIES FOR AMSU-A 1-15.
C
      CHFLAG(2) = RETANC(S(I),J,3)
C
C IFLAG(2) SHIFTED 44 BITS TO LEFT TO GET RID OF INFO FOR 
C AMSU-A 1-12, THEN SHIFTED 48 BITS TO RIGHT TO PUT CHANNEL
C AVAILABLITY INFO. FOR AMSU-A 13-15 IN BITS 15-13 OF IFLAG(2),
C AND ANY DATA PERTAINING TO AMSU-B IN BITS 12-8.
C
      IFLAG(2) = ISHFT(IFLAG(2),44)
      IFLAG(2) = ISHFT(IFLAG(2),-48)
C
C AVHRR CHANNEL AVAILABILITY (CHANNELS 1,2,3A,3B,4,5) IS
C SET IN BITS 7-2 OF IFLAG(2), AFTER WHICH A13AV6 IS SET
C TO IFLAG(2).
C
      LL = 8
      DO 50 KK = 53,143,18
         LL = LL - 1
         IF(.NOT. ISR4SPV(HIRDAT(II,JJ,KK))) IFLAG(2)=IBSET(IFLAG(2),LL)
   50 CONTINUE
      A13AV6 = IFLAG(2)
C
C RESCALING FOR EIGHT-BYTE TO TWO-BYTE CONVERSION.
C
      IF(HIR116.GT.32767)HIR116=HIR116-65536
      IF(H17A12.GT.32767)H17A12=H17A12-65536
      IF(A13AV6.GT.32767)A13AV6=A13AV6-65536
      CHCOMB(1:6) = CHAVIL(1:6)
      ODFBUF(44) = ITEMP
      ODFBUF(457) = HIR116
      ODFBUF(458) = H17A12
      ODFBUF(459) = A13AV6
C
C PACK THE SOLAR ZENITH ANGLE.
C
      IF(.NOT. ISR4SPV(HIRANC(II,JJ,3)))ODFBUF(34)=NINT(HIRANC(II,JJ,3)*128.0)
C
C PACK THE SATELLITE ZENITH ANGLE.
C
      IF(.NOT. ISR4SPV(HIRANC(II,JJ,5)))ODFBUF(35)=NINT(HIRANC(II,JJ,5)*128.0)
C
C PACK THE RETRIEVAL TEMPERATURE PROFILE (K).
C
      WORD = 44
      DO LEVEL = 1, 42
         WORD = WORD + 1
         IF (.NOT. ISR4SPV(RDATCY(LEVEL))) ODFBUF(WORD) = NINT(RDATCY(LEVEL) * 64.0)
      END DO
C
C CALL ROUTINE RTVHGT TO CALCULATE THE GEOPOTENTIAL HEIGHTS.
C
      CALL RTVHGT(RDATCY,PROFLV,PRFTLV,RDATCY(PRFTLV+1),PRFQLV,
     1            GEOHGT,GOHGKM,LAYERS)
C
C PACK THE GEOPOTENTIAL HEIGHTS (M).  THE FIRST 20 LEVELS ARE
C IN DECAMETERS, THE REMAINING LEVELS ARE IN METERS.  THIS IS
C TO BETTER CORRESPOND WITH THE PRODUCT FORMATTERS.
C
      WORD = 196
      DO LEVEL = 1, 42
         WORD = WORD + 1
         IF(.NOT. ISR4SPV(GEOHGT(LEVEL))) ODFBUF(WORD) = NINT(GEOHGT(LEVEL))
      END DO
C
C PACK THE WATER VAPOR MIXING RATIOS ALOG(G/KG).
C
      DUMOBS = 239
      DO 80 N = 1, PRFQLV
         NN = N+PRFTLV
         IF(.NOT. ISR4SPV(RDATCY(NN))) THEN
            IF(RDATCY(NN).LE.0.0) THEN
             WVMR(N) = R4SPV     
             GDDATA = .FALSE.
            ELSE
             WVMR(N) = ALOG(RDATCY(NN))
            ENDIF
         ELSE
            WVMR(N) = R4SPV     
         ENDIF
         IF(.NOT. ISR4SPV(WVMR(N))) THEN
          ODFBUF(DUMOBS) = NINT(WVMR(N) * 1024.0)
         ELSE
          ODFBUF(DUMOBS) = I2SPV
         ENDIF
         DUMOBS = DUMOBS + 1
   80 CONTINUE
C
C OBTAIN THE TROPOPAUSE TEMPERATURE AND PRESSURE WITH THE
C HEIGHT IN (KM).
C
      IF(GDDATA) THEN
         CALL TROPLV(PROFLV,GOHGKM,RDATCY,MAXRTV,TROTMP,TROPRS)
      ELSE
         TROTMP = R4SPV
         TROPRS = R4SPV
      ENDIF
C
C PACK THE TROPOPAUSE TEMPERATURE (K).
C
      IF(.NOT. ISR4SPV(TROTMP)) ODFBUF(258) = NINT(TROTMP * 64.0)
C
C PACK THE TROPOPAUSE PRESSURE (MB).
C
      IF(.NOT. ISR4SPV(TROPRS)) ODFBUF(259) = NINT(TROPRS)
C
C PACK THE RETRIEVED SURFACE TEMPERATURE (BT)
C
      IF(.NOT. ISR4SPV(RDATCY(62))) ODFBUF(326)=NINT(RDATCY(62)*64.0)
C
C PACK THE CLOUD LIQUID WATER
C
      IF(.NOT. ISR4SPV(AMAANC(AMASPT(II,JJ),AMALNE(II,JJ),10)))
     1   ODFBUF(438)=NINT(AMAANC(AMASPT(II,JJ),AMALNE(II,JJ),10)*64.0)
C
C
  100 CONTINUE
      RETURN
      END
