!> @file !> @brief otlift() computes SFC to 500mb lifted index. !> !> This routine computes a surface to 500mb lifted index. !> The lifted parcel is from the first atmpspheric 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. !> !> @param[out] SLINDX lifted index. !> !> ### Program History Log !> Date | Programmer | Comments !> -----|------------|--------- !> ????-??-?? | ??? | Subroutine OTLIFT in ETA model. !> 1993-03-10 | Russ Treadon | Adapted OTLIFT for use with new post. !> 1998-06-18 | T Black | Conversion from 1-D to 2-D !> 2000-01-04 | Jim Tuccillo | MPI Version !> 2001-10-25 | H Chuang | Modified to process hybrid model output !> 2002-06-11 | Mike Baldwin | WRF Version !> 2011-04-12 | Geoff Manikin | Use virtual temperature !> 2020-11-10 | Jesse Meng | Use UPP_PHYSICS Module !> 2021-09-30 | JESSE MENG | 2D DECOMPOSITION !> !> @author Russ Treadon W/NP2 @date 1993-03-10 SUBROUTINE OTLIFT(SLINDX) ! 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, SPVAL, ISTA, IEND use params_mod, only: D00,H10E5, CAPA, ELOCP, EPS, ONEPS use upp_physics, only: FPVSNEW ! ! implicit none ! ! SET LOCAL PARAMETERS. real,PARAMETER :: D8202=.820231E0 , H5E4=5.E4 , P500=50000. ! ! DECLARE VARIABLES. real,intent(out) :: SLINDX(ista:iend,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=ISTA,IEND SLINDX(I,J) = D00 ENDDO ENDDO !--------------FIND EXNER AT LOWEST LEVEL------------------------------- DO J=JSTA,JEND DO I=ISTA,IEND LBTM=NINT(LMH(I,J)) IF(T(I,J,LBTM)= 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 < 1)THEN IQTB = 1 PPQ = D00 ENDIF IF(IQTB >= 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 <= 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 < 1)THEN IPTB = 1 QQ = D00 ENDIF IF(IPTB >= 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 < 1)THEN ITHTB = 1 PP = D00 ENDIF IF(ITHTB >= 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 >= 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 ENDIF !end T(I,J,LBTM)