      SUBROUTINE CTPADJUST(SPOT,QCFLAG,CLDAMT,PTRANS,PCLOUD,BTHIRS,TPROFI,
     +                  CLDTMP,TROPRS,TROTMP,TCLEAR4,HEIGHT,RADT8C,
     +                  CCHRAD,RCCCTT,RCC8STE,RCCPC8,CONPCT,CPERROR,SFCPRS,
     +                  RADTC8,H8STE,NCH1,NCH2,
     +                  DELPRS8,TCLOUD,AEROSOL,AMSU6,
     +                  PEAKPR,DELPR1,DELPR2,DELPR3,
     +                  DELPR4,HBTCCL,DENOMTH,SFCTYP,
     +                  FOVLAT,RNUMERIN,RDENOMIN,
     +                  MINPRESS,CTPEXIT,CTPITER,
     +                  RCLOUD,MINECA,IBIAS,DELPRSX,
     +                  RADSTE,RADCLR,TVALUE)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME- CTPADJUST
C
C   LANGUAGE- FORTRAN         TYPE- SUBROUTINE      COMPUTER- AIX
C
C   VERSION- 1.0     DATE- 12/27/07      PROGRAMMER-  FRANK TILLEY (IMSG)
C
C   FUNCTION- THIS SUBROUTINE ADJUSTS CLOUD TOP PRESSURE BASED ON THE CLOUD
C             PRODUCT ERROR AND ATTEMPTS TO REDUCE THE CLOUD PRODUCT ERROR.
C             CLOUD TOP TEMPERATURE IS ADJUSTED BY CALCULATING THE TEMPERATURE
C             WHERE THE ADJUSTED CLOUD TOP PRESSURE FALLS IN THE RETRIEVED
C             TEMPERATURE PROFILE. THIS ROUTINE IS USED ONLY FOR CLOUD TOP
C             PRESSURES THAT ARE GREATER THAN THE TROPOPAUSE PRESSURE. THE
C             HIRS CHANNEL THAT PEAKS JUST ABOVE THE CLOUD TOP IS ASSUMED
C             TO BE 3 OR GREATER.
C
C
C   CALLING ARGUMENTS-
C   NAME    TYPE  I/O    DESCRIPTION
C   ----    ----  ---    -----------
C   SPOT      INT  I     HIRS SPOT NUMBER (1-4) IN THE 2X2 BOX FROM WHICH
C                        A RETRIEVAL WAS MADE.
C   QCFLAG    INT  I     INTEGER VALUE INDICATING THE CLOUD AMOUNT ALGORITHM
C                        USED TO GET THE ORIGINAL CLOUD AMOUNT.
C   CLDAMT   REAL  I     ORIGINAL CALCULATED CLOUD AMOUNT.
C   PTRANS   REAL  I     ARRAY OF HIRS CHANNEL TRANSMITTANCES AT
C                        RETRIEVAL LEVELS.
C   PCLOUD   REAL I/O    CALCULATED CLOUD TOP PRESSURE.
C   BTHIRS   REAL  I     HIRS BRIGHTNESS TEMPERATURES (IN)
C                        (HIRS CHANNEL 20 IS NOT USED)
C   TPROFI   REAL  I     TEMPERATURE PROFILE FROM RETRIEVAL.
C   TROPRS   REAL  I     TROPOPAUSE PRESSURE.
C   TROTMP   REAL  I     TROPOPAUSE TEMPERATURE.
C   TCLEAR4  REAL  I     ARRAY OF OBSERVED HIRS AND AMSU-A BRIGHTNESS TEMPERATURES.
C                        HIRS CHANNEL 2 THROUGH 8 ARE PREDICTED CLEAR.
C   HEIGHT    INT  I     TERRAIN HEIGHT AT THE HIRS SPOTS.
C   RADT8C   REAL  I     ORIGINAL PREDICTED CLEAR HIRS CHANNEL 8 RADIANCE.
C   CCHRAD   REAL I/O    CLOUD-CLEARED HIRS CHANNEL RADIANCES FOR CHANNELS
C                        1-19.
C   RCCCTT   REAL I/O    CLOUD-CLEARED CLOUD TOP TEMPERATURE RADIANCES.
C   RCC8STE  REAL I/O    CLOUD-CLEARED HIRS 8 SURFACE TEMPERATURE ESTIMATE RADIANCES.
C   RCCPC8   REAL I/O    CLOUD-CLEARED PREDICTED CLEAR HIRS CHANNEL 8 RADIANCES.
C   RCCPC8   REAL I/O    CLOUD-CLEARED PREDICTED CLEAR HIRS CHANNEL 8 RADIANCES
C   CONPCT   REAL  O     PERCENT OF CLOUD CONTAMINATION FOR EACH HIRS
C                        CHANNEL.
C   CPERROR  REAL I/O    CLOUD PRODUCT ERROR (CLOUD AMOUNT CALCULATED AFTER CLOUD
C                        CLEARING).
C   NCH1     INT   I     UPPER PEAKING CHANNEL USED TO GENERATE ORIGINAL CLOUD TOP
C                        TEMPERATURE.
C   NCH2     INT   I     LOWER PEAKING CHANNEL USED TO GENERATE ORIGINAL CLOUD TOP
C                        TEMPERATURE.
C   TCLOUD   REAL  O     EFFECTIVE CLOUD AMOUNT USING RECALCULATED CLOUD TOP
C                        TEMPERATURE.
C   AEROSOL   LOG  I     AEROSOL FLAG.
C   AMSU6    REAL  I     AMSU-A CHANNEL 6 BRIGHTNESS TEMPERATURE, USED IN THE
C                        AEROSOL CHECK.
C   PEAKPR   REAL  I     PRESSURES WHERE HIRS CHANNEL SENSITIVITY PEAKS FOR THE
C                        CURRENT TEMPERATURE PROFILE.
C   HBTCCL   REAL  O     CLOUD-CLEARED HIRS BRIGHTNESS TEMPERATURES (OUT)
C                        (HIRS CHANNEL 20 IS NOT USED)
C
C   COMMOM AREA PARAMETERS - SPVAL, RETPARM, PLCOEF
C
C   LOCAL VARIABLES
C   NAME      TYPE       DESCRIPTION
C   ----      ----       -----------
C
C   FUNCTIONS USED- PLKRAD
C
      REAL     PLKRAD, LINVAL, ECACPE
