37 use vrbls3d,
only: zint, pmid, q, t, uh, vh, el_pbl, zmid
38 use vrbls2d,
only: z0, uz0, vz0
40 use params_mod,
only: d00, d50, h1, d608, rd, d25
41 use ctlblk_mod,
only: jsta_2l, jend_2u, lm, jsta, jend, spval, jsta_m,&
42 jm, im, jend_m, ista, iend, ista_m, iend_m, ista_2l, iend_2u
43 use gridspec_mod,
only: gridtype
48 INTEGER,
dimension(4) :: KK(4)
49 INTEGER,
dimension(jm) :: ive, ivw
50 REAL,
dimension(ista:iend,jsta:jend),
intent(inout) :: TAUX, TAUY
51 REAL,
ALLOCATABLE :: EL(:,:,:)
52 REAL,
dimension(ista:iend,jsta:jend) :: EGRIDU,EGRIDV,EGRID4,EGRID5, EL0
55 integer I,J,LMHK,IE,IW,ii,jj
56 real DZ,RDZ,RSFC,TV,RHO,ULMH,VLMH,DELUDZ,DELVDZ,ELSQR,ZINT1, &
57 zint2,z0v,psfc,tvv,qvv,elv,elv1,elv2
62 ALLOCATE (el(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
84 IF(gridtype ==
'A')
THEN
85 CALL clmax(el0,egridu,egridv,egrid4,egrid5)
92 IF(el(i,j,lmhk-1)<spval.and.z0(i,j)<spval.and. &
93 uz0(i,j)<spval.and.vz0(i,j)<spval)
THEN
97 dz = d50*(zint(i,j,lmhk)-zint(i,j,lmhk+1))
103 psfc = pmid(i,j,lmhk)
104 tv = (h1+d608*q(i,j,lmhk))*t(i,j,lmhk)
115 deludz = (ulmh-uz0(i,j))*rdz
116 delvdz = (vlmh-vz0(i,j))*rdz
120 elsqr = el(i,j,lmhk-1)*el(i,j,lmhk-1)
121 taux(i,j) = rho*elsqr*deludz*deludz
122 tauy(i,j) = rho*elsqr*delvdz*delvdz
131 ELSE IF(gridtype ==
'E')
THEN
132 call exch(zint(1,jsta_2l,lm))
133 call exch(zint(1,jsta_2l,lm+1))
134 call exch(z0(1,jsta_2l))
135 call exch(pmid(1,jsta_2l,lm))
136 call exch(t(1,jsta_2l,lm))
137 call exch(q(1,jsta_2l,lm))
138 call exch(el_pbl(1,jsta_2l,lm))
139 call exch(el_pbl(1,jsta_2l,lm-1))
149 lmhk = nint(lmh(i,j))
152 zint1=(zint(iw,j,lmhk)+zint(ie,j,lmhk) &
153 +zint(i,j+1,lmhk)+zint(i,j-1,lmhk))*d25
154 zint2=(zint(iw,j,lmhk+1)+zint(ie,j,lmhk+1) &
155 +zint(i,j+1,lmhk+1)+zint(i,j-1,lmhk+1))*d25
156 dz = d50*(zint1-zint2)
157 z0v=(z0(iw,j)+z0(ie,j)+z0(i,j+1)+z0(i,j-1))*d25
163 psfc = (pmid(iw,j,lmhk)+pmid(ie,j,lmhk) &
164 +pmid(i,j+1,lmhk)+pmid(i,j-1,lmhk))*d25
165 tvv = (t(iw,j,lmhk)+t(ie,j,lmhk) &
166 +t(i,j+1,lmhk)+t(i,j-1,lmhk))*d25
167 qvv = (q(iw,j,lmhk)+q(ie,j,lmhk) &
168 +q(i,j+1,lmhk)+q(i,j-1,lmhk))*d25
169 tv = (h1+d608*qvv)*tvv
174 deludz = (uh(i,j,lmhk)-uz0(i,j))*rdz
175 delvdz = (vh(i,j,lmhk)-vz0(i,j))*rdz
179 elv1=(el_pbl(iw,j,lmhk)+el_pbl(ie,j,lmhk) &
180 +el_pbl(i,j+1,lmhk)+el_pbl(i,j-1,lmhk))*d25
181 elv2=(el_pbl(iw,j,lmhk-1)+el_pbl(ie,j,lmhk-1) &
182 +el_pbl(i,j+1,lmhk-1)+el_pbl(i,j-1,lmhk-1))*d25
185 taux(i,j)=rho*elsqr*deludz*deludz
186 tauy(i,j)=rho*elsqr*delvdz*delvdz
193 ELSE IF(gridtype ==
'B')
THEN
195 call exch(vh(1,jsta_2l,lm))
199 lmhk = nint(lmh(i,j))
205 dz=zmid(i,j,lmhk)-(z0(i,j)+zint(i,j,lmhk+1))
211 psfc = pmid(i,j,lmhk)
212 tv = (h1+d608*q(i,j,lmhk))*t(i,j,lmhk)
217 ulmh = 0.5*(uh(i-1,j,lmhk)+uh(i,j,lmhk))
218 vlmh = 0.5*(vh(i,j-1,lmhk)+vh(i,j,lmhk))
222 deludz = (ulmh-uz0(i,j))*rdz
223 delvdz = (vlmh-vz0(i,j))*rdz
227 elv=0.5*(el_pbl(i,j,lmhk)+el_pbl(i,j,lmhk-1))
229 taux(i,j) = rho*elsqr*deludz*deludz
232 tauy(i,j) = rho*elsqr*delvdz*delvdz