      SUBROUTINE CCHIRS(SAMOUNT,PTRANS,PCLOUD,SFCPRS,HIRSBTS,HIRRAD,PCTCON,
     +                  DELPRS8,NCH1,SPOT,TCLEAR4,AMSU6,
     +                  PEAKPR,TROPRS,DELPR1,DELPR2,DELPR3,DELPR4,SFCTYP,
     +                  HEIGHT,DELPRSX8,QCFLAG,FOVLAT)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME- CCHIRS
C
C   LANGUAGE- FORTRAN         TYPE- SUBROUTINE      COMPUTER- AIX
C
C   VERSION- 1.0     DATE- 03/03/06      PROGRAMMER-  FRANK TILLEY (ERT)
C
C   FUNCTION- THIS SUBROUTINE COMPUTES CLOUD-CLEARED HIRS BRIGHTNESS
C             TEMPERATURES USING THE CALCULATED CLOUD AMOUNT AND CLOUD
C             TOP PRESSURE FOR A GIVEN HIRS SPOT AND THE TRANSMITTANCES
C             FROM THE ASSOCIATED TEMPERATURE RETRIEVAL.
C
C   CALLING ARGUMENTS-
C   NAME    TYPE  I/O    DESCRIPTION
C   ----    ----  ---    -----------
C   SAMOUNT  REAL  I     CALCULATED CLOUD AMOUNT.
C   PTRANS   REAL  I     ARRAY OF HIRS CHANNEL TRANSMITTANCES AT
C                        RETRIEVAL LEVELS.
C   PCLOUD   REAL  I     CALCULATED CLOUD TOP PRESSURE
C   FCSPRS   REAL  I     FORECAST SURFACE PRESSURE
C   SPOT     INT   I     SPOT (RANGE 1-4) BEING PROCESSED
C   HIRSBTS  REAL I/O    HIRS BRIGHTNESS TEMPERATURES (IN) AND
C                        CLOUD-CLEARED HIRS BRIGHTNESS TEMPERATURES (OUT)
C                        (HIRS CHANNEL 20 IS NOT USED)
C   HIRRAD   REAL  O     CLOUD-CLEARED HIRS CHANNEL RADIANCES FOR CHANNELS
C                        1-19.
C   PCTCON   REAL  O     PERCENT OF CLOUD CONTAMINATION FOR EACH HIRS
C                        CHANNEL.
C   NCH1     INT   I     UPPER PEAKING CHANNEL OF THE HIRS CHANNEL PAIR
C   SPOT     INT   I     INDEX INTO THE TCLEAR4 AND XTBX ARRAYS
C   TCLEAR4  REAL  I     ARRAY OF CLW ADJUSTED PREDICTED CLEAR HIRS
C                        TEMPERATURES.
C   PEAKPR   REAL  I     PRESSURES WHERE HIRS CHANNEL SENSITIVITY PEAKS FOR
C                        THIS TEMPERATURE PROFILE.
C   TROPRS   REAL  I     TROPOPAUSE PRESSURE
C   SFCTYP   INT   I     SURFACE TYPE
C   HEIGHT   INT   I     TERRAIN HEIGHT
C
C   COMMOM AREA PARAMETERS - SPVAL, RETPARM, RTPLVL, PLCOEF
C
C   LOCAL VARIABLES
C   NAME      TYPE       DESCRIPTION
C   ----      ----       -----------
C   CHAN       INT       HIRS CHANNEL NUMBER USED AS AN INDEX
C   CHPLVL     INT       ATOVS LEVEL BELOW WHICH PERCENT CONTAMINATION
C                        IS IGNORED IF THE CLOUD TOP PRESSURE EXCEEDS
C                        THE RETRIEVAL PRESSURE AT THAT LEVEL.
C                        THIS AFFECTS CHANNELS 1, 2, AND 12.
C   CLDAMT    REAL       LOCAL COPY OF CALCULATED CLOUD AMOUNT.
C   CLDTRN    REAL       SUM OF CHANNEL TRANSMITTANCES BELOW THE
C                        CLOUD TOP PRESSURE.
C   CLOUDP    REAL       LOCAL COPY OF CLOUD TOP PRESSURE, CONSTRAINED
C                        TO A MAXIMUM OF 1000 MB.
C   DELPRS    REAL       NATURAL LOG OF THE FORECAST SURFACE PRESSURE
C                        MINUS THE NATURAL LOG OF THE CLOUD TOP PRESSURE
C   I          INT       LOOP INDEX
C   LVL        INT       PRESSURE LEVEL INDEX
C   LVLCTP     INT       LEVEL WITHIN THE RETRIEVAL PRESSURE ARRAY
C                        CORRESPONDING TO THE CLOUD TOP PRESSURE.     
C   PDELTA    REAL       DIFFERENCE BETWEEN PRSDN AND PRSUP
C   PRSDN     REAL       PRESSURE AT THE RETRIEVAL LEVEL JUST BELOW
C                        THE CLOUD TOP.
C   PRSPCT    REAL       PERCENTAGE OF THE CLOUD TOP LAYER REPRESENTED
C                        BY THE CLOUD TOP PRESSURE.
C   PRSUP     REAL       PRESSURE AT THE RETRIEVAL LEVEL JUST ABOVE
C                        THE CLOUD TOP.
C   TOTTRN    REAL       SUM OF CHANNEL TRANSMITTANCES FOR THE
C                        ENTIRE PRESSURE PROFILE.
C
C   FUNCTIONS USED- PLKRAD, IPLKRD
C
C***********************************************************************
C
      INCLUDE 'SPVAL'
      INCLUDE 'RETPARM'
      INCLUDE 'RTPLVL'
      INCLUDE 'PLCOEF'