C
C***********************************************************************
C
      INCLUDE 'SPVAL'
      INCLUDE 'RETPARM'
      INCLUDE 'PLCOEF'
      INCLUDE 'RTPLVL'
C
      INTEGER SPOT, QCFLAG(4), HEIGHT(4), NCH1, NCH2
      INTEGER SFCTYP,CTPEXIT(15), CTPITER(4), IBIAS
C
      LOGICAL AEROSOL, ECAFLAG

      REAL    CLDAMT, PTRANS(PRFTLV,35), PCLOUD(4), BTHIRS(4,19)
      REAL    CCHRAD(4,19), RCCCTT(4), RCC8STE(4), TCLEAR4(4,27)
      REAL    RCCPC8(4), CONPCT(4,19), CPERROR(4), TPROFI(PRFTLV)
      REAL    TROPRS,SFCPRS, RADT8C, RADTC8, TVALUE
      REAL    H8STE(56,6),TROTMP,DENOMTH, DELPRS8(19)
      REAL    RCLOUD, MINECA, MAXECA
      REAL    CLDTMP(4), TCLOUD(4), AMSU6(4), PEAKPR(19)
      REAL    DELPR1,DELPR2(19),DELPR3(19),DELPR4(19)
      REAL    HBTCCL(4,19)
      REAL    FOVLAT
      REAL    RNUMERIN, RDENOMIN, MINPRESS, DELPR1ORIG
      REAL    DELPRSX, RADSTE
      REAL    RADCLR
C
      INTEGER I, ITER, QCFSAV, MINLEV, MAXITER, QC6ITER
      INTEGER LVL, LEVTRO, TOPLVL, CHAN, ONCH1, ONCH2, NCH1ORIGINAL
      INTEGER QC2ITER, ORIGINALQC
C
      REAL    SAMOUNT, TMPSAV, CASAVE
      REAL    RNUMER, RDENOM
      REAL    CPRESS, CTP, CPESAV
      REAL    NEWCTP, MAXPRS, SAMNEW, RNUMERSAV, RDENOMSAV
      REAL    CLDPRS(4)
      REAL    DELTACPE
      REAL    CPENEW, CTTNEW, DELTAPR
      REAL    SAVCPE

      REAL    CCHRADSAV(19), RCCCTTSAV, RCCPC8SAV, CONPCTSAV(19)
      REAL    DELPRS8SAV(19), DELPR1SAV, DELPR2SAV(19)
      REAL    DELPR3SAV(19), DELPR4SAV(19), HBTCCLSAV(19)
      REAL    CPEORIGINAL
      REAL    CTPORIGINAL, CAORIGINAL
      REAL    PRSDIFF, DPFACTOR
      REAL    CPEITER(100)
      REAL    ALTOVSP(PRFTLV), ALCTP


      LOGICAL INTERP, HITMAX
      LOGICAL ANTARCTIC, CPEINCREASED, ECAGTMAX
      LOGICAL DELPRSLT1, FLIPPED, CTPGTMAX, RCLOUDLE0, NEGRNUMER

      PARAMETER (MAXECA=1.03)


      DO I = 1, PRFTLV
         ALTOVSP(I) = ALOG(PROFLV(I))
      END DO

      DO I = 1, 100
         CPEITER(I) = 0.0
      END DO

      CPEINCREASED = .FALSE.
      ECAGTMAX = .FALSE.
      RCLOUDLE0 = .FALSE.
      NEGRNUMER = .FALSE.
      FLIPPED = .FALSE.

      MAXITER = 2

      QC2ITER = 2
      QC6ITER = 3
      IF (.NOT.(AEROSOL)) QC6ITER = 2

      CPEORIGINAL = CPERROR(SPOT)
      ORIGINALQC = QCFLAG(SPOT)

C

      IF (QCFLAG(SPOT).EQ.2.OR.QCFLAG(SPOT).EQ.5) MAXITER = QC2ITER

      DO I = 1, 6
         CPEITER(I) = R4SPV
      END DO


      CTPEXIT(13) = CTPEXIT(13) + 1

C     FIND THE ATOVS RETRIEVAL PRESSURE LEVEL CLOSEST TO THE
C     PRESSURE SPECIFIED AS MINPRESS.

      PRSDIFF = 9999.9
      MINLEV = 0
      DO LVL = 1, 40
         IF (ABS(MINPRESS-PROFLV(LVL)).LT.PRSDIFF) THEN
            PRSDIFF = ABS(MINPRESS-PROFLV(LVL))
            MINLEV = LVL
         END IF
      END DO
      NCH1ORIGINAL = NCH1

