      SUBROUTINE TROPTP (PR, HEIGHT, TEMPS, N, AMSUA6, TROTMP, TROPRS, SPOT)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME- TROPTP
C
C   LANGUAGE- FORTRAN         TYPE- SUBROUTINE      COMPUTER- AIX
C
C   VERSION- 1.0      DATE- 4/01/08      PROGRAMMER-  FRANK TILLEY (IMSG)
C
C   FUNCTION- THIS SUBROUTINE CALCULATES THE TROPOPAUSE TEMPERATURE AND
C   PRESSURE FROM GIVEN PRESSURE, GEOMETRIC HEIGHT, AND TEMPERATURE
C   PROFILE. THE AMSU-A CHANNEL 6 BRIGHTNESS TEMPERATURE IS USED FOR
C   A GROSS TROPOPAUSE PRESSURE CHECK.
C
C   CALLING SEQUENCE PARAMETERS-
C
C   NAME    TYPE  I/O    DESCRIPTION
C   ----    ----  ---    -----------
C   PR      REAL   I     VECTOR OF N LEVEL PRESSURES (MB)
C   HEIGHT  REAL   I     VECTOR OF N GEOMETRIC HEIGHT IN (KM),
C                        CORRESPONDING TO THE LEVELS IN VECTOR PR.
C   TEMPS   REAL   I     VECTOR OF N TEMPERATURES (K),
C                        CORRESPONDING TO THE LEVELS IN VECTOR PR.
C   N       INT    I     NUMBER OF PRESSURE LEVELS, USED ONLY TO DEFINE
C                        THE DIMENSION OF THE PR, HEIGHT AND TEMPS
C                        VECTORS.
C   AMSUA6  REAL   I     AMSU-A CHANNEL 6 BRIGHTNESS TEMPERATURE (K).
C   TROTMP  REAL   O     TROPOPAUSE TEMPERATURE (K).
C   TROPRS  REAL   O     TROPOPAUSE PRESSURE (MB).
C   SPOT    INT    I
C
      INTEGER     N, SPOT
      REAL        PR(N), HEIGHT(N), TEMPS(N), AMSUA6, TROTMP, TROPRS
C
C   COMMON AREAS-  NONE
C
C   LOCAL VARIABLES
C   NAME      TYPE  DESCRIPTION
C   ----      ----  -----------
C   I          INT  DO LOOP INDEX
C   LPSRTE    REAL  VECTOR OF MAX 100 LAPSE RATES
C   PRESS1    REAL  NATURAL LOG OF THE PRESSURE TWO LEVELS ABOVE THE
C                   INFLECTION POINT.
C   PRESS2    REAL  NATURAL LOG OF THE PRESSURE ONE LEVEL ABOVE THE
C                   INFLECTION POINT.
C   PRESS3    REAL  NATURAL LOG OF THE PRESSURE AT THE INFLECTION POINT.
C   PRESS4    REAL  NATURAL LOG OF THE PRESSURE ONE LEVEL BELOW THE
C                   INFLECTION POINT.
C   SLOPEA    REAL  SLOPE OF THE TWO LEVELS ABOVE THE INFLECTION POINT.
C   SLOPEB    REAL  SLOPE OF THE INFLECTION POINT AND THE POINT ONE
C                   LEVEL BELOW THE INFLECTION POINT.
C   TEMP1     REAL  TEMPERATURE AT THE POINT TWO LEVELS ABOVE THE
C                   INFLECTION POINT.
C   TEMP2     REAL  TEMPERATURE AT THE POINT ONE LEVEL ABOVE THE
C                   INFLECTION POINT.
C   TEMP3     REAL  TEMPERATURE AT THE INFLECTION POINT.
C   TEMP4     REAL  TEMPERATURE AT THE POINT ONE LEVEL BELOW THE
C                   INFLECTION POINT.
C
C   SUBPROGRAMS CALLED-  LAPRTE
C
C   FUNCTIONS USED-  ALOG, EXP, LPSRAV
C
       REAL LPSRAV