C
      REAL    DELPRSX, DELPRSX8, FOVLAT
      REAL    DELPR1, DELPR2(19), DELPR3(19), DELPR4(19), SFCPRS
      REAL    SAMOUNT, PTRANS(PRFTLV,35),PCLOUD(4),HIRSBTS(19),HIRRAD(19)
      REAL    TOTTRN, CLDTRN, PCTCON(19), PRSDN, PRSUP, PRSPCT, DELPRS1
      REAL    DELPRS2, DELPRS3, TROPRS, DELPRS4, DELPRSA, DELPRS5
      REAL    DELPRS6, DELPRS7, DELPRS, DELPRS9, DELPRSR
      REAL    PDELTA, CLDAMT, FCSPRS, PEAKPR(19),TCLEAR4(4,27)
      REAL    IPLKRD, PLKRAD, CLOUDP, DELPRS8(19), AMSU6(4)
      REAL    DELPRS10, DELPRS11, DELPRS12, DELPRS13, DELPRSE, DELPRSF
      REAL    DELPRSC, DELPRSD, DELPRS2A, DELPRSC2, DELPRSG, DELPRSH
      REAL    DELPRSJ, DELPRSK, DELPRSL, DELPRSM, DELPRSN, DELPRSW
      REAL    DELPRSP, DELPRSV, DELPRSU, DELPRST, DELPRSQ
      REAL    THRESH, PCLEAR2, PCLEAR3, MEAS2, MEAS3
 
      INTEGER LVLCTP, I, CHAN, LVL, NCH1, SPOT, SFCTYP, HEIGHT, QCFLAG(4)

      LOGICAL ISR4SPV


      FCSPRS = SFCPRS
      DELPRSX = 0.0
      DELPRSX8 = 0.0

C
      DELPR1 = R4SPV
      DO I = 1, 19
         DELPR2(I) = R4SPV
         DELPR3(I) = R4SPV
         DELPR4(I) = R4SPV
         DELPRS8(I) = R4SPV
      END DO
      CLDAMT = SAMOUNT

      CLOUDP = PCLOUD(SPOT)      
      PRSPCT = 0.0
      TOTTRN = 0.0
      CLDTRN = 0.0

      PCLEAR2 = TCLEAR4(SPOT,2)
      PCLEAR3 = TCLEAR4(SPOT,3)
      MEAS2 = HIRSBTS(2)
      MEAS3 = HIRSBTS(3)
