SUBROUTINE OTLFT(PBND,TBND,QBND,SLINDX) !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: OTLFT COMPUTES LIFTED INDEX ! PRGRMMR: TREADON ORG: W/NP2 DATE: 93-03-10 ! ! ABSTRACT: ! THIS ROUTINE COMPUTES LIFTS A PARCEL SPECIFIED BY THE ! PASSED PRESSURE, TEMPERATURE, AND SPECIFIC HUMIDITY TO ! 500MB AND THEN COMPUTES A LIFTED INDEX. THIS LIFTED ! LIFTED INDEX IS THE DIFFERENCE BETWEEN THE LIFTED ! PARCEL'S TEMPERATURE AT 500MB AND THE AMBIENT 500MB ! TEMPERATURE. ! . ! ! PROGRAM HISTORY LOG: ! 93-03-10 RUSS TREADON - MODIFIED OTLIFT2 TO LIFT PARCELS ! SPECIFIED BY PASSED P, T, AND Q. ! 98-06-15 T BLACK - CONVERSION FROM 1-D TO 2-D ! 00-01-04 JIM TUCCILLO - MPI VERSION ! 02-06-17 MIKE BALDWIN - WRF VERSION ! 11-04-12 GEOFF MANIKIN - USE VIRTUAL TEMPERATURE ! ! USAGE: CALL OTLFT(PBND,TBND,QBND,SLINDX) ! INPUT ARGUMENT LIST: ! PBND - PARCEL PRESSURE. ! TBND - PARCEL TEMPERATURE. ! QBND - PARCEL SPECIFIC HUMIDITY. ! ! OUTPUT ARGUMENT LIST: ! SLINDX - LIFTED INDEX. ! ! OUTPUT FILES: ! NONE ! ! SUBPROGRAMS CALLED: ! UTILITIES: ! NONE ! LIBRARY: ! COMMON - CTLBLK ! LOOPS ! MASKS ! PHYS ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN ! MACHINE : CRAY C-90 !$$$ ! ! use vrbls2d, only: T500 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,dimension(IM,jsta:jend),intent(in) :: PBND,TBND,QBND real,dimension(IM,jsta:jend),intent(out) :: SLINDX REAL :: TVP, ESATP, QSATP REAL :: BQS00, SQS00, BQS10, SQS10, P00, P10, P01, P11, BQ, SQ, TQ REAL :: BTHE00, STHE00, BTHE10, STHE10, BTH, STH, TTH REAL :: T00, T10, T01, T11, TBT, QBT, APEBT, TTHBT, PPQ, PP REAL :: TQQ, QQ, TPSP, APESP, TTHES, TP, PARTMP ! INTEGER :: I, J, ITTBK, IQ, IT, IPTBK, ITH, IP INTEGER :: ITTB, IQTB, IPTB, ITHTB ! !******************************************************************** ! START OTLFT HERE. ! ! ZERO LIFTED INDEX ARRAY. ! !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=1,IM SLINDX(I,J) = D00 ENDDO ENDDO ! !--------------FIND EXNER IN BOUNDARY LAYER----------------------------- ! DO J=JSTA,JEND DO I=1,IM TBT = TBND(I,J) QBT = QBND(I,J) APEBT = (H10E5/PBND(I,J))**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 TTHES = 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=(TTHES-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 END DO END DO ! ! END OF ROUTINE. RETURN END