C
C   EXIT STATES- IF THE TROPOPAUSE CANNOT BE DETERMINED, THE TROPOPAUSE
C                TEMPERATURE AND PRESSURE ARE RETURNED AS MISSING VALUES.
C
C   ASSUMPTIONS - 1) THE INPUT DATA ARE AT THE 42 TOVS LEVELS, IN ORDER
C                    OF THE HIGHEST LEVEL 1ST AND 1000 MB AT LEVEL 40
C                    (LEVELS 41 AND 42 ARE NOT USED).
C                 2) THE TEMPERATURES AND HEIGHTS CAN BE MISSING VALUES,
C                    HOWEVER IT IS ASSUMED THAT THESE VALUES OCCUR ONLY
C                    AT THE TOP AND/OR BOTTOM OF THE PROFILE.  THAT IS,
C                    BETWEEN THE HIGHEST AND LOWEST NON-MISSING VALUES,
C                    THERE ARE NO MISSING VALUES.  IT IS ASSUMED THAT
C                    FOR ANY LEVEL, HEIGHT AND TEMPERATURE ARE EITHER
C                    BOTH MISSING OR BOTH PRESENT.
C***********************************************************************
C
      INTEGER    I, J, K, L, LVL
      REAL       LPSRTE(100), PRESS1, PRESS2, PRESS3, PRESS4
      REAL       TEMP1, TEMP2, TEMP3, TEMP4, SLOPEA, SLOPEB
      real       laprate(100)
      LOGICAl    FOUND
C
      INCLUDE 'SPVAL'
C
      LPSRAV(J,I) = -(TEMPS(J) - TEMPS(I))/(HEIGHT(J)-HEIGHT(I))
C
      TROTMP  = R4SPV
      TROPRS  = R4SPV
      FOUND = .FALSE.
C
C  THE HEIGHTS ARE ASSUMED TO BE IN GEOMETRIC KILOMETERS, THE LAPSE
C  RATE IS DEGREES KELVIN PER KM
C
C  CALCULATE THE LAPSE RATE FOR EACH LAYER. THE INDEX FOR THE LAPSE
C  RATE POINTS TO THE TOP LEVEL OF THE LAYER.
C
      CALL LAPRTE(HEIGHT,TEMPS,N,laprate)
      CALL LAPSER(HEIGHT,TEMPS,N,LPSRTE)
      do I = 15, 30
         print 321,'Press ',PR(I),' LPSRTE ',LPSRTE(I),
     +           ' laprate ',laprate(I),' Temp ',TEMPS(I)
      end do
 321  format(A,F7.0,A,F8.4,A,F8.4,A,F6.1)
