PageRenderTime 58ms CodeModel.GetById 20ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/phys/module_cu_camzm_driver.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 868 lines | 512 code | 106 blank | 250 comment | 17 complexity | 55dc83bbd8c6a078dee556a72d9890c2 MD5 | raw file
Possible License(s): AGPL-1.0
  1. MODULE module_cu_camzm_driver
  2. !Roughly based on zm_conv_intr.F90 from CAM
  3. USE module_cam_support, only: pcnst, pcols, pver, pverp
  4. IMPLICIT NONE
  5. PRIVATE !Default to private
  6. PUBLIC :: & !Public entities
  7. camzm_driver, &
  8. zm_conv_init
  9. CONTAINS
  10. !------------------------------------------------------------------------
  11. SUBROUTINE camzm_driver( &
  12. ids,ide, jds,jde, kds,kde &
  13. ,ims,ime, jms,jme, kms,kme &
  14. ,its,ite, jts,jte, kts,kte &
  15. ,itimestep, bl_pbl_physics, sf_sfclay_physics &
  16. ,th, t_phy, tsk, tke_pbl, ust, qv, qc, qi &
  17. ,mavail, kpbl, pblh, xland, z &
  18. ,z_at_w, dz8w, ht, p, p8w, pi_phy, psfc &
  19. ,u_phy, v_phy, hfx, qfx, cldfra &
  20. ,tpert_camuwpbl &
  21. ,dx, dt, stepcu, cudt, curr_secs, adapt_step_flag&
  22. ,cudtacttime &
  23. ,cape_out, mu_out, md_out, zmdt, zmdq &
  24. ,rliq_out, dlf_out &
  25. ,pconvb, pconvt, cubot, cutop, raincv, pratec &
  26. ,rucuten, rvcuten &
  27. ,rthcuten, rqvcuten, rqccuten, rqicuten &
  28. ,evaptzm, fzsntzm, evsntzm, evapqzm, zmflxprc &
  29. ,zmflxsnw, zmntprpd, zmntsnpd, zmeiheat &
  30. ,cmfmc, cmfmcdzm, preccdzm, precz &
  31. ,zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu, zmvpgd &
  32. ,zmicuu, zmicud, zmicvu, zmicvd &
  33. ,zmdice, zmdliq &
  34. )
  35. ! This routine is based on zm_conv_tend in CAM. It handles the mapping of
  36. ! variables from the WRF to the CAM framework for the Zhang-McFarlane
  37. ! convective parameterization.
  38. !
  39. ! Author: William.Gustafson@pnl.gov, Nov. 2009
  40. ! Last modified: William.Gustafson@pnl.gov, Nov. 2010
  41. !------------------------------------------------------------------------
  42. USE shr_kind_mod, only: r8 => shr_kind_r8
  43. USE physconst, only: cpair, gravit
  44. USE module_cu_camzm, only: convtran, momtran, zm_conv_evap, zm_convr
  45. ! Subroutine arguments...
  46. INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
  47. ims,ime, jms,jme, kms,kme, &
  48. its,ite, jts,jte, kts,kte, &
  49. bl_pbl_physics, & !pbl scheme
  50. itimestep, & !time step index
  51. sf_sfclay_physics, & !surface layer scheme
  52. stepcu !number of time steps between Cu calls
  53. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: &
  54. cldfra, & !cloud fraction
  55. dz8w, & !height between interfaces (m)
  56. p, & !pressure at mid-level (Pa)
  57. p8w, & !pressure at level interface (Pa)
  58. pi_phy, & !exner function, (p0/p)^(R/cpair) (none)
  59. qv, & !water vapor mixing ratio (kg/kg-dry air)
  60. th, & !potential temperature (K)
  61. tke_pbl, & !turbulent kinetic energy from PBL (m2/s2)
  62. t_phy, & !temperature (K)
  63. u_phy, & !zonal wind component on T points (m/s)
  64. v_phy, & !meridional wind component on T points (m/s)
  65. z, & !height above sea level at mid-level (m)
  66. z_at_w !height above sea level at interface (m)
  67. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN), OPTIONAL :: &
  68. qc, & !cloud droplet mixing ratio (kg/kg-dry air)
  69. qi !cloud ice crystal mixing ratio (kg/kg-dry air)
  70. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
  71. dlf_out, & !detraining cloud water tendendcy
  72. evaptzm, & !temp. tendency - evap/snow prod from ZM (K/s)
  73. fzsntzm, & !temp. tendency - rain to snow conversion from ZM (K/s)
  74. evsntzm, & !temp. tendency - snow to rain conversion from ZM (K/s)
  75. evapqzm, & !spec. humidity tend. - evaporation from ZM (kg/kg/s)
  76. zmflxprc, & !flux of precipitation from ZM (kg/m2/s)
  77. zmflxsnw, & !flux of snow from ZM (kg/m2/s)
  78. zmntprpd, & !net precipitation production from ZM (kg/kg/s)
  79. zmntsnpd, & !net snow production from ZM (kg/kg/s)
  80. zmeiheat, & !heating by ice and evaporation from ZM (W/kg)
  81. cmfmc, & !convective mass flux--m sub c, deep here but ultimately deep+shallow (kg/m2/s)
  82. cmfmcdzm, & !convection mass flux from ZM deep (kg/m2/s)
  83. md_out, & !output convective downdraft mass flux (kg/m2/s)
  84. mu_out, & !output convective updraft mass flux (kg/m2/s)
  85. rucuten, & !UNcoupled zonal wind tendency due to Cu scheme (m/s2)
  86. rvcuten, & !UNcoupled meridional wind tendency due to Cu scheme (m/s2)
  87. rthcuten, & !UNcoupled potential temperature tendendcy due to cu scheme (K/s)
  88. rqvcuten, & !UNcoupled water vapor mixing ratio tendency due to Cu scheme (kg/kg/s)
  89. zmdt, & !temp. tendency from moist convection (K/s)
  90. zmdq, & !spec. humidity tendency from moist convection (kg/kg/s)
  91. zmmtu, & !U tendency from ZM convective momentum transport (m/s2)
  92. zmmtv, & !V tendency from ZM convective momentum transport (m/s2)
  93. zmupgu, & !zonal force from ZM updraft pressure gradient term (m/s2)
  94. zmupgd, & !zonal force from ZM downdraft pressure gradient term (m/s2)
  95. zmvpgu, & !meridional force from ZM updraft pressure gradient term (m/s2)
  96. zmvpgd, & !meridional force from ZM downdraft pressure gradient term (m/s2)
  97. zmicuu, & !ZM in-cloud U updrafts (m/s)
  98. zmicud, & !ZM in-cloud U downdrafts (m/s)
  99. zmicvu, & !ZM in-cloud V updrafts (m/s)
  100. zmicvd, & !ZM in-cloud V downdrafts (m/s)
  101. zmdice, & !ZM cloud ice tendency (kg/kg/s)
  102. zmdliq !ZM cloud liquid tendency (kg/kg/s)
  103. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT), OPTIONAL :: &
  104. rqccuten, & !UNcoupled cloud droplet mixing ratio tendency due to Cu scheme (kg/kg/s)
  105. rqicuten !UNcoupled ice crystal mixing ratio tendency due to Cu scheme (kg/kg/s)
  106. REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: &
  107. hfx, & !upward heat flux at sfc (W/m2)
  108. ht, & !terrain height (m)
  109. xland, & !land/water mask, 1=land, 2=water
  110. mavail, & !soil moisture availability
  111. pblh, & !planetary boundary layer height (m)
  112. psfc, & !surface pressure (Pa)
  113. qfx, & !upward moisture flux at sfc (kg/m2/s)
  114. tpert_camuwpbl, & !temperature perturbation from UW CAM PBL
  115. tsk, & !skin temperature (K)
  116. ust !u* in similarity theory (m/s)
  117. REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
  118. cape_out, & !convective available potential energy (J/kg)
  119. cubot, & !level number of base of convection
  120. cutop, & !level number of top of convection
  121. pconvb, & !pressure of base of convection (Pa)
  122. pconvt, & !pressure of top of convection (Pa)
  123. pratec, & !rain rate returned to WRF for accumulation (mm/s)
  124. preccdzm, & !convection precipitation rate from ZM deep (m/s)
  125. precz, & !total precipitation rate from ZM (m/s)
  126. raincv, & !time-step convective rain amount (mm)
  127. rliq_out !vertical integral of reserved cloud water
  128. REAL, INTENT(IN) :: &
  129. cudt, & !cumulus time step (min)
  130. curr_secs, & !current forecast time (s)
  131. dt, & !domain time step (s)
  132. dx !grid spacing (m)
  133. REAL, INTENT (INOUT) :: &
  134. cudtacttime !for adaptive time stepping, next to to run scheme (s)
  135. INTEGER, DIMENSION( ims:ime, jms:jme), INTENT(IN) :: &
  136. kpbl !index of PBL level
  137. LOGICAL, INTENT(IN), OPTIONAL :: &
  138. adapt_step_flag !using adaptive time steps?
  139. ! Local variables...
  140. !Variables dimensioned for input to ZM routines
  141. REAL(r8), DIMENSION(pcols, kte+1) :: &
  142. mcon, & !convective mass flux--m sub c (sub arg out in CAM)
  143. pflx, & !scattered precip flux at each level (sub arg out in CAM)
  144. pint8, & !pressure at layer interface (Pa)
  145. zi8 !height above sea level at mid-level (m)
  146. REAL(r8), DIMENSION(pcols, kte, pcnst) :: &
  147. qh8 !specific humidity (kg/kg-moist air)
  148. REAL(r8), DIMENSION(pcols, kte, 3) :: &
  149. cloud, & !holder for cloud water and ice (q in CAM)
  150. cloudtnd, & !holder for cloud tendencies (ptend_loc%q in CAM)
  151. fracis !fraction of cloud species that are insoluble
  152. REAL(r8), DIMENSION(pcols, kte, 2) :: &
  153. icwu, & !in-cloud winds in upraft (m/s)
  154. icwd, & !in-cloud winds in downdraft (m/s)
  155. pguall, & !apparent force from updraft pres. gradient (~units?)
  156. pgdall, & !apparent force from downdraft pres. gradient (~units?)
  157. winds, & !wind components (m/s)
  158. wind_tends !wind component tendencies (m/s2)
  159. REAL(r8), DIMENSION(pcols, kte) :: &
  160. cld8, & !cloud fraction
  161. cme, & !cmf condensation - evaporation (~units?, sub arg out in CAM)
  162. dlf, & !scattered version of the detraining cld h2o tendency (~units?)
  163. fake_dpdry, & !place holder for dpdry, delta pres. of dry atmos.
  164. flxprec, & !evap outfld: convective-scale flux of precip at interfaces (kg/m2/s)
  165. flxsnow, & !evap outfld: convective-scale flux of snow at interfaces (kg/m2/s)
  166. ntprprd, & !evap outfld: net precip production in layer (kg/kg/s)
  167. ntsnprd, & !evap outfld: net snow production in layer (kg/kg/s)
  168. pdel8, & !pressure thickness of layer (between interfaces, Pa)
  169. pmid8, & !pressure at layer middle (Pa)
  170. ql8, & !cloud liquid water (~units?)
  171. qi8, & !cloud ice (~units?)
  172. t8, & !temperature (K)
  173. zm8, & !height above ground at mid-level (m)
  174. qtnd, & !specific humidity tendency (kg/kg/s)
  175. rprd, & !rain production rate (kg/kg/s, comes from pbuf array in CAM, add to restart?~)
  176. stnd, & !heating rate (dry static energy tendency, W/kg)
  177. tend_s_snwprd, & !heating rate of snow production (~units?)
  178. tend_s_snwevmlt, & !heating rate of evap/melting of snow (~units?)
  179. zdu !detraining mass flux (~units? sub arg out in CAM)
  180. REAL(r8), DIMENSION(pcols) :: &
  181. cape, & !convective available potential energy (J/kg)
  182. jctop, & !row of top-of-deep-convection indices passed out (sub arg out in CAM)
  183. jcbot, & !row of base of cloud indices passed out (sub arg out in CAM)
  184. landfrac, & !land fraction
  185. pblh8, & !planetary boundary layer height (m)
  186. phis, & !geopotential at terrain height (m2/s2)
  187. prec, & !convective-scale precipitation rate from ZM (m/s)
  188. rliq, & !reserved liquid (not yet in cldliq) for energy integrals (units? sub arg out in CAM)
  189. snow, & !convective-scale snowfall rate from ZM (m/s)
  190. tpert !thermal (convective) temperature excess (K)
  191. !Variables that were declared at the module level of zm_conv_intr in
  192. !CAM. In that context they needed to be held between calls to
  193. !zm_conv_tend and zm_conv_tend2 at the chunk level. In WRF, these vars
  194. !are setup to hold the whole "memory" dimension, but as a 1-D vector
  195. !instead of a 2-D array as is typically done in WRF. This allows us to
  196. !leave the CAM routines in tact. For now, this forces us to immediately
  197. !call zm_conv_tend2 before leaving this module, but it allows us to
  198. !follow the WRF rules. We can deal with generalizing this for handling
  199. !tracer convective transport of aerosols later.~
  200. REAL(r8), DIMENSION(pcols, kte, (ime-ims+1)*(jme-jms+1)) :: &
  201. dp, & !layer pres. thickness between interfaces (mb)
  202. du, &
  203. ed, &
  204. eu, &
  205. md, &
  206. mu
  207. REAL(r8), DIMENSION(pcols, (ime-ims+1)*(jme-jms+1)) :: &
  208. dsubcld ! layer pres. thickness between LCL and maxi (mb)
  209. INTEGER, DIMENSION(pcols, (ime-ims+1)*(jme-jms+1)) :: &
  210. ideep, & ! holds position of gathered points
  211. jt, & ! top-level index of deep cumulus convection
  212. maxg ! gathered values of maxi
  213. INTEGER, DIMENSION((ime-ims+1)*(jme-jms+1)) :: &
  214. lengath ! number of gathered points
  215. !Other local vars
  216. INTEGER :: i, j, k, kflip, n, ncnst
  217. INTEGER :: lchnk !chunk identifier, used to map 2-D to 1-D arrays in WRF
  218. INTEGER :: ncol !number of atmospheric columns in chunk
  219. LOGICAL, DIMENSION(3) :: l_qt !logical switches for constituent tendency presence
  220. LOGICAL, DIMENSION(2) :: l_windt !logical switches for wind tendency presence
  221. LOGICAL :: run_param , & !flag for handling alternate cumulus call freq.
  222. doing_adapt_dt , decided
  223. !
  224. ! Check to see if this is a convection timestep...
  225. !
  226. ! Initialization for adaptive time step.
  227. doing_adapt_dt = .FALSE.
  228. IF ( PRESENT(adapt_step_flag) ) THEN
  229. IF ( adapt_step_flag ) THEN
  230. doing_adapt_dt = .TRUE.
  231. IF ( cudtacttime .EQ. 0. ) THEN
  232. cudtacttime = curr_secs + cudt*60.
  233. END IF
  234. END IF
  235. END IF
  236. ! Do we run through this scheme or not?
  237. ! Test 1: If this is the initial model time, then yes.
  238. ! ITIMESTEP=1
  239. ! Test 2: If the user asked for the cumulus to be run every time step, then yes.
  240. ! CUDT=0 or STEPCU=1
  241. ! Test 3: If not adaptive dt, and this is on the requested cumulus frequency, then yes.
  242. ! MOD(ITIMESTEP,STEPCU)=0
  243. ! Test 4: If using adaptive dt and the current time is past the last requested activate cumulus time, then yes.
  244. ! CURR_SECS >= CUDTACTTIME
  245. ! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
  246. ! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
  247. ! We only proceed to other tests if the previous tests all have left decided as FALSE.
  248. ! If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
  249. ! cumulus run.
  250. decided = .FALSE.
  251. run_param = .FALSE.
  252. IF ( ( .NOT. decided ) .AND. &
  253. ( itimestep .EQ. 1 ) ) THEN
  254. run_param = .TRUE.
  255. decided = .TRUE.
  256. END IF
  257. IF ( ( .NOT. decided ) .AND. &
  258. ( ( cudt .EQ. 0. ) .OR. ( stepcu .EQ. 1 ) ) ) THEN
  259. run_param = .TRUE.
  260. decided = .TRUE.
  261. END IF
  262. IF ( ( .NOT. decided ) .AND. &
  263. ( .NOT. doing_adapt_dt ) .AND. &
  264. ( MOD(itimestep,stepcu) .EQ. 0 ) ) THEN
  265. run_param = .TRUE.
  266. decided = .TRUE.
  267. END IF
  268. IF ( ( .NOT. decided ) .AND. &
  269. ( doing_adapt_dt ) .AND. &
  270. ( curr_secs .GE. cudtacttime ) ) THEN
  271. run_param = .TRUE.
  272. decided = .TRUE.
  273. cudtacttime = curr_secs + cudt*60
  274. END IF
  275. !Leave the subroutine if it is not yet time to call the cumulus param
  276. if( .not. run_param ) return
  277. !
  278. ! Initialize...
  279. !
  280. ncol = 1 !chunk size in WRF is 1 since we loop over all columns in a tile
  281. cape_out(its:ite, jts:jte) = 0.
  282. mu_out(its:ite, kts:kte, jts:jte) = 0.
  283. md_out(its:ite, kts:kte, jts:jte) = 0.
  284. zmdt(its:ite, kts:kte, jts:jte) = 0.
  285. !
  286. ! Map variables to inputs for zm_convr and call it...
  287. ! Loop over the points in the tile and treat them each as a CAM chunk.
  288. !
  289. do j = jts,jte
  290. do i = its,ite
  291. lchnk = (j-jts)*(ite-its+1) + (i-its+1) !1-D index location from the 2-D tile
  292. !Flip variables on the layer middles
  293. do k = kts,kte
  294. kflip = kte-k+1
  295. cld8(1,kflip) = cldfra(i,k,j)
  296. pdel8(1,kflip) = p8w(i,k,j) - p8w(i,k+1,j)
  297. pmid8(1,kflip) = p(i,k,j)
  298. qh8(1,kflip,1) = max( qv(i,k,j)/(1.+qv(i,k,j)), 1e-30 ) !values of 0 cause a crash in entropy
  299. if( present(qc) ) then
  300. ql8(1,kflip) = qc(i,k,j)/(1.+qv(i,k,j)) !Convert to moist mix ratio
  301. else
  302. ql8(1,kflip) = 0.
  303. end if
  304. if( present(qi) ) then
  305. qi8(1,kflip) = qi(i,k,j)/(1.+qv(i,k,j)) !Used in convtran, ditto for conversion
  306. else
  307. qi8(1,kflip) = 0.
  308. end if
  309. t8(1,kflip) = t_phy(i,k,j)
  310. zm8(1,kflip) = z(i,k,j) - ht(i,j) !Height above the ground at midlevels
  311. end do
  312. !Flip variables on the layer interfaces
  313. do k = kts,kte+1
  314. kflip = kte-k+2
  315. pint8(1,kflip) = p8w(i,k,j)
  316. zi8(1,kflip) = z_at_w(i,k,j) -ht(i,j) !Height above the ground at interfaces
  317. end do
  318. !Other necessary conversions for input to ZM
  319. if( xland(i,j)==2 ) then
  320. landfrac(1) = 1. !land, WRF is all or nothing
  321. else
  322. landfrac(1) = 0. !water
  323. end if
  324. pblh8(1) = pblh(i,j)
  325. phis(1) = ht(i,j)*gravit
  326. call get_tpert(bl_pbl_physics, sf_sfclay_physics, dx, &
  327. mavail(i,j), kpbl(i,j), pblh(i,j), &
  328. dz8w(i,1,j), psfc(i,j), qv(i,1,j), t_phy(i,1,j), &
  329. th(i,1,j), tsk(i,j), tke_pbl(i,:,j), ust(i,j), &
  330. u_phy(i,1,j), v_phy(i,1,j), hfx(i,j), qfx(i,j), &
  331. tpert_camuwpbl(i,j), kte, &
  332. tpert(1))
  333. !Call the Zhang-McFarlane (1996) convection parameterization
  334. !NOTE: The 0.5*dt is correct and is a nuance of CAM typically
  335. ! using 2*dt for physics tendencies. Everywhere in zm_convr
  336. ! that dt is used, the dt is multiplied by 2 to get back to
  337. ! the 2*dt. Everywhere else in the CAM ZM interface the full
  338. ! 2*dt is passed into the subroutines. In WRF we use 1*dt
  339. ! in place of CAM's 2*dt since the adjustment is made
  340. ! elsewhere.
  341. call zm_convr( lchnk, ncol, &
  342. t8, qh8, prec, jctop, jcbot, &
  343. pblh8, zm8, phis, zi8, qtnd, &
  344. stnd, pmid8, pint8, pdel8, &
  345. 0.5_r8*real(dt,r8), mcon, cme, cape, &
  346. tpert, dlf, pflx, zdu, rprd, &
  347. mu(:,:,lchnk), md(:,:,lchnk),du(:,:,lchnk),eu(:,:,lchnk),ed(:,:,lchnk), &
  348. dp(:,:,lchnk), dsubcld(:,lchnk), jt(:,lchnk), maxg(:,lchnk), ideep(:,lchnk), &
  349. lengath(lchnk), ql8, rliq, landfrac )
  350. !Start mapping CAM output to WRF output variables. We follow the
  351. !same order as in CAM's zm_conv_tend to ease maintenance...
  352. do k=kts,kte
  353. kflip = kte-k+1
  354. dlf_out(i,k,j) = dlf(1,kflip)
  355. end do
  356. cape_out(i,j) = cape(1)
  357. rliq_out(i,j) = rliq(1)
  358. !Convert mass flux from reported mb/s to kg/m2/s
  359. mcon(:ncol,:pver) = mcon(:ncol,:pver) * 100._r8/gravit
  360. ! Store upward and downward mass fluxes in un-gathered arrays
  361. ! + convert from mb/s to kg/m2/s
  362. do n=1,lengath(lchnk)
  363. do k=kts,kte
  364. kflip = kte-k+1
  365. ! ii = ideep(n,lchnk) <--in WRF this is always 1 because chunk size=1
  366. mu_out(i,k,j) = mu(n,kflip,lchnk) * 100._r8/gravit
  367. md_out(i,k,j) = md(n,kflip,lchnk) * 100._r8/gravit
  368. end do
  369. end do
  370. do k=kts,kte
  371. kflip = kte-k+1
  372. zmdt(i,k,j) = stnd(1,kflip)/cpair
  373. zmdq(i,k,j) = qtnd(1,kflip)
  374. end do
  375. !Top and bottom pressure of convection
  376. pconvt(i,j) = p8w(i,1,j)
  377. pconvb(i,j) = p8w(i,1,j)
  378. do n = 1,lengath(lchnk)
  379. if (maxg(n,lchnk).gt.jt(n,lchnk)) then
  380. pconvt(i,j) = pmid8(ideep(n,lchnk),jt(n,lchnk)) ! gathered array (or jctop ungathered)
  381. pconvb(i,j) = pmid8(ideep(n,lchnk),maxg(n,lchnk))! gathered array
  382. endif
  383. end do
  384. cutop(i,j) = jctop(1)
  385. cubot(i,j) = jcbot(1)
  386. !Add tendency from this process to tendencies arrays. Also,
  387. !increment the local state arrays to reflect additional tendency
  388. !from zm_convr, i.e. the physics update call in CAM. Note that
  389. !we are not readjusting the pressure levels to hydrostatic
  390. !balance for the new virtual temperature like is done in CAM. We
  391. !will let WRF take care of such things later for the total
  392. !tendency.
  393. do k=kts,kte
  394. kflip = kte-k+1
  395. !Convert temperature to potential temperature and
  396. !specific humidity to water vapor mixing ratio
  397. rthcuten(i,k,j) = zmdt(i,k,j)/pi_phy(i,k,j)
  398. rqvcuten(i,k,j) = zmdq(i,k,j)/(1._r8 - zmdq(i,k,j))
  399. t8(1,kflip) = t8(1,kflip) + zmdt(i,k,j)*real(dt,r8)
  400. qh8(1,kflip,1) = qh8(1,kflip,1) + zmdq(i,k,j)*real(dt,r8)
  401. end do
  402. ! Determine the phase of the precipitation produced and add latent heat of fusion
  403. ! Evaporate some of the precip directly into the environment (Sundqvist)
  404. ! Allow this to use the updated state1 (t8 and qh8 in WRF) and the fresh ptend_loc type
  405. ! heating and specific humidity tendencies produced
  406. qtnd = 0._r8 !re-initialize tendencies (i.e. physics_ptend_init(ptend_loc))
  407. stnd = 0._r8
  408. call zm_conv_evap(ncol, lchnk, &
  409. t8, pmid8, pdel8, qh8(:,:,1), &
  410. stnd, tend_s_snwprd, tend_s_snwevmlt, qtnd, &
  411. rprd, cld8, real(dt,r8), &
  412. prec, snow, ntprprd, ntsnprd , flxprec, flxsnow)
  413. ! Parse output variables from zm_conv_evap
  414. do k=kts,kte
  415. kflip = kte-k+1
  416. evaptzm(i,k,j) = stnd(1,kflip)/cpair
  417. fzsntzm(i,k,j) = tend_s_snwprd(1,kflip)/cpair
  418. evsntzm(i,k,j) = tend_s_snwevmlt(1,kflip)/cpair
  419. evapqzm(i,k,j) = qtnd(1,kflip)
  420. zmflxprc(i,k,j) = flxprec(1,kflip)
  421. zmflxsnw(i,k,j) = flxsnow(1,kflip)
  422. zmntprpd(i,k,j) = ntprprd(1,kflip)
  423. zmntsnpd(i,k,j) = ntsnprd(1,kflip)
  424. zmeiheat(i,k,j) = stnd(1,kflip) !Do we really need this and evaptzm?
  425. cmfmc(i,k,j) = mcon(1,kflip) !Set to deep value here, shallow added in UW scheme
  426. cmfmcdzm(i,k,j) = mcon(1,kflip)
  427. preccdzm(i,j) = prec(1) !Rain rate from just deep
  428. precz(i,j) = prec(1) !Rain rate for total convection (just deep right now)
  429. pratec(i,j) = prec(1)*1e3 !Rain rate used in WRF for accumulation (mm/s)
  430. raincv(i,j) = pratec(i,j)*dt !Rain amount for time step returned back to WRF
  431. end do
  432. !Add tendency from zm_conv_evap to tendencies arrays. Also,
  433. !increment the local state arrays to reflect additional tendency
  434. !Note that we are not readjusting the pressure levels to hydrostatic
  435. !balance for the new virtual temperature like is done in CAM. We
  436. !will let WRF take care of such things later for the total
  437. !tendency.
  438. do k=kts,kte
  439. kflip = kte-k+1
  440. !Convert temperature to potential temperature and
  441. !specific humidity to water vapor mixing ratio
  442. rthcuten(i,k,j) = rthcuten(i,k,j) + &
  443. evaptzm(i,k,j)/pi_phy(i,k,j)
  444. rqvcuten(i,k,j) = rqvcuten(i,k,j) + &
  445. evapqzm(i,k,j)/(1. - qv(i,k,j))
  446. t8(1,kflip) = t8(1,kflip) + evaptzm(i,k,j)*real(dt,r8)
  447. qh8(1,kflip,1) = qh8(1,kflip,1) + evapqzm(i,k,j)*real(dt,r8)
  448. end do
  449. ! Momentum transport
  450. stnd = 0._r8 !Zero relevant tendencies in preparation
  451. wind_tends = 0._r8
  452. do k=kts,kte
  453. kflip = kte-k+1
  454. winds(1,k,1) = u_phy(i,kflip,j)
  455. winds(1,k,2) = v_phy(i,kflip,j)
  456. end do
  457. l_windt(1:2) = .true.
  458. call momtran (lchnk, ncol, &
  459. l_windt, winds, 2, mu(:,:,lchnk), md(:,:,lchnk), &
  460. du(:,:,lchnk), eu(:,:,lchnk), ed(:,:,lchnk), dp(:,:,lchnk), dsubcld(:,lchnk), &
  461. jt(:,lchnk),maxg(:,lchnk), ideep(:,lchnk), 1, lengath(lchnk), &
  462. itimestep, wind_tends, pguall, pgdall, icwu, icwd, real(dt,r8), stnd )
  463. !Add tendency from momtran to tendencies arrays. Also,
  464. !increment the local state arrays to reflect additional tendency
  465. !Note that we are not readjusting the pressure levels to hydrostatic
  466. !balance for the new virtual temperature like is done in CAM. We
  467. !will let WRF take care of such things later for the total
  468. !tendency.
  469. do k=kts,kte
  470. kflip = kte-k+1
  471. !Convert temperature to potential temperature and
  472. !specific humidity to water vapor mixing ratio
  473. rucuten(i,k,j) = wind_tends(1,kflip,1)
  474. rvcuten(i,k,j) = wind_tends(1,kflip,2)
  475. rthcuten(i,k,j) = rthcuten(i,k,j) + &
  476. stnd(1,kflip)/cpair/pi_phy(i,k,j)
  477. t8(1,kflip) = t8(1,kflip) + stnd(1,kflip)/cpair*real(dt,r8)
  478. !winds is not used again so do not bother updating them
  479. end do
  480. !Parse output arrays for momtran
  481. do k=kts,kte
  482. kflip = kte-k+1
  483. zmmtu(i,k,j) = wind_tends(1,kflip,1) !wind tendencies...
  484. zmmtv(i,k,j) = wind_tends(1,kflip,2)
  485. zmupgu(i,k,j) = pguall(1,kflip,1) !apparent force pres. grads...
  486. zmupgd(i,k,j) = pgdall(1,kflip,1)
  487. zmvpgu(i,k,j) = pguall(1,kflip,2)
  488. zmvpgd(i,k,j) = pgdall(1,kflip,2)
  489. zmicuu(i,k,j) = icwu(1,kflip,1) !in-cloud winds...
  490. zmicud(i,k,j) = icwd(1,kflip,1)
  491. zmicvu(i,k,j) = icwu(1,kflip,2)
  492. zmicvd(i,k,j) = icwd(1,kflip,2)
  493. end do
  494. !Setup for convective transport of cloud water and ice
  495. !~We should set this up to use an integer pointer instead of
  496. ! hard-coded numbers for each species so that we can easily
  497. ! handle other species. Something to come back to later...
  498. l_qt(1) = .false. !do not mix water vapor
  499. l_qt(2:3) = .true. !do mix cloud water and ice
  500. cloudtnd = 0._r8
  501. fracis(1,:,1:3) = 0._r8 !all cloud liquid & ice is soluble
  502. ncnst = 3 !number of constituents in cloud array (including vapor)
  503. fake_dpdry = 0._r8 !delta pres. for dry atmos. (0 since assuming moist mix ratios)
  504. do k=kts,kte
  505. kflip = kte-k+1
  506. cloud(1,kflip,1) = qh8(1,kflip,1) !We can either use moist mix ratios, as is
  507. cloud(1,kflip,2) = ql8(1,kflip) !done here, or else use dry mix ratios, send
  508. cloud(1,kflip,3) = qi8(1,kflip) !in appropriate dpdry values, and return the
  509. !approp. response from cnst_get_type_byind
  510. end do
  511. call convtran (lchnk, &
  512. l_qt, cloud, ncnst, mu(:,:,lchnk), md(:,:,lchnk), &
  513. du(:,:,lchnk), eu(:,:,lchnk), ed(:,:,lchnk), dp(:,:,lchnk), dsubcld(:,lchnk), &
  514. jt(:,lchnk), maxg(:,lchnk), ideep(:,lchnk), 1, lengath(lchnk), &
  515. itimestep, fracis, cloudtnd, fake_dpdry)
  516. !Parse output for convtran and increment tendencies
  517. do k=kts,kte
  518. kflip = kte-k+1
  519. zmdice(i,k,j) = cloudtnd(1,kflip,3)
  520. zmdliq(i,k,j) = cloudtnd(1,kflip,2)
  521. !Convert cloud tendencies from wet to dry mix ratios
  522. if( present(rqccuten) ) then
  523. rqccuten(i,k,j) = cloudtnd(1,kflip,2)/(1. - qv(i,k,j))
  524. end if
  525. if( present(rqicuten) ) then
  526. rqicuten(i,k,j) = cloudtnd(1,kflip,3)/(1. - qv(i,k,j))
  527. end if
  528. end do
  529. end do !i-loop
  530. end do !j-loop
  531. END SUBROUTINE camzm_driver
  532. !------------------------------------------------------------------------
  533. SUBROUTINE zm_conv_init(rucuten, rvcuten, rthcuten, rqvcuten, &
  534. rqccuten, rqicuten, &
  535. p_qc, p_qi, param_first_scalar, &
  536. restart, &
  537. ids, ide, jds, jde, kds, kde, &
  538. ims, ime, jms, jme, kms, kme, &
  539. its, ite, jts, jte, kts, kte )
  540. ! Initialization routine for Zhang-McFarlane cumulus parameterization
  541. ! from CAM. The routine with this name in CAM is revamped here to give
  542. ! the needed functionality within WRF.
  543. !
  544. ! Author: William.Gustafson@pnl.gov, Nov. 2009
  545. !------------------------------------------------------------------------
  546. USE module_cam_esinti, only: esinti
  547. USE physconst, only: epsilo, latvap, latice, rh2o, cpair, tmelt
  548. USE module_bl_camuwpbl_driver, only: vd_register
  549. USE module_cu_camzm, only: zm_convi, zmconv_readnl
  550. LOGICAL , INTENT(IN) :: restart
  551. INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
  552. ims, ime, jms, jme, kms, kme, &
  553. its, ite, jts, jte, kts, kte, &
  554. p_qc, p_qi, param_first_scalar
  555. REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT) :: &
  556. rucuten, &
  557. rvcuten, &
  558. rthcuten, &
  559. rqvcuten, &
  560. rqccuten, &
  561. rqicuten
  562. integer :: i, itf, j, jtf, k, ktf
  563. integer :: limcnv
  564. jtf = min(jte,jde-1)
  565. ktf = min(kte,kde-1)
  566. itf = min(ite,ide-1)
  567. !
  568. ! Initialize module_cam_support variables...
  569. ! This could be moved to a master "cam-init" subroutine once multiple CAM
  570. ! parameterizations are implemented in WRF. For now, it doesn't hurt to
  571. ! have these possibly initialized more than once since they are
  572. ! essentially constant.
  573. !
  574. pver = ktf-kts+1
  575. pverp = pver+1
  576. !
  577. ! Initialize the saturation vapor pressure look-up table...
  578. ! This could be moved to a master cam-init subroutine too if it is needed
  579. ! by more than one CAM parameterization. In CAM this is called from
  580. ! phys_init.
  581. !
  582. call esinti(epsilo, latvap, latice, rh2o, cpair, tmelt)
  583. !~Need code here to set limcnv to max convective level of 40 mb... To
  584. ! properly set an average value for the whole domain would involve doing
  585. ! a collective operation across the whole domain to get pressure averages
  586. ! by level, which is difficult within the WRF framework. So, we will just
  587. ! use the model top for now.
  588. !
  589. ! Technically, limcnv should be calculated for each grid point at each
  590. ! time because the levels in WRF do not have a constant pressure, as
  591. ! opposed to CAM. But, that would involve making this variable local
  592. ! instead of at the module level as is currently done in CAM. For now,
  593. ! we will not worry about this because WRF rarely has domains higher than
  594. ! 40 mb. There is also little variability between grid points near the
  595. ! model top due to the underlying topography so a constant value would
  596. ! be OK across the comain. Also, remember that CAM levels are reversed in
  597. ! the vertical from WRF. So, setting limcnv to 1 means the top of the
  598. ! domain. Note that because of a bug in the parcel_dilute routine, limcnv
  599. ! must be >=2 instead of 1. Otherwise, an array out-of-bounds occurs.
  600. limcnv = 2
  601. !
  602. ! Get the ZM namelist variables (hard-wired for now)...
  603. !
  604. call zmconv_readnl("hard-wired")
  605. !
  606. !~need to determine if convection should happen in PBL and set
  607. ! no_deep_pbl_in accordingly
  608. call zm_convi(limcnv, NO_DEEP_PBL_IN=.false.)
  609. !
  610. ! Set initial values for arrays dependent on restart conditions
  611. !
  612. if(.not.restart)then
  613. do j=jts,jtf
  614. do k=kts,ktf
  615. do i=its,itf
  616. rucuten(i,k,j) = 0.
  617. rvcuten(i,k,j) = 0.
  618. rthcuten(i,k,j) = 0.
  619. rqvcuten(i,k,j) = 0.
  620. if( p_qc > param_first_scalar ) rqccuten(i,k,j) = 0.
  621. if( p_qi > param_first_scalar ) rqicuten(i,k,j) = 0.
  622. enddo
  623. enddo
  624. enddo
  625. end if
  626. END SUBROUTINE zm_conv_init
  627. !------------------------------------------------------------------------
  628. SUBROUTINE get_tpert(bl_pbl_physics, sf_sfclay_physics, dx, &
  629. mavail, kpbl, pblh, dzlowest, &
  630. psfc, qvlowest, t_phylowest, thlowest, tsk, tke_pbl, ust, &
  631. u_phylowest, v_phylowest, hfx, qfx, tpert_camuwpbl, kte, tpert)
  632. ! Calculates the temperature perturbation used to trigger convection.
  633. ! This should only be used if tpert is not already provided by CAM's PBL
  634. ! scheme. Right now, this only works with the Mellor-Yamada boundary
  635. ! layer scheme in combination with the MYJ surface scheme. This is due to
  636. ! the need of TKE for the vertical velocity perturbation. This scheme has
  637. ! not been generalized to handle all schemes that produce TKE at this
  638. ! time, and the non-TKE schemes, e.g. YSU, could probably have an
  639. ! appropriate tpert deduced but we have not taken the time yet to do it.
  640. !
  641. ! Author: William.Gustafson@pnl.gov, Nov. 2009
  642. ! Last updated: William.Gustafson@pnl.gov, Nov. 2010
  643. !------------------------------------------------------------------------
  644. USE shr_kind_mod, only: r8 => shr_kind_r8
  645. USE module_model_constants, only: cp, ep_1, ep_2, g, r_d, rcp, &
  646. svp1, svp2, svp3, svpt0, xlv
  647. USE module_state_description, ONLY : SFCLAYSCHEME &
  648. ,MYJSFCSCHEME &
  649. ,GFSSFCSCHEME &
  650. ,SLABSCHEME &
  651. ,LSMSCHEME &
  652. ,RUCLSMSCHEME &
  653. ,MYJPBLSCHEME &
  654. ,CAMUWPBLSCHEME
  655. !
  656. ! Subroutine arguments...
  657. !
  658. real, dimension(:), intent(in) :: tke_pbl
  659. real, intent(in) :: dx, dzlowest, hfx, mavail, pblh, psfc, qvlowest, &
  660. tpert_camuwpbl, tsk, t_phylowest, thlowest, ust, u_phylowest, &
  661. v_phylowest
  662. integer, intent(in) :: bl_pbl_physics, kpbl, kte, sf_sfclay_physics
  663. real(r8),intent(inout) :: tpert
  664. !
  665. ! Local vars...
  666. !
  667. real, parameter :: fak = 8.5 !Constant in surface temperature excess
  668. real, parameter :: tfac = 1. !Ratio of 'tpert' to (w't')/wpert
  669. real, parameter :: wfac = 1. !Ratio of 'wpert' to sqrt(tke)
  670. real, parameter :: wpertmin = 1.e-6 !Min PBL eddy vertical velocity perturbation
  671. real :: ebrk !In CAM, net mean TKE of CL including
  672. !entrainment effect (m2/s2). In WRF,
  673. !average TKE within the PBL
  674. real :: br2, dthvdz, e1, flux, govrth, psfccmb, qfx, qsfc, rhox, thgb, &
  675. thv, tskv, tvcon, vconv, vsgd, wpert, wspd, za
  676. integer :: k
  677. character(len=250) :: msg
  678. logical :: UnstableOrNeutral
  679. !
  680. ! We can get the perturbation values directly from CAMUWPBLSCHEME if
  681. ! available. Otherwise, we have to calculate them.
  682. !
  683. if( bl_pbl_physics==CAMUWPBLSCHEME ) then
  684. tpert = tpert_camuwpbl
  685. !
  686. !...non-CAMUWPBL. Need MYJ SFC & PBL for now until other schemes
  687. ! get coded to give perturbations too.
  688. ! First, we need to determine if the conditions are stable or unstable.
  689. ! We will do this by mimicing the bulk Richardson calculation from
  690. ! module_sf_sfclay.F because the MYJ scheme does not provide this info.
  691. ! The logic borrowed from the CuP shallow cumulus scheme. Non-MYJ sfc
  692. ! scheme code is commented out for now since we also require MYJ PBL
  693. ! scheme.
  694. !
  695. elseif( bl_pbl_physics==MYJPBLSCHEME ) then
  696. UnstableOrNeutral = .false.
  697. sfclay_case: SELECT CASE (sf_sfclay_physics)
  698. CASE (MYJSFCSCHEME)
  699. ! The MYJ sfc scheme does not already provide a stability criteria.
  700. ! So, we will mimic the bulk Richardson calculation from
  701. ! module_sf_sfclay.F.
  702. if( pblh <= 0. ) call wrf_error_fatal( &
  703. "CAMZMSCHEME needs a PBL height from a PBL scheme.")
  704. za = 0.5*dzlowest
  705. e1 = svp1*exp(svp2*(tsk-svpt0)/(tsk-svp3))
  706. psfccmb=psfc/1000. !converts from Pa to cmb
  707. qsfc = ep_2*e1/(psfccmb-e1)
  708. thgb = tsk*(100./psfccmb)**rcp
  709. tskv = thgb*(1.+ep_1*qsfc*mavail)
  710. tvcon = 1.+ep_1*qvlowest
  711. thv = thlowest*tvcon
  712. dthvdz = (thv-tskv)
  713. govrth = g/thlowest
  714. rhox = psfc/(r_d*t_phylowest*tvcon)
  715. flux = max(hfx/rhox/cp + ep_1*tskv*qfx/rhox,0.)
  716. vconv = (g/tsk*pblh*flux)**.33
  717. vsgd = 0.32 * (max(dx/5000.-1.,0.))**.33
  718. wspd = sqrt(u_phylowest*u_phylowest+v_phylowest*v_phylowest)
  719. wspd = sqrt(wspd*wspd+vconv*vconv+vsgd*vsgd)
  720. wspd = max(wspd,0.1)
  721. !And finally, the bulk Richardson number...
  722. br2 = govrth*za*dthvdz/(wspd*wspd)
  723. if( br2 <= 0. ) UnstableOrNeutral = .true.
  724. CASE DEFAULT
  725. call wrf_error_fatal("CAMZMSCHEME requires MYJSFCSCHEME or else CAMUWPBLSCHEME.")
  726. END SELECT sfclay_case
  727. !
  728. ! The perturbation temperature for unstable conditions...
  729. ! The calculation follows the one in caleddy inside eddy_diff.F90 from
  730. ! CAM.
  731. !
  732. !Check that we are using the MJY BL scheme since we are hard-wired to
  733. !use TKE and u* from this scheme. At some point this dependency should
  734. !be broken and a way needs to be found for other schemes to provide
  735. !reasonable tpert values too.
  736. if( bl_pbl_physics /= MYJPBLSCHEME ) &
  737. call wrf_error_fatal("CAMZMSCHEME requires MYJPBLSCHEME or CAMUWPBLSCHEME")
  738. !Recalculate rhox in case a non-MYJ scheme is used to get
  739. !stability and rhox is not calculated above. Right now, this is
  740. !technically reduncant, but cheap.
  741. tvcon = 1.+ep_1*qvlowest
  742. rhox = psfc/(r_d*t_phylowest*tvcon)
  743. if( UnstableOrNeutral ) then
  744. !1st, get avg TKE w/n the PBL as a proxy for ebrk variable in CAM
  745. ebrk = 0.
  746. do k=1,min(kpbl,kte)
  747. ebrk = ebrk + tke_pbl(k)
  748. end do
  749. ebrk = ebrk/real(kpbl)
  750. wpert = max( wfac*sqrt(ebrk), wpertmin )
  751. tpert = max( abs(hfx/rhox/cp)*tfac/wpert, 0. )
  752. !
  753. ! Or, the perturbation temperature for stable conditions...
  754. !
  755. else !Stable conditions
  756. tpert = max( hfx/rhox/cp*fak/ust, 0. )
  757. end if
  758. else
  759. call wrf_error_fatal("CAMZMSCHEME requires MYJPBLSCHEME or CAMUWPBLSCHEME")
  760. end if !PBL choice
  761. END SUBROUTINE get_tpert
  762. END MODULE module_cu_camzm_driver