48 SUBROUTINE calhel2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)
51 use vrbls3d,
only: zmid, uh, vh, u, v, zint
52 use vrbls2d,
only: fis, u10, v10
54 use params_mod,
only: g
55 use lookup_mod,
only: itb,jtb,itbq,jtbq
56 use ctlblk_mod,
only: jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, &
57 lm, im, jm, me, spval, &
58 ista, iend, ista_m, iend_m, ista_2l, iend_2u
59 use gridspec_mod,
only: gridtype
63 real,
PARAMETER :: P150=15000.0,p300=30000.0,s15=15.0
64 real,
PARAMETER :: D3000=3000.0,pi6=0.5235987756,pi9=0.34906585
65 real,
PARAMETER :: D5500=5500.0,d6000=6000.0,d7000=7000.0
66 real,
PARAMETER :: D500=500.0
68 real,
PARAMETER :: D1000=1000.0
69 real,
PARAMETER :: D1500=1500.0
71 REAL,
PARAMETER :: pi = 3.1415927
76 integer,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: LLOW, LUPP
77 real,
intent(in) :: DEPTH(2)
78 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(out) :: UST,VST
79 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u,2),
intent(out) :: HELI
80 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(out) :: CANGLE
82 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: HTSFC, UST6, VST6, UST5, VST5, &
83 ust1, vst1, ushr1, vshr1, &
84 ushr6, vshr6, u1, v1, u2, v2, &
85 hgt1, hgt2, umean, vmean
86 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: USHR05,VSHR05
99 integer,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: COUNT6, COUNT5, COUNT1, L1, L2
105 INTEGER IVE(JM),IVW(JM)
106 integer I,J,IW,IE,JS,JN,JVN,JVS,L,N,lv
107 integer ISTART,ISTOP,JSTART,JSTOP
108 real Z2,DZABV,UMEAN5,VMEAN5,UMEAN1,VMEAN1,UMEAN6,VMEAN6, &
109 denom,z1,z3,dz,dz1,dz2,du1,du2,dv1,dv2
154 IF(gridtype ==
'E')
THEN
165 ELSE IF(gridtype ==
'B')
THEN
199 IF(gridtype /=
'A')
CALL exch(fis(ista_2l:iend_2u,jsta_2l:jend_2u))
201 IF(gridtype /=
'A')
CALL exch(zmid(ista_2l:iend_2u,jsta_2l:jend_2u,l))
211 IF (gridtype==
'B')
THEN
212 htsfc(i,j) = (0.25/g)*(fis(iw,j)+fis(ie,j)+fis(i,jn)+fis(ie,jn))
217 z2 = 0.25*(zmid(iw,j,l)+zmid(ie,j,l)+zmid(i,jn,l)+zmid(ie,jn,l))
219 htsfc(i,j) = (0.25/g)*(fis(iw,j)+fis(ie,j)+fis(i,jn)+fis(i,js))
224 z2 = 0.25*(zmid(iw,j,l)+zmid(ie,j,l)+zmid(i,jn,l)+zmid(i,js,l))
226 dzabv = z2-htsfc(i,j)
229 IF (dzabv <= d6000 .AND. l <= lv)
THEN
230 ust6(i,j) = ust6(i,j) + uh(i,j,l)
231 vst6(i,j) = vst6(i,j) + vh(i,j,l)
232 count6(i,j) = count6(i,j) + 1
235 IF (dzabv < d6000 .AND. dzabv >= d5500 .AND. l <= lv)
THEN
236 ust5(i,j) = ust5(i,j) + uh(i,j,l)
237 vst5(i,j) = vst5(i,j) + vh(i,j,l)
238 count5(i,j) = count5(i,j) + 1
241 IF (dzabv < d500 .AND. l <= lv)
THEN
242 ust1(i,j) = ust1(i,j) + uh(i,j,l)
243 vst1(i,j) = vst1(i,j) + vh(i,j,l)
244 count1(i,j) = count1(i,j) + 1
247 IF (dzabv >= d1000 .AND. dzabv <= d1500 .AND. l <= lv)
THEN
254 IF (dzabv >= d500 .AND. dzabv < d1000 .AND. &
255 l <= lv .AND. l1(i,j) <= l2(i,j))
THEN
271 IF (count5(i,j) == 0)
THEN
277 IF (gridtype==
'B')
THEN
278 z2 = 0.25*(zmid(iw,j,l)+zmid(ie,j,l)+zmid(i,jn,l)+zmid(ie,jn,l))
280 z2 = 0.25*(zmid(iw,j,l)+zmid(ie,j,l)+zmid(i,jn,l)+zmid(i,js,l))
284 IF (dzabv < d7000 .AND. dzabv >= d6000)
THEN
285 ust5(i,j) = ust5(i,j) + uh(i,j,l)
286 vst5(i,j) = vst5(i,j) + vh(i,j,l)
301 IF (count6(i,j) > 0 .AND. count1(i,j) > 0 .AND. count5(i,j) > 0)
THEN
302 umean5 = ust5(i,j) / count5(i,j)
303 vmean5 = vst5(i,j) / count5(i,j)
304 umean1 = ust1(i,j) / count1(i,j)
305 vmean1 = vst1(i,j) / count1(i,j)
306 umean6 = ust6(i,j) / count6(i,j)
307 vmean6 = vst6(i,j) / count6(i,j)
320 ushr6(i,j) = umean5 - umean1
321 vshr6(i,j) = vmean5 - vmean1
323 denom = ushr6(i,j)*ushr6(i,j)+vshr6(i,j)*vshr6(i,j)
324 IF (denom /= 0.0)
THEN
325 ust(i,j) = umean6 + (7.5*vshr6(i,j)/sqrt(denom))
326 vst(i,j) = vmean6 - (7.5*ushr6(i,j)/sqrt(denom))
338 IF(l1(i,j) > 0 .AND. l2(i,j) > 0)
THEN
339 umean(i,j) = u1(i,j) + (d1000 - hgt1(i,j))*(u2(i,j) - &
340 u1(i,j))/(hgt2(i,j) - hgt1(i,j))
341 vmean(i,j) = v1(i,j) + (d1000 - hgt1(i,j))*(v2(i,j) - &
342 v1(i,j))/(hgt2(i,j) - hgt1(i,j))
343 ELSE IF(l1(i,j) > 0 .AND. l2(i,j) == 0)
THEN
346 ELSE IF(l1(i,j) == 0 .AND. l2(i,j) > 0)
THEN
354 IF(l1(i,j) > 0 .OR. l2(i,j) > 0)
THEN
355 ushr05(i,j) = umean1 - u10(i,j)
356 vshr05(i,j) = vmean1 - v10(i,j)
357 ushr1(i,j) = umean(i,j) - u10(i,j)
358 vshr1(i,j) = vmean(i,j) - v10(i,j)
385 if(gridtype /=
'A')
then
386 call exch(zint(1,jsta_2l,l))
387 call exch(zint(1,jsta_2l,l+1))
395 IF (gridtype==
'B')
THEN
396 z2=0.25*(zmid(iw,j,l)+zmid(ie,j,l)+ &
397 zmid(i,jn,l)+zmid(ie,jn,l))
399 z2=0.25*(zmid(iw,j,l)+zmid(ie,j,l)+ &
400 zmid(i,jn,l)+zmid(i,js,l))
404 IF(dzabv < depth(n) .AND. l <= nint(lmv(i,j)))
THEN
405 IF (gridtype==
'B')
THEN
406 z1 = 0.25*(zmid(iw,j,l+1)+zmid(ie,j,l+1)+ &
407 zmid(i,jn,l+1)+zmid(ie,jn,l+1))
408 z3 = 0.25*(zmid(iw,j,l-1)+zmid(ie,j,l-1)+ &
409 zmid(i,jn,l-1)+zmid(ie,jn,l-1))
410 dz = 0.25*((zint(iw,j,l)+zint(ie,j,l)+ &
411 zint(i,jn,l)+zint(ie,jn,l))- &
412 (zint(iw,j,l+1)+zint(ie,j,l+1)+ &
413 zint(i,jn,l+1)+zint(ie,jn,l+1)))
415 z1 = 0.25*(zmid(iw,j,l+1)+zmid(ie,j,l+1)+ &
416 zmid(i,jn,l+1)+zmid(i,js,l+1))
417 z3 = 0.25*(zmid(iw,j,l-1)+zmid(ie,j,l-1)+ &
418 zmid(i,jn,l-1)+zmid(i,js,l-1))
419 dz = 0.25*((zint(iw,j,l)+zint(ie,j,l)+ &
420 zint(i,js,l)+zint(i,jn,l))- &
421 (zint(iw,j,l+1)+zint(ie,j,l+1)+ &
422 zint(i,js,l+1)+zint(i,jn,l+1)))
426 du1 = uh(i,j,l+1)-uh(i,j,l)
427 du2 = uh(i,j,l)-uh(i,j,l-1)
428 dv1 = vh(i,j,l+1)-vh(i,j,l)
429 dv2 = vh(i,j,l)-vh(i,j,l-1)
430 IF( l >= lupp(i,j) .AND. l <= llow(i,j) )
THEN
431 IF( vh(i,j,l) <spval.and.uh(i,j,l) <spval.and. &
432 vh(i,j,l+1)<spval.and.uh(i,j,l+1)<spval.and. &
433 vh(i,j,l-1)<spval.and.uh(i,j,l-1)<spval.and. &
434 vst(i,j) <spval.and.ust(i,j) <spval) &
435 heli(i,j,n) = ((vh(i,j,l)-vst(i,j))* &
436 (dz2*(du1/dz1)+dz1*(du2/dz2)) &
437 - (uh(i,j,l)-ust(i,j))* &
438 (dz2*(dv1/dz1)+dz1*(dv2/dz2))) &
439 *dz/(dz1+dz2)+heli(i,j,n)
441 IF(lupp(i,j) == llow(i,j)) heli(i,j,n) = 0.
458 IF(vshr05(i,j)<spval.and.ushr05(i,j)<spval.and. &
459 vst(i,j)<spval.and.ust(i,j)<spval)
THEN
460 cangle(i,j)=atan2(vshr05(i,j),ushr05(i,j))-atan2(vst(i,j),ust(i,j))
461 cangle(i,j)=(cangle(i,j)/pi)*180.
462 IF(cangle(i,j) > 180.) cangle(i,j)=360.-cangle(i,j)
463 IF(cangle(i,j) < 0. .AND. cangle(i,j) >= -180.) cangle(i,j)=-cangle(i,j)
464 IF(cangle(i,j) < -180.) cangle(i,j)=360.+cangle(i,j)