1 SUBROUTINE ttblex(TREF,TTBL,ITB,JTB,KARR,PMIDL &
2 ,pl,qq,pp,rdp,the0,sthe,rdthe,thesp &
34 use ctlblk_mod
, only: jsta, jend, im, jsta_2l, jend_2u, me, &
35 ista, iend, ista_2l, iend_2u
40 integer,
intent(in) :: itb,jtb
41 integer,
intent(in) :: karr(ista:iend,jsta:jend)
42 real,
dimension(JTB,ITB),
intent(in) :: ttbl
43 real,
dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),
intent(in) :: pmidl
44 real,
dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),
intent(out) :: tref
45 real,
dimension(ista:iend,jsta:jend),
intent(out) :: qq,pp
46 real,
dimension(ista:iend,jsta:jend),
intent(in) :: thesp
47 real,
dimension(ITB),
intent(in) :: the0,sthe
48 integer,
dimension(ista:iend,jsta:jend),
intent(out) :: iptb,ithtb
49 real,
intent(in) :: pl,rdp,rdthe
52 integer i,j,ith,ip,iptbk
53 real pk,tpk,t00k,t10k,t01k,t11k,bthe00k,sthe00k,bthk,sthk, &
61 IF(karr(i,j) > 0)
THEN
65 qq(i,j) = tpk-aint(tpk)
66 iptb(i,j) = int(tpk) + 1
68 IF(iptb(i,j) < 1)
THEN
73 IF(iptb(i,j) >= itb)
THEN
81 bthe10k = the0(iptbk+1)
82 sthe10k = sthe(iptbk+1)
84 bthk = (bthe10k-bthe00k)*qq(i,j)+bthe00k
85 sthk = (sthe10k-sthe00k)*qq(i,j)+sthe00k
86 tthk = (thesp(i,j)-bthk)/sthk*rdthe
87 pp(i,j) = tthk-aint(tthk)
91 ithtb(i,j) = int(tthk)+1
93 IF(ithtb(i,j) < 1)
THEN
98 IF(ithtb(i,j) >= jtb)
THEN
105 t00k = ttbl(ith ,ip )
106 t10k = ttbl(ith+1,ip )
107 t01k = ttbl(ith ,ip+1)
108 t11k = ttbl(ith+1,ip+1)
110 tref(i,j) = (t00k+(t10k-t00k)*pp(i,j)+(t01k-t00k)*qq(i,j) &
111 + (t00k-t10k-t01k+t11k)*pp(i,j)*qq(i,j))
117 END SUBROUTINE ttblex