34 use vrbls3d,
only: pmid, q, t, uh, vh, zmid, q2
36 use params_mod,
only: h10e5, capa, d608,h1, epsq2, g, beta
37 use ctlblk_mod,
only: jsta, jend, spval, lm1, jsta_m, jend_m, im, &
38 jsta_2l, jend_2u, lm, &
39 ista, iend, ista_m, iend_m, ista_2l, iend_2u
40 use gridspec_mod,
only: gridtype
46 REAL,
intent(in) :: EL(ista_2l:iend_2u,jsta_2l:jend_2u,LM)
47 REAL,
intent(inout) :: RICHNO(ista_2l:iend_2u,jsta_2l:jend_2u,LM)
49 REAL,
ALLOCATABLE :: THV(:,:,:)
51 real APE,UHKL,ULKL,VHKL,VLKL,WNDSL,WNDSLP,RDZKL, &
52 dthvkl,dukl,dvkl,ri,ct,cs
60 ALLOCATE ( thv(ista_2l:iend_2u,jsta_2l:jend_2u,lm) )
78 ape = (h10e5/pmid(i,j,l))**capa
79 thv(i,j,l) = (q(i,j,l)*d608+h1)*t(i,j,l)*ape
92 if(gridtype /=
'A')
THEN
93 call exch(vtm(1,jsta_2l,l))
94 call exch(uh(1,jsta_2l,l))
95 call exch(vh(1,jsta_2l,l))
96 call exch(vtm(1,jsta_2l,l+1))
97 call exch(uh(1,jsta_2l,l+1))
98 call exch(vh(1,jsta_2l,l+1))
104 IF(gridtype ==
'A')
THEN
109 ELSE IF(gridtype ==
'E')
THEN
119 wndsl = vtm(i,j-1,l)+vtm(iw,j,l)+vtm(ie,j,l)+vtm(i,j+1,l)
120 wndslp = vtm(i,j-1,l+1) + vtm(iw,j,l+1)+ &
121 vtm(ie,j,l+1) + vtm(i,j+1,l+1)
122 IF(wndsl == 0. .OR. wndslp == 0.) cycle
123 uhkl = (uh(i,j-1,l)+uh(iw,j,l)+uh(ie,j,l)+uh(i,j+1,l))/wndsl
124 ulkl = (uh(i,j-1,l+1)+uh(iw,j,l+1)+uh(ie,j,l+1)+ &
125 uh(i,j+1,l+1))/wndslp
126 vhkl = (vh(i,j-1,l)+vh(iw,j,l)+vh(ie,j,l)+vh(i,j+1,l))/wndsl
127 vlkl = (vh(i,j-1,l+1)+vh(iw,j,l+1)+vh(ie,j,l+1)+ &
128 vh(i,j+1,l+1))/wndslp
129 ELSE IF(gridtype ==
'B')
THEN
132 uhkl = (uh(iw,j-1,l)+uh(iw,j,l)+uh(ie,j-1,l)+uh(i,j,l))/4.0
133 ulkl = (uh(iw,j-1,l+1)+uh(iw,j,l+1)+uh(ie,j-1,l+1)+ &
135 vhkl = (vh(iw,j-1,l)+vh(iw,j,l)+vh(ie,j-1,l)+vh(i,j,l))/4.0
136 vlkl = (vh(iw,j-1,l+1)+vh(iw,j,l+1)+vh(ie,j-1,l+1)+ &
140 rdzkl = 1.0 / (zmid(i,j,l)-zmid(i,j,l+1))
148 dthvkl = thv(i,j,l)-thv(i,j,l+1)
149 dukl = (uhkl-ulkl) * rdzkl
150 dvkl = (vhkl-vlkl) * rdzkl
151 cs = dukl*dukl + dvkl*dvkl
160 richno(i,j,l) = spval
166 ct = -1.*g*beta*dthvkl*rdzkl