C
      IF (CLOUDP.LT.PROFLV(2)) THEN
c        PRINT *,'CCHIRS: CLOUDP = ',CLOUDP
         GO TO 900
      END IF
C
      IF (CLOUDP.GT.1000.0) CLOUDP = 1000.0

C
C-- FIND THE RETRIEVAL LEVEL CORRESPONDING TO THE CLOUD TOP
C   PRESSURE. IF THE CLOUD TOP PRESSURE IS GREATER THAN 1000 MB
C   SET THE RETRIEVAL LEVEL TO 40 (1000 MB).
C
      LVLCTP = 0
      DO I = 1, 40
         IF (PROFLV(I).GE.CLOUDP) THEN
            IF (LVLCTP.EQ.0) LVLCTP = I
         END IF
      END DO
c     IF (LVLCTP.LT.1) then
c        print *,'LVLCTP ',LVLCTP,' CLOUDP ',CLOUDP
c     END IF
      IF (LVLCTP.EQ.0) GO TO 900
      IF (LVLCTP.GT.40) then
         print *,'LVLCTP ',LVLCTP
         stop
      end if
      IF (CLOUDP.GT.PROFLV(40)) LVLCTP = 40
C
C
C-- DETERMINE THE RETRIEVAL PRESSURES BRACKETING THE CLOUD
C   TOP PRESSURE.
C
      PRSDN = PROFLV(LVLCTP)
      PRSUP = PROFLV(LVLCTP-1)
      PDELTA = PRSDN-PRSUP
C
C-- CALCULATE THE PERCENTAGE OF THE LAYER REPRESENTED BY THE
C   CLOUD TOP PRESSURE
C
      IF (CLOUDP.LT.PRSDN) THEN
         PRSPCT = (PRSDN-CLOUDP) / PDELTA
      END IF


      DELPRS1 = (ALOG(FCSPRS)-ALOG(CLOUDP)) /
     +                        ALOG(FCSPRS) 

      DELPR1 = DELPRS1
C
C-- LOOP THROUGH THE HIRS CHANNELS
C
      DO 800 CHAN = 1, 19
C
C-- CALCULATE THE SUM OF TRANSMITTANCES FOR THIS CHANNEL FOR THE ENTIRE
C   PRESSURE PROFILE.
C        
         TOTTRN = 0.0
         CLDTRN = 0.0
C
C-- DO NOT CALCULATE PERCENT CONTAMINATION FOR CHANNELS WHERE THE CLOUD
C   TOP IS LOWER IN THE ATMOSPHERE THAN THE CHANNEL CAN SENSE.
C
c        IF (CLOUDP.GT.PEAKPR(CHAN)) GO TO 700
C
         DO LVL = 1, 40
            IF (PTRANS(LVL,CHAN).GT.0.0) THEN
               TOTTRN = TOTTRN + (1.0 - (PTRANS(LVL,CHAN)))
            END IF
         END DO
C
C-- CALCULATE THE SUM OF THE TRANSMITTANCES BETWEEN THE SURFACE AND THE
C   CLOUD TOP PRESSURE FOR THIS CHANNEL. INCLUDE THE PARTIAL LAYER
C   (IF ANY) AROUND THE CLOUD TOP PRESSURE.
C
         DO LVL = LVLCTP, 40
            IF (PTRANS(LVL,CHAN).GT.0.0) THEN
               CLDTRN = CLDTRN + (1.0 - (PTRANS(LVL,CHAN)))
            END IF
         END DO
         IF (PRSPCT.GT.0.0) THEN
            IF ((.NOT.(ISR4SPV(PTRANS(LVLCTP,CHAN)))).AND.
     +          (.NOT.(ISR4SPV(PTRANS(LVLCTP-1,CHAN))))) THEN
               CLDTRN = CLDTRN + (ABS(1.0 - PTRANS(LVLCTP,CHAN))
     +         - (1.0 - PTRANS(LVLCTP-1,CHAN))) * PRSPCT
            END IF
         END IF
