SUBROUTINE OTLIFT(SLINDX) !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: OTLIFT COMPUTES SFC TO 500MB LIFTED INDEX ! PRGRMMR: TREADON ORG: W/NP2 DATE: 93-03-10 ! ! ABSTRACT: ! THIS ROUTINE COMPUTES A SURFACE TO 500MB LIFTED INDEX. ! THE LIFTED PARCEL IS FROM THE FIRST ATMOSPHERIC ETA ! LAYER (IE, THE ETA LAYER CLOSEST TO THE MODEL GROUND). ! THE LIFTED INDEX IS THE DIFFERENCE BETWEEN THIS PARCEL'S ! TEMPERATURE AT 500MB AND THE AMBIENT 500MB TEMPERATURE. ! . ! ! PROGRAM HISTORY LOG: ! ??-??-?? ??? - SUBROUTINE OTLIFT IN ETA MODEL. ! 93-03-10 RUSS TREADON - ADAPTED OTLIFT FOR USE WITH NEW POST. ! 98-06-18 T BLACK - CONVERSION FROM 1-D TO 2-D ! 00-01-04 JIM TUCCILLO - MPI VERSION ! 01-10-25 H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT ! 02-06-11 MIKE BALDWIN - WRF VERSION ! 11-04-12 GEOFF MANIKIN - USE VIRTUAL TEMPERATURE ! ! USAGE: CALL OTLIFT(SLINDX) ! INPUT ARGUMENT LIST: ! ! OUTPUT ARGUMENT LIST: ! SLINDX - LIFTED INDEX. ! ! OUTPUT FILES: ! NONE ! ! SUBPROGRAMS CALLED: ! UTILITIES: ! NONE ! LIBRARY: ! COMMON - CTLBLK ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN ! MACHINE : CRAY C-90 !$$$ ! use vrbls3d, only: PMID, T, Q use vrbls2d, only: T500 use masks, only: LMH use lookup_mod, only: THL, RDTH, JTB, QS0, SQS, RDQ,ITB, PTBL, PL, & RDP, THE0, STHE, RDTHE, TTBL use ctlblk_mod, only: JSTA, JEND, IM use params_mod, only: D00,H10E5, CAPA, ELOCP, EPS, ONEPS ! ! implicit none ! ! SET LOCAL PARAMETERS. real,PARAMETER :: D8202=.820231E0 , H5E4=5.E4 , P500=50000. real,external::FPVSNEW ! ! DECLARE VARIABLES. real,intent(out) :: SLINDX(IM,jsta:jend) REAL :: TVP, ESATP, QSATP REAL :: TTH, TP, APESP, PARTMP, THESP, TPSP REAL :: BQS00, SQS00, BQS10, SQS10, BQ, SQ, TQ REAL :: P00, P10, P01, P11, T00, T10, T01, T11 REAL :: BTHE00, STHE00, BTHE10, STHE10, BTH, STH REAL :: TQQ, QQ, QBT, TTHBT, TBT, APEBT, PPQ, PP ! INTEGER :: I, J, LBTM, ITTBK, IQ, IT, IPTBK, ITH, IP, IQTB INTEGER :: ITTB, IPTB, ITHTB ! !*********************************************************************** ! START OTLIFT HERE ! ! INTIALIZE LIFTED INDEX ARRAY TO ZERO. !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM SLINDX(I,J) = D00 ENDDO ENDDO !--------------FIND EXNER AT LOWEST LEVEL------------------------------- DO J=JSTA,JEND DO I=1,IM LBTM=NINT(LMH(I,J)) TBT = T(I,J,LBTM) QBT = Q(I,J,LBTM) APEBT = (H10E5/PMID(I,J,LBTM))**CAPA !--------------SCALING POTENTIAL TEMPERATURE & TABLE INDEX-------------- TTHBT = TBT*APEBT TTH = (TTHBT-THL)*RDTH TQQ = TTH-AINT(TTH) ITTB = INT(TTH)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- IF(ITTB .LT. 1)THEN ITTB = 1 TQQ = D00 ENDIF IF(ITTB .GE. JTB)THEN ITTB = JTB-1 TQQ = D00 ENDIF !--------------BASE AND SCALING FACTOR FOR SPEC. HUMIDITY--------------- ITTBK = ITTB BQS00=QS0(ITTBK) SQS00=SQS(ITTBK) BQS10=QS0(ITTBK+1) SQS10=SQS(ITTBK+1) !--------------SCALING SPEC. HUMIDITY & TABLE INDEX--------------------- BQ=(BQS10-BQS00)*TQQ+BQS00 SQ=(SQS10-SQS00)*TQQ+SQS00 TQ=(QBT-BQ)/SQ*RDQ PPQ = TQ-AINT(TQ) IQTB = INT(TQ)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- IF(IQTB .LT. 1)THEN IQTB = 1 PPQ = D00 ENDIF IF(IQTB .GE. ITB)THEN IQTB = ITB-1 PPQ = D00 ENDIF !--------------SATURATION PRESSURE AT FOUR SURROUNDING TABLE PTS.------- IQ=IQTB IT = ITTB P00=PTBL(IQ,IT) P10=PTBL(IQ+1,IT) P01=PTBL(IQ,IT+1) P11=PTBL(IQ+1,IT+1) !--------------SATURATION POINT VARIABLES AT THE BOTTOM----------------- TPSP = P00+(P10-P00)*PPQ+(P01-P00)*TQQ & +(P00-P10-P01+P11)*PPQ*TQQ IF(TPSP .LE. D00) TPSP = H10E5 APESP = (H10E5/TPSP)**CAPA THESP = TTHBT*EXP(ELOCP*QBT*APESP/TTHBT) !--------------SCALING PRESSURE & TT TABLE INDEX------------------------ TP=(H5E4-PL)*RDP QQ = TP-AINT(TP) IPTB = INT(TP)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- IF(IPTB .LT. 1)THEN IPTB = 1 QQ = D00 ENDIF IF(IPTB .GE. ITB)THEN IPTB = ITB-1 QQ = D00 ENDIF !--------------BASE AND SCALING FACTOR FOR THE-------------------------- IPTBK=IPTB BTHE00=THE0(IPTBK) STHE00=STHE(IPTBK) BTHE10=THE0(IPTBK+1) STHE10=STHE(IPTBK+1) !--------------SCALING THE & TT TABLE INDEX----------------------------- BTH=(BTHE10-BTHE00)*QQ+BTHE00 STH=(STHE10-STHE00)*QQ+STHE00 TTH=(THESP-BTH)/STH*RDTHE PP = TTH-AINT(TTH) ITHTB = INT(TTH)+1 !--------------KEEPING INDICES WITHIN THE TABLE------------------------- IF(ITHTB .LT. 1)THEN ITHTB = 1 PP = D00 ENDIF IF(ITHTB .GE. JTB)THEN ITHTB = JTB-1 PP = D00 ENDIF !--------------TEMPERATURE AT FOUR SURROUNDING TT TABLE PTS.------------ ITH=ITHTB IP=IPTB T00=TTBL(ITH,IP) T10=TTBL(ITH+1,IP) T01=TTBL(ITH,IP+1) T11=TTBL(ITH+1,IP+1) !--------------PARCEL TEMPERATURE AT 500MB---------------------------- IF(TPSP .GE. H5E4)THEN PARTMP=(T00+(T10-T00)*PP+(T01-T00)*QQ & +(T00-T10-T01+T11)*PP*QQ) ELSE PARTMP=TBT*APEBT*D8202 ENDIF !--------------LIFTED INDEX--------------------------------------------- ! ! GSM THE PARCEL TEMPERATURE AT 500 MB HAS BEEN COMPUTED, AND WE ! FIND THE MIXING RATIO AT THAT LEVEL WHICH WILL BE THE SATURATION ! VALUE SINCE WE'RE FOLLOWING A MOIST ADIABAT. NOTE THAT THE ! AMBIENT 500 MB SHOULD PROBABLY BE VIRTUALIZED, BUT THE IMPACT ! OF MOISTURE AT THAT LEVEL IS QUITE SMALL ESATP=FPVSNEW(PARTMP) QSATP=EPS*ESATP/(P500-ESATP*ONEPS) TVP=PARTMP*(1+0.608*QSATP) SLINDX(I,J)=T500(I,J)-TVP ENDDO ENDDO ! write(*,*) ' in otlift t500 partmp ',t500(1,1),partmp(1,1) ! write(*,*) ' in otlift tbt ',tbt(1,1) ! RETURN END