C
C-- SAVE THE ORIGINAL CLOUD TOP PRESSURE, CLOUD TOP TEMPERATURE,
C   AND CLOUD AMOUNT.

      NEWCTP = PCLOUD(SPOT)
      CTTNEW = CLDTMP(SPOT)
      SAMOUNT = CLDAMT

C
C-- SET THE 'ANTARCTIC' FLAG TO .TRUE. IF THE SPOT IS SOUTH OF
C   -70.0 AND TERRAIN HEIGHT IS GREATER THAN 1200 METERS.
C

      ANTARCTIC = .FALSE.
      IF (FOVLAT .LT. -70.0 .AND. HEIGHT(SPOT) .GT. 1200) THEN
          ANTARCTIC = .TRUE.
      END IF


C-- CALCULATE RADIANCES FROM THE OBSERVED HIRS CHANNEL
C   BRIGHTNESS TEMPERATURES.

      CPEORIGINAL = CPERROR(SPOT)
      CTPORIGINAL = PCLOUD(SPOT)
      CAORIGINAL  = CLDAMT
      DELPR1ORIG = DELPR1
      RCCCTTSAV = RCCCTT(SPOT)
      RCCPC8SAV = RCCPC8(SPOT)
      DELPR1SAV = DELPR1

      DO CHAN = 1, 19
         CCHRADSAV(CHAN) = CCHRAD(SPOT,CHAN)
         CONPCTSAV(CHAN) = CONPCT(SPOT,CHAN)
         DELPRS8SAV(CHAN) = DELPRS8(CHAN)
         DELPR2SAV(CHAN) = DELPR2(CHAN)
         DELPR3SAV(CHAN) = DELPR3(CHAN)
         DELPR4SAV(CHAN) = DELPR4(CHAN)
         HBTCCLSAV(CHAN) = HBTCCL(SPOT,CHAN)
      END DO

      CLDPRS(SPOT) = PCLOUD(SPOT)
      CPRESS = PCLOUD(SPOT)
      CPESAV = CPERROR(SPOT)
      CPENEW = CPERROR(SPOT)
      QCFSAV = QCFLAG(SPOT)
      TMPSAV = CLDTMP(SPOT)
      CASAVE = CLDAMT
      SAMOUNT = CLDAMT
      CTTNEW = CLDTMP(SPOT)
      HITMAX = .FALSE.
      DELPRSLT1 = .FALSE.

      ITER = 1
      DPFACTOR = 1.0
      INTERP  = .FALSE.

      ONCH1 = NCH1
      ONCH2 = NCH2
C

C-- SET THE MAXIMUM CLOUD TOP PRESSURE TO THE FORECAST SURFACE PRESSURE
C   OR 1000 MB, WHICHEVER IS LESS.

      IF (SFCPRS.LE.1000.0) THEN
         MAXPRS = SFCPRS
      ELSE
         MAXPRS = 1000.0
      END IF

      CTP = PCLOUD(SPOT)
      NEWCTP = PCLOUD(SPOT)

      IF (CTP.GE.MAXPRS) THEN
         CTPEXIT(2) = CTPEXIT(2) + 1
         GO TO 300
      END IF


C
C-- FIND THE ATOVS PRESSURE LEVEL JUST BELOW THE TROPOPAUSE
C

      LEVTRO = 0
      DO LVL = 1, 42
         IF (LEVTRO.EQ.0) THEN
            IF (PROFLV(LVL).GE.TROPRS) THEN
               LEVTRO = LVL
            END IF
         END IF
      END DO

      IF (LEVTRO.EQ.0) THEN
         PRINT *,'CTPADJUST: NO TROPOPAUSE LEVEL FOUND FOR TROPOPAUSE ',
     +           'PRESSURE ',TROPRS
         CTPEXIT(3) = CTPEXIT(3) + 1
         GO TO 400
      END IF
C
 10   CONTINUE

      CTP = CLDPRS(SPOT)
      CPESAV = CPERROR(SPOT)
      CPRESS = CTP
      TMPSAV = CTTNEW

C-- CALCULATE THE PRESSURE DELTA BASED ON THE CLOUD PRODUCT ERROR
C   CONSTRAIN THE PRESSURE DELTA TO A MAXIMUM OF 100 MB.

      IF (QCFLAG(SPOT).EQ.6.OR.QCFLAG(SPOT).EQ.3.OR.QCFLAG(SPOT).EQ.1) THEN
         IF (AEROSOL) THEN
            DELTAPR = (CTP*0.002) * (CPERROR(SPOT) * (285.0))
         ELSE
            IF (SFCTYP.EQ.0) THEN
               DELTAPR = (CTP*0.002) * (CPERROR(SPOT) * (285.0))
            ELSE
               DELTAPR = (CTP*0.002) * (CPERROR(SPOT) * (285.0))
            END IF
         END IF
      ELSE IF (QCFLAG(SPOT).EQ.2.OR.QCFLAG(SPOT).EQ.5) THEN
         DELTAPR = (CTP*0.002) * (CPERROR(SPOT) * (500.0))
      END IF
      IF (QCFLAG(SPOT).EQ.0) THEN
         IF (CPERROR(SPOT).LT.0.0) THEN
            DELTAPR = (CTP*0.006) * (CPERROR(SPOT) * (-285.0))
         ELSE
            DELTAPR = (CTP*0.003) * (CPERROR(SPOT) * (-285.0))
         END IF
      END IF


      IF (FLIPPED) THEN
         DELTAPR = DELTAPR * (-1.0)
      END IF

