28 SUBROUTINE calpblregime(PBLREGIME)
31 use vrbls3d, only: uh, vh, pmid, t, q, pint, zmid, zint
32 use vrbls2d, only: ths, qs, smstav, twbs, qwbs, pblh
34 use params_mod, only: p1000, capa, d608, h1, g, rd, cp
35 use ctlblk_mod, only: jsta, jend, spval, lm, jsta_m, jend_m, im, &
36 jsta_2l, jend_2u, ista, iend, ista_m, iend_m,ista_2l,iend_2u
37 use gridspec_mod
, only: gridtype
43 REAL ,
PARAMETER :: vconvc=1.
47 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(inout) :: pblregime
49 integer i,j,ie,iw,ii,jj
50 real ape,thv,thvx,govrth,umass,vmass,wspd,tskv,dthv,rhox,fluxc,tsfc, &
62 pblregime(i,j) = spval
82 IF(gridtype /=
'A')
THEN
83 call exch(uh(1,jsta_2l,lm))
84 call exch(vh(1,jsta_2l,lm))
90 IF(pmid(i,j,lm)<spval .AND. qs(i,j)<spval .AND. &
91 smstav(i,j)<spval)
THEN
92 ape = (p1000/pmid(i,j,lm))**capa
94 thvx = (q(i,j,lm)*d608+h1)*thx
96 IF(gridtype ==
'E')
THEN
99 umass = (uh(i,j-1,lm)+uh(iw,j,lm)+uh(ie,j,lm) &
101 vmass = (vh(i,j-1,lm)+vh(iw,j,lm)+vh(ie,j,lm) &
103 wspd= sqrt(umass*umass+vmass*vmass)
104 ELSE IF(gridtype ==
'B')
THEN
107 umass = (uh(iw,j-1,lm)+uh(iw,j,lm)+uh(ie,j-1,lm) &
109 vmass = (vh(iw,j-1,lm)+vh(iw,j,lm)+vh(ie,j-1,lm) &
111 wspd= sqrt(umass*umass+vmass*vmass)
113 wspd = sqrt(uh(i,j,lm)*uh(i,j,lm)+vh(i,j,lm)*vh(i,j,lm))
116 tskv = ths(i,j)*(1.+d608*qs(i,j)*smstav(i,j))
122 rhox = pint(i,j,lm+1)/rd/(t(i,j,lm)*(q(i,j,lm)*d608+h1))
123 fluxc = max(-twbs(i,j)/rhox/cp - d608*tskv*qwbs(i,j)/rhox,0.)
124 tsfc = ths(i,j)*(pint(i,j,lm+1)/p1000)**capa
125 vconv = vconvc*(g/tsfc*pblh(i,j)*fluxc)**.33
127 vsgd = 0.32 * (max(dx(i,j)/5000.-1.,0.))**.33
128 wspd = sqrt(wspd*wspd+vconv*vconv+vsgd*vsgd)
130 br = govrth*(zmid(i,j,lm)-zint(i,j,lm+1))*dthv/(wspd*wspd)
134 ELSE IF(br == 0.0)
THEN
136 ELSE IF(br < 0.2)
THEN