68 USE vrbls2d,
only: fis, u10, v10
69 use params_mod,
only: gi
70 use ctlblk_mod,
only: jsta, jend, im, jm, lsm, spval, ista, iend
76 REAL,
DIMENSION(IM,JM,LSM),
INTENT(IN) :: U,V,H
77 REAL,
DIMENSION(IM,JM),
INTENT(INOUT) :: LLWS
78 REAL :: Z1,Z2,HZ1,DH,U2,V2,W2,RT
89 z1 = 10.0 + fis(i,j)*gi
91 IF(z1<h(i,j,lsm))
THEN
95 IF(z1>=h(i,j,lp).AND.z1<h(i,j,lp-1))
THEN
101 hz1 = h(i,j,k1-1) - z1
105 IF((hz1+10)>609.6)
THEN
106 u2= u10(i,j) + (u(i,j,k1-1)-u10(i,j))*599.6/hz1
107 v2= v10(i,j) + (v(i,j,k1-1)-v10(i,j))*599.6/hz1
108 z2= fis(i,j)*gi + 609.6
111 dh=dh+(h(i,j,lp-1) - h(i,j,lp))
112 IF((dh+hz1+10)>609.6)
THEN
114 rt=(z2-h(i,j,lp))/(h(i,j,lp-1)-h(i,j,lp))
115 u2=u(i,j,lp)+rt*(u(i,j,lp-1)-u(i,j,lp))
116 v2=v(i,j,lp)+rt*(v(i,j,lp-1)-v(i,j,lp))
125 if(u10(i,j)<spval.and.v10(i,j)<spval) &
126 llws(i,j)=sqrt((u2-u10(i,j))**2+(v2-v10(i,j))**2)/ &
264 SUBROUTINE calcat(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
265 use masks,
only: dx, dy
266 use ctlblk_mod,
only: spval, jsta_2l, jend_2u, jsta_m, jend_m, &
267 im, jm, ista_2l, iend_2u, ista_m, iend_m, ista, iend
268 use gridspec_mod,
only: gridtype
276 REAL,
DIMENSION(ista_2l:iend_2u,jsta_2l:jend_2u),
INTENT(IN) :: U,V,H, &
279 REAL,
DIMENSION(ista_2l:iend_2u,jsta_2l:jend_2u),
INTENT(INOUT) :: CAT
281 REAL DSH, DST, DEF, CVG, VWS, TRBINDX
282 INTEGER IHE(JM),IHW(JM)
284 integer ISTART,ISTOP,JSTART,JSTOP
285 real VWS1,VWS2,VWS3,VWS4
292 IF(gridtype ==
'A')
THEN
299 ELSE IF(gridtype==
'E')
THEN
306 ELSE IF(gridtype==
'B')
THEN
314 print*,
'no gridtype specified, exit calcat comp'
326 DO 100 j=jstart,jstop
329 IF(gridtype==
'B')
THEN
330 IF(u(i,j)<spval.and.u(i,j-1)<spval.and.u(i-1,j)<spval.and.u(i-1,j-1)<spval.and.&
331 v(i,j)<spval.and.v(i,j-1)<spval.and.v(i-1,j)<spval.and.v(i-1,j-1)<spval)
THEN
333 dsh=(0.5*(v(i,j)+v(i,j-1))-0.5*(v(i-1,j)+v(i-1,j-1)))*10000./dx(i,j) &
334 +(0.5*(u(i,j)+u(i-1,j))-0.5*(u(i,j-1)+u(i-1,j-1)))*10000./dy(i,j)
336 dst =(0.5*(u(i,j)+u(i,j-1))-0.5*(u(i-1,j)+u(i-1,j-1)))*10000./dx(i,j) &
337 -(0.5*(v(i,j)+v(i-1,j))-0.5*(v(i,j-1)+v(i-1,j-1)))*10000./dy(i,j)
338 def = sqrt(dsh*dsh + dst*dst)
341 cvg = -((0.5*(u(i,j)+u(i,j-1))-0.5*(u(i-1,j)+u(i-1,j-1)))*10000./dx(i,j) &
342 +(0.5*(v(i,j)+v(i-1,j))-0.5*(v(i,j-1)+v(i-1,j-1)))*10000./dy(i,j))
348 IF(u(i,j+1)<spval.and.u(i,j-1)<spval.and.u(i+ihe(j),j)<spval.and.u(i+ihw(j),j)<spval.and.&
349 v(i,j+1)<spval.and.v(i,j-1)<spval.and.v(i+ihe(j),j)<spval.and.v(i+ihw(j),j)<spval)
THEN
351 dsh = (v(i+ihe(j),j) - v(i+ihw(j),j))*10000./(2*dx(i,j)) &
352 + (u(i,j+1) - u(i,j-1))*10000./(2*dy(i,j))
355 dst = (u(i+ihe(j),j) - u(i+ihw(j),j))*10000./(2*dx(i,j)) &
356 - (v(i,j+1) - v(i,j-1))*10000./(2*dy(i,j))
358 def = sqrt(dsh*dsh + dst*dst)
361 cvg = -( (u(i+ihe(j),j) - u(i+ihw(j),j))*10000./(2*dx(i,j)) &
362 +(v(i,j+1) - v(i,j-1))*10000./(2*dy(i,j)) )
369 IF(gridtype ==
'A')
THEN
371 IF(u_old(i,j)<spval.and.u(i,j)<spval.and.&
372 v_old(i,j)<spval.and.v(i,j)<spval.and.&
373 h_old(i,j)<spval.and.h(i,j)<spval)
THEN
374 vws = ( sqrt(u_old(i,j)**2+v_old(i,j)**2 ) - &
375 sqrt(u(i,j)**2+v(i,j)**2 ) ) * &
376 1000.0/(h_old(i,j) - h(i,j))
380 else IF(gridtype ==
'E')
THEN
382 IF(u_old(i+ihe(j),j)<spval.and.u(i+ihe(j),j)<spval.and.&
383 v_old(i+ihe(j),j)<spval.and.v(i+ihe(j),j)<spval)
THEN
385 vws1 = ( sqrt(u_old(i+ihe(j),j)**2+v_old(i+ihe(j),j)**2 ) -&
386 sqrt(u(i+ihe(j),j)**2+v(i+ihe(j),j)**2 ) )
391 IF(u_old(i+ihw(j),j)<spval.and.u(i+ihw(j),j)<spval.and.&
392 v_old(i+ihw(j),j)<spval.and.v(i+ihw(j),j)<spval)
THEN
393 vws2 = ( sqrt(u_old(i+ihw(j),j)**2+v_old(i+ihw(j),j)**2 ) -&
394 sqrt(u(i+ihw(j),j)**2+v(i+ihw(j),j)**2 ) )
399 IF(u_old(i,j-1)<spval.and.u(i,j-1)<spval.and.&
400 v_old(i,j-1)<spval.and.v(i,j-1)<spval)
THEN
401 vws3 = ( sqrt(u_old(i,j-1)**2+v_old(i,j-1)**2 ) - &
402 sqrt(u(i,j-1)**2+v(i,j-1)**2 ) )
407 IF(u_old(i,j+1)<spval.and.u(i,j+1)<spval.and.&
408 v_old(i,j+1)<spval.and.v(i,j+1)<spval)
THEN
409 vws4 = ( sqrt(u_old(i,j+1)**2+v_old(i,j+1)**2 ) - &
410 sqrt(u(i,j+1)**2+v(i,j+1)**2 ) )
415 IF(vws1<spval.and.vws2<spval.and.vws3<spval.and.vws4<spval.and.&
416 h_old(i,j)<spval.and.h(i,j)<spval)
THEN
417 vws=1000.0*(vws1+vws2+vws3+vws4)/4.0/(h_old(i,j) - h(i,j))
421 ELSE IF(gridtype ==
'B')
THEN
422 IF(u_old(i+ihe(j),j)<spval.and.u(i+ihe(j),j)<spval.and.&
423 v_old(i+ihe(j),j)<spval.and.v(i+ihe(j),j)<spval)
THEN
424 vws1 = ( sqrt(u_old(i+ihe(j),j)**2+v_old(i+ihe(j),j)**2 ) -&
425 sqrt(u(i+ihe(j),j)**2+v(i+ihe(j),j)**2 ) )
430 IF(u_old(i+ihw(j),j)<spval.and.u(i+ihw(j),j)<spval.and.&
431 v_old(i+ihw(j),j)<spval.and.v(i+ihw(j),j)<spval)
THEN
432 vws2 = ( sqrt(u_old(i+ihw(j),j)**2+v_old(i+ihw(j),j)**2 ) -&
433 sqrt(u(i+ihw(j),j)**2+v(i+ihw(j),j)**2 ) )
438 IF(u_old(i,j-1)<spval.and.u(i,j-1)<spval.and.&
439 v_old(i,j-1)<spval.and.v(i,j-1)<spval)
THEN
440 vws3 = ( sqrt(u_old(i,j-1)**2+v_old(i,j-1)**2 ) - &
441 sqrt(u(i,j-1)**2+v(i,j-1)**2 ) )
446 IF(u_old(i-1,j-1)<spval.and.u(i-1,j-1)<spval.and.&
447 v_old(i-1,j-1)<spval.and.v(i-1,j-1)<spval)
THEN
448 vws4 = ( sqrt(u_old(i-1,j-1)**2+v_old(i-1,j-1)**2 ) - &
449 sqrt(u(i-1,j-1)**2+v(i-1,j-1)**2 ) )
454 IF(vws1<spval.and.vws2<spval.and.vws3<spval.and.vws4<spval.and.&
455 h_old(i,j)<spval.and.h(i,j)<spval)
THEN
456 vws=1000.0*(vws1+vws2+vws3+vws4)/4.0/(h_old(i,j) - h(i,j))
462 IF(vws<spval.and.def<spval.and.cvg<spval)
THEN
463 trbindx = abs(vws)*(def + abs(cvg))
467 ELSE IF(trbindx<=8.)
THEN
469 ELSE IF(trbindx<=12.)
THEN