C ---------------------------------------------

      IF (SAMOUNT.LT.0.5.AND.ABS(DELTAPR).LT.10.0.AND.CTP.LT.950.0) THEN
         IF (DELTAPR.GE.0.0) THEN
            DELTAPR = 10.0
         ELSE
            DELTAPR = (-10.0)
         END IF
      END IF
C ---------------------------------------------

C-- DO NOT LIMIT DELTAPR FOR AEROSOLS WITH QCFLAG 6

      IF (HEIGHT(SPOT).GT.1600.AND.CPERROR(SPOT).GT.0.5) THEN
         IF (QCFLAG(SPOT).NE.6.AND.QCFLAG(SPOT).NE.3) THEN
            DELTAPR = DELTAPR * 0.6
         END IF
      END IF

15    CONTINUE

      DELTAPR = DELTAPR * DPFACTOR

      IF (ABS(DELTAPR).LT.1.0) THEN
         CTPEXIT(5) = CTPEXIT(5) + 1
         DELPRSLT1 = .TRUE.
         GO TO 350

         IF (INTERP) THEN
            GO TO 280
         ELSE
            GO TO 300
         END IF
      END IF


      NEWCTP = CTP + DELTAPR

C
C -- IF THE CLOUD TOP PRESSURE FOR AEROSOLS BECOMES LESS THAN THE
C    TROPOPAUSE PRESSURE, STOP AND RETURN WITH THE VALUES FROM THE
C    PREVIOUS ITERATION. (TRY SETTING TO TROPOPAUSE PRESS AND T

      IF ((QCFLAG(SPOT).EQ.2.OR.QCFLAG(SPOT).EQ.5).AND.NEWCTP.LT.TROPRS) THEN
         NEWCTP = TROPRS
         CTTNEW = TROTMP
         GO TO 200
      END IF
C
C -- IF THE CLOUD TOP PRESSURE BECOMES LESS THAN A SPECIFIED MINIMUM,
C    SET THE CTP TO THE SPECIFIED MINIMUM.
C    IF THE FLAG WAS ALREADY SET, FALL BACK TO THE PREVIOUS
C    ITERATION'S CLOUD PRODUCTS.
C
      IF (NEWCTP.LT.MINPRESS) THEN
         IF (ITER.EQ.1.AND.QCFLAG(SPOT).EQ.6) THEN
            DPFACTOR = DPFACTOR * (-1.0)
            GO TO 15
         END IF
         CTPEXIT(8) = CTPEXIT(8) + 1
         NEWCTP = MINPRESS
         IF (MINPRESS .EQ. TROPRS) THEN
            CTTNEW = TROTMP
         ELSE
            CTTNEW = TPROFI(MINLEV)
         END IF
         GO TO 200
      END IF

C
C-- DON'T LET THE CLOUD TOP PRESSURE GET TOO LARGE.
C
  20  CONTINUE
      IF (NEWCTP.GT.MAXPRS) THEN
         CTPGTMAX = .TRUE.
         DO WHILE (CTPGTMAX)
            DELTAPR = ABS(DELTAPR * 0.5)
            NEWCTP = CTP + DELTAPR
            IF (NEWCTP.LE.MAXPRS) CTPGTMAX = .FALSE.
         END DO
         IF ((MAXPRS-NEWCTP).LT.1.0) HITMAX = .TRUE.
      END IF


C
C-- OVER ANTARCTICA ABOVE 1200 METERS CONSTRAIN THE CLOUD TOP
C   PRESSURE TO BE NO LESS THAN THE TROPOPAUSE PRESSURE.
C
      IF (ANTARCTIC) THEN
         IF (NEWCTP.LT.TROPRS) THEN
            NEWCTP = TROPRS
         END IF
      END IF

C-- IF THE NEW CLOUD TOP PRESSURE IS AT THE TROPOPAUSE, ASSIGN
C   THE TROPOPAUSE TEMPERATURE AS THE CLOUD TOP TEMPERATURE.

      IF (NEWCTP.EQ.TROPRS) THEN
         CTTNEW = TROTMP
         GO TO 200
      END IF

C
C-- IF THE NEW CTP IS BETWEEN THE TROPOPAUSE AND THE FIRST ATOVS LEVEL
C   BELOW THE TROPOPAUSE, CALCULATE A NEW CTT USING THE TROPOPAUSE
C   TEMPERATURE AND THE TEMPERATURE AT THE ATOVS LEVEL SURFACEWARD OF
C   THE NEW CTP.

      IF (NEWCTP.GT.TROPRS) THEN
         IF (NEWCTP.LT.PROFLV(LEVTRO)) THEN

            CTTNEW =  TPROFI (LEVTRO) +  ( (ALOG(NEWCTP) - ALOG(PROFLV(LEVTRO)))
     +                * ((TROTMP - TPROFI(LEVTRO)) /
     +                  (ALOG(NEWCTP) - ALOG(PROFLV(LEVTRO)))) )
C
C-- IF THE NEW CTP IS BELOW THE FIRST ATOVS LEVEL BELOW THE TROPOPAUSE,
C   CALCULATE A NEW CTT BY INTERPOLATION.

         ELSE
            TOPLVL = 0
            DO LVL = LEVTRO, 42
               IF (NEWCTP.EQ.PROFLV(LVL)) THEN
                  CTTNEW = TPROFI(LVL)
                  GO TO 200
               END IF
               IF (TOPLVL.EQ.0) THEN
                  IF (NEWCTP.LT.PROFLV(LVL) ) THEN
                     TOPLVL = LVL - 1
                  END IF
               END IF
            END DO

            ALCTP = ALOG(NEWCTP)

            CTTNEW = LINVAL(ALTOVSP,TPROFI,PRFTLV,ALCTP)

         END IF
         GO TO 200
      END IF

C-- IF THE NEW CTP IS BETWEEN THE TROPOPAUSE AND THE FIRST ATOVS LEVEL ABOVE
C   THE TROPOPAUSE, USE A MODIFIED VERSION OF THE APPROACH USED TO CALCULATE CTT
C   BETWEEN THE TROPOPAUSE AND THE FIRST ATOVS LEVEL ABOVE THE TROPOPAUSE.

      IF (NEWCTP.LT.TROPRS) THEN
         IF (NEWCTP.GT.PROFLV(LEVTRO-1)) THEN

            CTTNEW =  TROTMP +  ( (ALOG(NEWCTP) - ALOG(PROFLV(LEVTRO-1)))
     +                * ((TROTMP - TPROFI(LEVTRO-1)) /
     +                  (ALOG(NEWCTP) - ALOG(PROFLV(LEVTRO-1)))) )
         ELSE
            TOPLVL = 0
            DO LVL = LEVTRO, 10, -1
               IF (NEWCTP.EQ.PROFLV(LVL)) THEN
                  CTTNEW = TPROFI(LVL)
                  GO TO 200
               END IF
               IF (TOPLVL.EQ.0) THEN
                  IF (NEWCTP.GT.PROFLV(LVL) ) THEN
                     TOPLVL = LVL
                  END IF
               END IF
            END DO

            ALCTP = ALOG(NEWCTP)
            CTTNEW = LINVAL(ALTOVSP,TPROFI,PRFTLV,ALCTP)

         END IF
      END IF

 200  CONTINUE

      RCLOUD = PLKRAD(CTTNEW,8)

C-- IF THE RADIANCE FROM THE CLOUD TOP TEMPERARTURE IS ZERO OR IS NEGATIVE,
C   RESTORE THE VALUES FROM THE PREVIOUS ITERATION AND STOP ITERATING.
C
      IF (RCLOUD.LE.0.0) THEN
         RCLOUDLE0 = .TRUE.
         GO TO 250
      END IF


      IF (QCFLAG(SPOT).EQ.0) THEN

         ECAFLAG = .TRUE.
         SAMNEW = ECACPE(QCFLAG(SPOT),RADTC8,RCLOUD,RADSTE,
     +                   ECAFLAG,RNUMER,RDENOM,RADCLR,
     +                   SFCTYP,MINECA,TVALUE)
         IF (RNUMER .LT. 0.0) THEN
             NEGRNUMER = .TRUE.
             GO TO 250
         END IF
C-- IF THE NEW ECA IS GREATER THAN THE MAXIMUM ALLOWED FALL BACK TO THE 
C   PREVIOUS ITERATION UNLESS THE ORIGINAL ECA WAS GREATER THAN THE MAXIMUM
C   ALLOWED AND THE NEW ECA IS LESS THAN THE ORIGINAL ECA.
C
         IF (SAMNEW.GT.MAXECA) THEN
            IF (SAMNEW.GT.CAORIGINAL) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
            IF (CAORIGINAL.LE.MAXECA) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
         END IF

         IF (QCFLAG(SPOT).EQ.6) GO TO 210
         IF (QCFLAG(SPOT).EQ.(-1).OR.QCFLAG(SPOT).EQ.7) THEN
            GO TO 350
         END IF

         IF (RDENOM .LT. 22.0 .AND. SAMNEW .GT. 1.4) THEN
            GO TO 250
         END IF

         IF (SAMNEW.LT.0.0.OR.(SAMNEW.GT.MAXECA.AND.
     +       SAMNEW.GE.CASAVE)) THEN
            SAMOUNT = CASAVE
            NEWCTP = CLDPRS(SPOT)
            CTTNEW = TMPSAV
            ITER = ITER -1
            GO TO 300
         END IF
C
         IF (SAMNEW.LT.MINECA) THEN
            IF (QCFLAG(SPOT).EQ.0) THEN
               QCFLAG(SPOT) = -1
            END IF
            GO TO 350
         ELSE
            SAMOUNT = SAMNEW
         END IF

      END IF

      IF (QCFLAG(SPOT).EQ.2.OR.QCFLAG(SPOT).EQ.5) THEN

C-- CALCULATE A NEW NUMERATOR USING THE RADIANCE FROM THE NEW CLOUD
C   TOP TEMPERATURE FOR AEROSOLS.

         ECAFLAG = .TRUE.
         SAMNEW = ECACPE(QCFLAG(SPOT),RADTC8,RCLOUD,RADSTE,
     +                   ECAFLAG,RNUMER,RDENOM,RADCLR,
     +                   SFCTYP,MINECA,TVALUE)
         IF (RNUMER .LT. 0.0) THEN
             NEGRNUMER = .TRUE.
             GO TO 250
         END IF
C-- IF THE NEW ECA IS GREATER THAN THE MAXIMUM ALLOWED FALL BACK TO THE 
C   PREVIOUS ITERATION UNLESS THE ORIGINAL ECA WAS GREATER THAN THE MAXIMUM
C   ALLOWED AND THE NEW ECA IS LESS THAN THE ORIGINAL ECA.
C
         IF (SAMNEW.GT.MAXECA) THEN
            IF (SAMNEW.GT.CAORIGINAL) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
            IF (CAORIGINAL.LE.MAXECA) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
         END IF
         
         IF (QCFLAG(SPOT).EQ.6.OR.QCFLAG(SPOT).EQ.3) GO TO 210
         IF (QCFLAG(SPOT).EQ.(-1).OR.QCFLAG(SPOT).EQ.7) THEN
            GO TO 350
         END IF

         IF (SAMNEW .GT. 0.65) THEN
            SAMOUNT = CASAVE
            NEWCTP = CLDPRS(SPOT)
            CTTNEW = TMPSAV
            ITER = ITER -1
            GO TO 300
         END IF

         IF (SAMNEW.LT.0.0.OR.(SAMNEW.GT.MAXECA.AND.
     +       SAMNEW.GE.CASAVE)) THEN
            SAMOUNT = CASAVE
            NEWCTP = CLDPRS(SPOT)
            CTTNEW = TMPSAV
            ITER = ITER -1
            GO TO 300
         END IF
         IF (SAMNEW .LT. MINECA) THEN
            QCFLAG(SPOT) = -1
            GO TO 350
         END IF

         IF (SAMNEW.GT.0.0) THEN
            SAMOUNT = SAMNEW
         ELSE
C
C  IF THE NEW CLOUD AMOUNT IS NEGATIVE, USE THE PREVIOUS
C  CLOUD AMOUNT AND CLOUD TOP TEMPERATURE AND BAIL OUT.
C
            NEWCTP = CLDPRS(SPOT)
            CTTNEW = TMPSAV
            GO TO 350
         END IF
      END IF

 210  CONTINUE
      IF (QCFLAG(SPOT).EQ.6.OR.QCFLAG(SPOT).EQ.1.OR.QCFLAG(SPOT).EQ.3) THEN
         MAXITER = QC6ITER
         ECAFLAG = .TRUE.
         SAMNEW = ECACPE(QCFLAG(SPOT),RADTC8,RCLOUD,RADSTE,
     +                   ECAFLAG,RNUMER,RDENOM,RADCLR,
     +                   SFCTYP,MINECA,TVALUE)
         IF (RNUMER .LT. 0.0) THEN
             NEGRNUMER = .TRUE.
             GO TO 250
         END IF
C-- IF THE NEW ECA IS GREATER THAN THE MAXIMUM ALLOWED FALL BACK TO THE 
C   PREVIOUS ITERATION UNLESS THE ORIGINAL ECA WAS GREATER THAN THE MAXIMUM
C   ALLOWED AND THE NEW ECA IS LESS THAN THE ORIGINAL ECA.
C
         IF (SAMNEW.GT.MAXECA) THEN
            IF (SAMNEW.GT.CAORIGINAL) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
            IF (CAORIGINAL.LE.MAXECA) THEN
               ECAGTMAX = .TRUE.
               GO TO 290
            END IF
         END IF

         IF (QCFLAG(SPOT).EQ.7) GO TO 350

         IF (SAMNEW.LT.0.0.OR.(SAMNEW.GT.MAXECA.AND.
     +       SAMNEW.GE.CASAVE)) THEN
            SAMOUNT = CASAVE
            NEWCTP = CLDPRS(SPOT)
            CTTNEW = TMPSAV
            ITER = ITER -1
            GO TO 300
         END IF
         IF (SAMNEW.LT.MINECA) THEN
            IF (CPERROR(SPOT).LT.0.05) THEN
               GO TO 350
            ELSE
               QCFLAG(SPOT) = 7
               GO TO 350
            END IF
         END IF
         SAMOUNT = SAMNEW
      END IF

C
C-- IF THE EFFECTIVE CLOUD AMOUNT IS GREATER THAN 3.0, STOP AND USE
C   THE CLOUD PRODUCTS FROM THE PREVIOUS ITERATION.
C
      IF (SAMOUNT.GT.3.0) THEN
         CTPEXIT(4) = CTPEXIT(4) + 1
         GO TO 250
      END IF
C
C-- SAVE THE NEW CLOUD TOP PRESSURE FOR THE CALL TO GETERR
C

      CLDPRS(SPOT) = NEWCTP
C
C-- SELECT A NEW CHANNEL PAIR, IF NECESSARY, BASED ON THE NEW CTP
C
      ONCH1 = NCH1
      ONCH2 = NCH2
      IF (NCH2.GT.3) THEN
         IF (PEAKPR(3).LE.NEWCTP.AND.PEAKPR(4).GT.NEWCTP) THEN
            NCH1 = 3
            NCH2 = 4
         ELSE IF (PEAKPR(4).LE.NEWCTP.AND.PEAKPR(5).GT.NEWCTP) THEN
            NCH1 = 4
            NCH2 = 5
         ELSE IF (PEAKPR(5).LE.NEWCTP.AND.PEAKPR(6).GT.NEWCTP) THEN
            IF (HEIGHT(SPOT).GT.2280) THEN
               NCH1 = 4
               NCH2 = 5
            ELSE
               NCH1 = 5
               NCH2 = 6
            END IF
            NCH2 = 6
         ELSE IF (PEAKPR(6).LE.NEWCTP.AND.PEAKPR(7).GT.NEWCTP) THEN
            IF (HEIGHT(SPOT).GT.1600) THEN
               NCH1 = 5
               NCH2 = 6
            ELSE
               NCH1 = 6
               NCH2 = 7
            END IF
         ELSE IF (NEWCTP.GT.PEAKPR(6)) THEN
            NCH1 = 6
            NCH2 = 8
         END IF
      END IF
C
      CALL GETERR(SPOT,QCFLAG,SAMOUNT,PTRANS,CLDPRS,BTHIRS,TROPRS,
     +            TCLEAR4,HEIGHT,RADT8C,CCHRAD,RCCCTT,RCC8STE,RCCPC8,
     +            CONPCT,CPERROR,SFCPRS,RADTC8,H8STE,NCH1,NCH2,
     +            DELPRS8,AMSU6,PEAKPR,DELPR1,DELPR2,DELPR3,DELPR4,
     +            HBTCCL,DENOMTH,SFCTYP,FOVLAT,RCLOUD,IBIAS,
     +            DELPRSX,RNUMER,RDENOM,RADCLR,MINECA,TVALUE)


      CPENEW = CPERROR(SPOT)

      RNUMERSAV = RNUMER
      RDENOMSAV = RDENOM

      CPEITER(ITER) = CPENEW
      SAVCPE = CPESAV
C
C-- IF THE CPE IS SMALL AND THE CPE CHANGES BY A SMALL AMOUNT,
C   STOP ITERATING.
C
      IF (ITER.GT.1) THEN
         IF ((CPEITER(ITER-1).GT.0.0.AND.CPEITER(ITER).GT.0.0) .OR.
     +       (CPEITER(ITER-1).LT.0.0.AND.CPEITER(ITER).LT.0.0)) THEN
             DELTACPE = ABS(CPEITER(ITER-1)) - ABS(CPEITER(ITER))
         ELSE
             DELTACPE = ABS(CPEITER(ITER-1)) + ABS(CPEITER(ITER))
         END IF
         IF (ABS(DELTACPE).LT.0.005.AND.ABS(CPEITER(ITER)).LE.0.02) THEN
            GO TO 300
         END IF
      END IF


C
C-- IF THE CPE CHANGES SIGN, CUT THE CTP DELTA IN HALF AND GO BACK
C   TO RE-CALCULATE CTT, ECA, AND CPE.

      IF ((CPENEW.GT.0.0.AND.SAVCPE.LT.0.0).OR.(CPENEW.LT.0.0.AND.
     +      SAVCPE.GT.0.0)) THEN
         IF (ABS(CPENEW).LE.0.05.OR.ABS(SAVCPE).LE.0.05) THEN
            IF (ABS(SAVCPE).LT.ABS(CPENEW)) THEN
               IF (ABS(SAVCPE).LE.0.05) THEN
                  GO TO 250
               END IF
            END IF
            IF (ABS(CPENEW).LT.ABS(SAVCPE)) THEN
               IF (ABS(CPENEW).LE.0.05) THEN
                  GO TO 350
               END IF
            END IF
         END IF
         IF (.NOT.(FLIPPED)) THEN
            DELTAPR = DELTAPR *(-0.5)
         END IF
         CTP = CLDPRS(SPOT)
         INTERP = .TRUE.
         FLIPPED = .TRUE.
         IF (ITER+1.LE.MAXITER) THEN
            ITER = ITER + 1
            GO TO 15
         END IF
      END IF
C
C-- IF CTP ADJUSTMENT MAKES CPE LARGER, REVERT TO THE ORIGINAL
C   VALUES UNLESS THE ORIGINAL CPE WAS ALREADY LARGE. ALSO REVERT
C   TO THE PREVIOUS SET OF VALUES IF ADJUSTING PRESSURE RESULTS
C   IN AN ECA THAT IS TOO SMALL.
C
 250  CONTINUE
      IF (DELPRSLT1 .OR. CPEINCREASED .OR. RCLOUDLE0 .OR. NEGRNUMER) THEN
         SAMOUNT = CASAVE
         NEWCTP = CLDPRS(SPOT)
         CTTNEW = TMPSAV
         CPERROR(SPOT) = SAVCPE
         QCFLAG(SPOT) = QCFSAV
         RCCCTT(SPOT) = RCCCTTSAV
         RCCPC8(SPOT) = RCCPC8SAV
         DELPR1 = DELPR1SAV
         DO CHAN = 1, 19
            CCHRAD(SPOT,CHAN) = CCHRADSAV(CHAN)
            CONPCT(SPOT,CHAN) = CONPCTSAV(CHAN)
            DELPRS8(CHAN) = DELPRS8SAV(CHAN)
            DELPR2(CHAN) = DELPR2SAV(CHAN)
            DELPR3(CHAN) = DELPR3SAV(CHAN)
            DELPR4(CHAN) = DELPR4SAV(CHAN)
            HBTCCL(SPOT,CHAN) = HBTCCLSAV(CHAN)
         END DO
         NCH1 = ONCH1
         NCH2 = ONCH2
         ITER = ITER - 1
         GO TO 300
      END IF
C
C  IF THE CLOUD PRODUCT ERROR INCREASES ON ITER 1, TRY CUTTING
C  THE PRESSURE DELTA IN HALF AND REVERSE THE DIRECTION OF THE
C  CTP ADJUSTMENT, STARTING WITH THE ORIGINAL CTP AND CPE
C
      IF (ABS(CPENEW).GT.ABS(SAVCPE)) THEN
         IF (ITER.EQ.1.AND.(.NOT.(FLIPPED)).AND.((CPENEW.GT.0.0.AND.SAVCPE.GT.0.0).OR.
     +       (CPENEW.LT.0.0.AND.SAVCPE.LT.0.0))) THEN
            CTP = CTPORIGINAL
            CPERROR(SPOT) = CPEORIGINAL
            CTTNEW = TMPSAV
            FLIPPED = .TRUE.
            DELTAPR = DELTAPR * (-0.5)
            ITER = ITER + 1
            GO TO 15
         END IF
      END IF
C
C  DO NOT LET THE CLOUD PRODUCT ERROR INCREASE.
C
 280  CONTINUE
      IF (ABS(CPENEW).GT.ABS(SAVCPE)) THEN
         IF (ITER+1 .LE. MAXITER.AND.(.NOT.(FLIPPED))) THEN
            IF (.NOT.(HITMAX)) THEN
               CTP = CPRESS
               DELTAPR = DELTAPR *(0.5)
               ITER = ITER + 1
               GO TO 15
            END IF
         ELSE
            CPEINCREASED = .TRUE.
         END IF
      END IF

 290  CONTINUE
C
C-- IF THE CPE INCREASED OR ECA EXCEEDS MAXECA RESTORE THE PREVIOUS VALUES
C   AND RETURN.
C
      IF (CPEINCREASED.OR.ECAGTMAX) THEN
         NEWCTP = CPRESS
         CPERROR(SPOT) = SAVCPE
         SAMOUNT = CASAVE
         CTTNEW = TMPSAV
         RCCCTT(SPOT) = RCCCTTSAV
         RCCPC8(SPOT) = RCCPC8SAV
         DELPR1 = DELPR1SAV
         DO CHAN = 1, 19
            DELPRS8(CHAN) = DELPRS8SAV(CHAN)
            DELPR2(CHAN) = DELPR2SAV(CHAN)
            DELPR3(CHAN) = DELPR3SAV(CHAN)
            DELPR4(CHAN) = DELPR4SAV(CHAN)
            CCHRAD(SPOT,CHAN) = CCHRADSAV(CHAN)
            CONPCT(SPOT,CHAN) = CONPCTSAV(CHAN)
            DELPRS8(CHAN) = DELPRS8SAV(CHAN)
            DELPR2(CHAN) = DELPR2SAV(CHAN)
            DELPR3(CHAN) = DELPR3SAV(CHAN)
            DELPR4(CHAN) = DELPR4SAV(CHAN)
            HBTCCL(SPOT,CHAN) = HBTCCLSAV(CHAN)
         END DO

         IF (CPEINCREASED) CTPEXIT(10) = CTPEXIT(10) + 1
         IF (ITER.EQ.1) CTPEXIT(7) = CTPEXIT(7) + 1
         NCH1 = ONCH1
         NCH2 = ONCH2
         GO TO 300
      END IF
C
C-- SAVE OUTPUT FROM GETERR JUST IN CASE ITERATION REQUIRES USING
C   SAVED VALUES BECAUSE ITERATION CAUSES CLOUD PRODUCT ERROR TO
C   INCREASE.
C
      RCCCTTSAV = RCCCTT(SPOT)
      RCCPC8SAV = RCCPC8(SPOT)
      DELPR1SAV = DELPR1
      DO CHAN = 1, 19
         CCHRADSAV(CHAN) = CCHRAD(SPOT,CHAN)
         CONPCTSAV(CHAN) = CONPCT(SPOT,CHAN)
         DELPRS8SAV(CHAN) = DELPRS8(CHAN)
         DELPR2SAV(CHAN) = DELPR2(CHAN)
         DELPR3SAV(CHAN) = DELPR3(CHAN)
         DELPR4SAV(CHAN) = DELPR4(CHAN)
         HBTCCLSAV(CHAN) = HBTCCL(SPOT,CHAN)
      END DO
      CPESAV = CPENEW
C

      CASAVE = SAMOUNT

      IF ((ITER+1) .LE. MAXITER .AND.(.NOT.(HITMAX))) THEN
         ITER = ITER + 1
         GO TO 10
      END IF
 300  CONTINUE

C

 350  CONTINUE


 400  CONTINUE

      IF (ITER.EQ.MAXITER) THEN
         CTPEXIT(12) = CTPEXIT(12) + 1
      END IF
      PCLOUD(SPOT) = NEWCTP
      CLDTMP(SPOT) = CTTNEW
      CLDAMT = SAMOUNT
      TCLOUD(SPOT) = SAMOUNT
      RCLOUD = PLKRAD(CLDTMP(SPOT),8)

      CTPITER(SPOT) = ITER
      IF (CTPITER(SPOT).EQ.0) THEN
         QCFLAG(SPOT) = ORIGINALQC
         CPERROR(SPOT) = CPEORIGINAL
         PCLOUD(SPOT) = CTPORIGINAL
         TCLOUD(SPOT) = CAORIGINAL
         DELPR1 = DELPR1ORIG
      END IF

      IF (QCFLAG(SPOT).EQ.6.OR.QCFLAG(SPOT).EQ.1.OR.QCFLAG(SPOT).EQ.3) THEN
         IF (SFCTYP.EQ.0) THEN
            IF (PCLOUD(SPOT).GE.MAXPRS) THEN
               QCFLAG(SPOT) = 7
               PCLOUD(SPOT) = R4SPV
               CLDTMP(SPOT) = R4SPV
               TCLOUD(SPOT) = 0.0
               CTPEXIT(6) = CTPEXIT(6) + 1
            END IF
         END IF
      END IF

      IF (QCFLAG(SPOT).EQ.7) THEN
         CTPEXIT(6) = CTPEXIT(6) + 1
      END IF

      RETURN
      END
