Line data Source code
1 : module macrop_driver
2 :
3 : !-------------------------------------------------------------------------------------------------------
4 : ! Purpose:
5 : !
6 : ! Provides the CAM interface to the prognostic cloud macrophysics
7 : !
8 : ! Author: Andrew Gettelman, Cheryl Craig October 2010
9 : ! Origin: modified from stratiform.F90 elements
10 : ! (Boville 2002, Coleman 2004, Park 2009, Kay 2010)
11 : !-------------------------------------------------------------------------------------------------------
12 :
13 : use shr_kind_mod, only: r8=>shr_kind_r8
14 : use spmd_utils, only: masterproc
15 : use ppgrid, only: pcols, pver, pverp
16 : use physconst, only: latice, latvap
17 : use phys_control, only: phys_getopts
18 : use constituents, only: cnst_get_ind, pcnst
19 : use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx
20 : use time_manager, only: is_first_step
21 : use cldwat2m_macro, only: ini_macro
22 : use perf_mod, only: t_startf, t_stopf
23 : use cam_logfile, only: iulog
24 : use cam_abortutils, only: endrun
25 :
26 : implicit none
27 : private
28 : save
29 :
30 : public :: macrop_driver_readnl
31 : public :: macrop_driver_register
32 : public :: macrop_driver_init
33 : public :: macrop_driver_tend
34 : public :: liquid_macro_tend
35 :
36 : logical, public :: do_cldice ! .true., park macrophysics is prognosing cldice
37 : logical, public :: do_cldliq ! .true., park macrophysics is prognosing cldliq
38 : logical, public :: do_detrain ! .true., park macrophysics is detraining ice into stratiform
39 :
40 : ! ------------------------- !
41 : ! Private Module Parameters !
42 : ! ------------------------- !
43 :
44 : ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus
45 : ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus,
46 : ! evaporate cumulus liquid condensate. This option only influences the treatment of cumulus
47 : ! liquid condensate, not cumulus ice condensate.
48 :
49 : logical, parameter :: cu_det_st = .false.
50 :
51 : ! Parameters used for selecting generalized critical RH for liquid and ice stratus
52 : integer :: rhminl_opt = 0
53 : integer :: rhmini_opt = 0
54 :
55 :
56 : character(len=16) :: shallow_scheme
57 : logical :: use_shfrc ! Local copy of flag from convect_shallow_use_shfrc
58 :
59 : integer :: &
60 : ixcldliq, &! cloud liquid amount index
61 : ixcldice, &! cloud ice amount index
62 : ixnumliq, &! cloud liquid number index
63 : ixnumice, &! cloud ice water index
64 : qcwat_idx, &! qcwat index in physics buffer
65 : lcwat_idx, &! lcwat index in physics buffer
66 : iccwat_idx, &! iccwat index in physics buffer
67 : nlwat_idx, &! nlwat index in physics buffer
68 : niwat_idx, &! niwat index in physics buffer
69 : tcwat_idx, &! tcwat index in physics buffer
70 : CC_T_idx, &!
71 : CC_qv_idx, &!
72 : CC_ql_idx, &!
73 : CC_qi_idx, &!
74 : CC_nl_idx, &!
75 : CC_ni_idx, &!
76 : CC_qlst_idx, &!
77 : cld_idx, &! cld index in physics buffer
78 : ast_idx, &! stratiform cloud fraction index in physics buffer
79 : aist_idx, &! ice stratiform cloud fraction index in physics buffer
80 : alst_idx, &! liquid stratiform cloud fraction index in physics buffer
81 : qist_idx, &! ice stratiform in-cloud IWC
82 : qlst_idx, &! liquid stratiform in-cloud LWC
83 : concld_idx, &! concld index in physics buffer
84 : fice_idx, &
85 : cmeliq_idx, &
86 : shfrc_idx
87 :
88 : integer :: &
89 : dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio.
90 : difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio.
91 : dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen.
92 : dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen.
93 :
94 :
95 : integer :: &
96 : tke_idx = -1, &! tke defined at the model interfaces
97 : qtl_flx_idx = -1, &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme
98 : qti_flx_idx = -1, &! overbar(w'qti' where qti = qv + qi) from the PBL scheme
99 : cmfr_det_idx = -1, &! detrained convective mass flux from UNICON
100 : qlr_det_idx = -1, &! detrained convective ql from UNICON
101 : qir_det_idx = -1, &! detrained convective qi from UNICON
102 : cmfmc_sh_idx = -1
103 :
104 : contains
105 :
106 : ! ===============================================================================
107 1536 : subroutine macrop_driver_readnl(nlfile)
108 :
109 : use namelist_utils, only: find_group_name
110 : use units, only: getunit, freeunit
111 : use mpishorthand
112 :
113 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
114 :
115 : ! Namelist variables
116 : logical :: macro_park_do_cldice = .true. ! do_cldice = .true., park macrophysics is prognosing cldice
117 : logical :: macro_park_do_cldliq = .true. ! do_cldliq = .true., park macrophysics is prognosing cldliq
118 : logical :: macro_park_do_detrain = .true. ! do_detrain = .true., park macrophysics is detraining ice into stratiform
119 :
120 : ! Local variables
121 : integer :: unitn, ierr
122 : character(len=*), parameter :: subname = 'macrop_driver_readnl'
123 :
124 : namelist /macro_park_nl/ macro_park_do_cldice, macro_park_do_cldliq, macro_park_do_detrain
125 : !-----------------------------------------------------------------------------
126 :
127 1536 : if (masterproc) then
128 2 : unitn = getunit()
129 2 : open( unitn, file=trim(nlfile), status='old' )
130 2 : call find_group_name(unitn, 'macro_park_nl', status=ierr)
131 2 : if (ierr == 0) then
132 0 : read(unitn, macro_park_nl, iostat=ierr)
133 0 : if (ierr /= 0) then
134 0 : call endrun(subname // ':: ERROR reading namelist')
135 : end if
136 : end if
137 2 : close(unitn)
138 2 : call freeunit(unitn)
139 :
140 : ! set local variables
141 :
142 2 : do_cldice = macro_park_do_cldice
143 2 : do_cldliq = macro_park_do_cldliq
144 2 : do_detrain = macro_park_do_detrain
145 :
146 : end if
147 :
148 : #ifdef SPMD
149 : ! Broadcast namelist variables
150 1536 : call mpibcast(do_cldice, 1, mpilog, 0, mpicom)
151 1536 : call mpibcast(do_cldliq, 1, mpilog, 0, mpicom)
152 1536 : call mpibcast(do_detrain, 1, mpilog, 0, mpicom)
153 : #endif
154 :
155 1536 : end subroutine macrop_driver_readnl
156 :
157 : !================================================================================================
158 :
159 0 : subroutine macrop_driver_register
160 :
161 : !---------------------------------------------------------------------- !
162 : ! !
163 : ! Register the constituents (cloud liquid and cloud ice) and the fields !
164 : ! in the physics buffer. !
165 : ! !
166 : !---------------------------------------------------------------------- !
167 :
168 :
169 : use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls
170 :
171 : !-----------------------------------------------------------------------
172 :
173 0 : call phys_getopts(shallow_scheme_out=shallow_scheme)
174 :
175 0 : call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx)
176 0 : call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx)
177 0 : call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx)
178 0 : call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx)
179 0 : call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx)
180 0 : call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx)
181 0 : call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx)
182 :
183 0 : call pbuf_add_field('QCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qcwat_idx)
184 0 : call pbuf_add_field('LCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), lcwat_idx)
185 0 : call pbuf_add_field('ICCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), iccwat_idx)
186 0 : call pbuf_add_field('NLWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), nlwat_idx)
187 0 : call pbuf_add_field('NIWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), niwat_idx)
188 0 : call pbuf_add_field('TCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), tcwat_idx)
189 :
190 0 : call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx)
191 :
192 0 : call pbuf_add_field('CMELIQ', 'physpkg', dtype_r8, (/pcols,pver/), cmeliq_idx)
193 :
194 0 : end subroutine macrop_driver_register
195 :
196 : !============================================================================ !
197 : ! !
198 : !============================================================================ !
199 :
200 0 : subroutine macrop_driver_init(pbuf2d)
201 :
202 : !-------------------------------------------- !
203 : ! !
204 : ! Initialize the cloud water parameterization !
205 : ! !
206 : !-------------------------------------------- !
207 0 : use physics_buffer, only : pbuf_get_index
208 : use cam_history, only: addfld, add_default
209 : use convect_shallow, only: convect_shallow_use_shfrc
210 :
211 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
212 :
213 : logical :: history_aerosol ! Output the MAM aerosol tendencies
214 : logical :: history_budget ! Output tendencies and state variables for CAM4
215 : ! temperature, water vapor, cloud ice and cloud
216 : ! liquid budgets.
217 : integer :: history_budget_histfile_num ! output history file number for budget fields
218 : integer :: istat
219 :
220 : character(len=*), parameter :: subname = 'macrop_driver_init'
221 : !-----------------------------------------------------------------------
222 :
223 : ! Initialization routine for cloud macrophysics
224 0 : if (shallow_scheme .eq. 'UNICON') rhminl_opt = 1
225 0 : call ini_macro(rhminl_opt, rhmini_opt)
226 :
227 : call phys_getopts(history_aerosol_out = history_aerosol , &
228 : history_budget_out = history_budget , &
229 0 : history_budget_histfile_num_out = history_budget_histfile_num )
230 :
231 : ! Find out whether shfrc from convect_shallow will be used in cldfrc
232 :
233 0 : if( convect_shallow_use_shfrc() ) then
234 0 : use_shfrc = .true.
235 0 : shfrc_idx = pbuf_get_index('shfrc')
236 : else
237 0 : use_shfrc = .false.
238 : endif
239 :
240 0 : call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection' )
241 0 : call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection' )
242 0 : call addfld ('SHDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from shallow convection' )
243 0 : call addfld ('SHDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from shallow convection' )
244 0 : call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment' )
245 0 : call addfld ('SHDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to shallow convective detrainment' )
246 :
247 0 : call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection' )
248 :
249 0 : call addfld ('MACPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Revised macrophysics' )
250 0 : call addfld ('MACPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Revised macrophysics' )
251 0 : call addfld ('MACPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Revised macrophysics' )
252 0 : call addfld ('MACPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Revised macrophysics' )
253 :
254 : call addfld ('CLDVAPADJ', (/ 'lev' /), 'A', 'kg/kg/s', &
255 0 : 'Q tendency associated with liq/ice adjustment - Revised macrophysics' )
256 0 : call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ adjustment tendency - Revised macrophysics' )
257 0 : call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE adjustment tendency - Revised macrophysics' )
258 : call addfld ('CLDLIQDET', (/ 'lev' /), 'A', 'kg/kg/s', &
259 0 : 'Detrainment of conv cld liq into envrionment - Revised macrophysics' )
260 : call addfld ('CLDICEDET', (/ 'lev' /), 'A', 'kg/kg/s', &
261 0 : 'Detrainment of conv cld ice into envrionment - Revised macrophysics' )
262 0 : call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ limiting tendency - Revised macrophysics' )
263 0 : call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE limiting tendency - Revised macrophysics' )
264 :
265 0 : call addfld ('AST', (/ 'lev' /), 'A', '1', 'Stratus cloud fraction' )
266 0 : call addfld ('LIQCLDF', (/ 'lev' /), 'A', '1', 'Stratus Liquid cloud fraction' )
267 0 : call addfld ('ICECLDF', (/ 'lev' /), 'A', '1', 'Stratus ICE cloud fraction' )
268 :
269 0 : call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' )
270 0 : call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' )
271 :
272 0 : call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus' )
273 0 : call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus' )
274 :
275 0 : call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ' )
276 0 : call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE' )
277 0 : call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ' )
278 0 : call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE' )
279 :
280 0 : call addfld ('CLDSICE', (/ 'lev' /), 'A', 'kg/kg', 'CloudSat equivalent ice mass mixing ratio' )
281 0 : call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud' )
282 :
283 0 : call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment' )
284 0 : call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment' )
285 0 : call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment' )
286 0 : call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment' )
287 0 : if ( history_budget ) then
288 :
289 0 : call add_default ('DPDLFLIQ ', history_budget_histfile_num, ' ')
290 0 : call add_default ('DPDLFICE ', history_budget_histfile_num, ' ')
291 0 : call add_default ('SHDLFLIQ ', history_budget_histfile_num, ' ')
292 0 : call add_default ('SHDLFICE ', history_budget_histfile_num, ' ')
293 0 : call add_default ('DPDLFT ', history_budget_histfile_num, ' ')
294 0 : call add_default ('SHDLFT ', history_budget_histfile_num, ' ')
295 0 : call add_default ('ZMDLF ', history_budget_histfile_num, ' ')
296 :
297 0 : call add_default ('MACPDT ', history_budget_histfile_num, ' ')
298 0 : call add_default ('MACPDQ ', history_budget_histfile_num, ' ')
299 0 : call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ')
300 0 : call add_default ('MACPDICE ', history_budget_histfile_num, ' ')
301 :
302 0 : call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ')
303 0 : call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ')
304 0 : call add_default ('CLDLIQDET', history_budget_histfile_num, ' ')
305 0 : call add_default ('CLDLIQADJ', history_budget_histfile_num, ' ')
306 0 : call add_default ('CLDICELIM', history_budget_histfile_num, ' ')
307 0 : call add_default ('CLDICEDET', history_budget_histfile_num, ' ')
308 0 : call add_default ('CLDICEADJ', history_budget_histfile_num, ' ')
309 :
310 0 : call add_default ('CMELIQ ', history_budget_histfile_num, ' ')
311 :
312 : end if
313 :
314 : ! Get constituent indices
315 0 : call cnst_get_ind('CLDLIQ', ixcldliq)
316 0 : call cnst_get_ind('CLDICE', ixcldice)
317 0 : call cnst_get_ind('NUMLIQ', ixnumliq)
318 0 : call cnst_get_ind('NUMICE', ixnumice)
319 :
320 : ! Get physics buffer indices
321 0 : CC_T_idx = pbuf_get_index('CC_T')
322 0 : CC_qv_idx = pbuf_get_index('CC_qv')
323 0 : CC_ql_idx = pbuf_get_index('CC_ql')
324 0 : CC_qi_idx = pbuf_get_index('CC_qi')
325 0 : CC_nl_idx = pbuf_get_index('CC_nl')
326 0 : CC_ni_idx = pbuf_get_index('CC_ni')
327 0 : CC_qlst_idx = pbuf_get_index('CC_qlst')
328 0 : cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
329 :
330 0 : if (rhminl_opt > 0 .or. rhmini_opt > 0) then
331 0 : cmfr_det_idx = pbuf_get_index('cmfr_det', istat)
332 0 : if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf')
333 0 : if (rhminl_opt > 0) then
334 0 : qlr_det_idx = pbuf_get_index('qlr_det', istat)
335 0 : if (istat < 0) call endrun(subname//': macrop option requires qlr_det in pbuf')
336 : end if
337 0 : if (rhmini_opt > 0) then
338 0 : qir_det_idx = pbuf_get_index('qir_det', istat)
339 0 : if (istat < 0) call endrun(subname//': macrop option requires qir_det in pbuf')
340 : end if
341 : end if
342 :
343 0 : if (rhminl_opt == 2 .or. rhmini_opt == 2) then
344 0 : tke_idx = pbuf_get_index('tke')
345 0 : if (rhminl_opt == 2) then
346 0 : qtl_flx_idx = pbuf_get_index('qtl_flx', istat)
347 0 : if (istat < 0) call endrun(subname//': macrop option requires qtl_flx in pbuf')
348 : end if
349 0 : if (rhmini_opt == 2) then
350 0 : qti_flx_idx = pbuf_get_index('qti_flx', istat)
351 0 : if (istat < 0) call endrun(subname//': macrop option requires qti_flx in pbuf')
352 : end if
353 : end if
354 :
355 : ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT,
356 : ! ICCWAT, and TCWAT are initialized in phys_inidat.
357 0 : if (is_first_step()) then
358 0 : call pbuf_set_field(pbuf2d, ast_idx, 0._r8)
359 0 : call pbuf_set_field(pbuf2d, aist_idx, 0._r8)
360 0 : call pbuf_set_field(pbuf2d, alst_idx, 0._r8)
361 0 : call pbuf_set_field(pbuf2d, qist_idx, 0._r8)
362 0 : call pbuf_set_field(pbuf2d, qlst_idx, 0._r8)
363 0 : call pbuf_set_field(pbuf2d, nlwat_idx, 0._r8)
364 0 : call pbuf_set_field(pbuf2d, niwat_idx, 0._r8)
365 : end if
366 :
367 : ! the following are physpkg, so they need to be init every time
368 0 : call pbuf_set_field(pbuf2d, fice_idx, 0._r8)
369 0 : call pbuf_set_field(pbuf2d, cmeliq_idx, 0._r8)
370 :
371 0 : end subroutine macrop_driver_init
372 :
373 : !============================================================================ !
374 : ! !
375 : !============================================================================ !
376 :
377 :
378 0 : subroutine macrop_driver_tend( &
379 : state, ptend, dtime, landfrac, &
380 : ocnfrac, snowh, &
381 : dlf, dlf2, cmfmc, ts, &
382 : sst, zdu, &
383 : pbuf, &
384 : det_s, det_ice)
385 :
386 : !-------------------------------------------------------- !
387 : ! !
388 : ! Purpose: !
389 : ! !
390 : ! Interface to detrain, cloud fraction and !
391 : ! cloud macrophysics subroutines !
392 : ! !
393 : ! Author: A. Gettelman, C. Craig, Oct 2010 !
394 : ! based on stratiform_tend by D.B. Coleman 4/2010 !
395 : ! !
396 : !-------------------------------------------------------- !
397 :
398 0 : use cloud_fraction, only: cldfrc, cldfrc_fice
399 : use physics_types, only: physics_state, physics_ptend
400 : use physics_types, only: physics_ptend_init, physics_update
401 : use physics_types, only: physics_ptend_sum, physics_state_copy
402 : use physics_types, only: physics_state_dealloc
403 : use cam_history, only: outfld
404 : use constituents, only: cnst_get_ind, pcnst
405 : use cldwat2m_macro, only: mmacro_pcond
406 : use physconst, only: cpair, tmelt, gravit
407 : use time_manager, only: get_nstep
408 :
409 : use ref_pres, only: top_lev => trop_cloud_top_lev
410 :
411 : !
412 : ! Input arguments
413 : !
414 :
415 : type(physics_state), intent(in) :: state ! State variables
416 : type(physics_ptend), intent(out) :: ptend ! macrophysics parameterization tendencies
417 : type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer
418 :
419 : real(r8), intent(in) :: dtime ! Timestep
420 : real(r8), intent(in) :: landfrac(pcols) ! Land fraction (fraction)
421 : real(r8), intent(in) :: ocnfrac (pcols) ! Ocean fraction (fraction)
422 : real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m)
423 : real(r8), intent(in) :: dlf(pcols,pver) ! Detrained water from convection schemes
424 : real(r8), intent(in) :: dlf2(pcols,pver) ! Detrained water from shallow convection scheme
425 : real(r8), intent(in) :: cmfmc(pcols,pverp) ! Deep + Shallow Convective mass flux [ kg /s/m^2 ]
426 :
427 : real(r8), intent(in) :: ts(pcols) ! Surface temperature
428 : real(r8), intent(in) :: sst(pcols) ! Sea surface temperature
429 : real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection
430 :
431 :
432 : ! These two variables are needed for energy check
433 : real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice
434 : real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check
435 :
436 : !
437 : ! Local variables
438 : !
439 :
440 0 : type(physics_state) :: state_loc ! Local copy of the state variable
441 0 : type(physics_ptend) :: ptend_loc ! Local parameterization tendencies
442 :
443 : integer i,k
444 : integer :: lchnk ! Chunk identifier
445 : integer :: ncol ! Number of atmospheric columns
446 :
447 : ! Physics buffer fields
448 :
449 : integer itim_old
450 0 : real(r8), pointer, dimension(:,:) :: qcwat ! Cloud water old q
451 0 : real(r8), pointer, dimension(:,:) :: tcwat ! Cloud water old temperature
452 0 : real(r8), pointer, dimension(:,:) :: lcwat ! Cloud liquid water old q
453 0 : real(r8), pointer, dimension(:,:) :: iccwat ! Cloud ice water old q
454 0 : real(r8), pointer, dimension(:,:) :: nlwat ! Cloud liquid droplet number condentration. old.
455 0 : real(r8), pointer, dimension(:,:) :: niwat ! Cloud ice droplet number condentration. old.
456 0 : real(r8), pointer, dimension(:,:) :: CC_T ! Grid-mean microphysical tendency
457 0 : real(r8), pointer, dimension(:,:) :: CC_qv ! Grid-mean microphysical tendency
458 0 : real(r8), pointer, dimension(:,:) :: CC_ql ! Grid-mean microphysical tendency
459 0 : real(r8), pointer, dimension(:,:) :: CC_qi ! Grid-mean microphysical tendency
460 0 : real(r8), pointer, dimension(:,:) :: CC_nl ! Grid-mean microphysical tendency
461 0 : real(r8), pointer, dimension(:,:) :: CC_ni ! Grid-mean microphysical tendency
462 0 : real(r8), pointer, dimension(:,:) :: CC_qlst ! In-liquid stratus microphysical tendency
463 0 : real(r8), pointer, dimension(:,:) :: cld ! Total cloud fraction
464 0 : real(r8), pointer, dimension(:,:) :: ast ! Relative humidity cloud fraction
465 0 : real(r8), pointer, dimension(:,:) :: aist ! Physical ice stratus fraction
466 0 : real(r8), pointer, dimension(:,:) :: alst ! Physical liquid stratus fraction
467 0 : real(r8), pointer, dimension(:,:) :: qist ! Physical in-cloud IWC
468 0 : real(r8), pointer, dimension(:,:) :: qlst ! Physical in-cloud LWC
469 0 : real(r8), pointer, dimension(:,:) :: concld ! Convective cloud fraction
470 :
471 0 : real(r8), pointer, dimension(:,:) :: shfrc ! Cloud fraction from shallow convection scheme
472 0 : real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux (pcols,pverp) [ kg/s/m^2 ]
473 :
474 0 : real(r8), pointer, dimension(:,:) :: cmeliq
475 :
476 0 : real(r8), pointer, dimension(:,:) :: tke
477 0 : real(r8), pointer, dimension(:,:) :: qtl_flx
478 0 : real(r8), pointer, dimension(:,:) :: qti_flx
479 0 : real(r8), pointer, dimension(:,:) :: cmfr_det
480 0 : real(r8), pointer, dimension(:,:) :: qlr_det
481 0 : real(r8), pointer, dimension(:,:) :: qir_det
482 :
483 : ! Convective cloud to the physics buffer for purposes of ql contrib. to radn.
484 :
485 0 : real(r8), pointer, dimension(:,:) :: fice_ql ! Cloud ice/water partitioning ratio.
486 :
487 : ! ZM microphysics
488 : real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
489 : real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio.
490 : real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen.
491 : real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen.
492 :
493 : real(r8) :: latsub
494 :
495 : ! tendencies for ice saturation adjustment
496 : real(r8) :: stend(pcols,pver)
497 : real(r8) :: qvtend(pcols,pver)
498 : real(r8) :: qitend(pcols,pver)
499 : real(r8) :: initend(pcols,pver)
500 :
501 : ! Local variables for cldfrc
502 :
503 : real(r8) cldst(pcols,pver) ! Stratus cloud fraction
504 : real(r8) rhcloud(pcols,pver) ! Relative humidity cloud (last timestep)
505 : real(r8) clc(pcols) ! Column convective cloud amount
506 : real(r8) rhu00(pcols,pver) ! RH threshold for cloud
507 : real(r8) icecldf(pcols,pver) ! Ice cloud fraction
508 : real(r8) liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud)
509 : real(r8) relhum(pcols,pver) ! RH, output to determine drh/da
510 :
511 : ! Local variables for macrophysics
512 :
513 : real(r8) rdtime ! 1./dtime
514 : real(r8) qtend(pcols,pver) ! Moisture tendencies
515 : real(r8) ttend(pcols,pver) ! Temperature tendencies
516 : real(r8) ltend(pcols,pver) ! Cloud liquid water tendencies
517 : real(r8) fice(pcols,pver) ! Fractional ice content within cloud
518 : real(r8) fsnow(pcols,pver) ! Fractional snow production
519 : real(r8) homoo(pcols,pver)
520 : real(r8) qcreso(pcols,pver)
521 : real(r8) prcio(pcols,pver)
522 : real(r8) praio(pcols,pver)
523 : real(r8) qireso(pcols,pver)
524 : real(r8) ftem(pcols,pver)
525 : real(r8) pracso (pcols,pver)
526 : real(r8) dpdlfliq(pcols,pver)
527 : real(r8) dpdlfice(pcols,pver)
528 : real(r8) shdlfliq(pcols,pver)
529 : real(r8) shdlfice(pcols,pver)
530 : real(r8) dpdlft (pcols,pver)
531 : real(r8) shdlft (pcols,pver)
532 :
533 : real(r8) dum1
534 : real(r8) qc(pcols,pver)
535 : real(r8) qi(pcols,pver)
536 : real(r8) nc(pcols,pver)
537 : real(r8) ni(pcols,pver)
538 :
539 : logical lq(pcnst)
540 :
541 : ! Output from mmacro_pcond
542 :
543 : real(r8) tlat(pcols,pver)
544 : real(r8) qvlat(pcols,pver)
545 : real(r8) qcten(pcols,pver)
546 : real(r8) qiten(pcols,pver)
547 : real(r8) ncten(pcols,pver)
548 : real(r8) niten(pcols,pver)
549 :
550 : ! Output from mmacro_pcond
551 :
552 : real(r8) qvadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (vapor)
553 : real(r8) qladj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (liquid)
554 : real(r8) qiadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (ice)
555 : real(r8) qllim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (liquid)
556 : real(r8) qilim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (ice)
557 :
558 : ! For revised macophysics, mmacro_pcond
559 :
560 : real(r8) itend(pcols,pver)
561 : real(r8) lmitend(pcols,pver)
562 : real(r8) zeros(pcols,pver)
563 : real(r8) t_inout(pcols,pver)
564 : real(r8) qv_inout(pcols,pver)
565 : real(r8) ql_inout(pcols,pver)
566 : real(r8) qi_inout(pcols,pver)
567 : real(r8) concld_old(pcols,pver)
568 :
569 : ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the
570 : ! liquid condensation process which is using 'alst' not 'ast'.
571 : ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'.
572 : ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used.
573 : ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old'
574 : real(r8) clrw_old(pcols,pver) ! (1 - concld_old - alst_old)
575 : real(r8) clri_old(pcols,pver) ! (1 - concld_old - ast_old)
576 :
577 : real(r8) nl_inout(pcols,pver)
578 : real(r8) ni_inout(pcols,pver)
579 :
580 : real(r8) nltend(pcols,pver)
581 : real(r8) nitend(pcols,pver)
582 :
583 :
584 : ! For detraining cumulus condensate into the 'stratus' without evaporation
585 : ! This is for use in mmacro_pcond
586 :
587 : real(r8) dlf_T(pcols,pver)
588 : real(r8) dlf_qv(pcols,pver)
589 : real(r8) dlf_ql(pcols,pver)
590 : real(r8) dlf_qi(pcols,pver)
591 : real(r8) dlf_nl(pcols,pver)
592 : real(r8) dlf_ni(pcols,pver)
593 :
594 : ! Local variables for CFMIP calculations
595 : real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg)
596 : real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg)
597 : real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg)
598 : real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg)
599 :
600 : ! CloudSat equivalent ice mass mixing ratio (kg/kg)
601 : real(r8) :: cldsice(pcols,pver)
602 :
603 : ! ======================================================================
604 :
605 0 : lchnk = state%lchnk
606 0 : ncol = state%ncol
607 :
608 0 : call physics_state_copy(state, state_loc) ! Copy state to local state_loc.
609 :
610 : ! Associate pointers with physics buffer fields
611 :
612 0 : itim_old = pbuf_old_tim_idx()
613 :
614 0 : call pbuf_get_field(pbuf, qcwat_idx, qcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
615 0 : call pbuf_get_field(pbuf, tcwat_idx, tcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
616 0 : call pbuf_get_field(pbuf, lcwat_idx, lcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
617 0 : call pbuf_get_field(pbuf, iccwat_idx, iccwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
618 0 : call pbuf_get_field(pbuf, nlwat_idx, nlwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
619 0 : call pbuf_get_field(pbuf, niwat_idx, niwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
620 :
621 0 : call pbuf_get_field(pbuf, cc_t_idx, cc_t, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
622 0 : call pbuf_get_field(pbuf, cc_qv_idx, cc_qv, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
623 0 : call pbuf_get_field(pbuf, cc_ql_idx, cc_ql, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
624 0 : call pbuf_get_field(pbuf, cc_qi_idx, cc_qi, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
625 0 : call pbuf_get_field(pbuf, cc_nl_idx, cc_nl, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
626 0 : call pbuf_get_field(pbuf, cc_ni_idx, cc_ni, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
627 0 : call pbuf_get_field(pbuf, cc_qlst_idx, cc_qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
628 :
629 0 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
630 0 : call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
631 0 : call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
632 0 : call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
633 0 : call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
634 0 : call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
635 0 : call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
636 :
637 0 : call pbuf_get_field(pbuf, cmeliq_idx, cmeliq)
638 :
639 : ! For purposes of convective ql.
640 :
641 0 : call pbuf_get_field(pbuf, fice_idx, fice_ql )
642 :
643 0 : call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh)
644 :
645 : ! check that qcwat and tcwat were initialized; if not then do it now.
646 0 : if (qcwat(1,1) == huge(1._r8)) then
647 0 : qcwat(:ncol,:) = state%q(:ncol,:,1)
648 : end if
649 0 : if (tcwat(1,1) == huge(1._r8)) then
650 0 : tcwat(:ncol,:) = state%t(:ncol,:)
651 : end if
652 :
653 : ! Initialize convective detrainment tendency
654 :
655 0 : dlf_T(:,:) = 0._r8
656 0 : dlf_qv(:,:) = 0._r8
657 0 : dlf_ql(:,:) = 0._r8
658 0 : dlf_qi(:,:) = 0._r8
659 0 : dlf_nl(:,:) = 0._r8
660 0 : dlf_ni(:,:) = 0._r8
661 :
662 : ! ------------------------------------- !
663 : ! From here, process computation begins !
664 : ! ------------------------------------- !
665 :
666 : ! ----------------------------------------------------------------------------- !
667 : ! Detrainment of convective condensate into the environment or stratiform cloud !
668 : ! ----------------------------------------------------------------------------- !
669 :
670 0 : lq(:) = .FALSE.
671 0 : lq(ixcldliq) = .TRUE.
672 0 : lq(ixcldice) = .TRUE.
673 0 : lq(ixnumliq) = .TRUE.
674 0 : lq(ixnumice) = .TRUE.
675 0 : call physics_ptend_init(ptend_loc, state%psetcols, 'pcwdetrain', ls=.true., lq=lq) ! Initialize local physics_ptend object
676 :
677 : ! Procedures :
678 : ! (1) Partition detrained convective cloud water into liquid and ice based on T.
679 : ! This also involves heating.
680 : ! If convection scheme can handle this internally, this step is not necssary.
681 : ! (2) Assuming a certain effective droplet radius, computes number concentration
682 : ! of detrained convective cloud liquid and ice.
683 : ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into
684 : ! the pre-existing 'liquid' stratus ( mean environment ). The former does
685 : ! not involve any macrophysical evaporation while the latter does. This is
686 : ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded
687 : ! by qcst_min and qcst_max in mmacro_pcond.
688 : ! (4) In contrast to liquid, convective ice is detrained into the environment
689 : ! and involved in the sublimation. Similar bounds as liquid stratus are imposed.
690 : ! This is the key procesure generating upper-level cirrus clouds.
691 : ! The unit of dlf : [ kg/kg/s ]
692 :
693 0 : det_s(:) = 0._r8
694 0 : det_ice(:) = 0._r8
695 :
696 0 : dpdlfliq = 0._r8
697 0 : dpdlfice = 0._r8
698 0 : shdlfliq = 0._r8
699 0 : shdlfice = 0._r8
700 0 : dpdlft = 0._r8
701 0 : shdlft = 0._r8
702 :
703 0 : do k = top_lev, pver
704 0 : do i = 1, state_loc%ncol
705 0 : if( state_loc%t(i,k) > 268.15_r8 ) then
706 : dum1 = 0.0_r8
707 0 : elseif( state_loc%t(i,k) < 238.15_r8 ) then
708 : dum1 = 1.0_r8
709 : else
710 0 : dum1 = ( 268.15_r8 - state_loc%t(i,k) ) / 30._r8
711 : endif
712 :
713 : ! If detrainment was done elsewhere, still update the variables used for output
714 : ! assuming that the temperature split between liquid and ice is the same as assumed
715 : ! here.
716 0 : if (do_detrain) then
717 0 : ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 )
718 0 : ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1
719 : ! dum2 = dlf(i,k) * ( 1._r8 - dum1 )
720 0 : ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / &
721 : (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection
722 : 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / &
723 0 : (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
724 : ! dum2 = dlf(i,k) * dum1
725 0 : ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / &
726 : (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection
727 : 3._r8 * ( dlf2(i,k) * dum1 ) / &
728 0 : (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
729 0 : ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
730 : else
731 0 : ptend_loc%q(i,k,ixcldliq) = 0._r8
732 0 : ptend_loc%q(i,k,ixcldice) = 0._r8
733 0 : ptend_loc%q(i,k,ixnumliq) = 0._r8
734 0 : ptend_loc%q(i,k,ixnumice) = 0._r8
735 0 : ptend_loc%s(i,k) = 0._r8
736 : end if
737 :
738 : ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep
739 : ! track of the integrals of ice and static energy that is effected from conversion to ice
740 : ! so that the energy checker doesn't complain.
741 0 : det_s(i) = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit
742 0 : det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit
743 :
744 : ! Targetted detrainment of convective liquid water either directly into the
745 : ! existing liquid stratus or into the environment.
746 0 : if( cu_det_st ) then
747 : dlf_T(i,k) = ptend_loc%s(i,k)/cpair
748 : dlf_qv(i,k) = 0._r8
749 : dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq)
750 : dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice)
751 : dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq)
752 : dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice)
753 : ptend_loc%q(i,k,ixcldliq) = 0._r8
754 : ptend_loc%q(i,k,ixcldice) = 0._r8
755 : ptend_loc%q(i,k,ixnumliq) = 0._r8
756 : ptend_loc%q(i,k,ixnumice) = 0._r8
757 : ptend_loc%s(i,k) = 0._r8
758 : dpdlfliq(i,k) = 0._r8
759 : dpdlfice(i,k) = 0._r8
760 : shdlfliq(i,k) = 0._r8
761 : shdlfice(i,k) = 0._r8
762 : dpdlft (i,k) = 0._r8
763 : shdlft (i,k) = 0._r8
764 : else
765 0 : dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 )
766 0 : dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 )
767 0 : dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair
768 :
769 0 : shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 )
770 0 : shdlfice(i,k) = dlf2(i,k) * ( dum1 )
771 0 : shdlft (i,k) = dlf2(i,k) * dum1 * latice/cpair
772 : endif
773 : end do
774 : end do
775 :
776 0 : call outfld( 'DPDLFLIQ ', dpdlfliq, pcols, lchnk )
777 0 : call outfld( 'DPDLFICE ', dpdlfice, pcols, lchnk )
778 0 : call outfld( 'SHDLFLIQ ', shdlfliq, pcols, lchnk )
779 0 : call outfld( 'SHDLFICE ', shdlfice, pcols, lchnk )
780 0 : call outfld( 'DPDLFT ', dpdlft , pcols, lchnk )
781 0 : call outfld( 'SHDLFT ', shdlft , pcols, lchnk )
782 :
783 0 : call outfld( 'ZMDLF', dlf , pcols, state_loc%lchnk )
784 :
785 0 : det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water
786 :
787 : ! Add the detrainment tendency to the output tendency
788 0 : call physics_ptend_init(ptend, state%psetcols, 'macrop')
789 0 : call physics_ptend_sum(ptend_loc, ptend, ncol)
790 :
791 : ! update local copy of state with the detrainment tendency
792 : ! ptend_loc is reset to zero by this call
793 0 : call physics_update(state_loc, ptend_loc, dtime)
794 :
795 : ! -------------------------------------- !
796 : ! Computation of Various Cloud Fractions !
797 : ! -------------------------------------- !
798 :
799 : ! ----------------------------------------------------------------------------- !
800 : ! Treatment of cloud fraction in CAM4 and CAM5 differs !
801 : ! (1) CAM4 !
802 : ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + !
803 : ! Shallow Cumulus AMT ( empirical fcn of mass flux ) !
804 : ! . Stratus AMT = max( RH stratus AMT, Stability Stratus AMT ) !
805 : ! . Cumulus and Stratus are 'minimally' overlapped without hierarchy. !
806 : ! . Cumulus LWC,IWC is assumed to be the same as Stratus LWC,IWC !
807 : ! (2) CAM5 !
808 : ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + !
809 : ! Shallow Cumulus AMT ( internally fcn of mass flux and w ) !
810 : ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) !
811 : ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus !
812 : ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. !
813 : ! ----------------------------------------------------------------------------- !
814 :
815 0 : concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver)
816 :
817 0 : nullify(tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det)
818 0 : if (tke_idx > 0) call pbuf_get_field(pbuf, tke_idx, tke)
819 0 : if (qtl_flx_idx > 0) call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx)
820 0 : if (qti_flx_idx > 0) call pbuf_get_field(pbuf, qti_flx_idx, qti_flx)
821 0 : if (cmfr_det_idx > 0) call pbuf_get_field(pbuf, cmfr_det_idx, cmfr_det)
822 0 : if (qlr_det_idx > 0) call pbuf_get_field(pbuf, qlr_det_idx, qlr_det)
823 0 : if (qir_det_idx > 0) call pbuf_get_field(pbuf, qir_det_idx, qir_det)
824 :
825 0 : clrw_old(:ncol,:top_lev-1) = 0._r8
826 0 : clri_old(:ncol,:top_lev-1) = 0._r8
827 0 : do k = top_lev, pver
828 0 : do i = 1, ncol
829 0 : clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) )
830 0 : clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) )
831 : end do
832 : end do
833 :
834 0 : if( use_shfrc ) then
835 0 : call pbuf_get_field(pbuf, shfrc_idx, shfrc )
836 : else
837 0 : allocate(shfrc(pcols,pver))
838 0 : shfrc(:,:) = 0._r8
839 : endif
840 :
841 : ! CAM5 only uses 'concld' output from the below subroutine.
842 : ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld')
843 : ! will be computed using this updated 'concld' in the stratiform macrophysics
844 : ! scheme (mmacro_pcond) later below.
845 :
846 0 : call t_startf("cldfrc")
847 :
848 : call cldfrc( lchnk, ncol, pbuf, &
849 : state_loc%pmid, state_loc%t, state_loc%q(:,:,1), state_loc%omega, &
850 : state_loc%phis, shfrc, use_shfrc, &
851 : cld, rhcloud, clc, state_loc%pdel, &
852 : cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, &
853 : ts, sst, state_loc%pint(:,pverp), zdu, ocnfrac, rhu00, &
854 : state_loc%q(:,:,ixcldice), icecldf, liqcldf, &
855 0 : relhum, 0 )
856 :
857 0 : call t_stopf("cldfrc")
858 :
859 : ! ---------------------------------------------- !
860 : ! Stratiform Cloud Macrophysics and Microphysics !
861 : ! ---------------------------------------------- !
862 :
863 0 : lchnk = state_loc%lchnk
864 0 : ncol = state_loc%ncol
865 0 : rdtime = 1._r8/dtime
866 :
867 : ! Define fractional amount of stratus condensate and precipitation in ice phase.
868 : ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ).
869 : ! The ramp within convective cloud may be different
870 :
871 : !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists
872 0 : fice(:,:) = 0._r8
873 0 : fsnow(:,:) = 0._r8
874 : !REMOVECAM_END
875 0 : call cldfrc_fice( ncol, state_loc%t(:ncol,:), fice(:ncol,:), fsnow(:ncol,:) )
876 :
877 :
878 0 : lq(:) = .FALSE.
879 :
880 0 : lq(1) = .true.
881 0 : lq(ixcldice) = .true.
882 0 : lq(ixcldliq) = .true.
883 :
884 0 : lq(ixnumliq) = .true.
885 0 : lq(ixnumice) = .true.
886 :
887 : ! Initialize local physics_ptend object again
888 : call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', &
889 0 : ls=.true., lq=lq )
890 :
891 : ! --------------------------------- !
892 : ! Liquid Macrop_Driver Macrophysics !
893 : ! --------------------------------- !
894 :
895 0 : call t_startf('mmacro_pcond')
896 :
897 0 : zeros(:ncol,top_lev:pver) = 0._r8
898 0 : qc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldliq)
899 0 : qi(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldice)
900 0 : nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq)
901 0 : ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice)
902 :
903 : ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... )
904 : ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an
905 : ! attempt to resolve in-cloud and out-cloud forcings.
906 :
907 0 : if( get_nstep() .le. 1 ) then
908 0 : tcwat(:ncol,top_lev:pver) = state_loc%t(:ncol,top_lev:pver)
909 0 : qcwat(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,1)
910 0 : lcwat(:ncol,top_lev:pver) = qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver)
911 0 : iccwat(:ncol,top_lev:pver) = qi(:ncol,top_lev:pver)
912 0 : nlwat(:ncol,top_lev:pver) = nc(:ncol,top_lev:pver)
913 0 : niwat(:ncol,top_lev:pver) = ni(:ncol,top_lev:pver)
914 0 : ttend(:ncol,:) = 0._r8
915 0 : qtend(:ncol,:) = 0._r8
916 0 : ltend(:ncol,:) = 0._r8
917 0 : itend(:ncol,:) = 0._r8
918 0 : nltend(:ncol,:) = 0._r8
919 0 : nitend(:ncol,:) = 0._r8
920 0 : CC_T(:ncol,:) = 0._r8
921 0 : CC_qv(:ncol,:) = 0._r8
922 0 : CC_ql(:ncol,:) = 0._r8
923 0 : CC_qi(:ncol,:) = 0._r8
924 0 : CC_nl(:ncol,:) = 0._r8
925 0 : CC_ni(:ncol,:) = 0._r8
926 0 : CC_qlst(:ncol,:) = 0._r8
927 : else
928 0 : ttend(:ncol,top_lev:pver) = ( state_loc%t(:ncol,top_lev:pver) - tcwat(:ncol,top_lev:pver)) * rdtime &
929 0 : - CC_T(:ncol,top_lev:pver)
930 0 : qtend(:ncol,top_lev:pver) = ( state_loc%q(:ncol,top_lev:pver,1) - qcwat(:ncol,top_lev:pver)) * rdtime &
931 0 : - CC_qv(:ncol,top_lev:pver)
932 0 : ltend(:ncol,top_lev:pver) = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime &
933 0 : - (CC_ql(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver))
934 0 : itend(:ncol,top_lev:pver) = ( qi(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)) * rdtime &
935 0 : - CC_qi(:ncol,top_lev:pver)
936 0 : nltend(:ncol,top_lev:pver) = ( nc(:ncol,top_lev:pver) - nlwat(:ncol,top_lev:pver)) * rdtime &
937 0 : - CC_nl(:ncol,top_lev:pver)
938 0 : nitend(:ncol,top_lev:pver) = ( ni(:ncol,top_lev:pver) - niwat(:ncol,top_lev:pver)) * rdtime &
939 0 : - CC_ni(:ncol,top_lev:pver)
940 : endif
941 0 : lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver)
942 :
943 0 : t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver)
944 0 : qv_inout(:ncol,top_lev:pver) = qcwat(:ncol,top_lev:pver)
945 0 : ql_inout(:ncol,top_lev:pver) = lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)
946 0 : qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver)
947 0 : nl_inout(:ncol,top_lev:pver) = nlwat(:ncol,top_lev:pver)
948 0 : ni_inout(:ncol,top_lev:pver) = niwat(:ncol,top_lev:pver)
949 :
950 : ! Liquid Microp_Driver Macrophysics.
951 : ! The main roles of this subroutines are
952 : ! (1) compute net condensation rate of stratiform liquid ( cmeliq )
953 : ! (2) compute liquid stratus and ice stratus fractions.
954 : ! Note 'ttend...' are advective tendencies except microphysical process while
955 : ! 'CC...' are microphysical tendencies.
956 :
957 : call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel, &
958 : t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, &
959 : ttend, qtend, lmitend, itend, nltend, nitend, &
960 : CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, &
961 : dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni, &
962 : concld_old, concld, clrw_old, clri_old, landfrac, snowh, &
963 : tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det, &
964 : tlat, qvlat, qcten, qiten, ncten, niten, &
965 : cmeliq, qvadj, qladj, qiadj, qllim, qilim, &
966 0 : cld, alst, aist, qlst, qist, do_cldice )
967 :
968 : ! Copy of concld/fice to put in physics buffer
969 : ! Below are used only for convective cloud.
970 :
971 0 : fice_ql(:ncol,:top_lev-1) = 0._r8
972 0 : fice_ql(:ncol,top_lev:pver) = fice(:ncol,top_lev:pver)
973 :
974 :
975 : ! Compute net stratus fraction using maximum over-lapping assumption
976 0 : ast(:ncol,:top_lev-1) = 0._r8
977 0 : ast(:ncol,top_lev:pver) = max( alst(:ncol,top_lev:pver), aist(:ncol,top_lev:pver) )
978 :
979 0 : call t_stopf('mmacro_pcond')
980 :
981 0 : do k = top_lev, pver
982 0 : do i = 1, ncol
983 0 : ptend_loc%s(i,k) = tlat(i,k)
984 0 : ptend_loc%q(i,k,1) = qvlat(i,k)
985 0 : ptend_loc%q(i,k,ixcldliq) = qcten(i,k)
986 0 : ptend_loc%q(i,k,ixcldice) = qiten(i,k)
987 0 : ptend_loc%q(i,k,ixnumliq) = ncten(i,k)
988 0 : ptend_loc%q(i,k,ixnumice) = niten(i,k)
989 :
990 : ! Check to make sure that the macrophysics code is respecting the flags that control
991 : ! whether cldwat should be prognosing cloud ice and cloud liquid or not.
992 0 : if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then
993 : call endrun("macrop_driver:ERROR - "// &
994 0 : "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.")
995 : end if
996 0 : if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then
997 : call endrun("macrop_driver:ERROR -"// &
998 0 : " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.")
999 : end if
1000 :
1001 0 : if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then
1002 : call endrun("macrop_driver:ERROR - "// &
1003 0 : "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.")
1004 : end if
1005 0 : if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then
1006 : call endrun("macrop_driver:ERROR - "// &
1007 0 : "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.")
1008 : end if
1009 : end do
1010 : end do
1011 :
1012 : ! update the output tendencies with the mmacro_pcond tendencies
1013 0 : call physics_ptend_sum(ptend_loc, ptend, ncol)
1014 :
1015 : ! state_loc is the equlibrium state after macrophysics
1016 0 : call physics_update(state_loc, ptend_loc, dtime)
1017 :
1018 0 : call outfld('CLR_LIQ', clrw_old, pcols, lchnk)
1019 0 : call outfld('CLR_ICE', clri_old, pcols, lchnk)
1020 :
1021 0 : call outfld( 'MACPDT ', tlat , pcols, lchnk )
1022 0 : call outfld( 'MACPDQ ', qvlat, pcols, lchnk )
1023 0 : call outfld( 'MACPDLIQ ', qcten, pcols, lchnk )
1024 0 : call outfld( 'MACPDICE ', qiten, pcols, lchnk )
1025 0 : call outfld( 'CLDVAPADJ', qvadj, pcols, lchnk )
1026 0 : call outfld( 'CLDLIQADJ', qladj, pcols, lchnk )
1027 0 : call outfld( 'CLDICEADJ', qiadj, pcols, lchnk )
1028 0 : call outfld( 'CLDLIQDET', dlf_ql, pcols, lchnk )
1029 0 : call outfld( 'CLDICEDET', dlf_qi, pcols, lchnk )
1030 0 : call outfld( 'CLDLIQLIM', qllim, pcols, lchnk )
1031 0 : call outfld( 'CLDICELIM', qilim, pcols, lchnk )
1032 :
1033 0 : call outfld( 'ICECLDF ', aist, pcols, lchnk )
1034 0 : call outfld( 'LIQCLDF ', alst, pcols, lchnk )
1035 0 : call outfld( 'AST', ast, pcols, lchnk )
1036 :
1037 0 : call outfld( 'CONCLD ', concld, pcols, lchnk )
1038 0 : call outfld( 'CLDST ', cldst, pcols, lchnk )
1039 :
1040 0 : call outfld( 'CMELIQ' , cmeliq, pcols, lchnk )
1041 :
1042 :
1043 : ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP
1044 :
1045 : ! initialize local variables
1046 0 : mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0
1047 0 : mr_ccice = 0._r8 !! not seen by radiation, so setting to 0
1048 0 : mr_lsliq = 0._r8
1049 0 : mr_lsice = 0._r8
1050 :
1051 0 : do k=top_lev,pver
1052 0 : do i=1,ncol
1053 0 : if (cld(i,k) .gt. 0._r8) then
1054 0 : mr_lsliq(i,k) = state_loc%q(i,k,ixcldliq)
1055 0 : mr_lsice(i,k) = state_loc%q(i,k,ixcldice)
1056 : else
1057 0 : mr_lsliq(i,k) = 0._r8
1058 0 : mr_lsice(i,k) = 0._r8
1059 : end if
1060 : end do
1061 : end do
1062 :
1063 0 : call outfld( 'CLDLIQSTR ', mr_lsliq, pcols, lchnk )
1064 0 : call outfld( 'CLDICESTR ', mr_lsice, pcols, lchnk )
1065 0 : call outfld( 'CLDLIQCON ', mr_ccliq, pcols, lchnk )
1066 0 : call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk )
1067 :
1068 : ! ------------------------------------------------- !
1069 : ! Save equilibrium state variables for macrophysics !
1070 : ! at the next time step !
1071 : ! ------------------------------------------------- !
1072 0 : cldsice = 0._r8
1073 0 : do k = top_lev, pver
1074 0 : tcwat(:ncol,k) = state_loc%t(:ncol,k)
1075 0 : qcwat(:ncol,k) = state_loc%q(:ncol,k,1)
1076 0 : lcwat(:ncol,k) = state_loc%q(:ncol,k,ixcldliq) + state_loc%q(:ncol,k,ixcldice)
1077 0 : iccwat(:ncol,k) = state_loc%q(:ncol,k,ixcldice)
1078 0 : nlwat(:ncol,k) = state_loc%q(:ncol,k,ixnumliq)
1079 0 : niwat(:ncol,k) = state_loc%q(:ncol,k,ixnumice)
1080 0 : cldsice(:ncol,k) = lcwat(:ncol,k) * min(1.0_r8, max(0.0_r8, (tmelt - tcwat(:ncol,k)) / 20._r8))
1081 : end do
1082 :
1083 0 : call outfld( 'CLDSICE' , cldsice, pcols, lchnk )
1084 :
1085 : ! ptend_loc is deallocated in physics_update above
1086 0 : call physics_state_dealloc(state_loc)
1087 :
1088 0 : end subroutine macrop_driver_tend
1089 :
1090 :
1091 : ! Saturation adjustment for liquid
1092 : !
1093 : ! With CLUBB, we are seeing relative humidity with respect to water
1094 : ! greater than 1. This should not be happening and is not what the
1095 : ! microphsyics expects from the macrophysics. As a work around while
1096 : ! this issue is investigated in CLUBB, this routine will enfornce a
1097 : ! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will
1098 : ! be converted into cloud drops.
1099 0 : subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend,vlen)
1100 :
1101 0 : use wv_sat_methods, only: wv_sat_qsat_ice_vect, wv_sat_qsat_water_vect
1102 : use micro_pumas_utils, only: rhow
1103 : use physconst, only: rair
1104 : use cldfrc2m, only: rhmini_const, rhmaxi_const
1105 :
1106 : integer, intent(in) :: vlen
1107 : real(r8), dimension(vlen), intent(in) :: npccn !Activated number of cloud condensation nuclei
1108 : real(r8), dimension(vlen), intent(in) :: t !temperature (k)
1109 : real(r8), dimension(vlen), intent(in) :: p !pressure (pa)
1110 : real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio
1111 : real(r8), dimension(vlen), intent(in) :: qc !liquid mixing ratio
1112 : real(r8), dimension(vlen), intent(in) :: nc !liquid number concentration
1113 : real(r8), intent(in) :: xxlv !latent heat of vaporization
1114 : real(r8), intent(in) :: deltat !timestep
1115 : real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency
1116 : real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency
1117 : real(r8), dimension(vlen), intent(out) :: qctend !liquid mass tendency
1118 : real(r8), dimension(vlen), intent(out) :: nctend !liquid number tendency
1119 :
1120 0 : real(r8) :: ESL(vlen)
1121 0 : real(r8) :: QSL(vlen)
1122 : real(r8) :: drop_size_param
1123 : integer :: i
1124 :
1125 0 : drop_size_param = 3._r8/(4._r8*3.14_r8*6.e-6_r8**3*rhow)
1126 :
1127 0 : do i = 1, vlen
1128 0 : stend(i) = 0._r8
1129 0 : qvtend(i) = 0._r8
1130 0 : qctend(i) = 0._r8
1131 0 : nctend(i) = 0._r8
1132 : end do
1133 :
1134 : ! calculate qsatl from t,p,q
1135 : !$acc data copyin(t,p) copyout(ESL,QSL)
1136 0 : call wv_sat_qsat_water_vect(t, p, ESL, QSL, vlen)
1137 : !$acc end data
1138 :
1139 0 : do i = 1, vlen
1140 : ! Don't allow supersaturation with respect to liquid.
1141 0 : if (qv(i) > QSL(i)) then
1142 :
1143 0 : qctend(i) = (qv(i) - QSL(i)) / deltat
1144 0 : qvtend(i) = 0._r8 - qctend(i)
1145 0 : stend(i) = qctend(i) * xxlv ! moist static energy tend...[J/kg/s] !
1146 :
1147 : ! If drops exists (more than 1 L-1) and there is condensation,
1148 : ! do not add to number (= growth), otherwise add 6um drops.
1149 : !
1150 : ! This is somewhat arbitrary, but ensures that some reasonable droplet
1151 : ! size is created to remove the excess water. This could be enhanced to
1152 : ! look at npccn, but ideally this entire routine should go away.
1153 0 : if ((nc(i)*p(i)/rair/t(i) < 1e3_r8) .and. (qc(i)+qctend(i)*deltat > 1e-18_r8)) then
1154 0 : nctend(i) = nctend(i) + qctend(i)*drop_size_param
1155 : end if
1156 : end if
1157 : end do
1158 :
1159 0 : end subroutine liquid_macro_tend
1160 :
1161 : end module macrop_driver
|
