      SUBROUTINE TOPINTS(CLDTMP,TEMP,TAUIR,TROPRS,ILEVEL,TAUHRS)
      IMPLICIT NONE
C**********************************************************************
C
C   NAME- TOPINTS
C
C   LANGUAGE- FORTRAN   TYPE- SUBROUTINE     COMPUTER- AIX
C
C   VERSION- 1.0    DATE- 04/05/07   PROGRAMMER- FRANK TILLEY (IMSG)
C           ADAPTED FROM SUBROUTINE TOPINT.
C
C   FUNCTION-  THIS ROUTINE FINDS THE TOVS LEVEL CORRESPONDING TO
C              A CLOUD TOP TEMPERATURE WHERE THE CLOUD TOP IS ABOVE
C              THE TROPOPAUSE.
C
C   CALLING ARGUMENTS-
C   NAME     TYPE  I/O  DESCRIPTION
C   ----     ----  ---  --------
C   CLDTMP   REAL   I   CLOUD TOP TEMPERATURE
C   TEMP     REAL   I   RETRIEVAL TEMPERATURE PROFILE
C   TAUIR    REAL   I   TRANSMITTANCES AT RETRIEVAL LEVELS FOR HIRS
C                       CHANNELS 1 THROUGH 11.
C   TROPRS   REAL   I   TROPOPAUSE PRESSURE.
C   ILEVEL    INT   O   CLOUD TOP LEVEL IN THE RETRIEVAL TEMPERATURE
C                       PROFILE.
C   TAUHRS   REAL   O   TRANSMITTANCES FOR HIRS CHANNELS 1 THROUGH 11
C                       AT THE CLOUD TOP LEVEL
C
C   COMMON AREAS- RETPARM, RTPLVL, SPVAL
C
C   LOCAL VARIABLES-
C   NAME     TYPE    DESCRIPTION
C   ----     ----    -----------
C   I, L      INT    LOOP INDEX VARIABLES
C   LOW       INT    TOVS LEVEL BELOW THE CLOUD TOP TEMPERATURE
C   LUP       INT    TOVS LEVEL ABOVE THE CLOUD TOP TEMPERATURE
C   RATE     REAL    TEMPERATURE LAPSE RATE BETWEEN LOW AND LUP
C   TLEVEL   REAL    TEMPERATURE AT A GIVEN TOVS LEVEL
C   TLOW     REAL    TEMPERATURE AT THE TOVS LEVEL BELOW THE CLOUD
C                    TOP PRESSURE
C   TLUP     REAL    TEMPERATURE AT THE TOVS LEVEL ABOVE THE CLOUD
C                    TOP PRESSURE
C   TROPLV    INT    TOVS LEVEL CORRESPONDING TO THE TROPOPAUSE
C                    PRESSURE.
C
C   SUBROUTINES CALLED- NONE
C
C**********************************************************************
C
      INCLUDE 'RETPARM'
      INCLUDE 'RTPLVL'
      INCLUDE 'SPVAL'

      REAL   TEMP(PRFTLV),TAUIR(PRFTLV,11),TAUHRS(PRFTLV,11)
      REAL   CLDTMP,TROPRS

      REAL    RATE, TLEVEL, TLOW, TLUP
      INTEGER I, ILEVEL, L, LOW, LUP, TROPLV
C
C FIND THE TOVS LEVEL CORRESPONDING TO THE TROPOPAUSE PRESSURE.
C USE LEVEL 21 (115 MB) IF THE TROPOPAUSE PRESSURE IS MISSING.
C
      TROPLV = 0
      IF (TROPRS.NE.R4SPV) THEN
         DO I = 11, (PRFTLV -2)
            IF (TROPLV.EQ.0) THEN
               IF (PROFLV(I).GE.TROPRS) TROPLV = I
            END IF
         END DO 
      END IF
C
      IF (TROPLV.LT.2) TROPLV = 21

C
C FIND CLOUD TOP LEVEL BY SEARCHING FOR THE CLOUD TOP
C TEMPERATURE IN THE RETRIEVED TEMPERATURE PROFILE. START
C BY SETTING THE CLOUD LEVEL AT THE SURFACE (1000 MB).
C
      LUP = TROPLV-1
      LOW = TROPLV
C
C SEARCH BETWEEN 60 MB AND THE TROPOPAUSE FOR A RETRIEVED
C TEMPERATURE GREATER THAN THE CLOUD TOP TEMPERATURE.
C
      DO 100 I=TROPLV, 11, -1
         TLEVEL = TEMP(I)
         IF(TLEVEL.LT.CLDTMP) GOTO 100
         LUP = I
         LOW = I+1
         GOTO 200
  100 CONTINUE
C
  200 CONTINUE
C
C-- IF THE PRESSURE LEVEL IS GREATER THAN 40 (1000 MB),
C   SET IT TO 40.
C
      IF (LOW .GT. 40) THEN
          LOW = 40
          LUP = LOW - 1
      END IF
      TLUP = TEMP(LUP)
      TLOW = TEMP(LOW)
C
      ILEVEL = LOW
C
      IF(TLOW.EQ.TLUP) THEN
         RATE = 1.0
      ELSE
         RATE = (TLUP-CLDTMP)/(TLUP-TLOW)
      ENDIF
C
C COPY TRANSMITTANCES TO TEMPORARY ARRAY
C
      DO I=1,11
         DO L=1,LUP
            TAUHRS(L,I) = TAUIR(L,I)
         END DO
      END DO
C
C COMPUTE THE TRANSMITTANCE AT THE CLOUD TOP LEVEL
C
      DO I=1,11
        TAUHRS(ILEVEL,I) = TAUIR(LUP,I)-(TAUIR(LUP,I)-TAUIR(LOW,I))*RATE
      END DO
C
      RETURN
      END
