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