C
C-- CALCULATE THE PERCENT OF CLOUD CONTAMINATION FOR THIS CHANNEL BY
C   DIVIDING THE SUM OF THE PROFILE TRANSMITTANCES INTO THE SUM OF
C   TRANSMITTANCES BELOW THE CLOUD TOP.
C
  700    CONTINUE
         PCTCON(CHAN) = 0.0 
         IF (TOTTRN.GT.0.0.AND.CLDTRN.GT.0.0) THEN
            PCTCON(CHAN) = CLDTRN / TOTTRN
         END IF
C
C-- CALCULATE THE CLOUD-CLEARED BRIGHTNESS TEMPERATURE FOR THIS CHANNEL.
C   CONVERT THE HIRS CHANNEL BRIGHTNESS TEMPERATURE TO RADIANCE AND
C   APPLY CLOUD CLEARING TO THE RADIANCE BEFORE CONVERTING IT BACK TO
C   BRIGHTNESS TEMPERATURE.
C
         HIRRAD(CHAN) = R4SPV   
         IF (.NOT. ISR4SPV(HIRSBTS(CHAN))) THEN
            HIRRAD(CHAN) = PLKRAD(HIRSBTS(CHAN),CHAN)
            IF (PCTCON(CHAN).GT.0.0) THEN
               DELPRS2 = (ALOG(PEAKPR(CHAN)) - ALOG(CLOUDP)) /
     +                   ALOG (PEAKPR(CHAN))
               DELPRS2A = (ALOG(PEAKPR(CHAN)) - ALOG(CLOUDP)) /
     +                   ALOG(FCSPRS)
               DELPRS3 = ALOG(PEAKPR(CHAN))/ ALOG(CLOUDP)
               DELPRS4 = ALOG(FCSPRS) / ALOG(CLOUDP)
               DELPRS5 = ALOG(PEAKPR(CHAN)) / ALOG(FCSPRS)
               DELPRS6 = (ALOG(FCSPRS) / ALOG(CLOUDP)) / ALOG(CLOUDP)
               DELPRS7 = (ALOG(FCSPRS) - ALOG(CLOUDP)) / ALOG(CLOUDP)
               DELPRS9 = ALOG(PEAKPR(CHAN)) / ALOG(TROPRS)
               DELPRS10 = ALOG(CLOUDP) / ALOG(PEAKPR(CHAN))
               DELPRS11 = ALOG(CLOUDP) / ALOG(TROPRS)
               DELPRS12 = ALOG(TROPRS) / ALOG(FCSPRS)
               DELPRS13 = 1.0 / (ALOG(FCSPRS) - ALOG(TROPRS))
               
               DELPRSA = DELPRS1 + DELPRS2 + DELPRS2A
               
               DELPRSC = DELPRS2
               IF (DELPRSC.LT.0.0) DELPRSC = 0.0
               DELPRSC2 = 0.0
               IF (DELPRSC .GT. 0.0) DELPRSC2 = 1.0
               IF (DELPRSA.LT.0.0) DELPRSA = 0.0
               IF (DELPRS13.GT.1.0) DELPRS13 = 1.0
               DELPRSD = DELPRS3 - DELPRS5
               DELPRSE = DELPRS1 + DELPRS2
               IF (DELPRSE .LT. 0.0) DELPRSE = 0.0
               DELPRSF = (DELPRS1 * DELPRSD) - (DELPRS2**2)