C
C     ASSUME THE TROPOPAUSE IS BETWEEN 500 AND 30 MB (ATOVS LEVELS
C     31 AND 15, RESPECTIVELY. START AT THE LAYER BOUNDED BY 475
C     AND 500 MB AND SEARCH UPWARD IN THE ATMOSPHERE LOOKING FOR
C     A LAYER WHERE THE LAPSE RATE DROPS TO 2.0 DEGREES K PER KM
C     OR LESS. THE LEVEL AT THE LOWER BOUND OF THIS LAYER IS THE
C     DEFLECTION POINT. 
C
      LVL = 0
      DO 30 I = 30, 15, -1
C
c        IF (LPSRTE(I).EQ.R4SPV) GO TO 400
         IF (laprate(I).EQ.R4SPV) GO TO 400
C
C        FIND THE LOWEST LAYER AT WHICH THE LAPSE RATE DECREASES TO
C        2 K/KM. THE LOWER BOUNDARY OF THIS LAYER IS THE DEFLECTION
C        POINT.
C
         IF (laprate(I) .LE. 2.0) THEN
C
C           IF A MISSING PRESSURE IS ENCOUNTERED, ASSUME THAT NO
C           TROPOPAUSE CAN BE DETERMINED AND RETURN TO THE CALLING
C           ROUTINE
C
            IF (PR(I-2).EQ.R4SPV) GO TO 400
            DO J = I-2, 14, -1
               IF (HEIGHT(J).EQ.R4SPV) GO TO 30
               IF ((HEIGHT(J) - HEIGHT(I)) .GT. 2.0) GO TO 20
            END DO
   20       CONTINUE
            IF (LPSRAV(J,I) .LE. 2.0) THEN
               LVL = I
               FOUND = .TRUE.
               GO TO 50
            END IF 
         ENDIF
  30  CONTINUE
C
  50  CONTINUE
      IF (.NOT.(FOUND)) GO TO 400
c     PRESS1 = ALOG(PR(LVL-1))
      PRESS1 = PR(LVL-2)
      TEMP1  = TEMPS(LVL-2)
c     PRESS2 = ALOG(PR(LVL))
      PRESS2 = PR(LVL-1)
      TEMP2  = TEMPS(LVL-1)
c     PRESS3 = ALOG(PR(LVL))
      PRESS3 = PR(LVL)
      TEMP3  = TEMPS(LVL)
c     PRESS4 = ALOG(PR(LVL+2))
      PRESS4 = PR(LVL+1)
      TEMP4  = TEMPS(LVL+1)
C
C       COMPUTE THE SLOPES ABOVE AND BELOW THE INFLECTION POINT.
C
      SLOPEA = (PRESS2 - PRESS1) / (TEMP2 - TEMP1)
      SLOPEB = (TEMP4 - TEMP3) / (PRESS4 - PRESS3)
C
C       SOLVE FOR THE NATURAL LOG OF THE TROPOPAUSE PRESSURE.
C
      TROPRS = (PRESS1 + (TEMP3 * SLOPEA) - (PRESS3 * SLOPEB * SLOPEA) -
     +         (TEMP1 * SLOPEA)) / (1.0 - (SLOPEB * SLOPEA))
C
C       SOLVE FOR THE TROPOPAUSE TEMPERATURE.
C
      TROTMP = TEMP3 + ((TROPRS - PRESS3) * SLOPEB)
C
C       CHANGE THE TROPOPAUSE PRESSURE FROM NATURAL LOG TO PRESSURE IN MB.
C
c     TROPRS = EXP(TROPRS)
C
  200 CONTINUE
C
      IF (TROPRS.LT.PR(I)) THEN
      IF (SPOT.EQ.1) THEN
         print 201,'PRESS1 ',(ANINT(EXP(PRESS1))),' TEMP1 ',TEMP1
         print 201,'PRESS2 ',(ANINT(EXP(PRESS2))),' TEMP2 ',TEMP2
         print 201,'PRESSI ',(ANINT(PR(I))),' TEMPS(I) ',TEMPS(I)
         print 201,'TROPRS ',TROPRS,' TROTMP ',TROTMP
         print 201,'PRESS3 ',(ANINT(EXP(PRESS3))),' TEMP3 ',TEMP3
         print 201,'PRESS4 ',(ANINT(EXP(PRESS4))),' TEMP4 ',TEMP4
         print *,'SLOPEA = ',SLOPEA,' SLOPEB = ',SLOPEB
         print *,' '
      end if
      END IF
  201 FORMAT(A,F7.0,A,F9.4)
C
C  USE THE AMSU-A CHANNEL 6 BRIGHTNESS TEMPERATURE TO VALIDATE THE CALCULATED TROPOPAUSE
C  PRESSURE.
C
c     IF (AMSUA6.GT.240.0) THEN
c        IF (TROPRS.GT.155.0) THEN
c           PRINT *,'TROPRS = ',(NINT(TROPRS)),'. AMSU-A CHANNEL 6 BT IS ',AMSUA6
c        END IF
c     END IF
c     IF (AMSUA6.LT.237.0) THEN
c        IF (TROPRS.LT.155.0) THEN
c           PRINT *,'TROPRS = ',(NINT(TROPRS)),'. AMSU-A CHANNEL 6 BT IS ',AMSUA6
c        END IF
c     END IF
c     IF (AMSUA6.GE.237.0.AND.AMSUA6.LE.240.0) THEN
c        IF (TROPRS.LT.150.0.OR.TROPRS.GT.180.0) THEN
c           PRINT *,'TROPRS = ',(NINT(TROPRS)),'. AMSU-A CHANNEL 6 BT IS ',AMSUA6
c        END IF
c     END IF
C
  400 CONTINUE
      IF (TROPRS.EQ.R4SPV) THEN
         if (SPOT.EQ.1) print *,'Calculated TROPRS is missing'
      END IF
      print *,'Tropopause Pressure: ',TROPRS,' Tropopause Temperature ',TROTMP
      print *,' '
      RETURN
      END
