SUBROUTINE TRPAUS(PTROP,TTROP,ZTROP,UTROP,VTROP,SHTROP)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . .
! SUBPROGRAM: TRPAUS COMPUTE TROPOPAUSE DATA.
! PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-22
!
! ABSTRACT:
! THIS ROUTINE COMPUTES TROPOPAUSE DATA. AT EACH MASS
! POINT A SURFACE UP SEARCH IS MADE FOR THE FIRST
! OCCURRENCE OF A THREE LAYER MEAN LAPSE RATE LESS THAN
! OR EQUAL TO A CRITICAL LAPSE RATE. THIS CRITCAL LAPSE
! RATE IS 2DEG/KM. THIS IS IN ACCORD WITH THE WMO
! DEFINITION OF A TROPOPAUSE. A MAXIMUM TROPOPAUSE
! PRESSURE OF 500MB IS ENFORCED. ONC THE TROPOPAUSE
! IS LOCATED IN A COLUMN, PRESSURE, TEMPERATURE, U
! AND V WINDS, AND VERTICAL WIND SHEAR ARE COMPUTED.
! .
!
! PROGRAM HISTORY LOG:
! 92-12-22 RUSS TREADON
! 97-03-06 GEOFF MANIKIN - CHANGED CRITERIA FOR DETERMINING
! THE TROPOPAUSE AND ADDED HEIGHT
! 98-06-15 T BLACK - CONVERSION FROM 1-D TO 2-D
! 00-01-04 JIM TUCCILLO - MPI VERSION
! 02-04-23 MIKE BALDWIN - WRF VERSION
!
! USAGE: CALL TRPAUS(PTROP,TTROP,ZTROP,UTROP,VTROP,SHTROP)
! INPUT ARGUMENT LIST:
! NONE
!
! OUTPUT ARGUMENT LIST:
! PTROP - TROPOPAUSE PRESSURE.
! TTROP - TROPOPAUSE TEMPERATURE.
! ZTROP - TROPOPAUSE HEIGHT
! UTROP - TROPOPAUSE U WIND COMPONENT.
! VTROP - TROPOPAUSE V WIND COMPONENT.
! SHTROP - VERTICAL WIND SHEAR AT TROPOPAUSE.
!
! OUTPUT FILES:
! NONE
!
! SUBPROGRAMS CALLED:
! UTILITIES:
!
! LIBRARY:
!
! ATTRIBUTES:
! LANGUAGE: FORTRAN
! MACHINE : CRAY C-90
!$$$
!
!
! INCLUDE ETA GRID DIMENSIONS. SET/DERIVE PARAMETERS.
!
use vrbls3d, only: pint, t, zint, uh, vh
use masks, only: lmh
use params_mod, only: d50
use ctlblk_mod, only: jsta, jend, spval, im, jm, lm
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
! PARAMTER CRTLAP SPECIFIES THE CRITICAL LAPSE RATE
! (IN K/M) IDENTIFYING THE TROPOPAUSE. WE START
! LOOKING FOR THE TROPOPAUSE ABOVE PRESSURE LEVEL
! PSTART (IN PASALS).
real,PARAMETER :: CRTLAP=0.002E0, PSTART=5.0E4
!
! DECLARE VARIABLES.
!
REAL,dimension(IM,JM),intent(out) :: PTROP,TTROP,ZTROP,UTROP, &
VTROP,SHTROP
REAL TLAPSE(LM),DZ2(LM),DELT2(LM),TLAPSE2(LM)
!
integer I,J,LL,LLMH,L
real PM,DELT,DZ,RSQDIF
!
!*****************************************************************************
! START TRPAUS HERE.
!
! LOOP OVER THE HORIZONTAL GRID.
!
DO J=JSTA,JEND
DO I=1,IM
PTROP(I,J) = SPVAL
TTROP(I,J) = SPVAL
ZTROP(I,J) = SPVAL
UTROP(I,J) = SPVAL
VTROP(I,J) = SPVAL
SHTROP(I,J) = SPVAL
ENDDO
ENDDO
!
!!$omp parallel do
!!$omp& private(delt,delt2,dz,dz2,ie,iw,l,llmh,pm,rsqdif,
!!$omp& tlapse,tlapse2,u0,u0l,uh,uh0,ul,
!!$omp& v0,v0l,vh,vh0)
DO 20 J=JSTA,JEND
DO 20 I=1,IM
!
! COMPUTE THE TEMPERATURE LAPSE RATE (-DT/DZ) BETWEEN ETA
! LAYERS MOVING UP FROM THE GROUND. THE FIRST ETA LAYER
! ABOVE PRESSURE "PSTART" IN WHICH THE LAPSE RATE IS LESS
! THAN THE CRITCAL LAPSE RATE IS LABELED THE TROPOPAUSE.
!
LLMH=NINT(LMH(I,J))
!
DO 10 L=LLMH-1,2,-1
PM = PINT(I,J,L)
DELT = T(I,J,L-1)-T(I,J,L)
DZ = D50*(ZINT(I,J,L-1)-ZINT(I,J,L+1))
TLAPSE(L) = -DELT/DZ
!
IF ((TLAPSE(L).LT.CRTLAP).AND.(PM.LT.PSTART)) THEN
IF (L .EQ. 2 .AND. TLAPSE(L) .LT. CRTLAP) GOTO 15
DZ2(L+1) = 0.
!
DO 17 LL=L,3,-1
DZ2(LL) = 0.
DELT2(LL) = 0.
TLAPSE2(LL) = 0.
DZ2(LL) = (2./3.)*(ZINT(I,J,LL-2)-ZINT(I,J,L+1))
IF ((DZ2(LL) .GT. 2000.) .AND. &
(DZ2(LL+1) .GT. 2000.)) GO TO 15
DELT2(LL) = T(I,J,LL-2)-T(I,J,L)
TLAPSE2(LL) = -DELT2(LL)/DZ2(LL)
!
IF (TLAPSE2(LL) .GT. CRTLAP) THEN
GOTO 10
ENDIF
!
17 CONTINUE
ELSE
GOTO 10
ENDIF
!
15 PTROP(I,J) = D50*(PINT(I,J,L)+PINT(I,J,L+1))
TTROP(I,J) = T(I,J,L)
ZTROP(I,J)= 0.5*(ZINT(I,J,L)+ZINT(I,J,L+1))
!
UTROP (I,J) = UH(I,J,L)
VTROP (I,J) = VH(I,J,L)
DZ = ZINT(I,J,L)-ZINT(I,J,L+1)
RSQDIF = SQRT(((UH(I,J,L-1)-UH(I,J,L+1))*0.5)**2 &
& +((VH(I,J,L-1)-VH(I,J,L+1))*0.5)**2)
SHTROP(I,J) = RSQDIF/DZ
GOTO 20
10 CONTINUE
!X WRITE(88,*)'REACHED TOP FOR K,P,TLAPSE: ',K,PM,TLAPSE
DZ = D50*(ZINT(I,J,2)-ZINT(I,J,3))
PTROP(I,J) = D50*(PINT(I,J,2)+PINT(I,J,3))
TTROP(I,J) = T(I,J,2)
ZTROP(I,J)= D50*(ZINT(I,J,2)+ZINT(I,J,3))
UTROP (I,J) = UH(I,J,2)
VTROP (I,J) = VH(I,J,2)
RSQDIF = SQRT(((UH(I,J,1)-UH(I,J,3))*0.5)**2 &
& +((VH(I,J,1)-VH(I,J,3))*0.5)**2)
SHTROP(I,J) = RSQDIF/DZ
!X WRITE(82,1010)I,J,L,PTROP(I,J)*D01,TTROP(I,J),
!X X UTROP(I,J),VTROP(I,J),SHTROP(I,J)
!
20 CONTINUE
!
! END OF ROUTINE.
!
RETURN
END