2 SUBROUTINE tableq(TTBLQ,RDP,RDTHE,PL,THL,STHE,THE0)
13 integer,
parameter :: itb=152,jtb=440
14 real,
parameter :: thh=325.,ph=105000. &
15 &, PQ0=379.90516,A1=610.78,A2=17.2693882,A3=273.16,A4=35.86 &
16 &, R=287.04,CP=1004.6,ELIWV=2.683E6,EPS=1.E-9
18 real,
dimension(JTB,ITB),
intent(out) :: ttblq
19 real,
dimension(ITB),
intent(out) :: the0,sthe
20 real,
intent(in) :: pl,thl
21 real,
intent(out) :: rdp,rdthe
23 real told (jtb),theold(jtb) &
24 &, Y2T (JTB),THENEW(JTB),APT (JTB),AQT (JTB),TNEW (JTB)
26 real pt,rdq,dth,dp,rdth,th,p,ape,denom,the0k, dthe, &
27 qs0k,sqsk,dqs,qs,theok,sthek
28 integer kthm,kpm,kthm1,kpm1,kp,kmm,kth
36 dth=(thh-thl)/
REAL(kthm-1)
37 dp =(ph -pl )/
REAL(kpm -1)
48 ape=(100000./p)**(r/cp)
49 qs=pq0/p*exp(a2*(th-a3*ape)/(th-a4*ape))
51 theold(kth)=th*exp(eliwv*qs/(cp*told(kth)))
55 sthek=theold(kthm)-theold(1)
60 theold(kth)=(theold(kth)-the0k)/sthek
62 IF((theold(kth)-theold(kth-1))<eps) &
63 theold(kth)=theold(kth-1) + eps
76 thenew(kth)=thenew(kth-1)+dthe
82 CALL spline(jtb,kthm,theold,told,y2t,kthm,thenew,tnew,apt,aqt)
85 ttblq(kth,kp)=tnew(kth)