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