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