C              IF (DELPRSF .LT. 0.0) DELPRSF = 0.0
               DELPRSG = DELPRSA - DELPRSD
               IF (DELPRSG .LT. 0.0) DELPRSG = 0.0
               DELPRSH = (DELPRS1**2) - (DELPRSD**2)
               IF (DELPRSH .LT. 0.0) DELPRSH = 0.0
               DELPRSJ = DELPRS1 - (DELPRS2**2)
               DELPRSK = DELPRSD * DELPRS2
               DELPRSL = 0.0
               IF (DELPRSK .GT. 0.0) THEN
                  DELPRSL = DELPRSK
                  DELPRSK = 0.0
               END IF
               DELPRSP = DELPRSD - (DELPRSA * DELPRSD) - DELPRS1 + (DELPRSA * DELPRS1)
               DELPRSN = 0.0 
               IF (DELPRSP .GT. 0.0) DELPRSN = DELPRSP
               DELPRSM = DELPRSD + DELPRS2
               DELPRSQ = 1.0 + DELPRS2
               DELPRSR = 1.0 + (ALOG(TROPRS) - ALOG(CLOUDP))
               DELPRST = (ALOG(FCSPRS) - ALOG(CLOUDP)) / ALOG(FCSPRS)
               DELPRSU = 1.0 + ((ALOG(PEAKPR(CHAN)) - ALOG(CLOUDP)) /
     +                   ALOG(PEAKPR(CHAN)))
               DELPRSV = ALOG(FCSPRS) - ALOG(CLOUDP)
               DELPRSW = ALOG(FCSPRS) - ALOG(TROPRS)
               DELPRSX = (ALOG(FCSPRS) - ALOG(TROPRS)) / ALOG(CLOUDP)
               DELPRS = 0.0
               THRESH = 2.0

