44 use lookup_mod, only: thl, rdth, jtb, qs0, sqs, rdq,itb, ptbl, pl, &
45 rdp, the0, sthe, rdthe, ttbl
46 use ctlblk_mod, only: jsta, jend, im, spval, ista, iend
47 use params_mod, only: d00,h10e5, capa, elocp, eps, oneps
55 real,
PARAMETER :: d8202=.820231e0 , h5e4=5.e4 , p500=50000.
59 real,
intent(out) :: slindx(ista:iend,jsta:jend)
60 REAL :: tvp, esatp, qsatp
61 REAL :: tth, tp, apesp, partmp, thesp, tpsp
62 REAL :: bqs00, sqs00, bqs10, sqs10, bq, sq, tq
63 REAL :: p00, p10, p01, p11, t00, t10, t01, t11
64 REAL :: bthe00, sthe00, bthe10, sthe10, bth, sth
65 REAL :: tqq, qq, qbt, tthbt, tbt, apebt, ppq, pp
67 INTEGER :: i, j, lbtm, ittbk, iq, it, iptbk, ith, ip, iqtb
68 INTEGER :: ittb, iptb, ithtb
84 IF(t(i,j,lbtm)<spval .AND. q(i,j,lbtm)<spval)
THEN
87 apebt = (h10e5/pmid(i,j,lbtm))**capa
90 tth = (tthbt-thl)*rdth
109 bq=(bqs10-bqs00)*tqq+bqs00
110 sq=(sqs10-sqs00)*tqq+sqs00
131 tpsp = p00+(p10-p00)*ppq+(p01-p00)*tqq &
132 +(p00-p10-p01+p11)*ppq*tqq
133 IF(tpsp <= d00) tpsp = h10e5
134 apesp = (h10e5/tpsp)**capa
135 thesp = tthbt*exp(elocp*qbt*apesp/tthbt)
156 bth=(bthe10-bthe00)*qq+bthe00
157 sth=(sthe10-sthe00)*qq+sthe00
158 tth=(thesp-bth)/sth*rdthe
179 partmp=(t00+(t10-t00)*pp+(t01-t00)*qq &
180 +(t00-t10-t01+t11)*pp*qq)
182 partmp=tbt*apebt*d8202
193 qsatp=eps*esatp/(p500-esatp*oneps)
194 tvp=partmp*(1+0.608*qsatp)
195 slindx(i,j)=t500(i,j)-tvp
subroutine otlift(SLINDX)
otlift() computes SFC to 500mb lifted index.
elemental real function, public fpvsnew(t)