CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of TROPSE from tropse.f
CMAX: ----------------------------------------------------
      SUBROUTINE tropse(tmod,zmod)
      include '/usr/include/cm/CMF_defs.h'
C
C  Optimum Interpolation Analysis Version 1.1
C
C  COMPUTES TROPOPAUSE PRESSURE USING NMC ALGORITHM
C  RESULT, PTROP, IS RETURNED IN BLANK COMMON
      REAL APBAR (8)
C  APBAR = MEAN LOG(PRESSURE) FOR 8 LAYERS.
      REAL APTROP
      REAL GTROP (3)
      INTEGER I
      INTEGER II
      INTEGER II1
      INTEGER IJ
      INTEGER IMJNP
      INTEGER J
      INTEGER L
      INTEGER NOTROP
      COMMON PTROP (13104), GAM (104832)
C  GAM = (-DT/DZ) FOR 8 LAYERS BETWEEN 500 MB AND 50 MB. ( DEG K / KM )
      DIMENSION TMOD (IM * JNP, MLEV)
      DIMENSION ZMOD (IM * JNP, MLEV)
C  ANALYSIS CONTROL PARAMETERS
      LOGICAL STRAT, SLP, FDCOS, FEXP, SAVEAE, SIGDAT
      COMMON / pmh / pmand (18)
      COMMON / CONTRL / IM, JNP, NB, NDALT, NHMS, NLAY, NLAYM1, NLAYP1, 
     &NYMD, STRAT, IDIMEN, SLP, FDCOS, FEXP, SAVEAE, SIGDAT, MAXREP
C  VERTICAL INDICES
      COMMON / MLAY / MLEV, MLEVM1, MMIX, MMIXM1, LS, LSM1
C  MANDATORY PRESSURE LEVELS
      COMMON / PRMAND18 / PMAND18 (18), ALOGP18 (18), PKAP18 (18), PKAP1
     &18 (18), PM18 (18)
!hpf$ distribute alogp18(block)
!hpf$ distribute apbar(block)
!hpf$ distribute gam(block)
!hpf$ distribute gtrop(block)
!hpf$ distribute pkap118(block)
!hpf$ distribute pkap18(block)
!hpf$ distribute pm18(block)
!hpf$ distribute pmand(block)
!hpf$ distribute pmand18(block)
!hpf$ distribute ptrop(block)
!hpf$ distribute tmod(block,block)
!hpf$ distribute zmod(block,block)
      DATA GTROP / 2.0, 2.5, 3.0 /
C  STATEMENT FUNCTIONS
C  INITIALIZE
      i(ij) = mod(ij - 1,im) + 1
      j(ij) = (ij - 1) / im + 1
      imjnp = im * jnp
      notrop = 0
C  COMPUTE GAM = (-DT/DZ) FOR 8 LAYERS BETWEEN 500 MB AND 50 MB AND
C  MEAN LOG(PRESURE) FOR THE SAME LAYERS ( BOTTOM - TOP )
      ii = 0
      DO l = 1 , 8
        apbar(l) = (alog(pmand(mlev - l - 2)) + alog(pmand(mlev-l-3)))
     &      *0.5
      ENDDO
      DO l = 1 , 8
        DO ij = 1 , imjnp
          gam(ii + ij) = 1000.0 * (tmod(ij,mlev - l - 2) 
     &        - tmod(ij,mlev - l - 3)) / (zmod(ij,mlev - l - 3) 
     &        - zmod(ij,mlev - l - 2))
        ENDDO
        ii = ii + imjnp
      ENDDO
C  ESTIMATE TROPOPAUSE AT EACH GRID POINT.
      DO 7008 ij = 1 , imjnp
C  TRY TO DEFINE THE TROPOPAUSE 3 TIMES WITH 3 DIFFERENT THRESHOLD
C  VALUES  GTROP(K).
        DO 7006 k = 1 , 3
          ii = ij
          DO 7004 l = 1 , 8
            IF (gam(ii) .LT. gtrop(k)) THEN
              IF (l .GT. 1) THEN
                ii1 = ii - imjnp
C  INTERPOLATE LOG(P) LINEARLY BETWEEN THE 2 MID LOG(P) LEVELS AT WHICH
C  WE KNOW THE GAMMA VALUES TO FIND THE GTROP LOCATION.
                aptrop = (apbar(l - 1) * (gtrop(k) - gam(ii)) + apbar(l)
     &              * (gam(ii1) - gtrop(k))) / (gam(ii1) - gam(ii))
              ELSE
                aptrop = apbar(1)
              ENDIF
              ptrop(ij) = exp(aptrop)
              GOTO 200
            ENDIF
            ii = ii + imjnp
  180       CONTINUE
 7004     CONTINUE
          CONTINUE
 7006   CONTINUE
C  NO TROPOPAUSE FOUND. FILL PTROP WITH A 0.0
        notrop = notrop + 1
        ptrop(ij) = 0.0
        WRITE( 6,900 ) i(ij),j(ij)
  200   CONTINUE
 7008 CONTINUE
      WRITE( 6,910 ) notrop
      RETURN
900   FORMAT (' TROPSE: TROPOPAUSE NOT FOUND FOR I, J = ',2I4)
910   FORMAT ('0TROPSE: TROPOPAUSE SEARCH FAILED FOR ',I5,' GRIDPOINTS')
      END