C Channels
          
               IF (CHAN.EQ.2) THEN
                  IF ((DELPRSD**2) .GT. 0.0 .AND. DELPRSW .GT. THRESH .AND.
     +               AMSU6(SPOT) .GT. 241.0.AND.PCLEAR2.GE.MEAS2) THEN
                     DELPRS =  (1.1 * DELPRSD**2) - (4.0 * (DELPRSD**4))
                  END IF
                  IF (DELPRS .LE. 0.01) DELPRS = 0.0 
               END IF

               IF (CHAN.EQ.3) THEN
                  IF ((DELPRSD**2) .GT. 0.0 .AND. DELPRSW .GT. THRESH .AND.
     +               AMSU6(SPOT) .GT. 241.0.AND.PCLEAR3.GE.MEAS3) THEN
                     DELPRS = (1.8 * DELPRSD**2) - (0.5 *(DELPRSD **3)) - (4.0 * (DELPRSD**4))
                  END IF
                  IF (DELPRS .LE. 0.01) DELPRS = 0.0
               END IF

               IF (CHAN.EQ.12) THEN
                  IF (DELPRSE .GT. 0.0) THEN
                     IF (QCFLAG(SPOT) .EQ. 0) THEN
                        DELPRS = ( 18.0 *  DELPRSC) + 
     +                           (  2.0 * (DELPRSC  *  DELPRSC)) -
     +                           (  6.0 * (DELPRSC  *  DELPRSC  *  DELPRSC))
                     END IF
                     IF (SFCTYP .GT. 0 .AND. HEIGHT .GT. 170) THEN
                        DELPRS = DELPRS
                     END IF
                  END IF
               END IF
               
               IF (CHAN.EQ.4) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     IF (QCFLAG(SPOT) .EQ. 0) THEN
                        DELPRS = (  3.0 *  DELPRSC) +
     +                           (  6.5 * (DELPRSC * DELPRSC)) -
     +                           (  6.0 * (DELPRSC * DELPRSC   * DELPRSC))
                     END IF
                  END IF
               END IF


               IF (CHAN.EQ.5) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     IF (QCFLAG(SPOT) .EQ. 0) THEN
                        DELPRS = (  3.0 *  DELPRSC) +
     +                           (  6.5 * (DELPRSC * DELPRSC)) -
     +                           (  3.0 * (DELPRSC  *  DELPRSC  *  DELPRSC))
                     END IF
                  END IF
               END IF

               IF (CHAN.EQ.16) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     IF (QCFLAG(SPOT) .EQ. 0) THEN
                        DELPRS = ( 23.0 *  DELPRSC) +
     +                           (  4.0 * (DELPRSC  * DELPRSC)) +
     +                           ( 10.0 * (DELPRSC  * DELPRSC   *  DELPRSC))
                     END IF
                  END IF
               END IF

               IF (CHAN.EQ.15) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     IF (QCFLAG(SPOT) .EQ. 0) THEN
                        DELPRS = ( 29.0 *  DELPRSC) +
     +                           (  4.0 * (DELPRSC * DELPRSC)) +
     +                           ( 18.0 * (DELPRSC  * DELPRSC  *  DELPRSC))
                     END IF
                  END IF
               END IF

               IF (CHAN.EQ.11) THEN
                  IF (DELPRS2 .GT. 0.0) THEN
                     DELPRS = (  4.6 *  DELPRSC) +
     +                        ( 29.0 * (DELPRSC  * DELPRSC)) +
     +                        ( 37.0 * (DELPRSC  * DELPRSC   * DELPRSC))
                  END IF
               END IF

               IF (CHAN.EQ.14) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = (  7.5 *  DELPRSC) +
     +                        ( 30.0 * (DELPRSC  * DELPRSC)) +
     +                        ( 35.0 * (DELPRSC  * DELPRSC  * DELPRSC))
                  END IF
               END IF

               
               IF (CHAN.EQ.6) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = ( 2.0 *  DELPRSC) +
     +                        (11.0 * (DELPRSC  * DELPRSC)) +
     +                        (10.0 * (DELPRSC  * DELPRSC   *  DELPRSC))
                  END IF
               END IF
       
               IF (CHAN.EQ.7) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = ( 2.0 *  DELPRSC) +
     +                        (10.0 * (DELPRSC  * DELPRSC)) +
     +                        ( 6.0 * (DELPRSC  * DELPRSC   *  DELPRSC))
                  END IF
               END IF

               IF (CHAN.EQ.13) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = (  8.5 *  DELPRSC) +
     +                        ( 20.0 * (DELPRSC  * DELPRSC)) +
     +                        ( 38.0 * (DELPRSC  * DELPRSC * DELPRSC))
                  END IF
               END IF

               IF (CHAN.EQ.10) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = ( 4.0 *  DELPRSC) +
     +                        (12.0 * (DELPRSC  * DELPRSC)) +
     +                        (15.0 * (DELPRSC  * DELPRSC   *  DELPRSC))
                  END IF
               END IF

               IF (CHAN.EQ.8) THEN
                  IF (DELPRSM .GT. 0.0) THEN
                     DELPRS = (  4.0 *  DELPRSC) +
     +                        ( 10.0 * (DELPRSC  * DELPRSC)) +
     +                        ( 60.0 * (DELPRSC  * DELPRSC   * DELPRSC))
                  END IF
               END IF
               
  750          CONTINUE
               IF (DELPRS.LT.0.0) DELPRS = 0.0
               DELPR2(CHAN) = DELPRS2
               DELPR3(CHAN) = DELPRSD
               DELPR4(CHAN) = DELPRSC
               DELPRS8(CHAN) = DELPRS
               DELPRSX8 = DELPRSX
               IF (CHAN.GT.1) THEN
                  HIRRAD(CHAN) = HIRRAD(CHAN) * (1.0 + (CLDAMT*
     +            (PCTCON(CHAN)*DELPRS)))
               END IF
               HIRSBTS(CHAN) = IPLKRD(HIRRAD(CHAN),CHAN)
            END IF
         END IF
  800 CONTINUE
C
  900 CONTINUE
      RETURN
      END
