Line data Source code
1 : module micro_pumas_cam
2 :
3 : !---------------------------------------------------------------------------------
4 : !
5 : ! CAM Interfaces for MG microphysics
6 : !
7 : !---------------------------------------------------------------------------------
8 :
9 : use shr_kind_mod, only: r8=>shr_kind_r8
10 : use spmd_utils, only: masterproc
11 : use ppgrid, only: pcols, pver, pverp, psubcols
12 : use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, &
13 : latvap, latice, mwh2o
14 : use phys_control, only: phys_getopts, use_hetfrz_classnuc
15 : use shr_const_mod, only: pi => shr_const_pi
16 : use time_manager, only: get_curr_date, get_curr_calday
17 : use phys_grid, only: get_rlat_all_p, get_rlon_all_p
18 : use orbit, only: zenith
19 :
20 : use physics_types, only: physics_state, physics_ptend, &
21 : physics_ptend_init, physics_state_copy, &
22 : physics_update, physics_state_dealloc, &
23 : physics_ptend_sum, physics_ptend_scale
24 :
25 : use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, &
26 : pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, &
27 : pbuf_get_field, pbuf_set_field, col_type_subcol, &
28 : pbuf_register_subcol
29 : use constituents, only: cnst_add, cnst_get_ind, &
30 : cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst
31 :
32 : use cldfrc2m, only: rhmini=>rhmini_const
33 :
34 : use cam_history, only: addfld, add_default, outfld, horiz_only
35 :
36 : use cam_logfile, only: iulog
37 : use cam_abortutils, only: endrun
38 : use error_messages, only: handle_errmsg
39 : use ref_pres, only: top_lev=>trop_cloud_top_lev
40 :
41 : use subcol_utils, only: subcol_get_scheme
42 :
43 : implicit none
44 : private
45 : save
46 :
47 : public :: &
48 : micro_pumas_cam_readnl, &
49 : micro_pumas_cam_register, &
50 : micro_pumas_cam_init_cnst, &
51 : micro_pumas_cam_implements_cnst, &
52 : micro_pumas_cam_init, &
53 : micro_pumas_cam_tend, &
54 : micro_mg_version, &
55 : massless_droplet_destroyer
56 :
57 : integer :: micro_mg_version = 1 ! Version number for MG.
58 : integer :: micro_mg_sub_version = 0 ! Second part of version number.
59 :
60 : real(r8) :: micro_mg_dcs = -1._r8
61 :
62 : logical :: microp_uniform = .false.
63 : logical :: micro_mg_adjust_cpt = .false.
64 :
65 : logical :: micro_do_massless_droplet_destroyer ! turn on/off destruction of massless droplets
66 :
67 : character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method
68 :
69 : real(r8), parameter :: unset_r8 = huge(1.0_r8)
70 :
71 : ! Tunable namelist parameters (set in atm_in)
72 : real(r8) :: micro_mg_berg_eff_factor = unset_r8 ! berg efficiency factor
73 : real(r8) :: micro_mg_accre_enhan_fact = unset_r8 ! accretion enhancment factor
74 : real(r8) :: micro_mg_autocon_fact = unset_r8 ! autoconversion prefactor
75 : real(r8) :: micro_mg_autocon_nd_exp = unset_r8 ! autoconversion nd exponent
76 : real(r8) :: micro_mg_autocon_lwp_exp = unset_r8 ! autoconversion lwp exponent
77 : real(r8) :: micro_mg_homog_size = unset_r8 ! size of freezing homogeneous ice
78 : real(r8) :: micro_mg_vtrmi_factor = unset_r8 ! ice fall speed factor
79 : real(r8) :: micro_mg_effi_factor = unset_r8 ! ice effective radius factor
80 : real(r8) :: micro_mg_iaccr_factor = unset_r8 ! ice accretion of cloud droplet
81 : real(r8) :: micro_mg_max_nicons = unset_r8 ! max allowed ice number concentration
82 :
83 :
84 : logical, public :: do_cldliq ! Prognose cldliq flag
85 : logical, public :: do_cldice ! Prognose cldice flag
86 :
87 : integer :: num_steps ! Number of MG substeps
88 :
89 : integer :: ncnst = 4 ! Number of constituents
90 :
91 : ! Namelist variables for option to specify constant cloud droplet/ice number
92 : logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number
93 : logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number
94 : logical :: micro_mg_ngcons = .false. ! set .true. to specify constant graupel/hail number
95 : logical :: micro_mg_nrcons = .false. ! set .true. to specify constant rain number
96 : logical :: micro_mg_nscons = .false. ! set .true. to specify constant snow number
97 :
98 : ! parameters for specified ice and droplet number concentration
99 : ! note: these are local in-cloud values, not grid-mean
100 : real(r8) :: micro_mg_ncnst = 50.e6_r8 ! constant liquid droplet num concentration (m-3)
101 : real(r8) :: micro_mg_ninst = 0.05e6_r8 ! ice num concentration when nicons=.true. (m-3)
102 : real(r8) :: micro_mg_nrnst = 0.2e6_r8 ! rain num concentration when nrcons=.true. (m-3)
103 : real(r8) :: micro_mg_nsnst = 0.005e6_r8 ! snow num concentration when nscons=.true. (m-3)
104 : real(r8) :: micro_mg_ngnst = 0.0005e6_r8 ! graupel/hail num concentration when ngcons=.true. (m-3)
105 :
106 : logical, public :: micro_mg_do_graupel
107 : logical, public :: micro_mg_do_hail
108 :
109 : ! switches for IFS like behavior
110 : logical :: micro_mg_evap_sed_off = .false. ! Turn off evaporation/sublimation based on cloud fraction for sedimenting condensate
111 : logical :: micro_mg_icenuc_rh_off = .false. ! Remove RH conditional from ice nucleation
112 : logical :: micro_mg_icenuc_use_meyers = .false. ! Meyers Ice Nucleation
113 : logical :: micro_mg_evap_scl_ifs = .false. ! Scale evaporation as IFS does
114 : logical :: micro_mg_evap_rhthrsh_ifs = .false. ! Evap RH threhold following IFS
115 : logical :: micro_mg_rainfreeze_ifs = .false. ! Rain freezing at 0C following IFS
116 : logical :: micro_mg_ifs_sed = .false. ! Snow sedimentation = 1 m/s following IFS
117 : logical :: micro_mg_precip_fall_corr = .false. ! Precip fall speed following IFS
118 :
119 : character(len=10), parameter :: & ! Constituent names
120 : cnst_names(10) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', &
121 : 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO','GRAUQM','NUMGRA'/)
122 :
123 : integer :: &
124 : ixq = -1, &! water vapor
125 : ixcldliq = -1, &! cloud liquid amount index
126 : ixcldice = -1, &! cloud ice amount index
127 : ixnumliq = -1, &! cloud liquid number index
128 : ixnumice = -1, &! cloud ice water index
129 : ixrain = -1, &! rain index
130 : ixsnow = -1, &! snow index
131 : ixnumrain = -1, &! rain number index
132 : ixnumsnow = -1, &! snow number index
133 : ixgraupel = -1, &! graupel index
134 : ixnumgraupel = -1 ! graupel number index
135 :
136 : ! Physics buffer indices for fields registered by this module
137 : integer :: &
138 : cldo_idx, &
139 : qme_idx, &
140 : prain_idx, &
141 : nevapr_idx, &
142 : wsedl_idx, &
143 : rei_idx, &
144 : sadice_idx, &
145 : sadsnow_idx, &
146 : rel_idx, &
147 : dei_idx, &
148 : mu_idx, &
149 : prer_evap_idx, &
150 : lambdac_idx, &
151 : iciwpst_idx, &
152 : iclwpst_idx, &
153 : des_idx, &
154 : icswp_idx, &
155 : cldfsnow_idx, &
156 : degrau_idx = -1, &
157 : icgrauwp_idx = -1, &
158 : cldfgrau_idx = -1, &
159 : rate1_cw2pr_st_idx = -1, &
160 : ls_flxprc_idx, &
161 : ls_flxsnw_idx, &
162 : relvar_idx, &
163 : cmeliq_idx, &
164 : accre_enhan_idx
165 :
166 : ! Fields for UNICON
167 : integer :: &
168 : am_evp_st_idx, &! Evaporation area of stratiform precipitation
169 : evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0.
170 : evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0.
171 :
172 : ! Fields needed as inputs to COSP
173 : integer :: &
174 : ls_mrprc_idx, ls_mrsnw_idx, &
175 : ls_reffrain_idx, ls_reffsnow_idx, &
176 : cv_reffliq_idx, cv_reffice_idx
177 :
178 : ! Fields needed by Park macrophysics
179 : integer :: &
180 : cc_t_idx, cc_qv_idx, &
181 : cc_ql_idx, cc_qi_idx, &
182 : cc_nl_idx, cc_ni_idx, &
183 : cc_qlst_idx
184 :
185 : ! Used to replace aspects of MG microphysics
186 : ! (e.g. by CARMA)
187 : integer :: &
188 : tnd_qsnow_idx = -1, &
189 : tnd_nsnow_idx = -1, &
190 : re_ice_idx = -1
191 :
192 : ! Index fields for precipitation efficiency.
193 : integer :: &
194 : acpr_idx = -1, &
195 : acgcme_idx = -1, &
196 : acnum_idx = -1
197 :
198 : ! Physics buffer indices for fields registered by other modules
199 : integer :: &
200 : ast_idx = -1, &
201 : cld_idx = -1, &
202 : concld_idx = -1, &
203 : prec_dp_idx = -1, &
204 : prec_sh_idx = -1, &
205 : qsatfac_idx = -1
206 :
207 : ! Pbuf fields needed for subcol_SILHS
208 : integer :: &
209 : qrain_idx=-1, qsnow_idx=-1, &
210 : nrain_idx=-1, nsnow_idx=-1, &
211 : qcsedten_idx=-1, qrsedten_idx=-1, &
212 : qisedten_idx=-1, qssedten_idx=-1, &
213 : vtrmc_idx=-1, umr_idx=-1, &
214 : vtrmi_idx=-1, ums_idx=-1, &
215 : qcsevap_idx=-1, qisevap_idx=-1
216 :
217 : integer :: &
218 : naai_idx = -1, &
219 : naai_hom_idx = -1, &
220 : npccn_idx = -1, &
221 : rndst_idx = -1, &
222 : nacon_idx = -1, &
223 : prec_str_idx = -1, &
224 : snow_str_idx = -1, &
225 : prec_pcw_idx = -1, &
226 : snow_pcw_idx = -1, &
227 : prec_sed_idx = -1, &
228 : snow_sed_idx = -1
229 :
230 : ! pbuf fields for heterogeneous freezing
231 : integer :: &
232 : frzimm_idx = -1, &
233 : frzcnt_idx = -1, &
234 : frzdep_idx = -1
235 :
236 : logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop
237 : logical :: micro_do_sb_physics = .false. ! do SB 2001 autoconversion and accretion
238 :
239 : integer :: bergso_idx = -1
240 :
241 : !===============================================================================
242 : contains
243 : !===============================================================================
244 :
245 1536 : subroutine micro_pumas_cam_readnl(nlfile)
246 :
247 : use namelist_utils, only: find_group_name
248 : use units, only: getunit, freeunit
249 : use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, &
250 : mpi_logical, mpi_character
251 :
252 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
253 :
254 : ! Namelist variables
255 : logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice
256 : logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq
257 : integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now).
258 :
259 :
260 : ! Local variables
261 : integer :: unitn, ierr
262 : character(len=*), parameter :: sub = 'micro_pumas_cam_readnl'
263 :
264 : namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, &
265 : micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, &
266 : microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, &
267 : micro_mg_berg_eff_factor, micro_do_sb_physics, micro_mg_adjust_cpt, &
268 : micro_mg_do_hail, micro_mg_do_graupel, micro_mg_ngcons, micro_mg_ngnst, &
269 : micro_mg_vtrmi_factor, micro_mg_effi_factor, micro_mg_iaccr_factor, &
270 : micro_mg_max_nicons, micro_mg_accre_enhan_fact, &
271 : micro_mg_autocon_fact, micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, &
272 : micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst, &
273 : micro_mg_nrcons, micro_mg_nscons, micro_mg_nrnst, micro_mg_nsnst, &
274 : micro_do_massless_droplet_destroyer, &
275 : micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, &
276 : micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, &
277 : micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr
278 :
279 :
280 : !-----------------------------------------------------------------------------
281 :
282 1536 : if (masterproc) then
283 2 : unitn = getunit()
284 2 : open( unitn, file=trim(nlfile), status='old' )
285 2 : call find_group_name(unitn, 'micro_mg_nl', status=ierr)
286 2 : if (ierr == 0) then
287 2 : read(unitn, micro_mg_nl, iostat=ierr)
288 2 : if (ierr /= 0) then
289 0 : call endrun(sub // ':: ERROR reading namelist')
290 : end if
291 : end if
292 2 : close(unitn)
293 2 : call freeunit(unitn)
294 :
295 : ! set local variables
296 2 : do_cldice = micro_mg_do_cldice
297 2 : do_cldliq = micro_mg_do_cldliq
298 2 : num_steps = micro_mg_num_steps
299 :
300 : ! Verify that version numbers are valid.
301 0 : select case (micro_mg_version)
302 : case (1)
303 2 : select case (micro_mg_sub_version)
304 : case(0)
305 : ! MG version 1.0
306 : case default
307 0 : call bad_version_endrun()
308 : end select
309 : case (2)
310 0 : select case (micro_mg_sub_version)
311 : case(0)
312 : ! MG version 2.0
313 : case default
314 2 : call bad_version_endrun()
315 : end select
316 : case (3)
317 0 : select case (micro_mg_sub_version)
318 : case(0)
319 : ! MG version 3.0
320 : case default
321 0 : call bad_version_endrun()
322 : end select
323 : case default
324 2 : call bad_version_endrun()
325 : end select
326 :
327 2 : if (micro_mg_dcs < 0._r8) call endrun( "micro_pumas_cam_readnl: &
328 0 : µ_mg_dcs has not been set to a valid value.")
329 :
330 2 : if (micro_mg_version < 3) then
331 :
332 2 : if(micro_mg_do_graupel .or. micro_mg_do_hail ) then
333 : call endrun ("micro_pumas_cam_readnl: Micro_mg_do_graupel and micro_mg_do_hail &
334 0 : &must be false for MG versions before MG3.")
335 : end if
336 :
337 : else ! micro_mg_version = 3 or greater
338 :
339 0 : if(micro_mg_do_graupel .and. micro_mg_do_hail ) then
340 : call endrun ("micro_pumas_cam_readnl: Only one of micro_mg_do_graupel or &
341 0 : µ_mg_do_hail may be true at a time.")
342 : end if
343 :
344 : end if
345 :
346 : end if
347 :
348 : ! Broadcast namelist variables
349 1536 : call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr)
350 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version")
351 :
352 1536 : call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr)
353 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version")
354 :
355 1536 : call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr)
356 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice")
357 :
358 1536 : call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr)
359 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq")
360 :
361 1536 : call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr)
362 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps")
363 :
364 1536 : call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr)
365 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform")
366 :
367 1536 : call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr)
368 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs")
369 :
370 1536 : call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr)
371 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor")
372 :
373 1536 : call mpi_bcast(micro_mg_accre_enhan_fact, 1, mpi_real8, mstrid, mpicom, ierr)
374 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_accre_enhan_fact")
375 :
376 1536 : call mpi_bcast(micro_mg_autocon_fact, 1, mpi_real8, mstrid, mpicom, ierr)
377 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_fact")
378 :
379 1536 : call mpi_bcast(micro_mg_autocon_nd_exp, 1, mpi_real8, mstrid, mpicom, ierr)
380 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_nd_exp")
381 :
382 1536 : call mpi_bcast(micro_mg_autocon_lwp_exp, 1, mpi_real8, mstrid, mpicom, ierr)
383 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_lwp_exp")
384 :
385 1536 : call mpi_bcast(micro_mg_homog_size, 1, mpi_real8, mstrid, mpicom, ierr)
386 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_homog_size")
387 :
388 1536 : call mpi_bcast(micro_mg_vtrmi_factor, 1, mpi_real8, mstrid, mpicom, ierr)
389 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_vtrmi_factor")
390 :
391 1536 : call mpi_bcast(micro_mg_effi_factor, 1, mpi_real8, mstrid, mpicom, ierr)
392 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_effi_factor")
393 :
394 1536 : call mpi_bcast(micro_mg_iaccr_factor, 1, mpi_real8, mstrid, mpicom, ierr)
395 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_iaccr_factor")
396 :
397 1536 : call mpi_bcast(micro_mg_max_nicons, 1, mpi_real8, mstrid, mpicom, ierr)
398 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_max_nicons")
399 :
400 1536 : call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr)
401 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method")
402 :
403 1536 : call mpi_bcast(micro_do_sb_physics, 1, mpi_logical, mstrid, mpicom, ierr)
404 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_sb_physics")
405 :
406 1536 : call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr)
407 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt")
408 :
409 1536 : call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr)
410 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons")
411 :
412 1536 : call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr)
413 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons")
414 :
415 1536 : call mpi_bcast(micro_mg_nrcons, 1, mpi_logical, mstrid, mpicom, ierr)
416 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrcons")
417 :
418 1536 : call mpi_bcast(micro_mg_nscons, 1, mpi_logical, mstrid, mpicom, ierr)
419 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nscons")
420 :
421 1536 : call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr)
422 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst")
423 :
424 1536 : call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr)
425 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst")
426 :
427 1536 : call mpi_bcast(micro_mg_nrnst, 1, mpi_real8, mstrid, mpicom, ierr)
428 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrnst")
429 :
430 1536 : call mpi_bcast(micro_mg_nsnst, 1, mpi_real8, mstrid, mpicom, ierr)
431 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nsnst")
432 :
433 1536 : call mpi_bcast(micro_mg_do_hail, 1, mpi_logical, mstrid, mpicom, ierr)
434 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_hail")
435 :
436 1536 : call mpi_bcast(micro_mg_do_graupel, 1, mpi_logical, mstrid, mpicom, ierr)
437 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_graupel")
438 :
439 1536 : call mpi_bcast(micro_mg_ngcons, 1, mpi_logical, mstrid, mpicom, ierr)
440 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngcons")
441 :
442 1536 : call mpi_bcast(micro_mg_ngnst, 1, mpi_real8, mstrid, mpicom, ierr)
443 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngnst")
444 :
445 1536 : call mpi_bcast(micro_do_massless_droplet_destroyer, 1, mpi_logical, mstrid, mpicom, ierr)
446 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_massless_droplet_destroyer")
447 :
448 1536 : call mpi_bcast(micro_mg_evap_sed_off, 1, mpi_logical, mstrid, mpicom, ierr)
449 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_sed_off")
450 :
451 1536 : call mpi_bcast(micro_mg_icenuc_rh_off, 1, mpi_logical, mstrid, mpicom, ierr)
452 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_rh_off")
453 :
454 1536 : call mpi_bcast(micro_mg_icenuc_use_meyers, 1, mpi_logical, mstrid, mpicom, ierr)
455 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_use_meyers")
456 :
457 1536 : call mpi_bcast(micro_mg_evap_scl_ifs, 1, mpi_logical, mstrid, mpicom, ierr)
458 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_scl_ifs")
459 :
460 1536 : call mpi_bcast(micro_mg_evap_rhthrsh_ifs, 1, mpi_logical, mstrid, mpicom, ierr)
461 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_rhthrsh_ifs")
462 :
463 1536 : call mpi_bcast(micro_mg_rainfreeze_ifs, 1, mpi_logical, mstrid, mpicom, ierr)
464 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_rainfreeze_ifs")
465 :
466 1536 : call mpi_bcast(micro_mg_ifs_sed, 1, mpi_logical, mstrid, mpicom, ierr)
467 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ifs_sed")
468 :
469 1536 : call mpi_bcast(micro_mg_precip_fall_corr, 1, mpi_logical, mstrid, mpicom, ierr)
470 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_fall_corr")
471 :
472 1536 : if(micro_mg_berg_eff_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_berg_eff_factor is not set")
473 1536 : if(micro_mg_accre_enhan_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_accre_enhan_fact is not set")
474 1536 : if(micro_mg_autocon_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_fact is not set")
475 1536 : if(micro_mg_autocon_nd_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_nd_exp is not set")
476 1536 : if(micro_mg_autocon_lwp_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_lwp_exp is not set")
477 1536 : if(micro_mg_homog_size == unset_r8) call endrun(sub//": FATAL: micro_mg_homog_size is not set")
478 1536 : if(micro_mg_vtrmi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_vtrmi_factor is not set")
479 1536 : if(micro_mg_effi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_effi_factor is not set")
480 1536 : if(micro_mg_iaccr_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_iaccr_factor is not set")
481 1536 : if(micro_mg_max_nicons == unset_r8) call endrun(sub//": FATAL: micro_mg_max_nicons is not set")
482 :
483 1536 : if (masterproc) then
484 :
485 2 : write(iulog,*) 'MG microphysics namelist:'
486 2 : write(iulog,*) ' micro_mg_version = ', micro_mg_version
487 2 : write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version
488 2 : write(iulog,*) ' micro_mg_do_cldice = ', do_cldice
489 2 : write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq
490 2 : write(iulog,*) ' micro_mg_num_steps = ', num_steps
491 2 : write(iulog,*) ' microp_uniform = ', microp_uniform
492 2 : write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs
493 2 : write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor
494 2 : write(iulog,*) ' micro_mg_accre_enhan_fact = ', micro_mg_accre_enhan_fact
495 2 : write(iulog,*) ' micro_mg_autocon_fact = ' , micro_mg_autocon_fact
496 2 : write(iulog,*) ' micro_mg_autocon_nd_exp = ' , micro_mg_autocon_nd_exp
497 2 : write(iulog,*) ' micro_mg_autocon_lwp_exp = ' , micro_mg_autocon_lwp_exp
498 2 : write(iulog,*) ' micro_mg_homog_size = ', micro_mg_homog_size
499 2 : write(iulog,*) ' micro_mg_vtrmi_factor = ', micro_mg_vtrmi_factor
500 2 : write(iulog,*) ' micro_mg_effi_factor = ', micro_mg_effi_factor
501 2 : write(iulog,*) ' micro_mg_iaccr_factor = ', micro_mg_iaccr_factor
502 2 : write(iulog,*) ' micro_mg_max_nicons = ', micro_mg_max_nicons
503 2 : write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method
504 2 : write(iulog,*) ' micro_do_sb_physics = ', micro_do_sb_physics
505 2 : write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt
506 2 : write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons
507 2 : write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons
508 2 : write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst
509 2 : write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst
510 2 : write(iulog,*) ' micro_mg_ngcons = ', micro_mg_ngcons
511 2 : write(iulog,*) ' micro_mg_ngnst = ', micro_mg_ngnst
512 2 : write(iulog,*) ' micro_mg_do_hail = ', micro_mg_do_hail
513 2 : write(iulog,*) ' micro_mg_do_graupel = ', micro_mg_do_graupel
514 2 : write(iulog,*) ' micro_do_massless_droplet_destroyer = ', micro_do_massless_droplet_destroyer
515 2 : write(iulog,*) ' micro_mg_nrcons = ', micro_mg_nrcons
516 2 : write(iulog,*) ' micro_mg_nscons = ', micro_mg_nscons
517 2 : write(iulog,*) ' micro_mg_nrnst = ', micro_mg_nrnst
518 2 : write(iulog,*) ' micro_mg_nsnst = ', micro_mg_nsnst
519 2 : write(iulog,*) ' micro_mg_evap_sed_off = ', micro_mg_evap_sed_off
520 2 : write(iulog,*) ' micro_mg_icenuc_rh_off = ', micro_mg_icenuc_rh_off
521 2 : write(iulog,*) ' micro_mg_icenuc_use_meyers = ', micro_mg_icenuc_use_meyers
522 2 : write(iulog,*) ' micro_mg_evap_scl_ifs = ', micro_mg_evap_scl_ifs
523 2 : write(iulog,*) ' micro_mg_evap_rhthrsh_ifs = ', micro_mg_evap_rhthrsh_ifs
524 2 : write(iulog,*) ' micro_mg_rainfreeze_ifs = ', micro_mg_rainfreeze_ifs
525 2 : write(iulog,*) ' micro_mg_ifs_sed = ', micro_mg_ifs_sed
526 2 : write(iulog,*) ' micro_mg_precip_fall_corr = ', micro_mg_precip_fall_corr
527 : end if
528 :
529 : contains
530 :
531 0 : subroutine bad_version_endrun
532 : ! Endrun wrapper with a more useful error message.
533 : character(len=128) :: errstring
534 0 : write(errstring,*) "Invalid version number specified for MG microphysics: ", &
535 0 : micro_mg_version,".",micro_mg_sub_version
536 0 : call endrun(errstring)
537 0 : end subroutine bad_version_endrun
538 :
539 : end subroutine micro_pumas_cam_readnl
540 :
541 : !================================================================================================
542 :
543 1536 : subroutine micro_pumas_cam_register
544 : use carma_flags_mod, only: carma_model
545 :
546 : ! Register microphysics constituents and fields in the physics buffer.
547 : !-----------------------------------------------------------------------
548 :
549 : logical :: prog_modal_aero
550 : logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics
551 : logical :: ndropmixed ! If true, then vertically mixed by ndrop routine
552 :
553 : call phys_getopts(use_subcol_microp_out = use_subcol_microp, &
554 1536 : prog_modal_aero_out = prog_modal_aero)
555 :
556 : ! Register microphysics constituents and save indices.
557 :
558 : call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, &
559 1536 : longname='Grid box averaged cloud liquid amount', is_convtran1=.true.)
560 : call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, &
561 1536 : longname='Grid box averaged cloud ice amount', is_convtran1=.true.)
562 :
563 : ! Droplet number is transported in dropmixnuc, therefore we
564 : ! do NOT want CLUBB to apply transport tendencies to avoid double
565 : ! counting.
566 1536 : ndropmixed = prog_modal_aero.or.(carma_model(:10)=='trop_strat')
567 :
568 : call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, ndropmixed=ndropmixed, &
569 1536 : longname='Grid box averaged cloud liquid number', is_convtran1=.true.)
570 : call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, &
571 1536 : longname='Grid box averaged cloud ice number', is_convtran1=.true.)
572 :
573 : ! Note is_convtran1 is set to .true.
574 1536 : if (micro_mg_version > 1) then
575 : call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, &
576 1536 : longname='Grid box averaged rain amount', is_convtran1=.true.)
577 : call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, &
578 1536 : longname='Grid box averaged snow amount', is_convtran1=.true.)
579 : call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, &
580 1536 : longname='Grid box averaged rain number', is_convtran1=.true.)
581 : call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, &
582 1536 : longname='Grid box averaged snow number', is_convtran1=.true.)
583 : end if
584 :
585 1536 : if (micro_mg_version > 2) then
586 : call cnst_add(cnst_names(9), mwh2o, cpair, 0._r8, ixgraupel, &
587 0 : longname='Grid box averaged graupel/hail amount', is_convtran1=.true.)
588 : call cnst_add(cnst_names(10), mwh2o, cpair, 0._r8, ixnumgraupel, &
589 0 : longname='Grid box averaged graupel/hail number', is_convtran1=.true.)
590 : end if
591 :
592 : ! Request physics buffer space for fields that persist across timesteps.
593 :
594 6144 : call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx)
595 :
596 : ! Physics buffer variables for convective cloud properties.
597 :
598 1536 : call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx)
599 1536 : call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx)
600 1536 : call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx)
601 1536 : call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx)
602 1536 : call pbuf_add_field('BERGSO', 'physpkg',dtype_r8,(/pcols,pver/), bergso_idx)
603 :
604 1536 : call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx)
605 :
606 1536 : call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx)
607 1536 : call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx)
608 1536 : call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx)
609 1536 : call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx)
610 :
611 : ! Mitchell ice effective diameter for radiation
612 1536 : call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx)
613 : ! Size distribution shape parameter for radiation
614 1536 : call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx)
615 : ! Size distribution shape parameter for radiation
616 1536 : call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx)
617 :
618 : ! Stratiform only in cloud ice water path for radiation
619 1536 : call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx)
620 : ! Stratiform in cloud liquid water path for radiation
621 1536 : call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx)
622 :
623 : ! Snow effective diameter for radiation
624 1536 : call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx)
625 : ! In cloud snow water path for radiation
626 1536 : call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx)
627 : ! Cloud fraction for liquid drops + snow
628 6144 : call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx)
629 :
630 1536 : if (micro_mg_version > 2) then
631 : ! Graupel effective diameter for radiation
632 0 : call pbuf_add_field('DEGRAU', 'physpkg',dtype_r8,(/pcols,pver/), degrau_idx)
633 : ! In cloud snow water path for radiation
634 0 : call pbuf_add_field('ICGRAUWP', 'physpkg',dtype_r8,(/pcols,pver/), icgrauwp_idx)
635 : ! Cloud fraction for liquid drops + graupel
636 0 : call pbuf_add_field('CLDFGRAU', 'physpkg',dtype_r8,(/pcols,pver/), cldfgrau_idx)
637 : end if
638 :
639 1536 : if (prog_modal_aero) then
640 1536 : call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx)
641 : endif
642 :
643 1536 : call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx)
644 1536 : call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx)
645 :
646 :
647 : ! Fields needed as inputs to COSP
648 1536 : call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx)
649 1536 : call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx)
650 1536 : call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx)
651 1536 : call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx)
652 1536 : call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx)
653 1536 : call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx)
654 :
655 : ! CC_* Fields needed by Park macrophysics
656 6144 : call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx)
657 6144 : call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx)
658 6144 : call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx)
659 6144 : call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx)
660 6144 : call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx)
661 6144 : call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx)
662 6144 : call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx)
663 :
664 : ! Fields for UNICON
665 1536 : call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx)
666 1536 : call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx)
667 1536 : call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx)
668 :
669 : ! Register subcolumn pbuf fields
670 1536 : if (use_subcol_microp) then
671 : ! Global pbuf fields
672 0 : call pbuf_register_subcol('CLDO', 'micro_pumas_cam_register', cldo_idx)
673 :
674 : ! CC_* Fields needed by Park macrophysics
675 0 : call pbuf_register_subcol('CC_T', 'micro_pumas_cam_register', cc_t_idx)
676 0 : call pbuf_register_subcol('CC_qv', 'micro_pumas_cam_register', cc_qv_idx)
677 0 : call pbuf_register_subcol('CC_ql', 'micro_pumas_cam_register', cc_ql_idx)
678 0 : call pbuf_register_subcol('CC_qi', 'micro_pumas_cam_register', cc_qi_idx)
679 0 : call pbuf_register_subcol('CC_nl', 'micro_pumas_cam_register', cc_nl_idx)
680 0 : call pbuf_register_subcol('CC_ni', 'micro_pumas_cam_register', cc_ni_idx)
681 0 : call pbuf_register_subcol('CC_qlst', 'micro_pumas_cam_register', cc_qlst_idx)
682 :
683 : ! Physpkg pbuf fields
684 : ! Physics buffer variables for convective cloud properties.
685 :
686 0 : call pbuf_register_subcol('QME', 'micro_pumas_cam_register', qme_idx)
687 0 : call pbuf_register_subcol('PRAIN', 'micro_pumas_cam_register', prain_idx)
688 0 : call pbuf_register_subcol('NEVAPR', 'micro_pumas_cam_register', nevapr_idx)
689 0 : call pbuf_register_subcol('PRER_EVAP', 'micro_pumas_cam_register', prer_evap_idx)
690 0 : call pbuf_register_subcol('BERGSO', 'micro_pumas_cam_register', bergso_idx)
691 :
692 0 : call pbuf_register_subcol('WSEDL', 'micro_pumas_cam_register', wsedl_idx)
693 :
694 0 : call pbuf_register_subcol('REI', 'micro_pumas_cam_register', rei_idx)
695 0 : call pbuf_register_subcol('SADICE', 'micro_pumas_cam_register', sadice_idx)
696 0 : call pbuf_register_subcol('SADSNOW', 'micro_pumas_cam_register', sadsnow_idx)
697 0 : call pbuf_register_subcol('REL', 'micro_pumas_cam_register', rel_idx)
698 :
699 : ! Mitchell ice effective diameter for radiation
700 0 : call pbuf_register_subcol('DEI', 'micro_pumas_cam_register', dei_idx)
701 : ! Size distribution shape parameter for radiation
702 0 : call pbuf_register_subcol('MU', 'micro_pumas_cam_register', mu_idx)
703 : ! Size distribution shape parameter for radiation
704 0 : call pbuf_register_subcol('LAMBDAC', 'micro_pumas_cam_register', lambdac_idx)
705 :
706 : ! Stratiform only in cloud ice water path for radiation
707 0 : call pbuf_register_subcol('ICIWPST', 'micro_pumas_cam_register', iciwpst_idx)
708 : ! Stratiform in cloud liquid water path for radiation
709 0 : call pbuf_register_subcol('ICLWPST', 'micro_pumas_cam_register', iclwpst_idx)
710 :
711 : ! Snow effective diameter for radiation
712 0 : call pbuf_register_subcol('DES', 'micro_pumas_cam_register', des_idx)
713 : ! In cloud snow water path for radiation
714 0 : call pbuf_register_subcol('ICSWP', 'micro_pumas_cam_register', icswp_idx)
715 : ! Cloud fraction for liquid drops + snow
716 0 : call pbuf_register_subcol('CLDFSNOW ', 'micro_pumas_cam_register', cldfsnow_idx)
717 :
718 0 : if (micro_mg_version > 2) then
719 : ! Graupel effective diameter for radiation
720 0 : call pbuf_register_subcol('DEGRAU', 'micro_pumas_cam_register', degrau_idx)
721 : ! In cloud snow water path for radiation
722 0 : call pbuf_register_subcol('ICGRAUWP', 'micro_pumas_cam_register', icgrauwp_idx)
723 : ! Cloud fraction for liquid drops + snow
724 0 : call pbuf_register_subcol('CLDFGRAU', 'micro_pumas_cam_register', cldfgrau_idx)
725 : end if
726 :
727 0 : if (prog_modal_aero) then
728 0 : call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_pumas_cam_register', rate1_cw2pr_st_idx)
729 : end if
730 :
731 0 : call pbuf_register_subcol('LS_FLXPRC', 'micro_pumas_cam_register', ls_flxprc_idx)
732 0 : call pbuf_register_subcol('LS_FLXSNW', 'micro_pumas_cam_register', ls_flxsnw_idx)
733 :
734 : ! Fields needed as inputs to COSP
735 0 : call pbuf_register_subcol('LS_MRPRC', 'micro_pumas_cam_register', ls_mrprc_idx)
736 0 : call pbuf_register_subcol('LS_MRSNW', 'micro_pumas_cam_register', ls_mrsnw_idx)
737 0 : call pbuf_register_subcol('LS_REFFRAIN', 'micro_pumas_cam_register', ls_reffrain_idx)
738 0 : call pbuf_register_subcol('LS_REFFSNOW', 'micro_pumas_cam_register', ls_reffsnow_idx)
739 0 : call pbuf_register_subcol('CV_REFFLIQ', 'micro_pumas_cam_register', cv_reffliq_idx)
740 0 : call pbuf_register_subcol('CV_REFFICE', 'micro_pumas_cam_register', cv_reffice_idx)
741 : end if
742 :
743 : ! Additional pbuf for CARMA interface
744 1536 : if (.not. do_cldice) then
745 0 : call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx)
746 0 : call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx)
747 0 : call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx)
748 : end if
749 :
750 : ! Precipitation efficiency fields across timesteps.
751 1536 : call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip
752 1536 : call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation
753 1536 : call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps
754 :
755 : ! SGS variability -- These could be reset by CLUBB so they need to be grid only
756 1536 : call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx)
757 1536 : call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx)
758 :
759 : ! Diagnostic fields needed for subcol_SILHS, need to be grid-only
760 1536 : if (subcol_get_scheme() == 'SILHS') then
761 0 : call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx)
762 0 : call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx)
763 0 : call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx)
764 0 : call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx)
765 : ! Fields for subcol_SILHS hole filling
766 0 : call pbuf_add_field('QCSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qcsedten_idx)
767 0 : if (micro_mg_version > 1) then
768 0 : call pbuf_add_field('QRSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qrsedten_idx)
769 : endif
770 0 : call pbuf_add_field('QISEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qisedten_idx)
771 0 : if (micro_mg_version > 1) then
772 0 : call pbuf_add_field('QSSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qssedten_idx)
773 : endif
774 0 : call pbuf_add_field('VTRMC', 'physpkg', dtype_r8, (/pcols,pver/), vtrmc_idx)
775 0 : if (micro_mg_version > 1) then
776 0 : call pbuf_add_field('UMR', 'physpkg', dtype_r8, (/pcols,pver/), umr_idx)
777 : endif
778 0 : call pbuf_add_field('VTRMI', 'physpkg', dtype_r8, (/pcols,pver/), vtrmi_idx)
779 0 : if (micro_mg_version > 1) then
780 0 : call pbuf_add_field('UMS', 'physpkg', dtype_r8, (/pcols,pver/), ums_idx)
781 : endif
782 0 : call pbuf_add_field('QCSEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qcsevap_idx)
783 1536 : call pbuf_add_field('QISEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qisevap_idx)
784 : end if
785 :
786 1536 : end subroutine micro_pumas_cam_register
787 :
788 : !===============================================================================
789 :
790 0 : function micro_pumas_cam_implements_cnst(name)
791 :
792 : ! Return true if specified constituent is implemented by the
793 : ! microphysics package
794 :
795 : character(len=*), intent(in) :: name ! constituent name
796 : logical :: micro_pumas_cam_implements_cnst ! return value
797 :
798 : !-----------------------------------------------------------------------
799 :
800 0 : micro_pumas_cam_implements_cnst = any(name == cnst_names)
801 :
802 0 : end function micro_pumas_cam_implements_cnst
803 :
804 : !===============================================================================
805 :
806 0 : subroutine micro_pumas_cam_init_cnst(name, latvals, lonvals, mask, q)
807 :
808 : ! Initialize the microphysics constituents, if they are
809 : ! not read from the initial file.
810 :
811 : character(len=*), intent(in) :: name ! constituent name
812 : real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
813 : real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
814 : logical, intent(in) :: mask(:) ! Only initialize where .true.
815 : real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev
816 : !-----------------------------------------------------------------------
817 : integer :: k
818 :
819 0 : if (micro_pumas_cam_implements_cnst(name)) then
820 0 : do k = 1, size(q, 2)
821 0 : where(mask)
822 0 : q(:, k) = 0.0_r8
823 : end where
824 : end do
825 : end if
826 :
827 0 : end subroutine micro_pumas_cam_init_cnst
828 :
829 : !===============================================================================
830 :
831 1536 : subroutine micro_pumas_cam_init(pbuf2d)
832 : use time_manager, only: is_first_step
833 : use micro_pumas_utils, only: micro_pumas_utils_init
834 : use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init
835 : use micro_pumas_v1, only: micro_mg_init3_0 => micro_pumas_init
836 :
837 : !-----------------------------------------------------------------------
838 : !
839 : ! Initialization for MG microphysics
840 : !
841 : !-----------------------------------------------------------------------
842 :
843 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
844 :
845 : integer :: m, mm
846 : logical :: history_amwg ! output the variables used by the AMWG diag package
847 : logical :: history_budget ! Output tendencies and state variables for CAM4
848 : ! temperature, water vapor, cloud ice and cloud
849 : ! liquid budgets.
850 : logical :: use_subcol_microp
851 : logical :: do_clubb_sgs
852 : integer :: budget_histfile ! output history file number for budget fields
853 : integer :: ierr
854 : character(128) :: errstring ! return status (non-blank for error return)
855 :
856 : !-----------------------------------------------------------------------
857 :
858 : call phys_getopts(use_subcol_microp_out=use_subcol_microp, &
859 1536 : do_clubb_sgs_out =do_clubb_sgs)
860 :
861 1536 : if (do_clubb_sgs) then
862 1536 : allow_sed_supersat = .false.
863 : else
864 0 : allow_sed_supersat = .true.
865 : endif
866 :
867 1536 : if (masterproc) then
868 2 : write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version
869 2 : if (.not. do_cldliq) &
870 0 : write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist."
871 2 : if (.not. do_cldice) &
872 0 : write(iulog,*) "MG prognostic cloud ice has been turned off via namelist."
873 2 : write(iulog,*) "Number of microphysics substeps is: ",num_steps
874 : end if
875 :
876 0 : select case (micro_mg_version)
877 : case (1)
878 : ! Set constituent number for later loops.
879 0 : ncnst = 4
880 :
881 1536 : select case (micro_mg_sub_version)
882 : case (0)
883 : ! MG 1 does not initialize micro_mg_utils, so have to do it here.
884 : call micro_pumas_utils_init(r8, rair, rh2o, cpair, tmelt, latvap, latice, &
885 0 : micro_mg_dcs, errstring)
886 :
887 0 : call handle_errmsg(errstring, subname="micro_pumas_utils_init")
888 :
889 : call micro_mg_init1_0( &
890 : r8, gravit, rair, rh2o, cpair, &
891 : rhoh2o, tmelt, latvap, latice, &
892 : rhmini, micro_mg_dcs, use_hetfrz_classnuc, &
893 : micro_mg_precip_frac_method, micro_mg_berg_eff_factor, &
894 : micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, &
895 0 : micro_mg_ninst, errstring)
896 : end select
897 : case (2:3)
898 : ! Set constituent number for later loops.
899 1536 : if(micro_mg_version == 2) then
900 1536 : ncnst = 8
901 : else
902 0 : ncnst = 10
903 : end if
904 :
905 : call micro_mg_init3_0( &
906 : r8, gravit, rair, rh2o, cpair, &
907 : tmelt, latvap, latice, rhmini, &
908 : micro_mg_dcs, &
909 : micro_mg_do_hail,micro_mg_do_graupel, &
910 : microp_uniform, do_cldice, use_hetfrz_classnuc, &
911 : micro_mg_precip_frac_method, micro_mg_berg_eff_factor, &
912 : micro_mg_accre_enhan_fact , &
913 : micro_mg_autocon_fact , micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, &
914 : micro_mg_vtrmi_factor, micro_mg_effi_factor, micro_mg_iaccr_factor, &
915 : micro_mg_max_nicons, &
916 : allow_sed_supersat, micro_do_sb_physics, &
917 : micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, &
918 : micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, &
919 : micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr,&
920 : micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, &
921 : micro_mg_ninst, micro_mg_ngcons, micro_mg_ngnst, &
922 3072 : micro_mg_nrcons, micro_mg_nrnst, micro_mg_nscons, micro_mg_nsnst, errstring)
923 : end select
924 :
925 1536 : call handle_errmsg(errstring, subname="micro_mg_init")
926 :
927 : ! Retrieve the index for water vapor
928 1536 : call cnst_get_ind('Q', ixq)
929 :
930 : ! Register history variables
931 13824 : do m = 1, ncnst
932 12288 : call cnst_get_ind(cnst_names(m), mm)
933 53760 : if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow, ixgraupel /)) ) then
934 : ! mass mixing ratios
935 12288 : call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm), sampled_on_subcycle=.true.)
936 6144 : call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.)
937 15360 : else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow, ixnumgraupel /)) ) then
938 : ! number concentrations
939 12288 : call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm), sampled_on_subcycle=.true.)
940 6144 : call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.)
941 : else
942 : call endrun( "micro_pumas_cam_init: &
943 0 : &Could not call addfld for constituent with unknown units.")
944 : endif
945 : end do
946 :
947 3072 : call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics', sampled_on_subcycle=.true.)
948 3072 : call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics', sampled_on_subcycle=.true.)
949 3072 : call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics', sampled_on_subcycle=.true.)
950 3072 : call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics', sampled_on_subcycle=.true.)
951 :
952 1536 : if (micro_mg_version > 1) then
953 3072 : call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics', sampled_on_subcycle=.true.)
954 3072 : call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics', sampled_on_subcycle=.true.)
955 3072 : call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics', sampled_on_subcycle=.true.)
956 3072 : call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics', sampled_on_subcycle=.true.)
957 : end if
958 :
959 1536 : if (micro_mg_version > 2) then
960 0 : call addfld(apcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' after physics', sampled_on_subcycle=.true.)
961 0 : call addfld(bpcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' before physics', sampled_on_subcycle=.true.)
962 : end if
963 :
964 3072 : call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud', sampled_on_subcycle=.true.)
965 3072 : call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip', sampled_on_subcycle=.true.)
966 3072 : call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip', sampled_on_subcycle=.true.)
967 3072 : call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow', sampled_on_subcycle=.true.)
968 3072 : call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds', sampled_on_subcycle=.true.)
969 3072 : call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud', sampled_on_subcycle=.true.)
970 3072 : call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow', sampled_on_subcycle=.true.)
971 3072 : call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio', sampled_on_subcycle=.true.)
972 3072 : call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio', sampled_on_subcycle=.true.)
973 :
974 : ! MG microphysics diagnostics
975 3072 : call addfld ('QCSEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water', sampled_on_subcycle=.true.)
976 3072 : call addfld ('QISEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice', sampled_on_subcycle=.true.)
977 3072 : call addfld ('QVRES', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term', sampled_on_subcycle=.true.)
978 3072 : call addfld ('CMEIOUT', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice',sampled_on_subcycle=.true.)
979 3072 : call addfld ('VTRMC', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed', sampled_on_subcycle=.true.)
980 3072 : call addfld ('VTRMI', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed', sampled_on_subcycle=.true.)
981 3072 : call addfld ('QCSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.)
982 3072 : call addfld ('QISEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.)
983 3072 : call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain', sampled_on_subcycle=.true.)
984 3072 : call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water', sampled_on_subcycle=.true.)
985 3072 : call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water', sampled_on_subcycle=.true.)
986 3072 : call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water', sampled_on_subcycle=.true.)
987 3072 : call addfld ('MNUCCDO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor', sampled_on_subcycle=.true.)
988 3072 : call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor', sampled_on_subcycle=.true.)
989 3072 : call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering', sampled_on_subcycle=.true.)
990 3072 : call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow', sampled_on_subcycle=.true.)
991 3072 : call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron', sampled_on_subcycle=.true.)
992 3072 : call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron', sampled_on_subcycle=.true.)
993 3072 : call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice', sampled_on_subcycle=.true.)
994 3072 : call addfld ('MELTSTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of snow', sampled_on_subcycle=.true.)
995 3072 : call addfld ('MNUDEPO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition Nucleation', sampled_on_subcycle=.true.)
996 3072 : call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water', sampled_on_subcycle=.true.)
997 3072 : call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water', sampled_on_subcycle=.true.)
998 3072 : call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice to snow', sampled_on_subcycle=.true.)
999 3072 : call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice to snow', sampled_on_subcycle=.true.)
1000 3072 : call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice', sampled_on_subcycle=.true.)
1001 3072 : call addfld ('MNUCCRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow', sampled_on_subcycle=.true.)
1002 3072 : call addfld ('MNUCCRIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to ice', sampled_on_subcycle=.true.)
1003 3072 : call addfld ('PRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow', sampled_on_subcycle=.true.)
1004 3072 : call addfld ('MELTSDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow', sampled_on_subcycle=.true.)
1005 3072 : call addfld ('FRZRDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain', sampled_on_subcycle=.true.)
1006 1536 : if (micro_mg_version > 1) then
1007 3072 : call addfld ('QRSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.)
1008 3072 : call addfld ('QSSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.)
1009 : end if
1010 :
1011 :
1012 1536 : if (micro_mg_version > 2) then
1013 :
1014 0 : call addfld ('PSACRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Collisions between rain & snow (Graupel collecting snow)', sampled_on_subcycle=.true.)
1015 0 : call addfld ('PRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection rain by graupel', sampled_on_subcycle=.true.)
1016 0 : call addfld ('PSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection droplets by graupel', sampled_on_subcycle=.true.)
1017 0 : call addfld ('PGSACWO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.)
1018 0 : call addfld ('PGRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.)
1019 0 : call addfld ('PRDGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition of graupel', sampled_on_subcycle=.true.)
1020 0 : call addfld ('QMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult droplets/graupel', sampled_on_subcycle=.true.)
1021 0 : call addfld ('QMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult rain/graupel', sampled_on_subcycle=.true.)
1022 0 : call addfld ('QGSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Graupel/Hail mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.)
1023 0 : call addfld ('NPRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection rain by graupel', sampled_on_subcycle=.true.)
1024 0 : call addfld ('NSCNGO', (/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.)
1025 0 : call addfld ('NGRACSO',(/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.)
1026 0 : call addfld ('NMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc droplets by graupel', sampled_on_subcycle=.true.)
1027 0 : call addfld ('NMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc rain by graupel', sampled_on_subcycle=.true.)
1028 0 : call addfld ('NPSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection droplets by graupel', sampled_on_subcycle=.true.)
1029 0 : call addfld ('CLDFGRAU', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for graupel', sampled_on_subcycle=.true.)
1030 0 : call addfld ('MELTGTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of graupel', sampled_on_subcycle=.true.)
1031 :
1032 : end if
1033 :
1034 1536 : call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow', sampled_on_subcycle=.true.)
1035 1536 : call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency', sampled_on_subcycle=.true.)
1036 1536 : call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle', sampled_on_subcycle=.true.)
1037 :
1038 : ! History variables for CAM5 microphysics
1039 3072 : call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1040 3072 : call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1041 3072 : call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1042 3072 : call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1043 3072 : call addfld ('MPDNLIQ', (/ 'lev' /), 'A', '1/kg/s', 'NUMLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1044 3072 : call addfld ('MPDNICE', (/ 'lev' /), 'A', '1/kg/s', 'NUMICE tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1045 3072 : call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1046 3072 : call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1047 3072 : call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1048 3072 : call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1049 3072 : call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1050 3072 : call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics', sampled_on_subcycle=.true.)
1051 3072 : call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc', sampled_on_subcycle=.true.)
1052 3072 : call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc', sampled_on_subcycle=.true.)
1053 3072 : call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)', sampled_on_subcycle=.true.)
1054 1536 : call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration', sampled_on_subcycle=.true.)
1055 : call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated &
1056 1536 : &in-cloud Initial Liquid WP (Before Micro)', sampled_on_subcycle=.true.)
1057 : call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated &
1058 1536 : &in-cloud Initial Ice WP (Before Micro)', sampled_on_subcycle=.true.)
1059 :
1060 : ! This is provided as an example on how to write out subcolumn output
1061 : ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step
1062 1536 : if (use_subcol_microp) then
1063 : call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', &
1064 0 : 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.)
1065 : call addfld('MPDICE_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', &
1066 0 : 'Sub-column CLDICE tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.)
1067 : call addfld('MPDLIQ_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', &
1068 0 : 'Sub-column CLDLIQ tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.)
1069 : end if
1070 :
1071 :
1072 : ! This is only if the coldpoint temperatures are being adjusted.
1073 : ! NOTE: Some fields related to these and output later are added in tropopause.F90.
1074 1536 : if (micro_mg_adjust_cpt) then
1075 0 : call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment', sampled_on_subcycle=.true.)
1076 0 : call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment', sampled_on_subcycle=.true.)
1077 0 : call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment', sampled_on_subcycle=.true.)
1078 0 : call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level', sampled_on_subcycle=.true.)
1079 : end if
1080 :
1081 :
1082 : ! Averaging for cloud particle number and size
1083 3072 : call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc', sampled_on_subcycle=.true.)
1084 3072 : call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc', sampled_on_subcycle=.true.)
1085 3072 : call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius', sampled_on_subcycle=.true.)
1086 3072 : call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius', sampled_on_subcycle=.true.)
1087 : ! Frequency arrays for above
1088 3072 : call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid', sampled_on_subcycle=.true.)
1089 3072 : call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice', sampled_on_subcycle=.true.)
1090 :
1091 : ! Average cloud top particle size and number (liq, ice) and frequency
1092 1536 : call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius', sampled_on_subcycle=.true.)
1093 1536 : call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius', sampled_on_subcycle=.true.)
1094 1536 : call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number', sampled_on_subcycle=.true.)
1095 1536 : call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number', sampled_on_subcycle=.true.)
1096 :
1097 1536 : call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid', sampled_on_subcycle=.true.)
1098 1536 : call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice', sampled_on_subcycle=.true.)
1099 :
1100 : ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere..
1101 3072 : call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase', sampled_on_subcycle=.true.)
1102 3072 : call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid', sampled_on_subcycle=.true.)
1103 3072 : call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice', sampled_on_subcycle=.true.)
1104 1536 : call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase', sampled_on_subcycle=.true.)
1105 1536 : call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid', sampled_on_subcycle=.true.)
1106 1536 : call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice', sampled_on_subcycle=.true.)
1107 :
1108 3072 : call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux', sampled_on_subcycle=.true.)
1109 3072 : call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux', sampled_on_subcycle=.true.)
1110 :
1111 3072 : call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid', sampled_on_subcycle=.true.)
1112 3072 : call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice', sampled_on_subcycle=.true.)
1113 3072 : call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius', sampled_on_subcycle=.true.)
1114 3072 : call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius', sampled_on_subcycle=.true.)
1115 3072 : call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius', sampled_on_subcycle=.true.)
1116 3072 : call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius', sampled_on_subcycle=.true.)
1117 3072 : call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice', sampled_on_subcycle=.true.)
1118 3072 : call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow', sampled_on_subcycle=.true.)
1119 :
1120 : ! diagnostic precip
1121 3072 : call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio', sampled_on_subcycle=.true.)
1122 3072 : call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio', sampled_on_subcycle=.true.)
1123 3072 : call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc', sampled_on_subcycle=.true.)
1124 3072 : call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc', sampled_on_subcycle=.true.)
1125 :
1126 : ! size of precip
1127 3072 : call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain', sampled_on_subcycle=.true.)
1128 3072 : call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter', sampled_on_subcycle=.true.)
1129 :
1130 : ! diagnostic radar reflectivity, cloud-averaged
1131 3072 : call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity', sampled_on_subcycle=.true.)
1132 3072 : call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.)
1133 3072 : call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity', sampled_on_subcycle=.true.)
1134 :
1135 3072 : call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.)
1136 3072 : call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.)
1137 3072 : call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.)
1138 :
1139 3072 : call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.)
1140 :
1141 : ! Aerosol information
1142 3072 : call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid', sampled_on_subcycle=.true.)
1143 3072 : call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice', sampled_on_subcycle=.true.)
1144 :
1145 : ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency
1146 3072 : call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio', sampled_on_subcycle=.true.)
1147 3072 : call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio', sampled_on_subcycle=.true.)
1148 3072 : call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc', sampled_on_subcycle=.true.)
1149 3072 : call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc', sampled_on_subcycle=.true.)
1150 3072 : call addfld ('ADRAIN', (/ 'lev' /), 'A', 'm', 'Average rain effective Diameter', sampled_on_subcycle=.true.)
1151 3072 : call addfld ('ADSNOW', (/ 'lev' /), 'A', 'm', 'Average snow effective Diameter', sampled_on_subcycle=.true.)
1152 3072 : call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain', sampled_on_subcycle=.true.)
1153 3072 : call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow', sampled_on_subcycle=.true.)
1154 :
1155 : ! precipitation efficiency & other diagnostic fields
1156 1536 : call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)', sampled_on_subcycle=.true.)
1157 1536 : call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation', sampled_on_subcycle=.true.)
1158 1536 : call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported', sampled_on_subcycle=.true.)
1159 1536 : call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate', sampled_on_subcycle=.true.)
1160 1536 : call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate', sampled_on_subcycle=.true.)
1161 1536 : call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average', sampled_on_subcycle=.true.)
1162 :
1163 1536 : if (micro_mg_version > 1) then
1164 3072 : call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed', sampled_on_subcycle=.true.)
1165 3072 : call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed', sampled_on_subcycle=.true.)
1166 : end if
1167 :
1168 1536 : if (micro_mg_version > 2) then
1169 0 : call addfld('UMG', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted graupel/hail fallspeed', sampled_on_subcycle=.true.)
1170 0 : call addfld ('FREQG', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of Graupel', sampled_on_subcycle=.true.)
1171 0 : call addfld ('LS_REFFGRAU', (/ 'lev' /), 'A', 'micron', 'ls stratiform graupel/hail effective radius', sampled_on_subcycle=.true.)
1172 0 : call addfld ('AQGRAU', (/ 'lev' /), 'A', 'kg/kg', 'Average graupel/hail mixing ratio', sampled_on_subcycle=.true.)
1173 0 : call addfld ('ANGRAU', (/ 'lev' /), 'A', 'm-3', 'Average graupel/hail number conc', sampled_on_subcycle=.true.)
1174 : end if
1175 :
1176 :
1177 : ! qc limiter (only output in versions 1.5 and later)
1178 1536 : if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then
1179 3072 : call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied', sampled_on_subcycle=.true.)
1180 : end if
1181 :
1182 : ! determine the add_default fields
1183 : call phys_getopts(history_amwg_out = history_amwg , &
1184 : history_budget_out = history_budget , &
1185 1536 : history_budget_histfile_num_out = budget_histfile)
1186 :
1187 1536 : if (history_amwg) then
1188 1536 : call add_default ('FICE ', 1, ' ')
1189 1536 : call add_default ('AQRAIN ', 1, ' ')
1190 1536 : call add_default ('AQSNOW ', 1, ' ')
1191 1536 : call add_default ('ANRAIN ', 1, ' ')
1192 1536 : call add_default ('ANSNOW ', 1, ' ')
1193 1536 : call add_default ('ADRAIN ', 1, ' ')
1194 1536 : call add_default ('ADSNOW ', 1, ' ')
1195 1536 : call add_default ('AREI ', 1, ' ')
1196 1536 : call add_default ('AREL ', 1, ' ')
1197 1536 : call add_default ('AWNC ', 1, ' ')
1198 1536 : call add_default ('AWNI ', 1, ' ')
1199 1536 : call add_default ('CDNUMC ', 1, ' ')
1200 1536 : call add_default ('FREQR ', 1, ' ')
1201 1536 : call add_default ('FREQS ', 1, ' ')
1202 1536 : call add_default ('FREQL ', 1, ' ')
1203 1536 : call add_default ('FREQI ', 1, ' ')
1204 13824 : do m = 1, ncnst
1205 12288 : call cnst_get_ind(cnst_names(m), mm)
1206 13824 : call add_default(cnst_name(mm), 1, ' ')
1207 : end do
1208 : end if
1209 :
1210 1536 : if ( history_budget ) then
1211 0 : call add_default ('EVAPSNOW ', budget_histfile, ' ')
1212 0 : call add_default ('EVAPPREC ', budget_histfile, ' ')
1213 0 : call add_default ('QVRES ', budget_histfile, ' ')
1214 0 : call add_default ('QISEVAP ', budget_histfile, ' ')
1215 0 : call add_default ('QCSEVAP ', budget_histfile, ' ')
1216 0 : call add_default ('QISEDTEN ', budget_histfile, ' ')
1217 0 : call add_default ('QCSEDTEN ', budget_histfile, ' ')
1218 0 : call add_default ('QIRESO ', budget_histfile, ' ')
1219 0 : call add_default ('QCRESO ', budget_histfile, ' ')
1220 0 : if (micro_mg_version > 1) then
1221 0 : call add_default ('QRSEDTEN ', budget_histfile, ' ')
1222 0 : call add_default ('QSSEDTEN ', budget_histfile, ' ')
1223 : end if
1224 0 : call add_default ('PSACWSO ', budget_histfile, ' ')
1225 0 : call add_default ('PRCO ', budget_histfile, ' ')
1226 0 : call add_default ('PRCIO ', budget_histfile, ' ')
1227 0 : call add_default ('PRAO ', budget_histfile, ' ')
1228 0 : call add_default ('PRAIO ', budget_histfile, ' ')
1229 0 : call add_default ('PRACSO ', budget_histfile, ' ')
1230 0 : call add_default ('MSACWIO ', budget_histfile, ' ')
1231 0 : call add_default ('MPDW2V ', budget_histfile, ' ')
1232 0 : call add_default ('MPDW2P ', budget_histfile, ' ')
1233 0 : call add_default ('MPDW2I ', budget_histfile, ' ')
1234 0 : call add_default ('MPDT ', budget_histfile, ' ')
1235 0 : call add_default ('MPDQ ', budget_histfile, ' ')
1236 0 : call add_default ('MPDLIQ ', budget_histfile, ' ')
1237 0 : call add_default ('MPDICE ', budget_histfile, ' ')
1238 0 : call add_default ('MPDI2W ', budget_histfile, ' ')
1239 0 : call add_default ('MPDI2V ', budget_histfile, ' ')
1240 0 : call add_default ('MPDI2P ', budget_histfile, ' ')
1241 0 : call add_default ('MNUCCTO ', budget_histfile, ' ')
1242 0 : call add_default ('MNUCCRO ', budget_histfile, ' ')
1243 0 : call add_default ('MNUCCRIO ', budget_histfile, ' ')
1244 0 : call add_default ('MNUCCCO ', budget_histfile, ' ')
1245 0 : call add_default ('MELTSDT ', budget_histfile, ' ')
1246 0 : call add_default ('MELTO ', budget_histfile, ' ')
1247 0 : call add_default ('HOMOO ', budget_histfile, ' ')
1248 0 : call add_default ('FRZRDT ', budget_histfile, ' ')
1249 0 : call add_default ('CMEIOUT ', budget_histfile, ' ')
1250 0 : call add_default ('BERGSO ', budget_histfile, ' ')
1251 0 : call add_default ('BERGO ', budget_histfile, ' ')
1252 0 : call add_default ('MELTSTOT ', budget_histfile, ' ')
1253 0 : call add_default ('MNUDEPO ', budget_histfile, ' ')
1254 0 : if (micro_mg_version > 2) then
1255 0 : call add_default ('QGSEDTEN ', budget_histfile, ' ')
1256 0 : call add_default ('PSACRO ', budget_histfile, ' ')
1257 0 : call add_default ('PRACGO ', budget_histfile, ' ')
1258 0 : call add_default ('PSACWGO ', budget_histfile, ' ')
1259 0 : call add_default ('PGSACWO ', budget_histfile, ' ')
1260 0 : call add_default ('PGRACSO ', budget_histfile, ' ')
1261 0 : call add_default ('PRDGO ', budget_histfile, ' ')
1262 0 : call add_default ('QMULTGO ', budget_histfile, ' ')
1263 0 : call add_default ('QMULTRGO ', budget_histfile, ' ')
1264 0 : call add_default ('MELTGTOT ', budget_histfile, ' ')
1265 : end if
1266 0 : call add_default(cnst_name(ixcldliq), budget_histfile, ' ')
1267 0 : call add_default(cnst_name(ixcldice), budget_histfile, ' ')
1268 0 : call add_default(apcnst (ixcldliq), budget_histfile, ' ')
1269 0 : call add_default(apcnst (ixcldice), budget_histfile, ' ')
1270 0 : call add_default(bpcnst (ixcldliq), budget_histfile, ' ')
1271 0 : call add_default(bpcnst (ixcldice), budget_histfile, ' ')
1272 0 : if (micro_mg_version > 1) then
1273 0 : call add_default(cnst_name(ixrain), budget_histfile, ' ')
1274 0 : call add_default(cnst_name(ixsnow), budget_histfile, ' ')
1275 0 : call add_default(apcnst (ixrain), budget_histfile, ' ')
1276 0 : call add_default(apcnst (ixsnow), budget_histfile, ' ')
1277 0 : call add_default(bpcnst (ixrain), budget_histfile, ' ')
1278 0 : call add_default(bpcnst (ixsnow), budget_histfile, ' ')
1279 : end if
1280 :
1281 0 : if (micro_mg_version > 2) then
1282 0 : call add_default(cnst_name(ixgraupel), budget_histfile, ' ')
1283 0 : call add_default(apcnst (ixgraupel), budget_histfile, ' ')
1284 0 : call add_default(bpcnst (ixgraupel), budget_histfile, ' ')
1285 : end if
1286 :
1287 : end if
1288 :
1289 : ! physics buffer indices
1290 1536 : ast_idx = pbuf_get_index('AST')
1291 1536 : cld_idx = pbuf_get_index('CLD')
1292 1536 : concld_idx = pbuf_get_index('CONCLD')
1293 1536 : prec_dp_idx = pbuf_get_index('PREC_DP')
1294 1536 : prec_sh_idx = pbuf_get_index('PREC_SH')
1295 :
1296 1536 : naai_idx = pbuf_get_index('NAAI')
1297 1536 : naai_hom_idx = pbuf_get_index('NAAI_HOM')
1298 1536 : npccn_idx = pbuf_get_index('NPCCN')
1299 1536 : rndst_idx = pbuf_get_index('RNDST')
1300 1536 : nacon_idx = pbuf_get_index('NACON')
1301 :
1302 1536 : prec_str_idx = pbuf_get_index('PREC_STR')
1303 1536 : snow_str_idx = pbuf_get_index('SNOW_STR')
1304 1536 : prec_sed_idx = pbuf_get_index('PREC_SED')
1305 1536 : snow_sed_idx = pbuf_get_index('SNOW_SED')
1306 1536 : prec_pcw_idx = pbuf_get_index('PREC_PCW')
1307 1536 : snow_pcw_idx = pbuf_get_index('SNOW_PCW')
1308 :
1309 1536 : cmeliq_idx = pbuf_get_index('CMELIQ')
1310 :
1311 : ! These fields may have been added, so don't abort if they have not been
1312 1536 : qsatfac_idx = pbuf_get_index('QSATFAC', ierr)
1313 1536 : qrain_idx = pbuf_get_index('QRAIN', ierr)
1314 1536 : qsnow_idx = pbuf_get_index('QSNOW', ierr)
1315 1536 : nrain_idx = pbuf_get_index('NRAIN', ierr)
1316 1536 : nsnow_idx = pbuf_get_index('NSNOW', ierr)
1317 :
1318 : ! fields for heterogeneous freezing
1319 1536 : frzimm_idx = pbuf_get_index('FRZIMM', ierr)
1320 1536 : frzcnt_idx = pbuf_get_index('FRZCNT', ierr)
1321 1536 : frzdep_idx = pbuf_get_index('FRZDEP', ierr)
1322 :
1323 : ! Initialize physics buffer grid fields for accumulating precip and condensation
1324 1536 : if (is_first_step()) then
1325 768 : call pbuf_set_field(pbuf2d, cldo_idx, 0._r8)
1326 768 : call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8)
1327 768 : call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8)
1328 768 : call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8)
1329 768 : call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8)
1330 768 : call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8)
1331 768 : call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8)
1332 768 : call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8)
1333 768 : call pbuf_set_field(pbuf2d, acpr_idx, 0._r8)
1334 768 : call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8)
1335 768 : call pbuf_set_field(pbuf2d, acnum_idx, 0)
1336 768 : call pbuf_set_field(pbuf2d, relvar_idx, 2._r8)
1337 768 : call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8)
1338 768 : call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8)
1339 768 : call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8)
1340 768 : call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8)
1341 768 : call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8)
1342 768 : call pbuf_set_field(pbuf2d, bergso_idx, 0._r8)
1343 768 : call pbuf_set_field(pbuf2d, icswp_idx, 0._r8)
1344 768 : call pbuf_set_field(pbuf2d, cldfsnow_idx, 0._r8)
1345 768 : call pbuf_set_field(pbuf2d, dei_idx, 0.0_r8)
1346 768 : call pbuf_set_field(pbuf2d, des_idx, 0.0_r8)
1347 768 : call pbuf_set_field(pbuf2d, mu_idx, 0.0_r8)
1348 768 : call pbuf_set_field(pbuf2d, lambdac_idx, 0.0_r8)
1349 :
1350 768 : if (degrau_idx > 0) call pbuf_set_field(pbuf2d, degrau_idx, 0.0_r8)
1351 768 : if (icgrauwp_idx > 0) call pbuf_set_field(pbuf2d, icgrauwp_idx, 0.0_r8)
1352 768 : if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8)
1353 768 : if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8)
1354 768 : if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8)
1355 768 : if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8)
1356 768 : if (qcsedten_idx > 0) call pbuf_set_field(pbuf2d, qcsedten_idx, 0._r8)
1357 768 : if (qrsedten_idx > 0) call pbuf_set_field(pbuf2d, qrsedten_idx, 0._r8)
1358 768 : if (qisedten_idx > 0) call pbuf_set_field(pbuf2d, qisedten_idx, 0._r8)
1359 768 : if (qssedten_idx > 0) call pbuf_set_field(pbuf2d, qssedten_idx, 0._r8)
1360 768 : if (vtrmc_idx > 0) call pbuf_set_field(pbuf2d, vtrmc_idx, 0._r8)
1361 768 : if (umr_idx > 0) call pbuf_set_field(pbuf2d, umr_idx, 0._r8)
1362 768 : if (vtrmi_idx > 0) call pbuf_set_field(pbuf2d, vtrmi_idx, 0._r8)
1363 768 : if (ums_idx > 0) call pbuf_set_field(pbuf2d, ums_idx, 0._r8)
1364 768 : if (qcsevap_idx > 0) call pbuf_set_field(pbuf2d, qcsevap_idx, 0._r8)
1365 768 : if (qisevap_idx > 0) call pbuf_set_field(pbuf2d, qisevap_idx, 0._r8)
1366 :
1367 : ! If sub-columns turned on, need to set the sub-column fields as well
1368 768 : if (use_subcol_microp) then
1369 0 : call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol)
1370 0 : call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol)
1371 0 : call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol)
1372 0 : call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol)
1373 0 : call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol)
1374 0 : call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol)
1375 0 : call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol)
1376 0 : call pbuf_set_field(pbuf2d, cc_qlst_idx, 0._r8, col_type=col_type_subcol)
1377 0 : call pbuf_set_field(pbuf2d, icswp_idx, 0._r8, col_type=col_type_subcol)
1378 0 : call pbuf_set_field(pbuf2d, cldfsnow_idx,0._r8, col_type=col_type_subcol)
1379 : end if
1380 :
1381 : end if
1382 :
1383 1536 : end subroutine micro_pumas_cam_init
1384 :
1385 : !===============================================================================
1386 :
1387 58302720 : subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf)
1388 :
1389 : use micro_pumas_utils, only: size_dist_param_basic, size_dist_param_liq
1390 1536 : use micro_pumas_utils, only: mg_liq_props, mg_ice_props, avg_diameter
1391 : use micro_pumas_utils, only: rhoi, rhosn, rhow, rhows, rhog, qsmall, mincld
1392 :
1393 : use micro_mg1_0, only: micro_mg_tend1_0 => micro_mg_tend
1394 : use micro_pumas_v1, only: micro_pumas_tend => micro_pumas_tend
1395 :
1396 : use physics_buffer, only: pbuf_col_type_index
1397 : use subcol, only: subcol_field_avg
1398 : use tropopause, only: tropopause_find_cam, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND
1399 : use wv_saturation, only: qsat
1400 : use infnan, only: nan, assignment(=)
1401 :
1402 : type(physics_state), intent(in) :: state
1403 : type(physics_ptend), intent(out) :: ptend
1404 : real(r8), intent(in) :: dtime
1405 : type(physics_buffer_desc), pointer :: pbuf(:)
1406 :
1407 : ! Local variables
1408 : integer :: lchnk, ncol, psetcols, ngrdcol
1409 :
1410 : integer :: i, k, itim_old, it
1411 :
1412 241920 : real(r8), pointer :: naai(:,:) ! ice nucleation number
1413 241920 : real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous)
1414 241920 : real(r8), pointer :: npccn(:,:) ! liquid activation number tendency
1415 241920 : real(r8), pointer :: rndst(:,:,:)
1416 241920 : real(r8), pointer :: nacon(:,:,:)
1417 241920 : real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1.
1418 241920 : real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s]
1419 241920 : real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s]
1420 :
1421 241920 : real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ]
1422 241920 : real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ]
1423 241920 : real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation
1424 241920 : real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation
1425 241920 : real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ]
1426 241920 : real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ]
1427 :
1428 241920 : real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction
1429 241920 : real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor.
1430 241920 : real(r8), pointer :: alst_mic(:,:)
1431 241920 : real(r8), pointer :: aist_mic(:,:)
1432 241920 : real(r8), pointer :: cldo(:,:) ! Old cloud fraction
1433 241920 : real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow)
1434 241920 : real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate
1435 241920 : real(r8), pointer :: relvar(:,:) ! relative variance of cloud water
1436 241920 : real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation
1437 241920 : real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow)
1438 241920 : real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters)
1439 241920 : real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation
1440 241920 : real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation
1441 241920 : real(r8), pointer :: des(:,:) ! Snow effective diameter (m)
1442 241920 : real(r8), pointer :: degrau(:,:) ! Graupel effective diameter (m)
1443 241920 : real(r8), pointer :: bergso(:,:) ! Conversion of cloud water to snow from bergeron
1444 :
1445 483840 : real(r8) :: rho(state%psetcols,pver)
1446 483840 : real(r8) :: cldmax(state%psetcols,pver)
1447 :
1448 483840 : real(r8) :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics
1449 :
1450 483840 : real(r8) :: tlat(state%psetcols,pver)
1451 483840 : real(r8) :: qvlat(state%psetcols,pver)
1452 483840 : real(r8) :: qcten(state%psetcols,pver)
1453 483840 : real(r8) :: qiten(state%psetcols,pver)
1454 483840 : real(r8) :: ncten(state%psetcols,pver)
1455 483840 : real(r8) :: niten(state%psetcols,pver)
1456 :
1457 483840 : real(r8) :: qrten(state%psetcols,pver)
1458 483840 : real(r8) :: qsten(state%psetcols,pver)
1459 483840 : real(r8) :: nrten(state%psetcols,pver)
1460 483840 : real(r8) :: nsten(state%psetcols,pver)
1461 483840 : real(r8) :: qgten(state%psetcols,pver)
1462 483840 : real(r8) :: ngten(state%psetcols,pver)
1463 :
1464 483840 : real(r8) :: prect(state%psetcols)
1465 483840 : real(r8) :: preci(state%psetcols)
1466 483840 : real(r8) :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates
1467 483840 : real(r8) :: evapsnow(state%psetcols,pver) ! Local evaporation of snow
1468 483840 : real(r8) :: prodsnow(state%psetcols,pver) ! Local production of snow
1469 483840 : real(r8) :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud
1470 483840 : real(r8) :: qsout(state%psetcols,pver) ! Snow mixing ratio
1471 483840 : real(r8) :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1)
1472 483840 : real(r8) :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1)
1473 483840 : real(r8) :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1)
1474 483840 : real(r8) :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1)
1475 483840 : real(r8) :: gflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1)
1476 483840 : real(r8) :: qrout(state%psetcols,pver) ! Rain mixing ratio
1477 483840 : real(r8) :: qcsevap(state%psetcols,pver) ! Evaporation of falling cloud water
1478 483840 : real(r8) :: qisevap(state%psetcols,pver) ! Sublimation of falling cloud ice
1479 483840 : real(r8) :: qvres(state%psetcols,pver) ! Residual condensation term to remove excess saturation
1480 483840 : real(r8) :: cmeiout(state%psetcols,pver) ! Deposition/sublimation rate of cloud ice
1481 483840 : real(r8) :: vtrmc(state%psetcols,pver) ! Mass-weighted cloud water fallspeed
1482 483840 : real(r8) :: vtrmi(state%psetcols,pver) ! Mass-weighted cloud ice fallspeed
1483 483840 : real(r8) :: umr(state%psetcols,pver) ! Mass-weighted rain fallspeed
1484 483840 : real(r8) :: ums(state%psetcols,pver) ! Mass-weighted snow fallspeed
1485 483840 : real(r8) :: qcsedten(state%psetcols,pver) ! Cloud water mixing ratio tendency from sedimentation
1486 483840 : real(r8) :: qisedten(state%psetcols,pver) ! Cloud ice mixing ratio tendency from sedimentation
1487 483840 : real(r8) :: qrsedten(state%psetcols,pver) ! Rain mixing ratio tendency from sedimentation
1488 483840 : real(r8) :: qssedten(state%psetcols,pver) ! Snow mixing ratio tendency from sedimentation
1489 483840 : real(r8) :: qgsedten(state%psetcols,pver) ! Graupel/Hail mixing ratio tendency from sedimentation
1490 483840 : real(r8) :: umg(state%psetcols,pver) ! Mass-weighted Graupel/Hail fallspeed
1491 :
1492 483840 : real(r8) :: prao(state%psetcols,pver)
1493 483840 : real(r8) :: prco(state%psetcols,pver)
1494 483840 : real(r8) :: mnuccco(state%psetcols,pver)
1495 483840 : real(r8) :: mnuccto(state%psetcols,pver)
1496 483840 : real(r8) :: msacwio(state%psetcols,pver)
1497 483840 : real(r8) :: psacwso(state%psetcols,pver)
1498 483840 : real(r8) :: bergo(state%psetcols,pver)
1499 483840 : real(r8) :: melto(state%psetcols,pver)
1500 483840 : real(r8) :: homoo(state%psetcols,pver)
1501 483840 : real(r8) :: qcreso(state%psetcols,pver)
1502 483840 : real(r8) :: prcio(state%psetcols,pver)
1503 483840 : real(r8) :: praio(state%psetcols,pver)
1504 483840 : real(r8) :: qireso(state%psetcols,pver)
1505 483840 : real(r8) :: mnuccro(state%psetcols,pver)
1506 483840 : real(r8) :: mnuccrio(state%psetcols,pver)
1507 483840 : real(r8) :: mnudepo(state%psetcols,pver)
1508 483840 : real(r8) :: meltstot(state%psetcols,pver)
1509 483840 : real(r8) :: meltgtot(state%psetcols,pver)
1510 483840 : real(r8) :: pracso (state%psetcols,pver)
1511 483840 : real(r8) :: meltsdt(state%psetcols,pver)
1512 483840 : real(r8) :: frzrdt (state%psetcols,pver)
1513 483840 : real(r8) :: mnuccdo(state%psetcols,pver)
1514 483840 : real(r8) :: nrout(state%psetcols,pver)
1515 483840 : real(r8) :: nsout(state%psetcols,pver)
1516 483840 : real(r8) :: refl(state%psetcols,pver) ! analytic radar reflectivity
1517 483840 : real(r8) :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range
1518 483840 : real(r8) :: areflz(state%psetcols,pver) ! average reflectivity in z.
1519 483840 : real(r8) :: frefl(state%psetcols,pver)
1520 483840 : real(r8) :: csrfl(state%psetcols,pver) ! cloudsat reflectivity
1521 483840 : real(r8) :: acsrfl(state%psetcols,pver) ! cloudsat average
1522 483840 : real(r8) :: fcsrfl(state%psetcols,pver)
1523 483840 : real(r8) :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud
1524 483840 : real(r8) :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3)
1525 483840 : real(r8) :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3)
1526 483840 : real(r8) :: qrout2(state%psetcols,pver)
1527 483840 : real(r8) :: qsout2(state%psetcols,pver)
1528 483840 : real(r8) :: nrout2(state%psetcols,pver)
1529 483840 : real(r8) :: nsout2(state%psetcols,pver)
1530 483840 : real(r8) :: freqs(state%psetcols,pver)
1531 483840 : real(r8) :: freqr(state%psetcols,pver)
1532 483840 : real(r8) :: nfice(state%psetcols,pver)
1533 483840 : real(r8) :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit)
1534 : !Hail/Graupel Output
1535 483840 : real(r8) :: freqg(state%psetcols,pver)
1536 483840 : real(r8) :: qgout(state%psetcols,pver)
1537 483840 : real(r8) :: ngout(state%psetcols,pver)
1538 483840 : real(r8) :: dgout(state%psetcols,pver)
1539 483840 : real(r8) :: qgout2(state%psetcols,pver)
1540 483840 : real(r8) :: ngout2(state%psetcols,pver)
1541 483840 : real(r8) :: dgout2(state%psetcols,pver)
1542 : !Hail/Graupel Process Rates
1543 483840 : real(r8) :: psacro(state%psetcols,pver)
1544 483840 : real(r8) :: pracgo(state%psetcols,pver)
1545 483840 : real(r8) :: psacwgo(state%psetcols,pver)
1546 483840 : real(r8) :: pgsacwo(state%psetcols,pver)
1547 483840 : real(r8) :: pgracso(state%psetcols,pver)
1548 483840 : real(r8) :: prdgo(state%psetcols,pver)
1549 483840 : real(r8) :: qmultgo(state%psetcols,pver)
1550 483840 : real(r8) :: qmultrgo(state%psetcols,pver)
1551 483840 : real(r8) :: npracgo(state%psetcols,pver)
1552 483840 : real(r8) :: nscngo(state%psetcols,pver)
1553 483840 : real(r8) :: ngracso(state%psetcols,pver)
1554 483840 : real(r8) :: nmultgo(state%psetcols,pver)
1555 483840 : real(r8) :: nmultrgo(state%psetcols,pver)
1556 483840 : real(r8) :: npsacwgo(state%psetcols,pver)
1557 :
1558 : ! Dummy arrays for cases where we throw away the MG version and
1559 : ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging
1560 : ! issues.
1561 483840 : real(r8) :: rel_fn_dum(state%ncol,pver)
1562 483840 : real(r8) :: dsout2_dum(state%ncol,pver)
1563 483840 : real(r8) :: drout_dum(state%ncol,pver)
1564 483840 : real(r8) :: reff_rain_dum(state%ncol,pver)
1565 483840 : real(r8) :: reff_snow_dum(state%ncol,pver)
1566 483840 : real(r8) :: reff_grau_dum(state%ncol,pver) !not used for now or passed to COSP.
1567 483840 : real(r8), target :: nan_array(state%ncol,pver) ! Array for NaN's
1568 :
1569 : ! Heterogeneous-only version of mnuccdo.
1570 483840 : real(r8) :: mnuccdohet(state%psetcols,pver)
1571 :
1572 : ! physics buffer fields for COSP simulator
1573 241920 : real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s)
1574 241920 : real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s)
1575 241920 : real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg)
1576 241920 : real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg)
1577 241920 : real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um)
1578 241920 : real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um)
1579 241920 : real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um)
1580 241920 : real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um)
1581 :
1582 : ! physics buffer fields used with CARMA
1583 241920 : real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s)
1584 241920 : real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s)
1585 241920 : real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m)
1586 :
1587 241920 : real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of
1588 : ! strat. cloud water to precip (1/s) ! rce 2010/05/01
1589 241920 : real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ]
1590 :
1591 :
1592 241920 : real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency
1593 241920 : real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency
1594 241920 : real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency
1595 241920 : real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency
1596 241920 : real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency
1597 241920 : real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency
1598 241920 : real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency
1599 :
1600 : ! variables for heterogeneous freezing
1601 241920 : real(r8), pointer :: frzimm(:,:)
1602 241920 : real(r8), pointer :: frzcnt(:,:)
1603 241920 : real(r8), pointer :: frzdep(:,:)
1604 :
1605 241920 : real(r8), pointer :: qme(:,:)
1606 :
1607 : ! A local copy of state is used for diagnostic calculations
1608 241920 : type(physics_state) :: state_loc
1609 58302720 : type(physics_ptend) :: ptend_loc
1610 :
1611 483840 : real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction
1612 483840 : real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud)
1613 :
1614 241920 : real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns)
1615 241920 : real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns)
1616 241920 : real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3)
1617 241920 : real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3)
1618 :
1619 :
1620 241920 : real(r8), pointer :: cmeliq(:,:)
1621 :
1622 241920 : real(r8), pointer :: cld(:,:) ! Total cloud fraction
1623 241920 : real(r8), pointer :: concld(:,:) ! Convective cloud fraction
1624 241920 : real(r8), pointer :: prec_dp(:) ! Deep Convective precip
1625 241920 : real(r8), pointer :: prec_sh(:) ! Shallow Convective precip
1626 :
1627 241920 : real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation
1628 241920 : real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation
1629 241920 : real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow
1630 241920 : real(r8), pointer :: icswp(:,:) ! In-cloud snow water path
1631 :
1632 241920 : real(r8), pointer :: cldfgrau(:,:) ! Cloud fraction for liquid+snow
1633 241920 : real(r8), pointer :: icgrauwp(:,:) ! In-cloud snow water path
1634 :
1635 483840 : real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio
1636 483840 : real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio
1637 483840 : real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc
1638 483840 : real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc
1639 :
1640 483840 : real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics
1641 483840 : real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics
1642 :
1643 : ! Averaging arrays for effective radius and number....
1644 : real(r8) :: efiout_grid(pcols,pver)
1645 : real(r8) :: efcout_grid(pcols,pver)
1646 : real(r8) :: ncout_grid(pcols,pver)
1647 : real(r8) :: niout_grid(pcols,pver)
1648 : real(r8) :: freqi_grid(pcols,pver)
1649 : real(r8) :: freql_grid(pcols,pver)
1650 :
1651 : ! Averaging arrays for supercooled liquid
1652 : real(r8) :: freqm_grid(pcols,pver)
1653 : real(r8) :: freqsl_grid(pcols,pver)
1654 : real(r8) :: freqslm_grid(pcols,pver)
1655 : real(r8) :: fctm_grid(pcols)
1656 : real(r8) :: fctsl_grid(pcols)
1657 : real(r8) :: fctslm_grid(pcols)
1658 :
1659 : real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration
1660 : real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio
1661 : real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio
1662 :
1663 : ! Cloud fraction used for precipitation.
1664 : real(r8) :: cldmax_grid(pcols,pver)
1665 :
1666 : ! Average cloud top radius & number
1667 : real(r8) :: ctrel_grid(pcols)
1668 : real(r8) :: ctrei_grid(pcols)
1669 : real(r8) :: ctnl_grid(pcols)
1670 : real(r8) :: ctni_grid(pcols)
1671 : real(r8) :: fcti_grid(pcols)
1672 : real(r8) :: fctl_grid(pcols)
1673 :
1674 : real(r8) :: ftem_grid(pcols,pver)
1675 :
1676 : ! Variables for precip efficiency calculation
1677 : real(r8) :: minlwp ! LWP threshold
1678 :
1679 241920 : real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps
1680 241920 : real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps
1681 241920 : integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated
1682 :
1683 : ! Variables for liquid water path and column condensation
1684 : real(r8) :: tgliqwp_grid(pcols) ! column liquid
1685 : real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units)
1686 :
1687 : real(r8) :: pe_grid(pcols) ! precip efficiency for output
1688 : real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out
1689 : real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation
1690 :
1691 : ! variables for autoconversion and accretion vertical averages
1692 : real(r8) :: vprco_grid(pcols) ! vertical average autoconversion
1693 : real(r8) :: vprao_grid(pcols) ! vertical average accretion
1694 : real(r8) :: racau_grid(pcols) ! ratio of vertical averages
1695 : integer :: cnt_grid(pcols) ! counters
1696 :
1697 : logical :: lq(pcnst)
1698 :
1699 : real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid
1700 : real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid
1701 :
1702 241920 : real(r8), pointer :: lambdac_grid(:,:)
1703 241920 : real(r8), pointer :: mu_grid(:,:)
1704 241920 : real(r8), pointer :: rel_grid(:,:)
1705 241920 : real(r8), pointer :: rei_grid(:,:)
1706 241920 : real(r8), pointer :: sadice_grid(:,:)
1707 241920 : real(r8), pointer :: sadsnow_grid(:,:)
1708 241920 : real(r8), pointer :: dei_grid(:,:)
1709 241920 : real(r8), pointer :: des_grid(:,:)
1710 241920 : real(r8), pointer :: iclwpst_grid(:,:)
1711 241920 : real(r8), pointer :: degrau_grid(:,:)
1712 :
1713 : real(r8) :: rho_grid(pcols,pver)
1714 : real(r8) :: liqcldf_grid(pcols,pver)
1715 : real(r8) :: qsout_grid(pcols,pver)
1716 : real(r8) :: ncic_grid(pcols,pver)
1717 : real(r8) :: niic_grid(pcols,pver)
1718 : real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid
1719 : real(r8) :: qrout_grid(pcols,pver)
1720 : real(r8) :: drout2_grid(pcols,pver)
1721 : real(r8) :: dsout2_grid(pcols,pver)
1722 : real(r8) :: nsout_grid(pcols,pver)
1723 : real(r8) :: nrout_grid(pcols,pver)
1724 : real(r8) :: reff_rain_grid(pcols,pver)
1725 : real(r8) :: reff_snow_grid(pcols,pver)
1726 : real(r8) :: reff_grau_grid(pcols,pver)
1727 : real(r8) :: cld_grid(pcols,pver)
1728 : real(r8) :: pdel_grid(pcols,pver)
1729 : real(r8) :: prco_grid(pcols,pver)
1730 : real(r8) :: prao_grid(pcols,pver)
1731 : real(r8) :: icecldf_grid(pcols,pver)
1732 : real(r8) :: icwnc_grid(pcols,pver)
1733 : real(r8) :: icinc_grid(pcols,pver)
1734 : real(r8) :: qcreso_grid(pcols,pver)
1735 : real(r8) :: melto_grid(pcols,pver)
1736 : real(r8) :: mnuccco_grid(pcols,pver)
1737 : real(r8) :: mnuccto_grid(pcols,pver)
1738 : real(r8) :: bergo_grid(pcols,pver)
1739 : real(r8) :: homoo_grid(pcols,pver)
1740 : real(r8) :: msacwio_grid(pcols,pver)
1741 : real(r8) :: psacwso_grid(pcols,pver)
1742 : real(r8) :: cmeiout_grid(pcols,pver)
1743 : real(r8) :: qireso_grid(pcols,pver)
1744 : real(r8) :: prcio_grid(pcols,pver)
1745 : real(r8) :: praio_grid(pcols,pver)
1746 : real(r8) :: psacro_grid(pcols,pver)
1747 : real(r8) :: pracgo_grid(pcols,pver)
1748 : real(r8) :: psacwgo_grid(pcols,pver)
1749 : real(r8) :: pgsacwo_grid(pcols,pver)
1750 : real(r8) :: pgracso_grid(pcols,pver)
1751 : real(r8) :: prdgo_grid(pcols,pver)
1752 : real(r8) :: qmultgo_grid(pcols,pver)
1753 : real(r8) :: qmultrgo_grid(pcols,pver)
1754 : real(r8) :: npracgo_grid(pcols,pver)
1755 : real(r8) :: nscngo_grid(pcols,pver)
1756 : real(r8) :: ngracso_grid(pcols,pver)
1757 : real(r8) :: nmultgo_grid(pcols,pver)
1758 : real(r8) :: nmultrgo_grid(pcols,pver)
1759 : real(r8) :: npsacwgo_grid(pcols,pver)
1760 : real(r8) :: qcsedtenout_grid(pcols,pver)
1761 : real(r8) :: qrsedtenout_grid(pcols,pver)
1762 : real(r8) :: qisedtenout_grid(pcols,pver)
1763 : real(r8) :: qssedtenout_grid(pcols,pver)
1764 : real(r8) :: vtrmcout_grid(pcols,pver)
1765 : real(r8) :: umrout_grid(pcols,pver)
1766 : real(r8) :: vtrmiout_grid(pcols,pver)
1767 : real(r8) :: umsout_grid(pcols,pver)
1768 : real(r8) :: qcsevapout_grid(pcols,pver)
1769 : real(r8) :: qisevapout_grid(pcols,pver)
1770 :
1771 : real(r8) :: nc_grid(pcols,pver)
1772 : real(r8) :: ni_grid(pcols,pver)
1773 : real(r8) :: qr_grid(pcols,pver)
1774 : real(r8) :: nr_grid(pcols,pver)
1775 : real(r8) :: qs_grid(pcols,pver)
1776 : real(r8) :: ns_grid(pcols,pver)
1777 : real(r8) :: qg_grid(pcols,pver)
1778 : real(r8) :: ng_grid(pcols,pver)
1779 :
1780 : real(r8) :: dgout2_grid(pcols,pver)
1781 :
1782 : real(r8) :: cp_rh(pcols,pver)
1783 : real(r8) :: cp_t(pcols)
1784 : real(r8) :: cp_z(pcols)
1785 : real(r8) :: cp_dt(pcols)
1786 : real(r8) :: cp_dz(pcols)
1787 : integer :: troplev(pcols)
1788 : real(r8) :: es
1789 : real(r8) :: qs
1790 :
1791 483840 : real(r8) :: state_loc_graup(state%psetcols,pver)
1792 483840 : real(r8) :: state_loc_numgraup(state%psetcols,pver)
1793 :
1794 241920 : real(r8), pointer :: cmeliq_grid(:,:)
1795 :
1796 241920 : real(r8), pointer :: prec_str_grid(:)
1797 241920 : real(r8), pointer :: snow_str_grid(:)
1798 241920 : real(r8), pointer :: prec_pcw_grid(:)
1799 241920 : real(r8), pointer :: snow_pcw_grid(:)
1800 241920 : real(r8), pointer :: prec_sed_grid(:)
1801 241920 : real(r8), pointer :: snow_sed_grid(:)
1802 241920 : real(r8), pointer :: cldo_grid(:,:)
1803 241920 : real(r8), pointer :: nevapr_grid(:,:)
1804 241920 : real(r8), pointer :: prain_grid(:,:)
1805 241920 : real(r8), pointer :: mgflxprc_grid(:,:)
1806 241920 : real(r8), pointer :: mgflxsnw_grid(:,:)
1807 241920 : real(r8), pointer :: mgmrprc_grid(:,:)
1808 241920 : real(r8), pointer :: mgmrsnw_grid(:,:)
1809 241920 : real(r8), pointer :: cvreffliq_grid(:,:)
1810 241920 : real(r8), pointer :: cvreffice_grid(:,:)
1811 241920 : real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:)
1812 241920 : real(r8), pointer :: wsedl_grid(:,:)
1813 241920 : real(r8), pointer :: CC_t_grid(:,:)
1814 241920 : real(r8), pointer :: CC_qv_grid(:,:)
1815 241920 : real(r8), pointer :: CC_ql_grid(:,:)
1816 241920 : real(r8), pointer :: CC_qi_grid(:,:)
1817 241920 : real(r8), pointer :: CC_nl_grid(:,:)
1818 241920 : real(r8), pointer :: CC_ni_grid(:,:)
1819 241920 : real(r8), pointer :: CC_qlst_grid(:,:)
1820 241920 : real(r8), pointer :: qme_grid(:,:)
1821 241920 : real(r8), pointer :: iciwpst_grid(:,:)
1822 241920 : real(r8), pointer :: icswp_grid(:,:)
1823 241920 : real(r8), pointer :: ast_grid(:,:)
1824 241920 : real(r8), pointer :: cldfsnow_grid(:,:)
1825 241920 : real(r8), pointer :: bergso_grid(:,:)
1826 :
1827 241920 : real(r8), pointer :: icgrauwp_grid(:,:)
1828 241920 : real(r8), pointer :: cldfgrau_grid(:,:)
1829 :
1830 241920 : real(r8), pointer :: qrout_grid_ptr(:,:)
1831 241920 : real(r8), pointer :: qsout_grid_ptr(:,:)
1832 241920 : real(r8), pointer :: nrout_grid_ptr(:,:)
1833 241920 : real(r8), pointer :: nsout_grid_ptr(:,:)
1834 241920 : real(r8), pointer :: qcsedtenout_grid_ptr(:,:)
1835 241920 : real(r8), pointer :: qrsedtenout_grid_ptr(:,:)
1836 241920 : real(r8), pointer :: qisedtenout_grid_ptr(:,:)
1837 241920 : real(r8), pointer :: qssedtenout_grid_ptr(:,:)
1838 241920 : real(r8), pointer :: vtrmcout_grid_ptr(:,:)
1839 241920 : real(r8), pointer :: umrout_grid_ptr(:,:)
1840 241920 : real(r8), pointer :: vtrmiout_grid_ptr(:,:)
1841 241920 : real(r8), pointer :: umsout_grid_ptr(:,:)
1842 241920 : real(r8), pointer :: qcsevapout_grid_ptr(:,:)
1843 241920 : real(r8), pointer :: qisevapout_grid_ptr(:,:)
1844 :
1845 :
1846 : logical :: use_subcol_microp
1847 : integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field
1848 : integer :: ierr
1849 : integer :: nlev
1850 :
1851 : character(128) :: errstring ! return status (non-blank for error return)
1852 :
1853 : ! For rrtmg optics. specified distribution.
1854 : real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters)
1855 : real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter
1856 : real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters)
1857 :
1858 : ! Rainbows: solar zenith angle (SZA)
1859 483840 : real(r8) :: zen_angle(state%psetcols) ! Daytime solar zenith angles (radians)
1860 483840 : real(r8) :: rlats(state%psetcols), rlons(state%psetcols) ! chunk latitudes and longitudes (radains)
1861 483840 : real(r8) :: sza(state%psetcols) ! solar zenith angles (degrees)
1862 : real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor
1863 : real(r8) :: calday !current calendar day
1864 :
1865 483840 : real(r8) :: precc(state%psetcols) ! convective precip rate
1866 :
1867 : ! Rainbow frequency and fraction for output
1868 :
1869 483840 : real(r8) :: rbfreq(state%psetcols)
1870 483840 : real(r8) :: rbfrac(state%psetcols)
1871 :
1872 : !Rainbows: parameters
1873 :
1874 : real(r8), parameter :: rb_rmin =1.e-6_r8 ! Strat Rain threshold (mixing ratio)
1875 : real(r8), parameter :: rb_rcmin = 5._r8/(86400._r8*1000._r8) ! Conv Rain Threshold (mm/d--> m/s)
1876 : real(r8), parameter :: rb_pmin =85000._r8 ! Minimum pressure for surface layer
1877 : real(r8), parameter :: deg2rad = pi/180._r8 ! Conversion factor
1878 : integer :: top_idx !Index for top level below rb_pmin
1879 : real(r8) :: convmx
1880 : real(r8) :: cldmx
1881 : real(r8) :: frlow
1882 : real(r8) :: cldtot
1883 : real(r8) :: rmax
1884 : logical :: rval
1885 :
1886 : !-------------------------------------------------------------------------------
1887 :
1888 241920 : lchnk = state%lchnk
1889 241920 : ncol = state%ncol
1890 241920 : psetcols = state%psetcols
1891 241920 : ngrdcol = state%ngrdcol
1892 241920 : itim_old = pbuf_old_tim_idx()
1893 241920 : nlev = pver - top_lev + 1
1894 :
1895 241920 : nan_array = nan
1896 :
1897 241920 : call phys_getopts(use_subcol_microp_out=use_subcol_microp)
1898 :
1899 : ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp
1900 241920 : call pbuf_col_type_index(use_subcol_microp, col_type=col_type)
1901 :
1902 : !-----------------------
1903 : ! These physics buffer fields are read only and not set in this parameterization
1904 : ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on
1905 : ! If subcolumns is not turned on, then these fields will be grid data
1906 :
1907 241920 : call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp)
1908 241920 : call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp)
1909 241920 : call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp)
1910 241920 : call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp)
1911 241920 : call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp)
1912 241920 : call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp)
1913 241920 : call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp)
1914 241920 : call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp)
1915 :
1916 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
1917 1693440 : col_type=col_type, copy_if_needed=use_subcol_microp)
1918 : call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
1919 1693440 : col_type=col_type, copy_if_needed=use_subcol_microp)
1920 : call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
1921 1693440 : col_type=col_type, copy_if_needed=use_subcol_microp)
1922 :
1923 : ! Get convective precip
1924 241920 : if (prec_dp_idx > 0) then
1925 241920 : call pbuf_get_field(pbuf, prec_dp_idx, prec_dp, col_type=col_type, copy_if_needed=use_subcol_microp)
1926 : else
1927 0 : nullify(prec_dp)
1928 : end if
1929 241920 : if (prec_sh_idx > 0) then
1930 241920 : call pbuf_get_field(pbuf, prec_sh_idx, prec_sh, col_type=col_type, copy_if_needed=use_subcol_microp)
1931 : else
1932 0 : nullify(prec_sh)
1933 : end if
1934 :
1935 : ! Merge Precipitation rates (multi-process)
1936 241920 : if (associated(prec_dp) .and. associated(prec_sh)) then
1937 3725568 : precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol)
1938 0 : else if (associated(prec_dp)) then
1939 0 : precc(:ncol) = prec_dp(:ncol)
1940 0 : else if (associated(prec_sh)) then
1941 0 : precc(:ncol) = prec_sh(:ncol)
1942 : else
1943 0 : precc(:ncol) = 0._r8
1944 : end if
1945 :
1946 241920 : if (.not. do_cldice) then
1947 : ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf
1948 0 : call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp)
1949 0 : call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp)
1950 0 : call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp)
1951 : else
1952 : ! If we ARE prognosing tendencies, then just point to an array of NaN fields to have
1953 : ! something for PUMAS to use in call
1954 241920 : tnd_qsnow => nan_array
1955 241920 : tnd_nsnow => nan_array
1956 241920 : re_ice => nan_array
1957 : end if
1958 :
1959 241920 : if (use_hetfrz_classnuc) then
1960 241920 : call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp)
1961 241920 : call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp)
1962 241920 : call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp)
1963 : else
1964 : ! Needed to satisfy gnu compiler with optional argument - set to an array of NaN fields
1965 0 : frzimm => nan_array
1966 0 : frzcnt => nan_array
1967 0 : frzdep => nan_array
1968 : end if
1969 :
1970 241920 : if (qsatfac_idx > 0) then
1971 241920 : call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp)
1972 : else
1973 0 : allocate(qsatfac(ncol,pver),stat=ierr)
1974 0 : if (ierr /= 0) then
1975 0 : call endrun(' micro_pumas_cam_tend: error allocating qsatfac')
1976 : end if
1977 0 : qsatfac = 1._r8
1978 : end if
1979 :
1980 : ! initialize tendency variables
1981 4112640 : preci = 0._r8
1982 4112640 : prect = 0._r8
1983 :
1984 :
1985 : !-----------------------
1986 : ! These physics buffer fields are calculated and set in this parameterization
1987 : ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid
1988 :
1989 241920 : call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type)
1990 241920 : call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type)
1991 241920 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type)
1992 241920 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type)
1993 241920 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type)
1994 241920 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type)
1995 241920 : call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type)
1996 241920 : call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type)
1997 241920 : call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type)
1998 241920 : call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type)
1999 241920 : call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type)
2000 241920 : call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type)
2001 241920 : call pbuf_get_field(pbuf, des_idx, des, col_type=col_type)
2002 241920 : call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type)
2003 241920 : call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type)
2004 241920 : call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type)
2005 241920 : call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type)
2006 241920 : call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type)
2007 241920 : call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type)
2008 241920 : call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type)
2009 241920 : call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type)
2010 241920 : call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type)
2011 241920 : call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type)
2012 241920 : call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type)
2013 241920 : call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type)
2014 241920 : call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type)
2015 241920 : call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type)
2016 241920 : call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type)
2017 241920 : call pbuf_get_field(pbuf, bergso_idx, bergso, col_type=col_type)
2018 241920 : if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau, col_type=col_type)
2019 241920 : if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp, col_type=col_type)
2020 241920 : if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, col_type=col_type)
2021 :
2022 1693440 : call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2023 1693440 : call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2024 1693440 : call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2025 1693440 : call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2026 1693440 : call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2027 1693440 : call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2028 1693440 : call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2029 1693440 : call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2030 1693440 : call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
2031 :
2032 241920 : if (rate1_cw2pr_st_idx > 0) then
2033 241920 : call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type)
2034 : end if
2035 :
2036 241920 : if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr)
2037 241920 : if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr)
2038 241920 : if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr)
2039 241920 : if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr)
2040 241920 : if (qcsedten_idx > 0) call pbuf_get_field(pbuf, qcsedten_idx, qcsedtenout_grid_ptr)
2041 241920 : if (qrsedten_idx > 0) call pbuf_get_field(pbuf, qrsedten_idx, qrsedtenout_grid_ptr)
2042 241920 : if (qisedten_idx > 0) call pbuf_get_field(pbuf, qisedten_idx, qisedtenout_grid_ptr)
2043 241920 : if (qssedten_idx > 0) call pbuf_get_field(pbuf, qssedten_idx, qssedtenout_grid_ptr)
2044 241920 : if (vtrmc_idx > 0) call pbuf_get_field(pbuf, vtrmc_idx, vtrmcout_grid_ptr)
2045 241920 : if (umr_idx > 0) call pbuf_get_field(pbuf, umr_idx, umrout_grid_ptr)
2046 241920 : if (vtrmi_idx > 0) call pbuf_get_field(pbuf, vtrmi_idx, vtrmiout_grid_ptr)
2047 241920 : if (ums_idx > 0) call pbuf_get_field(pbuf, ums_idx, umsout_grid_ptr)
2048 241920 : if (qcsevap_idx > 0) call pbuf_get_field(pbuf, qcsevap_idx, qcsevapout_grid_ptr)
2049 241920 : if (qisevap_idx > 0) call pbuf_get_field(pbuf, qisevap_idx, qisevapout_grid_ptr)
2050 :
2051 : !-----------------------
2052 : ! If subcolumns is turned on, all calculated fields which are on subcolumns
2053 : ! need to be retrieved on the grid as well for storing averaged values
2054 :
2055 241920 : if (use_subcol_microp) then
2056 0 : call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid)
2057 0 : call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid)
2058 0 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid)
2059 0 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid)
2060 0 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid)
2061 0 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid)
2062 0 : call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid)
2063 0 : call pbuf_get_field(pbuf, prain_idx, prain_grid)
2064 0 : call pbuf_get_field(pbuf, dei_idx, dei_grid)
2065 0 : call pbuf_get_field(pbuf, mu_idx, mu_grid)
2066 0 : call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid)
2067 0 : call pbuf_get_field(pbuf, des_idx, des_grid)
2068 0 : call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid)
2069 0 : call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid)
2070 0 : call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid)
2071 0 : call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid)
2072 0 : call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid)
2073 0 : call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid)
2074 0 : call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid)
2075 0 : call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid)
2076 0 : call pbuf_get_field(pbuf, icswp_idx, icswp_grid)
2077 0 : call pbuf_get_field(pbuf, rel_idx, rel_grid)
2078 0 : call pbuf_get_field(pbuf, rei_idx, rei_grid)
2079 0 : call pbuf_get_field(pbuf, sadice_idx, sadice_grid)
2080 0 : call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid)
2081 0 : call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid)
2082 0 : call pbuf_get_field(pbuf, qme_idx, qme_grid)
2083 0 : call pbuf_get_field(pbuf, bergso_idx, bergso_grid)
2084 0 : if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau_grid)
2085 0 : if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp_grid)
2086 0 : if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau_grid)
2087 :
2088 0 : call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2089 0 : call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2090 0 : call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2091 0 : call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2092 0 : call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2093 0 : call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2094 0 : call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2095 0 : call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2096 0 : call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2097 :
2098 0 : if (rate1_cw2pr_st_idx > 0) then
2099 0 : call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid)
2100 : end if
2101 :
2102 : end if
2103 :
2104 : !-----------------------
2105 : ! These are only on the grid regardless of whether subcolumns are turned on or not
2106 241920 : call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid)
2107 241920 : call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid)
2108 241920 : call pbuf_get_field(pbuf, acpr_idx, acprecl_grid)
2109 241920 : call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid)
2110 241920 : call pbuf_get_field(pbuf, acnum_idx, acnum_grid)
2111 241920 : call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid)
2112 967680 : call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2113 :
2114 241920 : call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid)
2115 241920 : call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid)
2116 241920 : call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid)
2117 :
2118 : !-----------------------------------------------------------------------
2119 : ! ... Calculate cosine of zenith angle
2120 : ! then cast back to angle (radians)
2121 : !-----------------------------------------------------------------------
2122 4112640 : zen_angle(:) = 0.0_r8
2123 4112640 : rlats(:) = 0.0_r8
2124 4112640 : rlons(:) = 0.0_r8
2125 241920 : calday = get_curr_calday()
2126 241920 : call get_rlat_all_p( lchnk, ncol, rlats )
2127 241920 : call get_rlon_all_p( lchnk, ncol, rlons )
2128 241920 : call zenith( calday, rlats, rlons, zen_angle, ncol )
2129 15724800 : where (zen_angle(:) <= 1.0_r8 .and. zen_angle(:) >= -1.0_r8)
2130 : zen_angle(:) = acos( zen_angle(:) )
2131 : elsewhere
2132 : zen_angle(:) = 0.0_r8
2133 : end where
2134 :
2135 4112640 : sza(:) = zen_angle(:) * rad2deg
2136 241920 : call outfld( 'rbSZA', sza, ncol, lchnk )
2137 :
2138 : !-------------------------------------------------------------------------------------
2139 : ! Microphysics assumes 'liquid stratus frac = ice stratus frac
2140 : ! = max( liquid stratus frac, ice stratus frac )'.
2141 241920 : alst_mic => ast
2142 241920 : aist_mic => ast
2143 :
2144 : ! Output initial in-cloud LWP (before microphysics)
2145 :
2146 4112640 : iclwpi = 0._r8
2147 4112640 : iciwpi = 0._r8
2148 :
2149 3725568 : do i = 1, ncol
2150 115202304 : do k = top_lev, pver
2151 111476736 : iclwpi(i) = iclwpi(i) + &
2152 0 : min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) &
2153 222953472 : * state%pdel(i,k) / gravit
2154 : iciwpi(i) = iciwpi(i) + &
2155 111476736 : min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) &
2156 226437120 : * state%pdel(i,k) / gravit
2157 : end do
2158 : end do
2159 :
2160 238678272 : cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver)
2161 :
2162 : ! Initialize local state from input.
2163 241920 : call physics_state_copy(state, state_loc)
2164 :
2165 : ! Because of the of limited vertical resolution, there can be a signifcant
2166 : ! warm bias at the cold point tropopause, which can create a wet bias in the
2167 : ! stratosphere. For the microphysics only, update the cold point temperature, with
2168 : ! an estimate of the coldest point between the model layers.
2169 241920 : if (micro_mg_adjust_cpt) then
2170 0 : cp_rh(:ncol, :pver) = 0._r8
2171 0 : cp_dt(:ncol) = 0._r8
2172 0 : cp_dz(:ncol) = 0._r8
2173 :
2174 : !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists
2175 0 : troplev(:) = 0
2176 0 : cp_z(:) = 0._r8
2177 0 : cp_t(:) = 0._r8
2178 : !REMOVECAM_END
2179 : call tropopause_find_cam(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, &
2180 0 : tropZ=cp_z, tropT=cp_t)
2181 :
2182 0 : do i = 1, ncol
2183 :
2184 : ! Update statistics and output results.
2185 0 : if (troplev(i) .ne. NOTFOUND) then
2186 0 : cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i))
2187 0 : cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i))
2188 :
2189 : ! NOTE: This change in temperature is just for the microphysics
2190 : ! and should not be added to any tendencies or used to update
2191 : ! any states
2192 0 : state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i)
2193 : end if
2194 : end do
2195 :
2196 : ! Output all of the statistics related to the cold point
2197 : ! tropopause adjustment. Th cold point information itself is
2198 : ! output in tropopause.F90.
2199 0 : call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk)
2200 0 : call outfld("TROPF_CDT", cp_dt, pcols, lchnk)
2201 0 : call outfld("TROPF_CDZ", cp_dz, pcols, lchnk)
2202 : end if
2203 :
2204 : ! Initialize ptend for output.
2205 241920 : lq = .false.
2206 241920 : lq(ixq) = .true.
2207 241920 : lq(ixcldliq) = .true.
2208 241920 : lq(ixcldice) = .true.
2209 241920 : lq(ixnumliq) = .true.
2210 241920 : lq(ixnumice) = .true.
2211 241920 : if (micro_mg_version > 1) then
2212 241920 : lq(ixrain) = .true.
2213 241920 : lq(ixsnow) = .true.
2214 241920 : lq(ixnumrain) = .true.
2215 241920 : lq(ixnumsnow) = .true.
2216 : end if
2217 241920 : if (micro_mg_version > 2) then
2218 0 : lq(ixgraupel) = .true.
2219 0 : lq(ixnumgraupel) = .true.
2220 : end if
2221 :
2222 : ! the name 'cldwat' triggers special tests on cldliq
2223 : ! and cldice in physics_update
2224 241920 : call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq)
2225 :
2226 241920 : if (micro_mg_version > 2) then
2227 0 : state_loc_graup(:ncol,:) = state_loc%q(:ncol,:,ixgraupel)
2228 0 : state_loc_numgraup(:ncol,:) = state_loc%q(:ncol,:,ixnumgraupel)
2229 : else
2230 119460096 : state_loc_graup(:ncol,:) = 0._r8
2231 119460096 : state_loc_numgraup(:ncol,:) = 0._r8
2232 : end if
2233 :
2234 : ! Zero out diagnostic rainbow arrays
2235 4112640 : rbfreq = 0._r8
2236 4112640 : rbfrac = 0._r8
2237 :
2238 : ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs
2239 241920 : naai(:ncol,:top_lev-1) = 0._r8
2240 241920 : npccn(:ncol,:top_lev-1) = 0._r8
2241 :
2242 : ! The null value for qsatfac is 1, not zero
2243 241920 : qsatfac(:ncol,:top_lev-1) = 1._r8
2244 :
2245 : ! Zero out values above top_lev for all output variables
2246 241920 : tlat(:ncol,:top_lev-1)=0._r8
2247 241920 : qvlat(:ncol,:top_lev-1)=0._r8
2248 241920 : qcten(:ncol,:top_lev-1)=0._r8
2249 241920 : qiten(:ncol,:top_lev-1)=0._r8
2250 241920 : ncten(:ncol,:top_lev-1)=0._r8
2251 241920 : niten(:ncol,:top_lev-1)=0._r8
2252 241920 : qrten(:ncol,:top_lev-1)=0._r8
2253 241920 : qsten(:ncol,:top_lev-1)=0._r8
2254 241920 : nrten(:ncol,:top_lev-1)=0._r8
2255 241920 : nsten(:ncol,:top_lev-1)=0._r8
2256 241920 : qgten(:ncol,:top_lev-1)=0._r8
2257 241920 : ngten(:ncol,:top_lev-1)=0._r8
2258 241920 : rel(:ncol,:top_lev-1)=0._r8
2259 241920 : rel_fn_dum(:ncol,:top_lev-1)=0._r8
2260 241920 : rei(:ncol,:top_lev-1)=0._r8
2261 241920 : sadice(:ncol,:top_lev-1)=0._r8
2262 241920 : sadsnow(:ncol,:top_lev-1)=0._r8
2263 3725568 : prect(:ncol)=0._r8
2264 3725568 : preci(:ncol)=0._r8
2265 241920 : nevapr(:ncol,:top_lev-1)=0._r8
2266 241920 : evapsnow(:ncol,:top_lev-1)=0._r8
2267 241920 : am_evp_st(:ncol,:top_lev-1)=0._r8
2268 241920 : prain(:ncol,:top_lev-1)=0._r8
2269 241920 : prodsnow(:ncol,:top_lev-1)=0._r8
2270 241920 : cmeice(:ncol,:top_lev-1)=0._r8
2271 241920 : dei(:ncol,:top_lev-1)=0._r8
2272 241920 : mu(:ncol,:top_lev-1)=0._r8
2273 241920 : lambdac(:ncol,:top_lev-1)=0._r8
2274 241920 : qsout(:ncol,:top_lev-1)=0._r8
2275 241920 : des(:ncol,:top_lev-1)=0._r8
2276 241920 : qgout(:ncol,:top_lev-1)=0._r8
2277 241920 : ngout(:ncol,:top_lev-1)=0._r8
2278 241920 : dgout(:ncol,:top_lev-1)=0._r8
2279 241920 : cflx(:ncol,:top_lev-1)=0._r8
2280 241920 : iflx(:ncol,:top_lev-1)=0._r8
2281 241920 : gflx(:ncol,:top_lev-1)=0._r8
2282 241920 : rflx(:ncol,:top_lev-1)=0._r8
2283 241920 : sflx(:ncol,:top_lev-1)=0._r8
2284 241920 : qrout(:ncol,:top_lev-1)=0._r8
2285 241920 : reff_rain_dum(:ncol,:top_lev-1)=0._r8
2286 241920 : reff_snow_dum(:ncol,:top_lev-1)=0._r8
2287 241920 : reff_grau_dum(:ncol,:top_lev-1)=0._r8
2288 241920 : qcsevap(:ncol,:top_lev-1)=0._r8
2289 241920 : qisevap(:ncol,:top_lev-1)=0._r8
2290 241920 : qvres(:ncol,:top_lev-1)=0._r8
2291 241920 : cmeiout(:ncol,:top_lev-1)=0._r8
2292 241920 : vtrmc(:ncol,:top_lev-1)=0._r8
2293 241920 : vtrmi(:ncol,:top_lev-1)=0._r8
2294 241920 : umr(:ncol,:top_lev-1)=0._r8
2295 241920 : ums(:ncol,:top_lev-1)=0._r8
2296 241920 : umg(:ncol,:top_lev-1)=0._r8
2297 241920 : qgsedten(:ncol,:top_lev-1)=0._r8
2298 241920 : qcsedten(:ncol,:top_lev-1)=0._r8
2299 241920 : qisedten(:ncol,:top_lev-1)=0._r8
2300 241920 : qrsedten(:ncol,:top_lev-1)=0._r8
2301 241920 : qssedten(:ncol,:top_lev-1)=0._r8
2302 241920 : prao(:ncol,:top_lev-1)=0._r8
2303 241920 : prco(:ncol,:top_lev-1)=0._r8
2304 241920 : mnuccco(:ncol,:top_lev-1)=0._r8
2305 241920 : mnuccto(:ncol,:top_lev-1)=0._r8
2306 241920 : msacwio(:ncol,:top_lev-1)=0._r8
2307 241920 : psacwso(:ncol,:top_lev-1)=0._r8
2308 241920 : bergso(:ncol,:top_lev-1)=0._r8
2309 241920 : bergo(:ncol,:top_lev-1)=0._r8
2310 241920 : melto(:ncol,:top_lev-1)=0._r8
2311 241920 : meltstot(:ncol,:top_lev-1)=0._r8
2312 241920 : meltgtot(:ncol,:top_lev-1)=0._r8
2313 241920 : homoo(:ncol,:top_lev-1)=0._r8
2314 241920 : qcreso(:ncol,:top_lev-1)=0._r8
2315 241920 : prcio(:ncol,:top_lev-1)=0._r8
2316 241920 : praio(:ncol,:top_lev-1)=0._r8
2317 241920 : qireso(:ncol,:top_lev-1)=0._r8
2318 241920 : mnuccro(:ncol,:top_lev-1)=0._r8
2319 241920 : mnudepo(:ncol,:top_lev-1)=0._r8
2320 241920 : mnuccrio(:ncol,:top_lev-1)=0._r8
2321 241920 : pracso(:ncol,:top_lev-1)=0._r8
2322 241920 : meltsdt(:ncol,:top_lev-1)=0._r8
2323 241920 : frzrdt(:ncol,:top_lev-1)=0._r8
2324 241920 : mnuccdo(:ncol,:top_lev-1)=0._r8
2325 241920 : pracgo(:ncol,:top_lev-1)=0._r8
2326 241920 : psacwgo(:ncol,:top_lev-1)=0._r8
2327 241920 : pgracso(:ncol,:top_lev-1)=0._r8
2328 241920 : prdgo(:ncol,:top_lev-1)=0._r8
2329 241920 : qmultgo(:ncol,:top_lev-1)=0._r8
2330 241920 : qmultrgo(:ncol,:top_lev-1)=0._r8
2331 241920 : psacro(:ncol,:top_lev-1)=0._r8
2332 241920 : npracgo(:ncol,:top_lev-1)=0._r8
2333 241920 : nscngo(:ncol,:top_lev-1)=0._r8
2334 241920 : ngracso(:ncol,:top_lev-1)=0._r8
2335 241920 : nmultgo(:ncol,:top_lev-1)=0._r8
2336 241920 : nmultrgo(:ncol,:top_lev-1)=0._r8
2337 241920 : npsacwgo(:ncol,:top_lev-1)=0._r8
2338 241920 : nrout(:ncol,:top_lev-1)=0._r8
2339 241920 : nsout(:ncol,:top_lev-1)=0._r8
2340 241920 : refl(:ncol,:top_lev-1)=0._r8
2341 241920 : arefl(:ncol,:top_lev-1)=0._r8
2342 241920 : areflz(:ncol,:top_lev-1)=0._r8
2343 241920 : frefl(:ncol,:top_lev-1)=0._r8
2344 241920 : csrfl(:ncol,:top_lev-1)=0._r8
2345 241920 : acsrfl(:ncol,:top_lev-1)=0._r8
2346 241920 : fcsrfl(:ncol,:top_lev-1)=0._r8
2347 241920 : rercld(:ncol,:top_lev-1)=0._r8
2348 241920 : ncai(:ncol,:top_lev-1)=0._r8
2349 241920 : ncal(:ncol,:top_lev-1)=0._r8
2350 241920 : qrout2(:ncol,:top_lev-1)=0._r8
2351 241920 : qsout2(:ncol,:top_lev-1)=0._r8
2352 241920 : nrout2(:ncol,:top_lev-1)=0._r8
2353 241920 : nsout2(:ncol,:top_lev-1)=0._r8
2354 241920 : qgout2(:ncol,:top_lev-1)=0._r8
2355 241920 : ngout2(:ncol,:top_lev-1)=0._r8
2356 241920 : dgout2(:ncol,:top_lev-1)=0._r8
2357 241920 : freqg(:ncol,:top_lev-1)=0._r8
2358 241920 : freqs(:ncol,:top_lev-1)=0._r8
2359 241920 : freqr(:ncol,:top_lev-1)=0._r8
2360 241920 : nfice(:ncol,:top_lev-1)=0._r8
2361 241920 : qcrat(:ncol,:top_lev-1)=0._r8
2362 241920 : tnd_qsnow(:ncol,:top_lev-1)=0._r8
2363 241920 : tnd_nsnow(:ncol,:top_lev-1)=0._r8
2364 241920 : re_ice(:ncol,:top_lev-1)=0._r8
2365 241920 : prer_evap(:ncol,:top_lev-1)=0._r8
2366 241920 : frzimm(:ncol,:top_lev-1)=0._r8
2367 241920 : frzcnt(:ncol,:top_lev-1)=0._r8
2368 241920 : frzdep(:ncol,:top_lev-1)=0._r8
2369 :
2370 483840 : do it = 1, num_steps
2371 :
2372 0 : select case (micro_mg_version)
2373 : case (1)
2374 241920 : select case (micro_mg_sub_version)
2375 : case (0)
2376 : call micro_mg_tend1_0( &
2377 : microp_uniform, ncol, nlev, ncol, 1, dtime/num_steps, &
2378 0 : state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), state_loc%q(:ncol,top_lev:,ixcldliq), &
2379 0 : state_loc%q(:ncol,top_lev:,ixcldice), state_loc%q(:ncol,top_lev:,ixnumliq), &
2380 0 : state_loc%q(:ncol,top_lev:,ixnumice), state_loc%pmid(:ncol,top_lev:), state_loc%pdel(:ncol,top_lev:), &
2381 0 : ast(:ncol,top_lev:), alst_mic(:ncol,top_lev:),&
2382 0 : relvar(:ncol,top_lev:), accre_enhan(:ncol,top_lev:), &
2383 0 : aist_mic(:ncol,top_lev:), rate1cld(:ncol,top_lev:), naai(:ncol,top_lev:), npccn(:ncol,top_lev:), &
2384 0 : rndst(:ncol,top_lev:,:), nacon(:ncol,top_lev:,:), tlat(:ncol,top_lev:), qvlat(:ncol,top_lev:), &
2385 0 : qcten(:ncol,top_lev:), &
2386 0 : qiten(:ncol,top_lev:), ncten(:ncol,top_lev:), niten(:ncol,top_lev:), rel(:ncol,top_lev:), &
2387 0 : rel_fn_dum(:ncol,top_lev:), &
2388 0 : rei(:ncol,top_lev:), prect(:ncol), preci(:ncol), nevapr(:ncol,top_lev:), evapsnow(:ncol,top_lev:), &
2389 0 : am_evp_st(:ncol,top_lev:), &
2390 0 : prain(:ncol,top_lev:), prodsnow(:ncol,top_lev:), cmeice(:ncol,top_lev:), dei(:ncol,top_lev:), mu(:ncol,top_lev:), &
2391 0 : lambdac(:ncol,top_lev:), qsout(:ncol,top_lev:), des(:ncol,top_lev:), rflx(:ncol,top_lev:), sflx(:ncol,top_lev:), &
2392 0 : qrout(:ncol,top_lev:), reff_rain_dum(:ncol,top_lev:), reff_snow_dum(:ncol,top_lev:), qcsevap(:ncol,top_lev:), &
2393 0 : qisevap(:ncol,top_lev:), &
2394 0 : qvres(:ncol,top_lev:), cmeiout(:ncol,top_lev:), vtrmc(:ncol,top_lev:), vtrmi(:ncol,top_lev:), &
2395 0 : qcsedten(:ncol,top_lev:), &
2396 0 : qisedten(:ncol,top_lev:), prao(:ncol,top_lev:), prco(:ncol,top_lev:), mnuccco(:ncol,top_lev:), &
2397 0 : mnuccto(:ncol,top_lev:), &
2398 0 : msacwio(:ncol,top_lev:), psacwso(:ncol,top_lev:), bergso(:ncol,top_lev:), bergo(:ncol,top_lev:), &
2399 0 : melto(:ncol,top_lev:), &
2400 0 : homoo(:ncol,top_lev:), qcreso(:ncol,top_lev:), prcio(:ncol,top_lev:), praio(:ncol,top_lev:), &
2401 0 : qireso(:ncol,top_lev:), &
2402 0 : mnuccro(:ncol,top_lev:), pracso(:ncol,top_lev:), meltsdt(:ncol,top_lev:), frzrdt(:ncol,top_lev:), &
2403 0 : mnuccdo(:ncol,top_lev:), &
2404 0 : nrout(:ncol,top_lev:), nsout(:ncol,top_lev:), refl(:ncol,top_lev:), arefl(:ncol,top_lev:), areflz(:ncol,top_lev:),&
2405 0 : frefl(:ncol,top_lev:), csrfl(:ncol,top_lev:), acsrfl(:ncol,top_lev:), fcsrfl(:ncol,top_lev:), &
2406 0 : rercld(:ncol,top_lev:), &
2407 0 : ncai(:ncol,top_lev:), ncal(:ncol,top_lev:), qrout2(:ncol,top_lev:), qsout2(:ncol,top_lev:), &
2408 0 : nrout2(:ncol,top_lev:), &
2409 0 : nsout2(:ncol,top_lev:), drout_dum(:ncol,top_lev:), dsout2_dum(:ncol,top_lev:), freqs(:ncol,top_lev:),&
2410 0 : freqr(:ncol,top_lev:), &
2411 0 : nfice(:ncol,top_lev:), prer_evap(:ncol,top_lev:), do_cldice, errstring, &
2412 0 : tnd_qsnow(:ncol,top_lev:), tnd_nsnow(:ncol,top_lev:), re_ice(:ncol,top_lev:), &
2413 0 : frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:))
2414 :
2415 : end select
2416 : case(2:3)
2417 : call micro_pumas_tend( &
2418 : ncol, nlev, dtime/num_steps,&
2419 0 : state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), &
2420 0 : state_loc%q(:ncol,top_lev:,ixcldliq), state_loc%q(:ncol,top_lev:,ixcldice), &
2421 0 : state_loc%q(:ncol,top_lev:,ixnumliq), state_loc%q(:ncol,top_lev:,ixnumice), &
2422 0 : state_loc%q(:ncol,top_lev:,ixrain), state_loc%q(:ncol,top_lev:,ixsnow), &
2423 0 : state_loc%q(:ncol,top_lev:,ixnumrain), state_loc%q(:ncol,top_lev:,ixnumsnow), &
2424 241920 : state_loc_graup(:ncol,top_lev:), state_loc_numgraup(:ncol,top_lev:), &
2425 0 : relvar(:ncol,top_lev:), accre_enhan(:ncol,top_lev:), &
2426 0 : state_loc%pmid(:ncol,top_lev:), state_loc%pdel(:ncol,top_lev:), &
2427 0 : ast(:ncol,top_lev:), alst_mic(:ncol,top_lev:), aist_mic(:ncol,top_lev:), qsatfac(:ncol,top_lev:), &
2428 483840 : rate1cld(:ncol,top_lev:), &
2429 0 : naai(:ncol,top_lev:), npccn(:ncol,top_lev:), &
2430 0 : rndst(:ncol,top_lev:,:), nacon(:ncol,top_lev:,:), &
2431 725760 : tlat(:ncol,top_lev:), qvlat(:ncol,top_lev:), &
2432 483840 : qcten(:ncol,top_lev:), qiten(:ncol,top_lev:), &
2433 483840 : ncten(:ncol,top_lev:), niten(:ncol,top_lev:), &
2434 483840 : qrten(:ncol,top_lev:), qsten(:ncol,top_lev:), &
2435 483840 : nrten(:ncol,top_lev:), nsten(:ncol,top_lev:), &
2436 483840 : qgten(:ncol,top_lev:), ngten(:ncol,top_lev:), &
2437 241920 : rel(:ncol,top_lev:), rel_fn_dum(:ncol,top_lev:), rei(:ncol,top_lev:), &
2438 0 : sadice(:ncol,top_lev:), sadsnow(:ncol,top_lev:), &
2439 241920 : prect(:ncol), preci(:ncol), &
2440 483840 : nevapr(:ncol,top_lev:), evapsnow(:ncol,top_lev:), &
2441 241920 : am_evp_st(:ncol,top_lev:), &
2442 483840 : prain(:ncol,top_lev:), prodsnow(:ncol,top_lev:), &
2443 241920 : cmeice(:ncol,top_lev:), dei(:ncol,top_lev:), &
2444 0 : mu(:ncol,top_lev:), lambdac(:ncol,top_lev:), &
2445 483840 : qsout(:ncol,top_lev:), des(:ncol,top_lev:), &
2446 967680 : qgout(:ncol,top_lev:), ngout(:ncol,top_lev:), dgout(:ncol,top_lev:), &
2447 483840 : cflx(:ncol,top_lev:), iflx(:ncol,top_lev:), &
2448 241920 : gflx(:ncol,top_lev:), &
2449 725760 : rflx(:ncol,top_lev:), sflx(:ncol,top_lev:), qrout(:ncol,top_lev:), &
2450 241920 : reff_rain_dum(:ncol,top_lev:), reff_snow_dum(:ncol,top_lev:), reff_grau_dum(:ncol,top_lev:), &
2451 725760 : qcsevap(:ncol,top_lev:), qisevap(:ncol,top_lev:), qvres(:ncol,top_lev:), &
2452 725760 : cmeiout(:ncol,top_lev:), vtrmc(:ncol,top_lev:), vtrmi(:ncol,top_lev:), &
2453 967680 : umr(:ncol,top_lev:), ums(:ncol,top_lev:), &
2454 483840 : umg(:ncol,top_lev:), qgsedten(:ncol,top_lev:), &
2455 483840 : qcsedten(:ncol,top_lev:), qisedten(:ncol,top_lev:), &
2456 483840 : qrsedten(:ncol,top_lev:), qssedten(:ncol,top_lev:), &
2457 483840 : prao(:ncol,top_lev:), prco(:ncol,top_lev:), &
2458 725760 : mnuccco(:ncol,top_lev:), mnuccto(:ncol,top_lev:), msacwio(:ncol,top_lev:), &
2459 725760 : psacwso(:ncol,top_lev:), bergso(:ncol,top_lev:), bergo(:ncol,top_lev:), &
2460 967680 : melto(:ncol,top_lev:), meltstot(:ncol,top_lev:), meltgtot(:ncol,top_lev:), homoo(:ncol,top_lev:), &
2461 725760 : qcreso(:ncol,top_lev:), prcio(:ncol,top_lev:), praio(:ncol,top_lev:), &
2462 967680 : qireso(:ncol,top_lev:), mnuccro(:ncol,top_lev:), mnudepo(:ncol,top_lev:), mnuccrio(:ncol,top_lev:), &
2463 241920 : pracso(:ncol,top_lev:), &
2464 725760 : meltsdt(:ncol,top_lev:), frzrdt(:ncol,top_lev:), mnuccdo(:ncol,top_lev:), &
2465 967680 : pracgo(:ncol,top_lev:), psacwgo(:ncol,top_lev:), pgsacwo(:ncol,top_lev:), &
2466 725760 : pgracso(:ncol,top_lev:), prdgo(:ncol,top_lev:), &
2467 725760 : qmultgo(:ncol,top_lev:), qmultrgo(:ncol,top_lev:), psacro(:ncol,top_lev:), &
2468 725760 : npracgo(:ncol,top_lev:), nscngo(:ncol,top_lev:), ngracso(:ncol,top_lev:), &
2469 725760 : nmultgo(:ncol,top_lev:), nmultrgo(:ncol,top_lev:), npsacwgo(:ncol,top_lev:), &
2470 483840 : nrout(:ncol,top_lev:), nsout(:ncol,top_lev:), &
2471 725760 : refl(:ncol,top_lev:), arefl(:ncol,top_lev:), areflz(:ncol,top_lev:), &
2472 967680 : frefl(:ncol,top_lev:), csrfl(:ncol,top_lev:), acsrfl(:ncol,top_lev:), &
2473 483840 : fcsrfl(:ncol,top_lev:), rercld(:ncol,top_lev:), &
2474 483840 : ncai(:ncol,top_lev:), ncal(:ncol,top_lev:), &
2475 483840 : qrout2(:ncol,top_lev:), qsout2(:ncol,top_lev:), &
2476 483840 : nrout2(:ncol,top_lev:), nsout2(:ncol,top_lev:), &
2477 241920 : drout_dum(:ncol,top_lev:), dsout2_dum(:ncol,top_lev:), &
2478 967680 : qgout2(:ncol,top_lev:), ngout2(:ncol,top_lev:), dgout2(:ncol,top_lev:), freqg(:ncol,top_lev:), &
2479 483840 : freqs(:ncol,top_lev:), freqr(:ncol,top_lev:), &
2480 483840 : nfice(:ncol,top_lev:), qcrat(:ncol,top_lev:), &
2481 : errstring, &
2482 0 : tnd_qsnow(:ncol,top_lev:),tnd_nsnow(:ncol,top_lev:),re_ice(:ncol,top_lev:),&
2483 0 : prer_evap(:ncol,top_lev:), &
2484 13757506560 : frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:) )
2485 : end select
2486 :
2487 241920 : call handle_errmsg(errstring, subname="micro_pumas_tend")
2488 :
2489 : call physics_ptend_init(ptend_loc, psetcols, "micro_pumas", &
2490 241920 : ls=.true., lq=lq)
2491 :
2492 : ! Set local tendency.
2493 119460096 : ptend_loc%s(:ncol,top_lev:) = tlat(:ncol,top_lev:)
2494 119460096 : ptend_loc%q(:ncol,top_lev:,ixq) = qvlat(:ncol,top_lev:)
2495 119460096 : ptend_loc%q(:ncol,top_lev:,ixcldliq) = qcten(:ncol,top_lev:)
2496 119460096 : ptend_loc%q(:ncol,top_lev:,ixcldice) = qiten(:ncol,top_lev:)
2497 119460096 : ptend_loc%q(:ncol,top_lev:,ixnumliq) = ncten(:ncol,top_lev:)
2498 :
2499 241920 : if (do_cldice) then
2500 119460096 : ptend_loc%q(:ncol,top_lev:,ixnumice) = niten(:ncol,top_lev:)
2501 : else
2502 : ! In this case, the tendency should be all 0.
2503 0 : if (any(niten(:ncol,:) /= 0._r8)) then
2504 : call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
2505 0 : " but micro_pumas_tend has ice number tendencies.")
2506 : end if
2507 0 : ptend_loc%q(:ncol,:,ixnumice) = 0._r8
2508 : end if
2509 :
2510 241920 : if (micro_mg_version > 1) then
2511 119460096 : ptend_loc%q(:ncol,top_lev:,ixrain) = qrten(:ncol,top_lev:)
2512 119460096 : ptend_loc%q(:ncol,top_lev:,ixsnow) = qsten(:ncol,top_lev:)
2513 119460096 : ptend_loc%q(:ncol,top_lev:,ixnumrain) = nrten(:ncol,top_lev:)
2514 119460096 : ptend_loc%q(:ncol,top_lev:,ixnumsnow) = nsten(:ncol,top_lev:)
2515 : end if
2516 :
2517 241920 : if (micro_mg_version > 2) then
2518 0 : ptend_loc%q(:ncol,top_lev:,ixgraupel) = qgten(:ncol,top_lev:)
2519 0 : ptend_loc%q(:ncol,top_lev:,ixnumgraupel) = ngten(:ncol,top_lev:)
2520 : end if
2521 :
2522 : ! Sum into overall ptend
2523 241920 : call physics_ptend_sum(ptend_loc, ptend, ncol)
2524 :
2525 : ! Update local state
2526 483840 : call physics_update(state_loc, ptend_loc, dtime/num_steps)
2527 :
2528 : end do
2529 :
2530 : ! Divide ptend by substeps.
2531 241920 : call physics_ptend_scale(ptend, 1._r8/num_steps, ncol)
2532 :
2533 : ! Check to make sure that the microphysics code is respecting the flags that control
2534 : ! whether MG should be prognosing cloud ice and cloud liquid or not.
2535 241920 : if (.not. do_cldice) then
2536 0 : if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) &
2537 : call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
2538 0 : " but micro_pumas_tend has ice mass tendencies.")
2539 0 : if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) &
2540 : call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
2541 0 : " but micro_pumas_tend has ice number tendencies.")
2542 : end if
2543 241920 : if (.not. do_cldliq) then
2544 0 : if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) &
2545 : call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// &
2546 0 : " but micro_pumas_tend has liquid mass tendencies.")
2547 0 : if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) &
2548 : call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// &
2549 0 : " but micro_pumas_tend has liquid number tendencies.")
2550 : end if
2551 :
2552 131846400 : mnuccdohet = 0._r8
2553 7983360 : do k=top_lev,pver
2554 119460096 : do i=1,ncol
2555 119218176 : if (naai(i,k) > 0._r8) then
2556 7212672 : mnuccdohet(i,k) = mnuccdo(i,k) - (naai_hom(i,k)/naai(i,k))*mnuccdo(i,k)
2557 : end if
2558 : end do
2559 : end do
2560 :
2561 123185664 : mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp)
2562 123185664 : mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp)
2563 :
2564 : !add condensate fluxes for MG2 (ice and snow already added for MG1)
2565 241920 : if (micro_mg_version >= 2) then
2566 123185664 : mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp)
2567 123185664 : mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp)
2568 : end if
2569 :
2570 : !add graupel fluxes for MG3 to snow flux
2571 241920 : if (micro_mg_version >= 3) then
2572 0 : mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp)
2573 0 : mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp)
2574 : end if
2575 :
2576 119460096 : mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver)
2577 119460096 : mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver)
2578 :
2579 : !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP)
2580 : !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505)
2581 119460096 : cvreffliq(:ncol,top_lev:pver) = 9.0_r8
2582 119460096 : cvreffice(:ncol,top_lev:pver) = 37.0_r8
2583 :
2584 : ! Reassign rate1 if modal aerosols
2585 241920 : if (rate1_cw2pr_st_idx > 0) then
2586 119460096 : rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver)
2587 : end if
2588 :
2589 : ! Sedimentation velocity for liquid stratus cloud droplet
2590 119460096 : wsedl(:ncol,top_lev:pver) = vtrmc(:ncol,top_lev:pver)
2591 :
2592 : ! Microphysical tendencies for use in the macrophysics at the next time step
2593 119460096 : CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair
2594 119460096 : CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver)
2595 119460096 : CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)
2596 119460096 : CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver)
2597 119460096 : CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver)
2598 119460096 : CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver)
2599 238678272 : CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver))
2600 :
2601 : ! Net micro_pumas_cam condensation rate
2602 241920 : qme(:ncol,:top_lev-1) = 0._r8
2603 238678272 : qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + cmeiout(:ncol,top_lev:pver)
2604 :
2605 241920 : bergso(:ncol,:top_lev-1) = 0._r8
2606 :
2607 : ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables.
2608 : ! Other precip output variables are set to 0
2609 : ! Do not subscript by ncol here, because in physpkg we divide the whole
2610 : ! array and need to avoid an FPE due to uninitialized data.
2611 4112640 : prec_pcw = prect
2612 4112640 : snow_pcw = preci
2613 4112640 : prec_sed = 0._r8
2614 4112640 : snow_sed = 0._r8
2615 7983360 : prec_str = prec_pcw + prec_sed
2616 7983360 : snow_str = snow_pcw + snow_sed
2617 :
2618 119460096 : icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver)
2619 119460096 : liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver)
2620 :
2621 : ! ------------------------------------------------------------ !
2622 : ! Compute in cloud ice and liquid mixing ratios !
2623 : ! Note that 'iclwp, iciwp' are used for radiation computation. !
2624 : ! ------------------------------------------------------------ !
2625 :
2626 131846400 : icinc = 0._r8
2627 131846400 : icwnc = 0._r8
2628 131846400 : iciwpst = 0._r8
2629 131846400 : iclwpst = 0._r8
2630 131846400 : icswp = 0._r8
2631 131846400 : cldfsnow = 0._r8
2632 241920 : if (micro_mg_version > 2) then
2633 0 : icgrauwp = 0._r8
2634 0 : cldfgrau = 0._r8
2635 : end if
2636 :
2637 7983360 : do k = top_lev, pver
2638 119460096 : do i = 1, ncol
2639 : ! Limits for in-cloud mixing ratios consistent with MG microphysics
2640 : ! in-cloud mixing ratio maximum limit of 0.005 kg/kg
2641 111476736 : icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 )
2642 111476736 : icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 )
2643 0 : icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * &
2644 111476736 : state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k))
2645 0 : icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * &
2646 111476736 : state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k))
2647 : ! Calculate micro_pumas_cam cloud water paths in each layer
2648 : ! Note: uses stratiform cloud fraction!
2649 111476736 : iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit
2650 111476736 : iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit
2651 :
2652 : ! ------------------------------ !
2653 : ! Adjust cloud fraction for snow !
2654 : ! ------------------------------ !
2655 111476736 : cldfsnow(i,k) = cld(i,k)
2656 : ! If cloud and only ice ( no convective cloud or ice ), then set to 0.
2657 0 : if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. &
2658 222953472 : ( concld(i,k) .lt. 1.e-4_r8 ) .and. &
2659 111476736 : ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then
2660 14535235 : cldfsnow(i,k) = 0._r8
2661 : end if
2662 : ! If no cloud and snow, then set to 0.25
2663 111476736 : if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then
2664 5844979 : cldfsnow(i,k) = 0.25_r8
2665 : end if
2666 : ! Calculate in-cloud snow water path
2667 111476736 : icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit
2668 :
2669 : ! --------------------------------- !
2670 : ! Adjust cloud fraction for graupel !
2671 : ! --------------------------------- !
2672 119218176 : if (micro_mg_version > 2) then
2673 0 : cldfgrau(i,k) = cld(i,k)
2674 : ! If cloud and only ice ( no convective cloud or ice ), then set to 0.
2675 0 : if( ( cldfgrau(i,k) .gt. 1.e-4_r8 ) .and. &
2676 0 : ( concld(i,k) .lt. 1.e-4_r8 ) .and. &
2677 0 : ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then
2678 0 : cldfgrau(i,k) = 0._r8
2679 : end if
2680 : ! If no cloud and graupel, then set to 0.25
2681 0 : if( ( cldfgrau(i,k) .le. 1.e-4_r8 ) .and. ( qgout(i,k) .gt. 1.e-9_r8 ) ) then
2682 0 : cldfgrau(i,k) = 0.25_r8
2683 : end if
2684 :
2685 : ! Calculate in-cloud snow water path
2686 0 : icgrauwp(i,k) = qgout(i,k) / max( 1.e-2_r8, cldfgrau(i,k) ) * state_loc%pdel(i,k) / gravit
2687 : end if
2688 :
2689 : end do
2690 : end do
2691 :
2692 : ! Calculate cloud fraction for prognostic precip sizes.
2693 241920 : if (micro_mg_version > 1) then
2694 : ! Cloud fraction for purposes of precipitation is maximum cloud
2695 : ! fraction out of all the layers that the precipitation may be
2696 : ! falling down from.
2697 119460096 : cldmax(:ncol,top_lev:) = max(mincld, ast(:ncol,top_lev:))
2698 7741440 : do k = top_lev+1, pver
2699 0 : where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. &
2700 123234048 : state_loc%q(:ncol,k-1,ixsnow) >= qsmall)
2701 7499520 : cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k))
2702 : end where
2703 : end do
2704 : end if
2705 :
2706 : ! ------------------------------------------------------ !
2707 : ! ------------------------------------------------------ !
2708 : ! All code from here to the end is on grid columns only !
2709 : ! ------------------------------------------------------ !
2710 : ! ------------------------------------------------------ !
2711 :
2712 : ! Average the fields which are needed later in this paramterization to be on the grid
2713 241920 : if (use_subcol_microp) then
2714 0 : call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid)
2715 0 : call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid)
2716 0 : call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid)
2717 0 : call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid)
2718 0 : call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid)
2719 0 : call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid)
2720 0 : call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid)
2721 0 : call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid)
2722 0 : call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid)
2723 0 : call subcol_field_avg(evapsnow, ngrdcol, lchnk, evpsnow_st_grid)
2724 0 : call subcol_field_avg(bergso, ngrdcol, lchnk, bergso_grid)
2725 :
2726 0 : call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid)
2727 :
2728 : ! Average fields which are not in pbuf
2729 0 : call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid)
2730 0 : call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid)
2731 0 : call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid)
2732 0 : call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid)
2733 0 : call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid)
2734 0 : call subcol_field_avg(qcreso, ngrdcol, lchnk, qcreso_grid)
2735 0 : call subcol_field_avg(melto, ngrdcol, lchnk, melto_grid)
2736 0 : call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid)
2737 0 : call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid)
2738 0 : call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid)
2739 0 : call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid)
2740 0 : call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid)
2741 0 : call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid)
2742 0 : call subcol_field_avg(cmeiout, ngrdcol, lchnk, cmeiout_grid)
2743 0 : call subcol_field_avg(qireso, ngrdcol, lchnk, qireso_grid)
2744 0 : call subcol_field_avg(prcio, ngrdcol, lchnk, prcio_grid)
2745 0 : call subcol_field_avg(praio, ngrdcol, lchnk, praio_grid)
2746 0 : call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid)
2747 0 : call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid)
2748 0 : call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid)
2749 0 : call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid)
2750 0 : call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid)
2751 0 : call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid)
2752 0 : call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid)
2753 0 : call subcol_field_avg(prao, ngrdcol, lchnk, prao_grid)
2754 0 : call subcol_field_avg(prco, ngrdcol, lchnk, prco_grid)
2755 :
2756 0 : call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid)
2757 0 : call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid)
2758 :
2759 0 : call subcol_field_avg(qcsedten, ngrdcol, lchnk, qcsedtenout_grid)
2760 0 : call subcol_field_avg(qisedten, ngrdcol, lchnk, qisedtenout_grid)
2761 0 : call subcol_field_avg(vtrmc, ngrdcol, lchnk, vtrmcout_grid)
2762 0 : call subcol_field_avg(vtrmi, ngrdcol, lchnk, vtrmiout_grid)
2763 0 : call subcol_field_avg(qcsevap, ngrdcol, lchnk, qcsevapout_grid)
2764 0 : call subcol_field_avg(qisevap, ngrdcol, lchnk, qisevapout_grid)
2765 :
2766 0 : if (micro_mg_version > 1) then
2767 0 : call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid)
2768 :
2769 0 : call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid)
2770 0 : call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid)
2771 0 : call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid)
2772 0 : call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid)
2773 0 : call subcol_field_avg(qrsedten, ngrdcol, lchnk, qrsedtenout_grid)
2774 0 : call subcol_field_avg(qssedten, ngrdcol, lchnk, qssedtenout_grid)
2775 0 : call subcol_field_avg(umr, ngrdcol, lchnk, umrout_grid)
2776 0 : call subcol_field_avg(ums, ngrdcol, lchnk, umsout_grid)
2777 : end if
2778 :
2779 0 : if (micro_mg_version > 2) then
2780 0 : call subcol_field_avg(state_loc%q(:,:,ixgraupel), ngrdcol, lchnk, qg_grid)
2781 0 : call subcol_field_avg(state_loc%q(:,:,ixnumgraupel), ngrdcol, lchnk, ng_grid)
2782 0 : call subcol_field_avg(psacro, ngrdcol, lchnk, psacro_grid)
2783 0 : call subcol_field_avg(pracgo, ngrdcol, lchnk, pracgo_grid)
2784 0 : call subcol_field_avg(psacwgo, ngrdcol, lchnk, psacwgo_grid)
2785 0 : call subcol_field_avg(pgsacwo, ngrdcol, lchnk, pgsacwo_grid)
2786 0 : call subcol_field_avg(pgracso, ngrdcol, lchnk, pgracso_grid)
2787 0 : call subcol_field_avg(prdgo, ngrdcol, lchnk, prdgo_grid)
2788 0 : call subcol_field_avg(qmultgo, ngrdcol, lchnk, qmultgo_grid)
2789 0 : call subcol_field_avg(qmultrgo, ngrdcol, lchnk, qmultrgo_grid)
2790 0 : call subcol_field_avg(npracgo, ngrdcol, lchnk, npracgo_grid)
2791 0 : call subcol_field_avg(nscngo, ngrdcol, lchnk, nscngo_grid)
2792 0 : call subcol_field_avg(ngracso, ngrdcol, lchnk, ngracso_grid)
2793 0 : call subcol_field_avg(nmultgo, ngrdcol, lchnk, nmultgo_grid)
2794 0 : call subcol_field_avg(nmultrgo, ngrdcol, lchnk, nmultrgo_grid)
2795 0 : call subcol_field_avg(npsacwgo, ngrdcol, lchnk, npsacwgo_grid)
2796 : end if
2797 :
2798 : else
2799 : ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg
2800 : ! as they are reset before being used, so it would be a needless calculation
2801 241920 : lambdac_grid => lambdac
2802 241920 : mu_grid => mu
2803 241920 : rel_grid => rel
2804 241920 : rei_grid => rei
2805 241920 : sadice_grid => sadice
2806 241920 : sadsnow_grid => sadsnow
2807 241920 : dei_grid => dei
2808 241920 : des_grid => des
2809 241920 : degrau_grid => degrau
2810 :
2811 : ! fields already on grids, so just assign
2812 241920 : prec_str_grid => prec_str
2813 241920 : iclwpst_grid => iclwpst
2814 241920 : cvreffliq_grid => cvreffliq
2815 241920 : cvreffice_grid => cvreffice
2816 241920 : mgflxprc_grid => mgflxprc
2817 241920 : mgflxsnw_grid => mgflxsnw
2818 241920 : qme_grid => qme
2819 241920 : nevapr_grid => nevapr
2820 241920 : prain_grid => prain
2821 241920 : bergso_grid => bergso
2822 :
2823 131846400 : am_evp_st_grid = am_evp_st
2824 :
2825 131846400 : evpsnow_st_grid = evapsnow
2826 131846400 : qrout_grid = qrout
2827 131846400 : qsout_grid = qsout
2828 131846400 : nsout_grid = nsout
2829 131846400 : nrout_grid = nrout
2830 131846400 : cld_grid = cld
2831 131846400 : qcreso_grid = qcreso
2832 131846400 : melto_grid = melto
2833 131846400 : mnuccco_grid = mnuccco
2834 131846400 : mnuccto_grid = mnuccto
2835 131846400 : bergo_grid = bergo
2836 131846400 : homoo_grid = homoo
2837 131846400 : msacwio_grid = msacwio
2838 131846400 : psacwso_grid = psacwso
2839 131846400 : cmeiout_grid = cmeiout
2840 131846400 : qireso_grid = qireso
2841 131846400 : prcio_grid = prcio
2842 131846400 : praio_grid = praio
2843 131846400 : icwmrst_grid = icwmrst
2844 131846400 : icimrst_grid = icimrst
2845 131846400 : liqcldf_grid = liqcldf
2846 131846400 : icecldf_grid = icecldf
2847 131846400 : icwnc_grid = icwnc
2848 131846400 : icinc_grid = icinc
2849 131846400 : pdel_grid = state_loc%pdel
2850 131846400 : prao_grid = prao
2851 131846400 : prco_grid = prco
2852 :
2853 131846400 : nc_grid = state_loc%q(:,:,ixnumliq)
2854 131846400 : ni_grid = state_loc%q(:,:,ixnumice)
2855 :
2856 131846400 : qcsedtenout_grid = qcsedten
2857 131846400 : qisedtenout_grid = qisedten
2858 131846400 : vtrmcout_grid = vtrmc
2859 131846400 : vtrmiout_grid = vtrmi
2860 131846400 : qcsevapout_grid = qcsevap
2861 131846400 : qisevapout_grid = qisevap
2862 :
2863 241920 : if (micro_mg_version > 1) then
2864 131846400 : cldmax_grid = cldmax
2865 :
2866 131846400 : qr_grid = state_loc%q(:,:,ixrain)
2867 131846400 : nr_grid = state_loc%q(:,:,ixnumrain)
2868 131846400 : qs_grid = state_loc%q(:,:,ixsnow)
2869 131846400 : ns_grid = state_loc%q(:,:,ixnumsnow)
2870 131846400 : qrsedtenout_grid = qrsedten
2871 131846400 : qssedtenout_grid = qssedten
2872 131846400 : umrout_grid = umr
2873 131846400 : umsout_grid = ums
2874 : end if
2875 :
2876 : ! Zero out terms for budgets if not mg3....
2877 241920 : psacwgo_grid = 0._r8
2878 241920 : pgsacwo_grid = 0._r8
2879 241920 : qmultgo_grid = 0._r8
2880 :
2881 241920 : if (micro_mg_version > 2) then
2882 0 : qg_grid = state_loc%q(:,:,ixgraupel)
2883 0 : ng_grid = state_loc%q(:,:,ixnumgraupel)
2884 0 : psacro_grid = psacro
2885 0 : pracgo_grid = pracgo
2886 0 : psacwgo_grid = psacwgo
2887 0 : pgsacwo_grid = pgsacwo
2888 0 : pgracso_grid = pgracso
2889 0 : prdgo_grid = prdgo
2890 0 : qmultgo_grid = qmultgo
2891 0 : qmultrgo_grid = qmultrgo
2892 0 : npracgo_grid = npracgo
2893 0 : nscngo_grid = nscngo
2894 0 : ngracso_grid = ngracso
2895 0 : nmultgo_grid = nmultgo
2896 0 : nmultrgo_grid = nmultrgo
2897 0 : npsacwgo_grid = npsacwgo
2898 : end if
2899 :
2900 :
2901 : end if
2902 :
2903 : ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in
2904 : ! this parameterization (no need to assign in the non-subcolumn case -- the else step)
2905 241920 : if (use_subcol_microp) then
2906 0 : call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid)
2907 0 : call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid)
2908 0 : call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid)
2909 0 : call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid)
2910 0 : call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid)
2911 0 : call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid)
2912 0 : call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid)
2913 0 : call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid)
2914 0 : call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid)
2915 0 : call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid)
2916 0 : call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid)
2917 0 : call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid)
2918 0 : call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid)
2919 0 : call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid)
2920 0 : call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid)
2921 0 : call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid)
2922 0 : call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid)
2923 0 : call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid)
2924 0 : call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid)
2925 :
2926 0 : if (micro_mg_version > 2) then
2927 0 : call subcol_field_avg(icgrauwp, ngrdcol, lchnk, icgrauwp_grid)
2928 0 : call subcol_field_avg(cldfgrau, ngrdcol, lchnk, cldfsnow_grid)
2929 : end if
2930 :
2931 0 : if (rate1_cw2pr_st_idx > 0) then
2932 0 : call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid)
2933 : end if
2934 :
2935 : end if
2936 :
2937 : ! ------------------------------------- !
2938 : ! Size distribution calculation !
2939 : ! ------------------------------------- !
2940 :
2941 : ! Calculate rho (on subcolumns if turned on) for size distribution
2942 : ! parameter calculations and average it if needed
2943 : !
2944 : ! State instead of state_loc to preserve answers for MG1 (and in any
2945 : ! case, it is unlikely to make much difference).
2946 483840 : rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / &
2947 119943936 : (rair*state%t(:ncol,top_lev:))
2948 241920 : if (use_subcol_microp) then
2949 0 : call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid)
2950 : else
2951 131846400 : rho_grid = rho
2952 : end if
2953 :
2954 : ! Effective radius for cloud liquid, fixed number.
2955 131846400 : mu_grid = 0._r8
2956 131846400 : lambdac_grid = 0._r8
2957 131846400 : rel_fn_grid = 10._r8
2958 :
2959 131846400 : ncic_grid = 1.e8_r8
2960 :
2961 7983360 : do k = top_lev, pver
2962 : !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k),rho_grid(:ngrdcol,k)) &
2963 : !$acc copy (ncic_grid(:ngrdcol,k)) &
2964 : !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k))
2965 0 : call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), &
2966 : ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), &
2967 7983360 : mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol)
2968 : !$acc end data
2969 : end do
2970 :
2971 119460096 : where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall)
2972 241920 : rel_fn_grid(:ngrdcol,top_lev:) = &
2973 241920 : (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ &
2974 241920 : lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8
2975 : end where
2976 :
2977 : ! Effective radius for cloud liquid, and size parameters
2978 : ! mu_grid and lambdac_grid.
2979 131846400 : mu_grid = 0._r8
2980 131846400 : lambdac_grid = 0._r8
2981 131846400 : rel_grid = 10._r8
2982 :
2983 : ! Calculate ncic on the grid
2984 : ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / &
2985 119460096 : max(mincld,liqcldf_grid(:ngrdcol,top_lev:))
2986 :
2987 7983360 : do k = top_lev, pver
2988 : !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k), rho_grid(:ngrdcol,k)) &
2989 : !$acc copy (ncic_grid(:ngrdcol,k)) &
2990 : !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k))
2991 0 : call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), &
2992 : ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), &
2993 7983360 : mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol)
2994 : !$acc end data
2995 : end do
2996 :
2997 477598464 : where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall)
2998 241920 : rel_grid(:ngrdcol,top_lev:) = &
2999 241920 : (mu_grid(:ngrdcol,top_lev:) + 3._r8) / &
3000 241920 : lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8
3001 : elsewhere
3002 : ! Deal with the fact that size_dist_param_liq sets mu_grid to -100
3003 : ! wherever there is no cloud.
3004 241920 : mu_grid(:ngrdcol,top_lev:) = 0._r8
3005 : end where
3006 :
3007 : ! Rain/Snow effective diameter.
3008 241920 : drout2_grid = 0._r8
3009 241920 : reff_rain_grid = 0._r8
3010 131846400 : des_grid = 0._r8
3011 241920 : dsout2_grid = 0._r8
3012 241920 : reff_snow_grid = 0._r8
3013 241920 : reff_grau_grid = 0._r8
3014 :
3015 241920 : if (micro_mg_version > 1) then
3016 : ! Prognostic precipitation
3017 :
3018 358138368 : where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
3019 : drout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
3020 241920 : qr_grid(:ngrdcol,top_lev:), &
3021 : nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
3022 : rho_grid(:ngrdcol,top_lev:), rhow)
3023 :
3024 : reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * &
3025 : 1.5_r8 * 1.e6_r8
3026 : end where
3027 :
3028 477598464 : where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
3029 : dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
3030 241920 : qs_grid(:ngrdcol,top_lev:), &
3031 : ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
3032 : rho_grid(:ngrdcol,top_lev:), rhosn)
3033 :
3034 241920 : des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *&
3035 : 3._r8 * rhosn/rhows
3036 :
3037 : reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * &
3038 : 1.5_r8 * 1.e6_r8
3039 : end where
3040 :
3041 : else
3042 : ! Diagnostic precipitation
3043 :
3044 0 : where (qrout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
3045 : drout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
3046 0 : qrout_grid(:ngrdcol,top_lev:), &
3047 : nrout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
3048 : rho_grid(:ngrdcol,top_lev:), rhow)
3049 :
3050 : reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * &
3051 : 1.5_r8 * 1.e6_r8
3052 : end where
3053 :
3054 0 : where (qsout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
3055 : dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
3056 0 : qsout_grid(:ngrdcol,top_lev:), &
3057 : nsout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
3058 : rho_grid(:ngrdcol,top_lev:), rhosn)
3059 :
3060 0 : des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) &
3061 : * 3._r8 * rhosn/rhows
3062 :
3063 : reff_snow_grid(:ngrdcol,top_lev:) = &
3064 : dsout2_grid(:ngrdcol,top_lev:) * 1.5_r8 * 1.e6_r8
3065 : end where
3066 :
3067 : end if
3068 :
3069 : ! Graupel/Hail size distribution Placeholder
3070 241920 : if (micro_mg_version > 2) then
3071 0 : degrau_grid = 0._r8
3072 0 : where (qg_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
3073 : dgout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
3074 0 : qg_grid(:ngrdcol,top_lev:), &
3075 : ng_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
3076 : rho_grid(:ngrdcol,top_lev:), rhog)
3077 :
3078 : reff_grau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) * &
3079 : 1.5_r8 * 1.e6_r8
3080 0 : degrau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) *&
3081 : 3._r8 * rhog/rhows
3082 : end where
3083 : end if
3084 :
3085 : ! Effective radius and diameter for cloud ice.
3086 131846400 : rei_grid = 25._r8
3087 :
3088 241920 : niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / &
3089 119702016 : max(mincld,icecldf_grid(:ngrdcol,top_lev:))
3090 :
3091 7983360 : do k = top_lev, pver
3092 : !$acc data copyin (mg_ice_props, icimrst_grid(:ngrdcol,k)) &
3093 : !$acc copy (niic_grid(:ngrdcol,k)) &
3094 : !$acc copyout (rei_grid(:ngrdcol,k))
3095 0 : call size_dist_param_basic(mg_ice_props,icimrst_grid(:ngrdcol,k), &
3096 7983360 : niic_grid(:ngrdcol,k),rei_grid(:ngrdcol,k),ngrdcol)
3097 : !$acc end data
3098 : end do
3099 :
3100 477598464 : where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall)
3101 241920 : rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) &
3102 : * 1.e6_r8
3103 : elsewhere
3104 241920 : rei_grid(:ngrdcol,top_lev:) = 25._r8
3105 : end where
3106 :
3107 263450880 : dei_grid = rei_grid * rhoi/rhows * 2._r8
3108 :
3109 : ! Limiters for low cloud fraction.
3110 7983360 : do k = top_lev, pver
3111 119460096 : do i = 1, ngrdcol
3112 : ! Convert snow effective diameter to microns
3113 111476736 : des_grid(i,k) = des_grid(i,k) * 1.e6_r8
3114 119218176 : if ( ast_grid(i,k) < 1.e-4_r8 ) then
3115 79478739 : mu_grid(i,k) = mucon
3116 79478739 : lambdac_grid(i,k) = (mucon + 1._r8)/dcon
3117 79478739 : dei_grid(i,k) = deicon
3118 : end if
3119 : end do
3120 : end do
3121 :
3122 119460096 : mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver)
3123 119460096 : mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver)
3124 :
3125 : ! ------------------------------------- !
3126 : ! Precipitation efficiency Calculation !
3127 : ! ------------------------------------- !
3128 :
3129 : !-----------------------------------------------------------------------
3130 : ! Liquid water path
3131 :
3132 : ! Compute liquid water paths, and column condensation
3133 3725568 : tgliqwp_grid(:ngrdcol) = 0._r8
3134 3725568 : tgcmeliq_grid(:ngrdcol) = 0._r8
3135 7983360 : do k = top_lev, pver
3136 119460096 : do i = 1, ngrdcol
3137 111476736 : tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k)
3138 :
3139 119218176 : if (cmeliq_grid(i,k) > 1.e-12_r8) then
3140 : !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s
3141 : tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * &
3142 9841493 : (pdel_grid(i,k) / gravit) / rhoh2o
3143 : end if
3144 : end do
3145 : end do
3146 :
3147 : ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s
3148 : ! this is 1ppmv of h2o in 10hpa
3149 : ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9
3150 :
3151 : !-----------------------------------------------------------------------
3152 : ! precipitation efficiency calculation (accumulate cme and precip)
3153 :
3154 : minlwp = 0.01_r8 !minimum lwp threshold (kg/m3)
3155 :
3156 : ! zero out precip efficiency and total averaged precip
3157 3725568 : pe_grid(:ngrdcol) = 0._r8
3158 3725568 : tpr_grid(:ngrdcol) = 0._r8
3159 3725568 : pefrac_grid(:ngrdcol) = 0._r8
3160 :
3161 : ! accumulate precip and condensation
3162 3725568 : do i = 1, ngrdcol
3163 :
3164 3483648 : acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i)
3165 3483648 : acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i)
3166 3483648 : acnum_grid(i) = acnum_grid(i) + 1
3167 :
3168 : ! if LWP is zero, then 'end of cloud': calculate precip efficiency
3169 3483648 : if (tgliqwp_grid(i) < minlwp) then
3170 1958941 : if (acprecl_grid(i) > 5.e-8_r8) then
3171 53345 : tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8)
3172 53345 : if (acgcme_grid(i) > 1.e-10_r8) then
3173 48930 : pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8)
3174 48930 : pefrac_grid(i) = 1._r8
3175 : end if
3176 : end if
3177 :
3178 : ! reset counters
3179 : ! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then
3180 : ! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', &
3181 : ! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i)
3182 : ! endif
3183 :
3184 1958941 : acprecl_grid(i) = 0._r8
3185 1958941 : acgcme_grid(i) = 0._r8
3186 1958941 : acnum_grid(i) = 0
3187 : end if ! end LWP zero conditional
3188 :
3189 : ! if never find any rain....(after 10^3 timesteps...)
3190 3725568 : if (acnum_grid(i) > 1000) then
3191 0 : acnum_grid(i) = 0
3192 0 : acprecl_grid(i) = 0._r8
3193 0 : acgcme_grid(i) = 0._r8
3194 : end if
3195 :
3196 : end do
3197 :
3198 : !-----------------------------------------------------------------------
3199 : ! vertical average of non-zero accretion, autoconversion and ratio.
3200 : ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid
3201 :
3202 241920 : vprao_grid = 0._r8
3203 241920 : cnt_grid = 0
3204 7983360 : do k = top_lev, pver
3205 119218176 : vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k)
3206 119460096 : where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1
3207 : end do
3208 :
3209 4112640 : where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid
3210 :
3211 241920 : vprco_grid = 0._r8
3212 241920 : cnt_grid = 0
3213 7983360 : do k = top_lev, pver
3214 119218176 : vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k)
3215 119460096 : where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1
3216 : end do
3217 :
3218 15724800 : where (cnt_grid > 0)
3219 : vprco_grid = vprco_grid/cnt_grid
3220 : racau_grid = vprao_grid/vprco_grid
3221 : elsewhere
3222 : racau_grid = 0._r8
3223 : end where
3224 :
3225 4112640 : racau_grid = min(racau_grid, 1.e10_r8)
3226 :
3227 : !-----------------------------------------------------------------------
3228 : ! Diagnostic Rainbow Calculation. Seriously.
3229 : !-----------------------------------------------------------------------
3230 :
3231 : ! Rainbows currently calculated on the grid, not subcolumn specific
3232 3725568 : do i = 1, ngrdcol
3233 :
3234 3483648 : top_idx = pver
3235 3483648 : convmx = 0._r8
3236 3483648 : frlow = 0._r8
3237 3483648 : cldmx = 0._r8
3238 118444032 : cldtot = maxval(ast(i,top_lev:))
3239 :
3240 : ! Find levels in surface layer
3241 114960384 : do k = top_lev, pver
3242 114960384 : if (state%pmid(i,k) > rb_pmin) then
3243 20198742 : top_idx = min(k,top_idx)
3244 : end if
3245 : end do
3246 :
3247 : !For all fractional precip calculated below, use maximum in surface layer.
3248 : !For convective precip, base on convective cloud area
3249 27535344 : convmx = maxval(concld(i,top_idx:))
3250 : !For stratiform precip, base on precip fraction
3251 27535344 : cldmx= maxval(freqr(i,top_idx:))
3252 : ! Combine and use maximum of strat or conv fraction
3253 3483648 : frlow= max(cldmx,convmx)
3254 :
3255 : !max precip
3256 27535344 : rmax=maxval(qrout_grid(i,top_idx:))
3257 :
3258 : ! Stratiform precip mixing ratio OR some convective precip
3259 : ! (rval = true if any sig precip)
3260 :
3261 3483648 : rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin))
3262 :
3263 : !Now can find conditions for a rainbow:
3264 : ! Maximum cloud cover (CLDTOT) < 0.5
3265 : ! 48 < SZA < 90
3266 : ! freqr (below rb_pmin) > 0.25
3267 : ! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s
3268 :
3269 3725568 : if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then
3270 :
3271 : !Rainbow 'probability' (area) derived from solid angle theory
3272 : !as the fraction of the hemisphere for a spherical cap with angle phi=sza-48.
3273 : ! This is only valid between 48 < sza < 90 (controlled for above).
3274 :
3275 73441 : rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow
3276 73441 : rbfreq(i) = 1.0_r8
3277 : end if
3278 :
3279 : end do ! end column loop for rainbows
3280 :
3281 241920 : call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3282 241920 : call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3283 :
3284 : ! --------------------- !
3285 : ! History Output Fields !
3286 : ! --------------------- !
3287 :
3288 : ! Column droplet concentration
3289 0 : cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * &
3290 115202304 : pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2)
3291 :
3292 : ! Averaging for new output fields
3293 241920 : efcout_grid = 0._r8
3294 241920 : efiout_grid = 0._r8
3295 241920 : ncout_grid = 0._r8
3296 241920 : niout_grid = 0._r8
3297 241920 : freql_grid = 0._r8
3298 241920 : freqi_grid = 0._r8
3299 241920 : icwmrst_grid_out = 0._r8
3300 241920 : icimrst_grid_out = 0._r8
3301 241920 : freqm_grid = 0._r8
3302 241920 : freqsl_grid = 0._r8
3303 241920 : freqslm_grid = 0._r8
3304 :
3305 7983360 : do k = top_lev, pver
3306 119460096 : do i = 1, ngrdcol
3307 111476736 : if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then
3308 4700228 : efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k)
3309 4700228 : ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k)
3310 4700228 : freql_grid(i,k) = liqcldf_grid(i,k)
3311 4700228 : icwmrst_grid_out(i,k) = icwmrst_grid(i,k)
3312 : end if
3313 111476736 : if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then
3314 7515921 : efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k)
3315 7515921 : niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k)
3316 7515921 : freqi_grid(i,k) = icecldf_grid(i,k)
3317 7515921 : icimrst_grid_out(i,k) = icimrst_grid(i,k)
3318 : end if
3319 :
3320 : ! Supercooled liquid
3321 111476736 : if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then
3322 275695 : freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k))
3323 : end if
3324 111476736 : if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
3325 2296429 : freqsl_grid(i,k)=liqcldf_grid(i,k)
3326 : end if
3327 119218176 : if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
3328 275685 : freqslm_grid(i,k)=liqcldf_grid(i,k)
3329 : end if
3330 :
3331 : end do
3332 : end do
3333 :
3334 : ! Cloud top effective radius and number.
3335 241920 : fcti_grid = 0._r8
3336 241920 : fctl_grid = 0._r8
3337 241920 : ctrel_grid = 0._r8
3338 241920 : ctrei_grid = 0._r8
3339 241920 : ctnl_grid = 0._r8
3340 241920 : ctni_grid = 0._r8
3341 241920 : fctm_grid = 0._r8
3342 241920 : fctsl_grid = 0._r8
3343 241920 : fctslm_grid= 0._r8
3344 :
3345 3725568 : do i = 1, ngrdcol
3346 72268571 : do k = top_lev, pver
3347 71492277 : if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then
3348 711695 : ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k)
3349 711695 : ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k)
3350 711695 : fctl_grid(i) = liqcldf_grid(i,k)
3351 :
3352 : ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed
3353 711695 : if (freqi_grid(i,k) > 0.01_r8) then
3354 42830 : fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k))
3355 : end if
3356 711695 : if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
3357 315872 : fctsl_grid(i)=liqcldf_grid(i,k)
3358 : end if
3359 711695 : if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
3360 42830 : fctslm_grid(i)=liqcldf_grid(i,k)
3361 : end if
3362 :
3363 : exit
3364 : end if
3365 :
3366 71314956 : if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then
3367 2237579 : ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k)
3368 2237579 : ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k)
3369 2237579 : fcti_grid(i) = icecldf_grid(i,k)
3370 2237579 : exit
3371 : end if
3372 : end do
3373 : end do
3374 :
3375 : ! Evaporation of stratiform precipitation fields for UNICON
3376 238678272 : evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver)
3377 7983360 : do k = top_lev, pver
3378 119460096 : do i = 1, ngrdcol
3379 111476736 : evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8)
3380 119218176 : evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8)
3381 : end do
3382 : end do
3383 :
3384 : ! Assign the values to the pbuf pointers if they exist in pbuf
3385 241920 : if (qrain_idx > 0) qrout_grid_ptr = qrout_grid
3386 241920 : if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid
3387 241920 : if (nrain_idx > 0) nrout_grid_ptr = nrout_grid
3388 241920 : if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid
3389 241920 : if (qcsedten_idx > 0) qcsedtenout_grid_ptr = qcsedtenout_grid
3390 241920 : if (qrsedten_idx > 0) qrsedtenout_grid_ptr = qrsedtenout_grid
3391 241920 : if (qisedten_idx > 0) qisedtenout_grid_ptr = qisedtenout_grid
3392 241920 : if (qssedten_idx > 0) qssedtenout_grid_ptr = qssedtenout_grid
3393 241920 : if (vtrmc_idx > 0) vtrmcout_grid_ptr = vtrmcout_grid
3394 241920 : if (umr_idx > 0) umrout_grid_ptr = umrout_grid
3395 241920 : if (vtrmi_idx > 0) vtrmiout_grid_ptr = vtrmiout_grid
3396 241920 : if (ums_idx > 0) umsout_grid_ptr = umsout_grid
3397 241920 : if (qcsevap_idx > 0 ) qcsevapout_grid_ptr = qcsevapout_grid
3398 241920 : if (qisevap_idx > 0 ) qisevapout_grid_ptr = qisevapout_grid
3399 :
3400 : ! --------------------------------------------- !
3401 : ! General outfield calls for microphysics !
3402 : ! --------------------------------------------- !
3403 :
3404 : ! Output a handle of variables which are calculated on the fly
3405 :
3406 241920 : ftem_grid = 0._r8
3407 :
3408 119460096 : ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver)
3409 241920 : call outfld( 'MPDW2V', ftem_grid, pcols, lchnk)
3410 :
3411 241920 : ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)&
3412 : - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)&
3413 119702016 : - msacwio_grid(:ngrdcol,top_lev:pver)
3414 241920 : call outfld( 'MPDW2I', ftem_grid, pcols, lchnk)
3415 :
3416 241920 : if (micro_mg_version > 2) then
3417 0 : ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)&
3418 0 : - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)&
3419 0 : - psacwgo_grid(:ngrdcol,top_lev:pver) - pgsacwo_grid(:ngrdcol,top_lev:pver)
3420 : else
3421 0 : ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)&
3422 119460096 : - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)
3423 : endif
3424 :
3425 241920 : call outfld( 'MPDW2P', ftem_grid, pcols, lchnk)
3426 :
3427 119460096 : ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver)
3428 241920 : call outfld( 'MPDI2V', ftem_grid, pcols, lchnk)
3429 :
3430 241920 : if (micro_mg_version > 2) then
3431 0 : ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) &
3432 : + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)&
3433 : + msacwio_grid(:ngrdcol,top_lev:pver)&
3434 0 : - qmultgo_grid(:ngrdcol,top_lev:pver)
3435 : else
3436 241920 : ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) &
3437 : + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)&
3438 119702016 : + msacwio_grid(:ngrdcol,top_lev:pver)
3439 : endif
3440 :
3441 241920 : call outfld( 'MPDI2W', ftem_grid, pcols, lchnk)
3442 :
3443 119460096 : ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver)
3444 241920 : call outfld( 'MPDI2P', ftem_grid, pcols, lchnk)
3445 :
3446 : ! Output fields which have not been averaged already, averaging if use_subcol_microp is true
3447 241920 : call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3448 241920 : call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3449 241920 : call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3450 241920 : call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3451 241920 : call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3452 241920 : call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3453 241920 : call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3454 241920 : call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3455 241920 : call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3456 241920 : call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3457 241920 : call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3458 241920 : call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3459 241920 : call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3460 241920 : call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3461 241920 : call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3462 241920 : call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3463 241920 : call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3464 241920 : call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3465 241920 : call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3466 241920 : call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3467 241920 : call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3468 241920 : call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3469 241920 : call outfld('MPDNLIQ', ncten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3470 241920 : call outfld('MPDNICE', niten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3471 241920 : call outfld('EVAPSNOW', evapsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3472 241920 : call outfld('QCSEVAP', qcsevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3473 241920 : call outfld('QISEVAP', qisevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3474 241920 : call outfld('QVRES', qvres, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3475 241920 : call outfld('VTRMC', vtrmc, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3476 241920 : call outfld('VTRMI', vtrmi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3477 241920 : call outfld('QCSEDTEN', qcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3478 241920 : call outfld('QISEDTEN', qisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3479 241920 : if (micro_mg_version > 1) then
3480 241920 : call outfld('QRSEDTEN', qrsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3481 241920 : call outfld('QSSEDTEN', qssedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3482 241920 : call outfld('MNUCCRIO', mnuccrio, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3483 241920 : call outfld('MNUDEPO', mnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3484 241920 : call outfld('MELTSTOT', meltstot, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3485 : end if
3486 241920 : call outfld('MNUCCDO', mnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3487 241920 : call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3488 241920 : call outfld('MNUCCRO', mnuccro, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3489 241920 : call outfld('PRACSO', pracso , psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3490 241920 : call outfld('MELTSDT', meltsdt, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3491 241920 : call outfld('FRZRDT', frzrdt , psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3492 241920 : call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3493 241920 : call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3494 :
3495 241920 : if (micro_mg_version > 1) then
3496 241920 : call outfld('UMR', umr, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3497 241920 : call outfld('UMS', ums, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3498 : end if
3499 :
3500 241920 : if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then
3501 241920 : call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3502 : end if
3503 :
3504 241920 : if (micro_mg_version > 2) then
3505 0 : call outfld('UMG', umg, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3506 0 : call outfld('QGSEDTEN', qgsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3507 0 : call outfld('FREQG', freqg, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3508 0 : call outfld('AQGRAU', qgout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3509 0 : call outfld('ANGRAU', ngout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3510 0 : call outfld('CLDFGRAU', cldfgrau, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3511 0 : call outfld('MELTGTOT', meltgtot, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
3512 :
3513 : end if
3514 :
3515 : ! Example subcolumn outfld call
3516 241920 : if (use_subcol_microp) then
3517 0 : call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk)
3518 0 : call outfld('MPDLIQ_SCOL', ptend%q(:,:,ixcldliq), psubcols*pcols, lchnk)
3519 0 : call outfld('MPDICE_SCOL', qiten, psubcols*pcols, lchnk)
3520 : end if
3521 :
3522 : ! Output fields which are already on the grid
3523 241920 : call outfld('QRAIN', qrout_grid, pcols, lchnk)
3524 241920 : call outfld('QSNOW', qsout_grid, pcols, lchnk)
3525 241920 : call outfld('NRAIN', nrout_grid, pcols, lchnk)
3526 241920 : call outfld('NSNOW', nsout_grid, pcols, lchnk)
3527 241920 : call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk)
3528 241920 : call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk)
3529 241920 : call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk)
3530 241920 : call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk)
3531 241920 : call outfld('CME', qme_grid, pcols, lchnk)
3532 241920 : call outfld('PRODPREC', prain_grid, pcols, lchnk)
3533 241920 : call outfld('EVAPPREC', nevapr_grid, pcols, lchnk)
3534 241920 : call outfld('QCRESO', qcreso_grid, pcols, lchnk)
3535 241920 : call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk)
3536 241920 : call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk)
3537 241920 : call outfld('DSNOW', des_grid, pcols, lchnk)
3538 241920 : call outfld('ADRAIN', drout2_grid, pcols, lchnk)
3539 241920 : call outfld('ADSNOW', dsout2_grid, pcols, lchnk)
3540 241920 : call outfld('PE', pe_grid, pcols, lchnk)
3541 241920 : call outfld('PEFRAC', pefrac_grid, pcols, lchnk)
3542 241920 : call outfld('APRL', tpr_grid, pcols, lchnk)
3543 241920 : call outfld('VPRAO', vprao_grid, pcols, lchnk)
3544 241920 : call outfld('VPRCO', vprco_grid, pcols, lchnk)
3545 241920 : call outfld('RACAU', racau_grid, pcols, lchnk)
3546 241920 : call outfld('AREL', efcout_grid, pcols, lchnk)
3547 241920 : call outfld('AREI', efiout_grid, pcols, lchnk)
3548 241920 : call outfld('AWNC' , ncout_grid, pcols, lchnk)
3549 241920 : call outfld('AWNI' , niout_grid, pcols, lchnk)
3550 241920 : call outfld('FREQL', freql_grid, pcols, lchnk)
3551 241920 : call outfld('FREQI', freqi_grid, pcols, lchnk)
3552 241920 : call outfld('ACTREL', ctrel_grid, pcols, lchnk)
3553 241920 : call outfld('ACTREI', ctrei_grid, pcols, lchnk)
3554 241920 : call outfld('ACTNL', ctnl_grid, pcols, lchnk)
3555 241920 : call outfld('ACTNI', ctni_grid, pcols, lchnk)
3556 241920 : call outfld('FCTL', fctl_grid, pcols, lchnk)
3557 241920 : call outfld('FCTI', fcti_grid, pcols, lchnk)
3558 241920 : call outfld('ICINC', icinc_grid, pcols, lchnk)
3559 241920 : call outfld('ICWNC', icwnc_grid, pcols, lchnk)
3560 241920 : call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk)
3561 241920 : call outfld('CDNUMC', cdnumc_grid, pcols, lchnk)
3562 241920 : call outfld('REL', rel_grid, pcols, lchnk)
3563 241920 : call outfld('REI', rei_grid, pcols, lchnk)
3564 241920 : call outfld('MG_SADICE', sadice_grid, pcols, lchnk)
3565 241920 : call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk)
3566 241920 : call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk)
3567 241920 : call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk)
3568 241920 : call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk)
3569 241920 : call outfld('PRAO', prao_grid, pcols, lchnk)
3570 241920 : call outfld('PRCO', prco_grid, pcols, lchnk)
3571 241920 : call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk)
3572 241920 : call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk)
3573 241920 : call outfld('MSACWIO', msacwio_grid, pcols, lchnk)
3574 241920 : call outfld('PSACWSO', psacwso_grid, pcols, lchnk)
3575 241920 : call outfld('BERGSO', bergso_grid, pcols, lchnk)
3576 241920 : call outfld('BERGO', bergo_grid, pcols, lchnk)
3577 241920 : call outfld('MELTO', melto_grid, pcols, lchnk)
3578 241920 : call outfld('HOMOO', homoo_grid, pcols, lchnk)
3579 241920 : call outfld('PRCIO', prcio_grid, pcols, lchnk)
3580 241920 : call outfld('PRAIO', praio_grid, pcols, lchnk)
3581 241920 : call outfld('QIRESO', qireso_grid, pcols, lchnk)
3582 241920 : call outfld('FREQM', freqm_grid, pcols, lchnk)
3583 241920 : call outfld('FREQSL', freqsl_grid, pcols, lchnk)
3584 241920 : call outfld('FREQSLM', freqslm_grid, pcols, lchnk)
3585 241920 : call outfld('FCTM', fctm_grid, pcols, lchnk)
3586 241920 : call outfld('FCTSL', fctsl_grid, pcols, lchnk)
3587 241920 : call outfld('FCTSLM', fctslm_grid, pcols, lchnk)
3588 :
3589 241920 : if (micro_mg_version > 2) then
3590 0 : call outfld('PRACGO', pracgo_grid, pcols, lchnk)
3591 0 : call outfld('PSACRO', psacro_grid, pcols, lchnk)
3592 0 : call outfld('PSACWGO', psacwgo_grid, pcols, lchnk)
3593 0 : call outfld('PGSACWO', pgsacwo_grid, pcols, lchnk)
3594 0 : call outfld('PGRACSO', pgracso_grid, pcols, lchnk)
3595 0 : call outfld('PRDGO', prdgo_grid, pcols, lchnk)
3596 0 : call outfld('QMULTGO', qmultgo_grid, pcols, lchnk)
3597 0 : call outfld('QMULTRGO', qmultrgo_grid, pcols, lchnk)
3598 0 : call outfld('LS_REFFGRAU', reff_grau_grid, pcols, lchnk)
3599 0 : call outfld ('NPRACGO', npracgo_grid, pcols, lchnk)
3600 0 : call outfld ('NSCNGO', nscngo_grid, pcols, lchnk)
3601 0 : call outfld ('NGRACSO', ngracso_grid, pcols, lchnk)
3602 0 : call outfld ('NMULTGO', nmultgo_grid, pcols, lchnk)
3603 0 : call outfld ('NMULTRGO', nmultrgo_grid, pcols, lchnk)
3604 0 : call outfld ('NPSACWGO', npsacwgo_grid, pcols, lchnk)
3605 : end if
3606 :
3607 241920 : if (micro_mg_adjust_cpt) then
3608 0 : cp_rh(:ncol, :pver) = 0._r8
3609 :
3610 0 : do i = 1, ncol
3611 :
3612 : ! Calculate the RH including any T change that we make.
3613 0 : do k = top_lev, pver
3614 0 : call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs)
3615 0 : cp_rh(i,k) = state_loc%q(i, k, ixq) / qs * 100._r8
3616 : end do
3617 : end do
3618 :
3619 0 : call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk)
3620 : end if
3621 :
3622 : ! ptend_loc is deallocated in physics_update above
3623 241920 : call physics_state_dealloc(state_loc)
3624 :
3625 241920 : if (qsatfac_idx <= 0) then
3626 0 : deallocate(qsatfac)
3627 : end if
3628 :
3629 725760 : end subroutine micro_pumas_cam_tend
3630 :
3631 0 : subroutine massless_droplet_destroyer(ztodt, state, ptend)
3632 :
3633 : ! This subroutine eradicates cloud droplets in grid boxes with no cloud
3634 : ! mass. This code is now expanded to remove massless rain drops, ice
3635 : ! crystals, and snow flakes.
3636 : !
3637 : ! Note: qsmall, which is a small, positive number, is used as the
3638 : ! threshold here instead of qmin, which is 0. Some numbers that are
3639 : ! supposed to have a value of 0, but don't because of numerical
3640 : ! roundoff (especially after hole filling) will have small, positive
3641 : ! values. Using qsmall as the threshold here instead of qmin allows
3642 : ! for unreasonable massless drop concentrations to be removed in
3643 : ! those scenarios.
3644 :
3645 241920 : use micro_pumas_utils, only: qsmall
3646 : use ref_pres, only: top_lev => trop_cloud_top_lev
3647 :
3648 : implicit none
3649 :
3650 : ! Input Variables
3651 : real(r8), intent(in) :: ztodt ! model time increment
3652 : type(physics_state), intent(in) :: state ! state for columns
3653 :
3654 : ! Input/Output Variables
3655 : type(physics_ptend), intent(inout) :: ptend ! ptend for columns
3656 :
3657 : ! Local Variables
3658 : integer :: icol, k
3659 :
3660 : !----- Begin Code -----
3661 :
3662 : ! Don't do anything if this option isn't enabled.
3663 0 : if ( .not. micro_do_massless_droplet_destroyer ) return
3664 :
3665 0 : col_loop: do icol=1, state%ncol
3666 0 : vert_loop: do k = top_lev, pver
3667 : ! If updated qc (after microphysics) is zero, then ensure updated nc is also zero!!
3668 0 : if ( state%q(icol,k,ixcldliq) + ztodt * ptend%q(icol,k,ixcldliq) < qsmall ) then
3669 0 : ptend%lq(ixnumliq) = .true. ! This is probably already true, but it doesn't
3670 : ! hurt to set it.
3671 0 : ptend%q(icol,k,ixnumliq) = -(state%q(icol,k,ixnumliq) / ztodt)
3672 : end if
3673 0 : if ( ixnumrain > 0 ) then
3674 : ! If updated qr (after microphysics) is zero, then ensure updated nr is also zero!!
3675 0 : if ( state%q(icol,k,ixrain) + ztodt * ptend%q(icol,k,ixrain) < qsmall ) then
3676 0 : ptend%lq(ixnumrain) = .true. ! This is probably already true, but it doesn't
3677 : ! hurt to set it.
3678 0 : ptend%q(icol,k,ixnumrain) = -(state%q(icol,k,ixnumrain) / ztodt)
3679 : end if
3680 : endif ! ixnumrain > 0
3681 : ! If updated qi (after microphysics) is zero, then ensure updated ni is also zero!!
3682 0 : if ( state%q(icol,k,ixcldice) + ztodt * ptend%q(icol,k,ixcldice) < qsmall ) then
3683 0 : ptend%lq(ixnumice) = .true. ! This is probably already true, but it doesn't
3684 : ! hurt to set it.
3685 0 : ptend%q(icol,k,ixnumice) = -(state%q(icol,k,ixnumice) / ztodt)
3686 : end if
3687 0 : if ( ixnumsnow > 0 ) then
3688 : ! If updated qs (after microphysics) is zero, then ensure updated ns is also zero!!
3689 0 : if ( state%q(icol,k,ixsnow) + ztodt * ptend%q(icol,k,ixsnow) < qsmall ) then
3690 0 : ptend%lq(ixnumsnow) = .true. ! This is probably already true, but it doesn't
3691 : ! hurt to set it.
3692 0 : ptend%q(icol,k,ixnumsnow) = -(state%q(icol,k,ixnumsnow) / ztodt)
3693 : end if
3694 : endif ! ixnumsnow > 0
3695 : end do vert_loop
3696 : end do col_loop
3697 :
3698 : return
3699 0 : end subroutine massless_droplet_destroyer
3700 :
3701 : end module micro_pumas_cam
|
