Line data Source code
1 : module clubb_intr
2 :
3 : !----------------------------------------------------------------------------------------------------- !
4 : ! Module to interface CAM with Cloud Layers Unified by Bi-normals (CLUBB), developed !
5 : ! by the University of Wisconsin Milwaukee Group (UWM). !
6 : ! !
7 : ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 !
8 : ! !
9 : ! Lastly, a implicit diffusion solver is called, and tendencies retrieved by !
10 : ! differencing the diffused and initial states. !
11 : ! !
12 : ! Calling sequence: !
13 : ! !
14 : !---------------------------Code history-------------------------------------------------------------- !
15 : ! Authors: P. Bogenschutz, C. Craig, A. Gettelman !
16 : ! Modified by: K Thayer-Calder !
17 : ! !
18 : !----------------------------------------------------------------------------------------------------- !
19 :
20 : use shr_kind_mod, only: r8=>shr_kind_r8
21 : use ppgrid, only: pver, pverp, pcols, begchunk, endchunk
22 : use phys_control, only: phys_getopts
23 : use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi
24 : use air_composition, only: rairv, cpairv
25 : use cam_history_support, only: max_fieldname_len
26 :
27 : use spmd_utils, only: masterproc
28 : use constituents, only: pcnst, cnst_add
29 : use pbl_utils, only: calc_ustar, calc_obklen
30 : use ref_pres, only: top_lev => trop_cloud_top_lev
31 :
32 : #ifdef CLUBB_SGS
33 : use clubb_api_module, only: pdf_parameter, implicit_coefs_terms
34 : use clubb_api_module, only: clubb_config_flags_type, grid, stats, &
35 : nu_vertical_res_dep, stats_metadata_type
36 : use clubb_api_module, only: nparams
37 : use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag
38 : use cloud_fraction, only: dp1, dp2
39 : #endif
40 :
41 : implicit none
42 : #ifdef CLUBB_SGS
43 : ! Variables that contains all the statistics
44 :
45 : type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid
46 : stats_zm(pcols), & ! stats_zm grid
47 : stats_rad_zt(pcols), & ! stats_rad_zt grid
48 : stats_rad_zm(pcols), & ! stats_rad_zm grid
49 : stats_sfc(pcols) ! stats_sfc
50 :
51 : type (stats_metadata_type) :: &
52 : stats_metadata
53 :
54 :
55 : #endif
56 :
57 : private
58 : save
59 :
60 : ! ----------------- !
61 : ! Public interfaces !
62 : ! ----------------- !
63 :
64 : public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, clubb_emissions_cam, &
65 : #ifdef CLUBB_SGS
66 : ! This utilizes CLUBB specific variables in its interface
67 : stats_init_clubb, &
68 : stats_metadata, &
69 : stats_zt, stats_zm, stats_sfc, &
70 : stats_rad_zt, stats_rad_zm, &
71 : stats_end_timestep_clubb, &
72 : #endif
73 : clubb_readnl, &
74 : clubb_init_cnst, &
75 : clubb_implements_cnst
76 :
77 : #ifdef CLUBB_SGS
78 : ! Both of these utilize CLUBB specific variables in their interface
79 : private :: stats_zero, stats_avg
80 : #endif
81 :
82 : logical, public :: do_cldcool
83 : logical :: clubb_do_icesuper
84 :
85 : #ifdef CLUBB_SGS
86 : type(clubb_config_flags_type), public :: clubb_config_flags
87 : real(r8), dimension(nparams), public :: clubb_params ! Adjustable CLUBB parameters (C1, C2 ...)
88 : #endif
89 :
90 : ! ------------ !
91 : ! Private data !
92 : ! ------------ !
93 :
94 : integer, parameter :: &
95 : grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels
96 : hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements
97 :
98 : ! Even though sclr_dim is set to 0, the dimension here is set to 1 to prevent compiler errors
99 : ! See github ticket larson-group/cam#133 for details
100 : real(r8), parameter, dimension(1) :: &
101 : sclr_tol = 1.e-8_r8 ! Total water in kg/kg
102 :
103 : character(len=6) :: saturation_equation
104 :
105 : real(r8), parameter :: &
106 : theta0 = 300._r8, & ! Reference temperature [K]
107 : ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s]
108 : p0_clubb = 100000._r8
109 :
110 : integer, parameter :: &
111 : sclr_dim = 0 ! Higher-order scalars, set to zero
112 :
113 : real(r8), parameter :: &
114 : wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected
115 :
116 : real(r8), parameter :: &
117 : wpthlp_const = 10.0_r8 ! Constant to add to wpthlp when moments are advected
118 :
119 : real(r8), parameter :: &
120 : wprtp_const = 0.01_r8 ! Constant to add to wprtp when moments are advected
121 :
122 : real(r8), parameter :: &
123 : rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected
124 :
125 : real(r8), parameter :: unset_r8 = huge(1.0_r8)
126 : integer, parameter :: unset_i = huge(1)
127 :
128 : ! Commonly used temperature for the melting temp of ice crystals [K]
129 : real(r8), parameter :: meltpt_temp = 268.15_r8
130 :
131 : real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist
132 : real(r8) :: clubb_rnevap_effic = unset_r8
133 :
134 : real(r8) :: clubb_c1 = unset_r8
135 : real(r8) :: clubb_c1b = unset_r8
136 : real(r8) :: clubb_C2rt = unset_r8
137 : real(r8) :: clubb_C2thl = unset_r8
138 : real(r8) :: clubb_C2rtthl = unset_r8
139 : real(r8) :: clubb_C4 = unset_r8
140 : real(r8) :: clubb_C6rt = unset_r8
141 : real(r8) :: clubb_c6rtb = unset_r8
142 : real(r8) :: clubb_c6rtc = unset_r8
143 : real(r8) :: clubb_c6thl = unset_r8
144 : real(r8) :: clubb_c6thlb = unset_r8
145 : real(r8) :: clubb_c6thlc = unset_r8
146 : real(r8) :: clubb_C8 = unset_r8
147 : real(r8) :: clubb_C8b = unset_r8
148 : real(r8) :: clubb_C7 = unset_r8
149 : real(r8) :: clubb_C7b = unset_r8
150 : real(r8) :: clubb_c11 = unset_r8
151 : real(r8) :: clubb_c11b = unset_r8
152 : real(r8) :: clubb_c14 = unset_r8
153 : real(r8) :: clubb_C_wp3_pr_turb = unset_r8
154 : real(r8) :: clubb_c_K1 = unset_r8
155 : real(r8) :: clubb_c_K2 = unset_r8
156 : real(r8) :: clubb_nu2 = unset_r8
157 : real(r8) :: clubb_c_K8 = unset_r8
158 : real(r8) :: clubb_c_K9 = unset_r8
159 : real(r8) :: clubb_nu9 = unset_r8
160 : real(r8) :: clubb_c_K10 = unset_r8
161 : real(r8) :: clubb_c_K10h = unset_r8
162 : real(r8) :: clubb_C_invrs_tau_bkgnd = unset_r8
163 : real(r8) :: clubb_C_invrs_tau_sfc = unset_r8
164 : real(r8) :: clubb_C_invrs_tau_shear = unset_r8
165 : real(r8) :: clubb_C_invrs_tau_N2 = unset_r8
166 : real(r8) :: clubb_C_invrs_tau_N2_wp2 = unset_r8
167 : real(r8) :: clubb_C_invrs_tau_N2_xp2 = unset_r8
168 : real(r8) :: clubb_C_invrs_tau_N2_wpxp = unset_r8
169 : real(r8) :: clubb_C_invrs_tau_N2_clear_wp3 = unset_r8
170 : real(r8) :: clubb_C_uu_shr = unset_r8
171 : real(r8) :: clubb_C_uu_buoy = unset_r8
172 : real(r8) :: clubb_gamma_coef = unset_r8
173 : real(r8) :: clubb_gamma_coefb = unset_r8
174 : real(r8) :: clubb_beta = unset_r8
175 : real(r8) :: clubb_lambda0_stability_coef = unset_r8
176 : real(r8) :: clubb_lmin_coef = unset_r8
177 : real(r8) :: clubb_mult_coef = unset_r8
178 : real(r8) :: clubb_Skw_denom_coef = unset_r8
179 : real(r8) :: clubb_skw_max_mag = unset_r8
180 : real(r8) :: clubb_up2_sfc_coef = unset_r8
181 : real(r8) :: clubb_C_wp2_splat = unset_r8
182 : real(r8) :: clubb_wpxp_L_thresh = unset_r8
183 : real(r8) :: clubb_detliq_rad = unset_r8
184 : real(r8) :: clubb_detice_rad = unset_r8
185 : real(r8) :: clubb_detphase_lowtemp = unset_r8
186 : real(r8) :: clubb_bv_efold = unset_r8
187 : real(r8) :: clubb_wpxp_Ri_exp = unset_r8
188 : real(r8) :: clubb_z_displace = unset_r8
189 :
190 : integer :: &
191 : clubb_iiPDF_type, & ! Selected option for the two-component normal
192 : ! (double Gaussian) PDF type to use for the w, rt,
193 : ! and theta-l (or w, chi, and eta) portion of
194 : ! CLUBB's multivariate, two-component PDF.
195 : clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to
196 : ! CLUBB's PDF.
197 : clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system
198 : clubb_tridiag_solve_method = unset_i ! Specifier for method to solve tri-diagonal systems
199 :
200 :
201 :
202 : logical :: &
203 : clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The
204 : ! precipitation fraction is automatically set to 1 when this
205 : ! flag is turned off.
206 : clubb_l_predict_upwp_vpwp, & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v>
207 : ! alongside the advancement of <rt>, <w'rt'>, <thl>,
208 : ! <w'thl'>, <sclr>, and <w'sclr'> in subroutine
209 : ! advance_xm_wpxp. Otherwise, <u'w'> and <v'w'> are still
210 : ! approximated by eddy diffusivity when <u> and <v> are
211 : ! advanced in subroutine advance_windm_edsclrm.
212 : clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping
213 : ! the overall correlation of w and x (w and rt, as well as w
214 : ! and theta-l) within the limits of -max_mag_correlation_flux
215 : ! to max_mag_correlation_flux.
216 : clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and
217 : ! thlp2) on keeping the overall correlation of w and x within
218 : ! the limits of -max_mag_correlation_flux to
219 : ! max_mag_correlation_flux.
220 : clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the
221 : ! turbulent dissipation coefficient, C2.
222 : clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm
223 : clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor
224 : clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2
225 : clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind
226 : ! differencing approximation rather than a centered
227 : ! differencing for turbulent or mean advection terms. It
228 : ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, &
229 : ! sclrpthlp.
230 : clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind
231 : ! differencing approximation rather than a centered
232 : ! differencing for turbulent or mean advection terms. It
233 : ! affects rtm, thlm, sclrm, um and vm.
234 : clubb_l_uv_nudge, & ! For wind speed nudging.
235 : clubb_l_rtm_nudge, & ! For rtm nudging
236 : clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e.
237 : ! TKE = 1/2 (u'^2 + v'^2 + w'^2)
238 : clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to
239 : ! compute the varibles that are output from high order
240 : ! closure
241 : clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the
242 : ! thermodynamic-level variables output from pdf_closure.
243 : clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three
244 : ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp -
245 : ! output from pdf_closure.
246 : clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call
247 : ! subroutine pdf_closure twice. If true, pdf_closure is
248 : ! called first on thermodynamic levels and then on momentum
249 : ! levels so that each variable is computed on its native
250 : ! level. If false, pdf_closure is only called on
251 : ! thermodynamic levels, and variables which belong on
252 : ! momentum levels are interpolated.
253 : clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection
254 : ! terms. Setting to .false. means that a_1 and a_3 are
255 : ! pulled outside of the derivative in
256 : ! advance_wp2_wp3_module.F90 and in
257 : ! advance_xp2_xpyp_module.F90.
258 : clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather
259 : ! than a centered discretization for the portion
260 : ! of the wp3 turbulent advection term for ADG1
261 : ! that is linearized in terms of wp3<t+1>.
262 : ! (Requires ADG1 PDF and clubb_l_standard_term_ta).
263 : clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind
264 : ! differencing approximation rather than a centered
265 : ! differencing for turbulent advection terms.
266 : ! It affects wpxp only.
267 : clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind
268 : ! differencing approximation rather than a centered
269 : ! differencing for turbulent advection terms. It affects
270 : ! xpyp only.
271 : clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac
272 : ! and rcm to help increase cloudiness at coarser grid
273 : ! resolutions.
274 : clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones
275 : clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors
276 : clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K)
277 : clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta)
278 : clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability
279 : ! correction
280 : clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of
281 : ! -(2/3)*em/tau_zm, as in Bougeault (1981)
282 : clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly
283 : clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values
284 : clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the
285 : ! mixing length scale as Lscale = tau * tke
286 : clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number
287 : clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number
288 : clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number
289 : clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in
290 : ! saturated atmospheres (from Durran and Klemp, 1982)
291 : clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency
292 : clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water
293 : clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping
294 : clubb_l_e3sm_config, & ! Run model with E3SM settings
295 : clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using
296 : ! a variable estimate of layer depth based on the depth
297 : ! over which wpthlp is positive near the ground when true
298 : ! More information can be found by
299 : ! Looking at issue #905 on the clubb repo
300 : clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term
301 : clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3
302 : clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test
303 : clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau
304 : clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test
305 : clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats
306 : clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds
307 : clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and
308 : ! rtpthlp
309 : clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4
310 : clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz
311 : clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner
312 : clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm
313 : clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm
314 : clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um
315 : clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm
316 : clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that
317 : ! eliminates spurious drying tendencies at model top
318 : clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes
319 :
320 : ! Constant parameters
321 : logical, parameter, private :: &
322 : l_implemented = .true., & ! Implemented in a host model (always true)
323 : l_host_applies_sfc_fluxes = .false. ! Whether the host model applies the surface fluxes
324 :
325 : logical, parameter, private :: &
326 : apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh))
327 :
328 : logical :: lq(pcnst)
329 : logical :: prog_modal_aero
330 : logical :: do_rainturb
331 : logical :: clubb_do_adv
332 : logical :: clubb_do_liqsupersat = .false.
333 : logical :: clubb_do_energyfix = .true.
334 : logical :: history_budget
335 : logical :: do_hb_above_clubb = .false.
336 : integer :: history_budget_histfile_num
337 : integer :: edsclr_dim ! Number of scalars to transport in CLUBB
338 : integer :: offset
339 :
340 : ! define physics buffer indicies here
341 : integer :: &
342 : wp2_idx, & ! vertical velocity variances
343 : wp3_idx, & ! third moment of vertical velocity
344 : wpthlp_idx, & ! turbulent flux of thetal
345 : wprtp_idx, & ! turbulent flux of total water
346 : rtpthlp_idx, & ! covariance of thetal and rt
347 : rtp2_idx, & ! variance of total water
348 : thlp2_idx, & ! variance of thetal
349 : rtp3_idx, & ! total water 3rd order
350 : thlp3_idx, & ! thetal 3rd order
351 : up2_idx, & ! variance of east-west wind
352 : vp2_idx, & ! variance of north-south wind
353 : up3_idx, & ! east-west wind 3rd order
354 : vp3_idx, & ! north-south wind 3rd order
355 : upwp_idx, & ! east-west momentum flux
356 : vpwp_idx, & ! north-south momentum flux
357 : thlm_idx, & ! mean thetal
358 : rtm_idx, & ! mean total water mixing ratio
359 : um_idx, & ! mean of east-west wind
360 : vm_idx, & ! mean of north-south wind
361 : wpthvp_idx, & ! buoyancy flux
362 : wp2thvp_idx, & ! second order buoyancy term
363 : rtpthvp_idx, & ! moisture buoyancy correlation
364 : thlpthvp_idx, & ! temperature buoyancy correlation
365 : sclrpthvp_idx, & ! passive scalar buoyancy correlation
366 : wp2rtp_idx, & ! w'^2 rt'
367 : wp2thlp_idx, & ! w'^2 thl'
368 : uprcp_idx, & ! < u' r_c' >
369 : vprcp_idx, & ! < v' r_c' >
370 : rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34)
371 : wp4_idx, & ! w'^4
372 : wpup2_idx, & ! w'u'^2
373 : wpvp2_idx, & ! w'v'^2
374 : wp2up2_idx, & ! w'^2 u'^2
375 : wp2vp2_idx, & ! w'^2 v'^2
376 : cloud_frac_idx, & ! CLUBB's cloud fraction
377 : cld_idx, & ! Cloud fraction
378 : concld_idx, & ! Convective cloud fraction
379 : ast_idx, & ! Stratiform cloud fraction
380 : alst_idx, & ! Liquid stratiform cloud fraction
381 : aist_idx, & ! Ice stratiform cloud fraction
382 : qlst_idx, & ! Physical in-cloud LWC
383 : qist_idx, & ! Physical in-cloud IWC
384 : dp_frac_idx, & ! deep convection cloud fraction
385 : sh_frac_idx, & ! shallow convection cloud fraction
386 : kvh_idx, & ! CLUBB eddy diffusivity on thermo levels
387 : pblh_idx, & ! PBL pbuf
388 : icwmrdp_idx, & ! In cloud mixing ratio for deep convection
389 : tke_idx, & ! turbulent kinetic energy
390 : tpert_idx, & ! temperature perturbation from PBL
391 : fice_idx, & ! fice_idx index in physics buffer
392 : cmeliq_idx, & ! cmeliq_idx index in physics buffer
393 : relvar_idx, & ! relative cloud water variance
394 : accre_enhan_idx, & ! optional accretion enhancement factor for MG
395 : npccn_idx, & ! liquid ccn number concentration
396 : naai_idx, & ! ice number concentration
397 : prer_evap_idx, & ! rain evaporation rate
398 : qrl_idx, & ! longwave cooling rate
399 : radf_idx, &
400 : qsatfac_idx, & ! subgrid cloud water saturation scaling factor
401 : ice_supersat_idx, & ! ice cloud fraction for SILHS
402 : rcm_idx, & ! Cloud water mixing ratio for SILHS
403 : ztodt_idx,& ! physics timestep for SILHS
404 : clubbtop_idx ! level index for CLUBB top
405 :
406 : ! Indices for microphysical covariance tendencies
407 : integer :: &
408 : rtp2_mc_zt_idx, &
409 : thlp2_mc_zt_idx, &
410 : wprtp_mc_zt_idx, &
411 : wpthlp_mc_zt_idx, &
412 : rtpthlp_mc_zt_idx
413 :
414 : integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2
415 : pdf_zm_w_1_idx, &
416 : pdf_zm_w_2_idx, &
417 : pdf_zm_varnce_w_1_idx, &
418 : pdf_zm_varnce_w_2_idx, &
419 : pdf_zm_mixt_frac_idx
420 :
421 : integer, public :: &
422 : ixthlp2 = 0, &
423 : ixwpthlp = 0, &
424 : ixwprtp = 0, &
425 : ixwp2 = 0, &
426 : ixwp3 = 0, &
427 : ixrtpthlp = 0, &
428 : ixrtp2 = 0, &
429 : ixup2 = 0, &
430 : ixvp2 = 0
431 :
432 : integer :: cmfmc_sh_idx = 0
433 :
434 : integer :: &
435 : dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio.
436 : difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio.
437 : dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen.
438 : dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen.
439 :
440 : ! Output arrays for CLUBB statistics
441 : real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc
442 :
443 : character(len=16) :: eddy_scheme ! Default set in phys_control.F90
444 : character(len=16) :: deep_scheme ! Default set in phys_control.F90
445 : character(len=16) :: subcol_scheme
446 :
447 : integer, parameter :: ncnst=9
448 : character(len=8) :: cnst_names(ncnst)
449 : logical :: do_cnst=.false.
450 :
451 : #ifdef CLUBB_SGS
452 : type(pdf_parameter), target, allocatable, public, protected :: &
453 : pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary]
454 :
455 : type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary]
456 :
457 : type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary]
458 : #endif
459 :
460 : contains
461 :
462 : ! =============================================================================== !
463 : ! !
464 : ! =============================================================================== !
465 :
466 178008 : subroutine clubb_register_cam( )
467 : !-------------------------------------------------------------------------------
468 : ! Description:
469 : ! Register the constituents and fields in the physics buffer
470 : ! Author: P. Bogenschutz, C. Craig, A. Gettelman
471 : ! Modified: 7/2013 by K Thayer-Calder to include support for SILHS/subcolumns
472 : !
473 : !-------------------------------------------------------------------------------
474 : #ifdef CLUBB_SGS
475 :
476 : !------------------------------------------------ !
477 : ! Register physics buffer fields and constituents !
478 : !------------------------------------------------ !
479 :
480 : ! Add CLUBB fields to pbuf
481 : use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4, dyn_time_lvls
482 : use subcol_utils, only: subcol_get_scheme
483 :
484 : !----- Begin Code -----
485 : call phys_getopts( eddy_scheme_out = eddy_scheme, &
486 : deep_scheme_out = deep_scheme, &
487 : history_budget_out = history_budget, &
488 : history_budget_histfile_num_out = history_budget_histfile_num, &
489 1536 : do_hb_above_clubb_out = do_hb_above_clubb)
490 1536 : subcol_scheme = subcol_get_scheme()
491 :
492 1536 : if (trim(subcol_scheme) == 'SILHS') then
493 0 : saturation_equation = "flatau"
494 : else
495 1536 : saturation_equation = "gfdl" ! Goff & Gratch (1946) approximation for SVP
496 : end if
497 :
498 1536 : if (clubb_do_adv) then
499 0 : cnst_names =(/'THLP2 ','RTP2 ','RTPTHLP','WPTHLP ','WPRTP ','WP2 ','WP3 ','UP2 ','VP2 '/)
500 0 : do_cnst=.true.
501 : ! If CLUBB moments are advected, do not output them automatically which is typically done. Some moments
502 : ! need a constant added to them before they are advected, thus this would corrupt the output.
503 : ! Users should refer to the "XXXX_CLUBB" (THLP2_CLUBB for instance) output variables for these moments
504 0 : call cnst_add(trim(cnst_names(1)),0._r8,0._r8,0._r8,ixthlp2,longname='second moment vertical velocity',cam_outfld=.false.)
505 0 : call cnst_add(trim(cnst_names(2)),0._r8,0._r8,0._r8,ixrtp2,longname='second moment rtp',cam_outfld=.false.)
506 0 : call cnst_add(trim(cnst_names(3)),0._r8,0._r8,-999999._r8,ixrtpthlp,longname='covariance rtp thlp',cam_outfld=.false.)
507 0 : call cnst_add(trim(cnst_names(4)),0._r8,0._r8,-999999._r8,ixwpthlp,longname='CLUBB heat flux',cam_outfld=.false.)
508 0 : call cnst_add(trim(cnst_names(5)),0._r8,0._r8,-999999._r8,ixwprtp,longname='CLUBB moisture flux',cam_outfld=.false.)
509 0 : call cnst_add(trim(cnst_names(6)),0._r8,0._r8,0._r8,ixwp2,longname='CLUBB wp2',cam_outfld=.false.)
510 0 : call cnst_add(trim(cnst_names(7)),0._r8,0._r8,-999999._r8,ixwp3,longname='CLUBB 3rd moment vert velocity',cam_outfld=.false.)
511 0 : call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.)
512 0 : call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.)
513 : end if
514 1536 : if (do_hb_above_clubb) then
515 1536 : call pbuf_add_field('clubbtop', 'physpkg', dtype_i4, (/pcols/), clubbtop_idx)
516 : endif
517 :
518 : ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top
519 1536 : call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx)
520 1536 : call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx)
521 1536 : call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx)
522 1536 : call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx)
523 6144 : call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx)
524 6144 : call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx)
525 6144 : call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx)
526 6144 : call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx)
527 6144 : call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx)
528 6144 : call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx)
529 6144 : call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx)
530 1536 : call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx)
531 1536 : call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx)
532 1536 : call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx)
533 1536 : call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx)
534 :
535 :
536 6144 : call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx)
537 6144 : call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx)
538 6144 : call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx)
539 6144 : call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx)
540 6144 : call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx)
541 6144 : call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx)
542 6144 : call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx)
543 6144 : call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx)
544 6144 : call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx)
545 :
546 6144 : call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp3_idx)
547 6144 : call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp3_idx)
548 6144 : call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up3_idx)
549 6144 : call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp3_idx)
550 :
551 6144 : call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx)
552 6144 : call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx)
553 6144 : call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlm_idx)
554 6144 : call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtm_idx)
555 6144 : call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), um_idx)
556 6144 : call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx)
557 :
558 1536 : call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx)
559 1536 : call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pverp/), wp2thvp_idx)
560 1536 : call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx)
561 1536 : call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx)
562 1536 : call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pverp/), cloud_frac_idx)
563 1536 : call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pverp/), ice_supersat_idx)
564 1536 : call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx)
565 1536 : call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx)
566 1536 : call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx)
567 1536 : call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx)
568 1536 : call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx)
569 1536 : call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx)
570 1536 : call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx)
571 1536 : call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx)
572 1536 : call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx)
573 1536 : call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx)
574 1536 : call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx)
575 1536 : call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx)
576 :
577 : ! For SILHS microphysical covariance contributions
578 1536 : call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx)
579 1536 : call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pverp/), thlp2_mc_zt_idx)
580 1536 : call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pverp/), wprtp_mc_zt_idx)
581 1536 : call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx)
582 1536 : call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx)
583 :
584 6144 : call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx)
585 6144 : call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx)
586 6144 : call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx)
587 6144 : call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx)
588 6144 : call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx)
589 :
590 : #endif
591 :
592 1536 : end subroutine clubb_register_cam
593 : ! =============================================================================== !
594 : ! !
595 : ! =============================================================================== !
596 :
597 0 : function clubb_implements_cnst(name)
598 :
599 : !----------------------------------------------------------------------------- !
600 : ! !
601 : ! Return true if specified constituent is implemented by this package !
602 : ! !
603 : !----------------------------------------------------------------------------- !
604 :
605 : character(len=*), intent(in) :: name ! constituent name
606 : logical :: clubb_implements_cnst ! return value
607 :
608 : !-----------------------------------------------------------------------
609 :
610 0 : clubb_implements_cnst = (do_cnst .and. any(name == cnst_names))
611 :
612 1536 : end function clubb_implements_cnst
613 :
614 :
615 : ! =============================================================================== !
616 : ! !
617 : ! =============================================================================== !
618 :
619 0 : subroutine clubb_init_cnst(name, latvals, lonvals, mask, q)
620 : #ifdef CLUBB_SGS
621 : use clubb_api_module, only: w_tol_sqd, rt_tol, thl_tol
622 : #endif
623 :
624 : !----------------------------------------------------------------------- !
625 : ! !
626 : ! Initialize the state if clubb_do_adv !
627 : ! !
628 : !----------------------------------------------------------------------- !
629 :
630 : character(len=*), intent(in) :: name ! constituent name
631 : real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
632 : real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
633 : logical, intent(in) :: mask(:) ! Only initialize where .true.
634 : real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev
635 :
636 : !-----------------------------------------------------------------------
637 : integer :: k, nlev
638 :
639 : #ifdef CLUBB_SGS
640 0 : if (clubb_do_adv) then
641 0 : nlev = size(q, 2)
642 0 : do k = 1, nlev
643 0 : if (trim(name) == trim(cnst_names(1))) then
644 0 : where(mask)
645 0 : q(:,k) = thl_tol**2
646 : end where
647 : end if
648 0 : if (trim(name) == trim(cnst_names(2))) then
649 0 : where(mask)
650 0 : q(:,k) = rt_tol**2
651 : end where
652 : end if
653 0 : if (trim(name) == trim(cnst_names(3))) then
654 0 : where(mask)
655 0 : q(:,k) = 0.0_r8
656 : end where
657 : end if
658 0 : if (trim(name) == trim(cnst_names(4))) then
659 0 : where(mask)
660 0 : q(:,k) = 0.0_r8
661 : end where
662 : end if
663 0 : if (trim(name) == trim(cnst_names(5))) then
664 0 : where(mask)
665 0 : q(:,k) = 0.0_r8
666 : end where
667 : end if
668 0 : if (trim(name) == trim(cnst_names(6))) then
669 0 : where(mask)
670 0 : q(:,k) = w_tol_sqd
671 : end where
672 : end if
673 0 : if (trim(name) == trim(cnst_names(7))) then
674 0 : where(mask)
675 0 : q(:,k) = 0.0_r8
676 : end where
677 : end if
678 0 : if (trim(name) == trim(cnst_names(8))) then
679 0 : where(mask)
680 0 : q(:,k) = w_tol_sqd
681 : end where
682 : end if
683 0 : if (trim(name) == trim(cnst_names(9))) then
684 0 : where(mask)
685 0 : q(:,k) = w_tol_sqd
686 : end where
687 : end if
688 : end do
689 : end if
690 : #endif
691 :
692 0 : end subroutine clubb_init_cnst
693 :
694 :
695 : ! =============================================================================== !
696 : ! !
697 : ! =============================================================================== !
698 :
699 1536 : subroutine clubb_readnl(nlfile)
700 :
701 : #ifdef CLUBB_SGS
702 : use namelist_utils, only: find_group_name
703 : use units, only: getunit, freeunit
704 : use cam_abortutils, only: endrun
705 : use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, &
706 : mpi_integer
707 : use clubb_mf, only: clubb_mf_readnl
708 :
709 : use clubb_api_module, only: &
710 : set_default_clubb_config_flags_api, & ! Procedure(s)
711 : initialize_clubb_config_flags_type_api
712 : #endif
713 :
714 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
715 :
716 : #ifdef CLUBB_SGS
717 :
718 : character(len=*), parameter :: sub = 'clubb_readnl'
719 :
720 : logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F)
721 : logical :: clubb_cloudtop_cooling = .false., clubb_rainevap_turb = .false.
722 :
723 : integer :: iunit, read_status, ierr
724 :
725 : namelist /clubb_his_nl/ clubb_history, clubb_rad_history
726 : namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, &
727 : clubb_do_adv, clubb_timestep, &
728 : clubb_rnevap_effic,clubb_do_icesuper
729 : namelist /clubb_params_nl/ clubb_beta, &
730 : clubb_bv_efold, &
731 : clubb_c1, &
732 : clubb_c1b, &
733 : clubb_c11, &
734 : clubb_c11b, &
735 : clubb_c14, &
736 : clubb_C2rt, &
737 : clubb_C2rtthl, &
738 : clubb_C2thl, &
739 : clubb_C4, &
740 : clubb_c6rt, &
741 : clubb_c6rtb, &
742 : clubb_c6rtc, &
743 : clubb_c6thl, &
744 : clubb_c6thlb, &
745 : clubb_c6thlc, &
746 : clubb_C7, &
747 : clubb_C7b, &
748 : clubb_C8, &
749 : clubb_C8b, &
750 : clubb_C_invrs_tau_bkgnd, &
751 : clubb_C_invrs_tau_sfc, &
752 : clubb_C_invrs_tau_shear, &
753 : clubb_C_invrs_tau_N2, &
754 : clubb_C_invrs_tau_N2_clear_wp3, &
755 : clubb_C_invrs_tau_N2_wp2, &
756 : clubb_C_invrs_tau_N2_wpxp, &
757 : clubb_C_invrs_tau_N2_xp2, &
758 : clubb_c_K1, &
759 : clubb_c_K10, &
760 : clubb_c_K10h, &
761 : clubb_c_K2, &
762 : clubb_c_K8, &
763 : clubb_c_K9, &
764 : clubb_C_uu_shr, &
765 : clubb_C_uu_buoy, &
766 : clubb_C_wp2_splat, &
767 : clubb_C_wp3_pr_turb, &
768 : clubb_detice_rad, &
769 : clubb_detliq_rad, &
770 : clubb_detphase_lowtemp, &
771 : clubb_do_energyfix, &
772 : clubb_do_liqsupersat, &
773 : clubb_gamma_coef, &
774 : clubb_gamma_coefb, &
775 : clubb_iiPDF_type, &
776 : clubb_ipdf_call_placement, &
777 : clubb_lambda0_stability_coef, &
778 : clubb_lmin_coef, &
779 : clubb_l_brunt_vaisala_freq_moist, &
780 : clubb_l_C2_cloud_frac, &
781 : clubb_l_calc_thlp2_rad, &
782 : clubb_l_calc_w_corr, &
783 : clubb_l_call_pdf_closure_twice, &
784 : clubb_l_const_Nc_in_cloud, &
785 : clubb_l_damp_wp2_using_em, &
786 : clubb_l_damp_wp3_Skw_squared, &
787 : clubb_l_diag_Lscale_from_tau, &
788 : clubb_l_diagnose_correlations, &
789 : clubb_l_diffuse_rtm_and_thlm, &
790 : clubb_l_do_expldiff_rtm_thlm, &
791 : clubb_l_e3sm_config, &
792 : clubb_l_enable_relaxed_clipping, &
793 : clubb_l_fix_w_chi_eta_correlations, &
794 : clubb_l_godunov_upwind_wpxp_ta, &
795 : clubb_l_godunov_upwind_xpyp_ta, &
796 : clubb_l_intr_sfc_flux_smooth, &
797 : clubb_l_lmm_stepping, &
798 : clubb_l_lscale_plume_centered, &
799 : clubb_l_min_wp2_from_corr_wx, &
800 : clubb_l_min_xp2_from_corr_wx, &
801 : clubb_l_modify_limiters_for_cnvg_test, &
802 : clubb_l_mono_flux_lim_rtm, &
803 : clubb_l_mono_flux_lim_spikefix, &
804 : clubb_l_mono_flux_lim_thlm, &
805 : clubb_l_mono_flux_lim_um, &
806 : clubb_l_mono_flux_lim_vm, &
807 : clubb_l_partial_upwind_wp3, &
808 : clubb_l_predict_upwp_vpwp, &
809 : clubb_l_prescribed_avg_deltaz, &
810 : clubb_l_rcm_supersat_adj, &
811 : clubb_l_rtm_nudge, &
812 : clubb_l_smooth_Heaviside_tau_wpxp, &
813 : clubb_l_stability_correct_Kh_N2_zm, &
814 : clubb_l_stability_correct_tau_zm, &
815 : clubb_l_standard_term_ta, &
816 : clubb_l_tke_aniso, &
817 : clubb_l_trapezoidal_rule_zm, &
818 : clubb_l_trapezoidal_rule_zt, &
819 : clubb_l_upwind_xm_ma, &
820 : clubb_l_upwind_xpyp_ta, &
821 : clubb_l_use_C11_Richardson, &
822 : clubb_l_use_C7_Richardson, &
823 : clubb_l_use_cloud_cover, &
824 : clubb_l_use_precip_frac, &
825 : clubb_l_use_shear_Richardson, &
826 : clubb_l_use_thvm_in_bv_freq, &
827 : clubb_l_use_tke_in_wp2_wp3_K_dfsn, &
828 : clubb_l_use_tke_in_wp3_pr_turb_term, &
829 : clubb_l_use_wp3_lim_with_smth_Heaviside, &
830 : clubb_l_uv_nudge, &
831 : clubb_l_vary_convect_depth, &
832 : clubb_l_vert_avg_closure, &
833 : clubb_mult_coef, &
834 : clubb_nu2, &
835 : clubb_nu9, &
836 : clubb_penta_solve_method, &
837 : clubb_Skw_denom_coef, &
838 : clubb_skw_max_mag, &
839 : clubb_tridiag_solve_method, &
840 : clubb_up2_sfc_coef, &
841 : clubb_wpxp_L_thresh, &
842 : clubb_wpxp_Ri_exp, &
843 : clubb_z_displace
844 :
845 : !----- Begin Code -----
846 :
847 : ! Determine if we want clubb_history to be output
848 1536 : clubb_history = .false. ! Initialize to false
849 1536 : stats_metadata%l_stats = .false. ! Initialize to false
850 1536 : stats_metadata%l_output_rad_files = .false. ! Initialize to false
851 1536 : do_cldcool = .false. ! Initialize to false
852 1536 : do_rainturb = .false. ! Initialize to false
853 :
854 : ! Initialize namelist variables to clubb defaults
855 : call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out
856 : clubb_ipdf_call_placement, & ! Out
857 : clubb_penta_solve_method, & ! Out
858 : clubb_tridiag_solve_method, & ! Out
859 : clubb_l_use_precip_frac, & ! Out
860 : clubb_l_predict_upwp_vpwp, & ! Out
861 : clubb_l_min_wp2_from_corr_wx, & ! Out
862 : clubb_l_min_xp2_from_corr_wx, & ! Out
863 : clubb_l_C2_cloud_frac, & ! Out
864 : clubb_l_diffuse_rtm_and_thlm, & ! Out
865 : clubb_l_stability_correct_Kh_N2_zm, & ! Out
866 : clubb_l_calc_thlp2_rad, & ! Out
867 : clubb_l_upwind_xpyp_ta, & ! Out
868 : clubb_l_upwind_xm_ma, & ! Out
869 : clubb_l_uv_nudge, & ! Out
870 : clubb_l_rtm_nudge, & ! Out
871 : clubb_l_tke_aniso, & ! Out
872 : clubb_l_vert_avg_closure, & ! Out
873 : clubb_l_trapezoidal_rule_zt, & ! Out
874 : clubb_l_trapezoidal_rule_zm, & ! Out
875 : clubb_l_call_pdf_closure_twice, & ! Out
876 : clubb_l_standard_term_ta, & ! Out
877 : clubb_l_partial_upwind_wp3, & ! Out
878 : clubb_l_godunov_upwind_wpxp_ta, & ! Out
879 : clubb_l_godunov_upwind_xpyp_ta, & ! Out
880 : clubb_l_use_cloud_cover, & ! Out
881 : clubb_l_diagnose_correlations, & ! Out
882 : clubb_l_calc_w_corr, & ! Out
883 : clubb_l_const_Nc_in_cloud, & ! Out
884 : clubb_l_fix_w_chi_eta_correlations, & ! Out
885 : clubb_l_stability_correct_tau_zm, & ! Out
886 : clubb_l_damp_wp2_using_em, & ! Out
887 : clubb_l_do_expldiff_rtm_thlm, & ! Out
888 : clubb_l_Lscale_plume_centered, & ! Out
889 : clubb_l_diag_Lscale_from_tau, & ! Out
890 : clubb_l_use_C7_Richardson, & ! Out
891 : clubb_l_use_C11_Richardson, & ! Out
892 : clubb_l_use_shear_Richardson, & ! Out
893 : clubb_l_brunt_vaisala_freq_moist, & ! Out
894 : clubb_l_use_thvm_in_bv_freq, & ! Out
895 : clubb_l_rcm_supersat_adj, & ! Out
896 : clubb_l_damp_wp3_Skw_squared, & ! Out
897 : clubb_l_prescribed_avg_deltaz, & ! Out
898 : clubb_l_lmm_stepping, & ! Out
899 : clubb_l_e3sm_config, & ! Out
900 : clubb_l_vary_convect_depth, & ! Out
901 : clubb_l_use_tke_in_wp3_pr_turb_term, & ! Out
902 : clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Out
903 : clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Out
904 : clubb_l_smooth_Heaviside_tau_wpxp, & ! Out
905 : clubb_l_modify_limiters_for_cnvg_test, & ! Out
906 : clubb_l_enable_relaxed_clipping, & ! Out
907 : clubb_l_linearize_pbl_winds, & ! Out
908 : clubb_l_mono_flux_lim_thlm, & ! Out
909 : clubb_l_mono_flux_lim_rtm, & ! Out
910 : clubb_l_mono_flux_lim_um, & ! Out
911 : clubb_l_mono_flux_lim_vm, & ! Out
912 1536 : clubb_l_mono_flux_lim_spikefix ) ! Out
913 :
914 : ! Call CLUBB+MF namelist
915 1536 : call clubb_mf_readnl(nlfile)
916 :
917 : ! Read namelist to determine if CLUBB history should be called
918 1536 : if (masterproc) then
919 2 : iunit = getunit()
920 2 : open( iunit, file=trim(nlfile), status='old' )
921 :
922 2 : call find_group_name(iunit, 'clubb_his_nl', status=read_status)
923 2 : if (read_status == 0) then
924 2 : read(unit=iunit, nml=clubb_his_nl, iostat=read_status)
925 2 : if (read_status /= 0) then
926 0 : call endrun('clubb_readnl: error reading namelist')
927 : end if
928 : end if
929 :
930 2 : call find_group_name(iunit, 'clubb_params_nl', status=read_status)
931 2 : if (read_status == 0) then
932 2 : read(unit=iunit, nml=clubb_params_nl, iostat=read_status)
933 2 : if (read_status /= 0) then
934 0 : call endrun('clubb_readnl: error reading namelist')
935 : end if
936 : else
937 0 : call endrun('clubb_readnl: error reading namelist')
938 : end if
939 :
940 2 : call find_group_name(iunit, 'clubbpbl_diff_nl', status=read_status)
941 2 : if (read_status == 0) then
942 2 : read(unit=iunit, nml=clubbpbl_diff_nl, iostat=read_status)
943 2 : if (read_status /= 0) then
944 0 : call endrun('clubb_readnl: error reading namelist')
945 : end if
946 : end if
947 :
948 2 : close(unit=iunit)
949 2 : call freeunit(iunit)
950 : end if
951 :
952 : ! Broadcast namelist variables
953 1536 : call mpi_bcast(clubb_history, 1, mpi_logical, mstrid, mpicom, ierr)
954 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_history")
955 1536 : call mpi_bcast(clubb_rad_history, 1, mpi_logical, mstrid, mpicom, ierr)
956 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rad_history")
957 1536 : call mpi_bcast(clubb_do_icesuper, 1, mpi_logical, mstrid, mpicom, ierr)
958 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_icesuper")
959 1536 : call mpi_bcast(clubb_cloudtop_cooling, 1, mpi_logical, mstrid, mpicom, ierr)
960 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling")
961 1536 : call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr)
962 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb")
963 1536 : call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr)
964 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv")
965 1536 : call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr)
966 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_timestep")
967 1536 : call mpi_bcast(clubb_rnevap_effic, 1, mpi_real8, mstrid, mpicom, ierr)
968 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rnevap_effic")
969 :
970 1536 : call mpi_bcast(clubb_c1, 1, mpi_real8, mstrid, mpicom, ierr)
971 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c1")
972 1536 : call mpi_bcast(clubb_c1b, 1, mpi_real8, mstrid, mpicom, ierr)
973 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c1b")
974 1536 : call mpi_bcast(clubb_c11, 1, mpi_real8, mstrid, mpicom, ierr)
975 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11")
976 1536 : call mpi_bcast(clubb_c11b, 1, mpi_real8, mstrid, mpicom, ierr)
977 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b")
978 1536 : call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr)
979 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14")
980 1536 : call mpi_bcast(clubb_C_wp3_pr_turb, 1, mpi_real8, mstrid, mpicom, ierr)
981 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp3_pr_turb")
982 1536 : call mpi_bcast(clubb_c6rt, 1, mpi_real8, mstrid, mpicom, ierr)
983 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rt")
984 1536 : call mpi_bcast(clubb_c6rtb, 1, mpi_real8, mstrid, mpicom, ierr)
985 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rtb")
986 1536 : call mpi_bcast(clubb_c6rtc, 1, mpi_real8, mstrid, mpicom, ierr)
987 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rtc")
988 1536 : call mpi_bcast(clubb_c6thl, 1, mpi_real8, mstrid, mpicom, ierr)
989 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thl")
990 1536 : call mpi_bcast(clubb_c6thlb, 1, mpi_real8, mstrid, mpicom, ierr)
991 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thlb")
992 1536 : call mpi_bcast(clubb_c6thlc, 1, mpi_real8, mstrid, mpicom, ierr)
993 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thlc")
994 1536 : call mpi_bcast(clubb_wpxp_L_thresh, 1, mpi_real8, mstrid, mpicom, ierr)
995 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_wpxp_L_thresh")
996 1536 : call mpi_bcast(clubb_mult_coef, 1, mpi_real8, mstrid, mpicom, ierr)
997 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mult_coef")
998 1536 : call mpi_bcast(clubb_gamma_coef, 1, mpi_real8, mstrid, mpicom, ierr)
999 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coef")
1000 1536 : call mpi_bcast(clubb_c_K10, 1, mpi_real8, mstrid, mpicom, ierr)
1001 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10")
1002 1536 : call mpi_bcast(clubb_c_K10h, 1, mpi_real8, mstrid, mpicom, ierr)
1003 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h")
1004 1536 : call mpi_bcast(clubb_beta, 1, mpi_real8, mstrid, mpicom, ierr)
1005 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_beta")
1006 1536 : call mpi_bcast(clubb_C2rt, 1, mpi_real8, mstrid, mpicom, ierr)
1007 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rt")
1008 1536 : call mpi_bcast(clubb_C2thl, 1, mpi_real8, mstrid, mpicom, ierr)
1009 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2thl")
1010 1536 : call mpi_bcast(clubb_C2rtthl, 1, mpi_real8, mstrid, mpicom, ierr)
1011 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rtthl")
1012 1536 : call mpi_bcast(clubb_C8, 1, mpi_real8, mstrid, mpicom, ierr)
1013 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C8")
1014 1536 : call mpi_bcast(clubb_C8b, 1, mpi_real8, mstrid, mpicom, ierr)
1015 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C8b")
1016 1536 : call mpi_bcast(clubb_C7, 1, mpi_real8, mstrid, mpicom, ierr)
1017 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7")
1018 1536 : call mpi_bcast(clubb_C7b, 1, mpi_real8, mstrid, mpicom, ierr)
1019 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b")
1020 1536 : call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr)
1021 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef")
1022 1536 : call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr)
1023 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C4")
1024 1536 : call mpi_bcast(clubb_C_uu_shr, 1, mpi_real8, mstrid, mpicom, ierr)
1025 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_shr")
1026 1536 : call mpi_bcast(clubb_C_uu_buoy, 1, mpi_real8, mstrid, mpicom, ierr)
1027 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_buoy")
1028 1536 : call mpi_bcast(clubb_c_K1, 1, mpi_real8, mstrid, mpicom, ierr)
1029 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K1")
1030 1536 : call mpi_bcast(clubb_c_K2, 1, mpi_real8, mstrid, mpicom, ierr)
1031 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K2")
1032 1536 : call mpi_bcast(clubb_nu2, 1, mpi_real8, mstrid, mpicom, ierr)
1033 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu2")
1034 1536 : call mpi_bcast(clubb_c_K8, 1, mpi_real8, mstrid, mpicom, ierr)
1035 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K8")
1036 1536 : call mpi_bcast(clubb_c_K9, 1, mpi_real8, mstrid, mpicom, ierr)
1037 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K9")
1038 1536 : call mpi_bcast(clubb_nu9, 1, mpi_real8, mstrid, mpicom, ierr)
1039 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu9")
1040 1536 : call mpi_bcast(clubb_C_wp2_splat, 1, mpi_real8, mstrid, mpicom, ierr)
1041 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp2_splat")
1042 1536 : call mpi_bcast(clubb_bv_efold, 1, mpi_real8, mstrid, mpicom, ierr)
1043 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_bv_efold")
1044 1536 : call mpi_bcast(clubb_wpxp_Ri_exp, 1, mpi_real8, mstrid, mpicom, ierr)
1045 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_wpxp_Ri_exp")
1046 1536 : call mpi_bcast(clubb_z_displace, 1, mpi_real8, mstrid, mpicom, ierr)
1047 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_z_displace")
1048 1536 : call mpi_bcast(clubb_lambda0_stability_coef, 1, mpi_real8, mstrid, mpicom, ierr)
1049 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef")
1050 1536 : call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr)
1051 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered")
1052 1536 : call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr)
1053 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat")
1054 1536 : call mpi_bcast(clubb_do_energyfix, 1, mpi_logical, mstrid, mpicom, ierr)
1055 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_energyfix")
1056 1536 : call mpi_bcast(clubb_C_invrs_tau_bkgnd, 1, mpi_real8, mstrid, mpicom, ierr)
1057 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd")
1058 1536 : call mpi_bcast(clubb_C_invrs_tau_sfc, 1, mpi_real8, mstrid, mpicom, ierr)
1059 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc")
1060 1536 : call mpi_bcast(clubb_C_invrs_tau_shear, 1, mpi_real8, mstrid, mpicom, ierr)
1061 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear")
1062 1536 : call mpi_bcast(clubb_C_invrs_tau_N2, 1, mpi_real8, mstrid, mpicom, ierr)
1063 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2")
1064 1536 : call mpi_bcast(clubb_C_invrs_tau_N2_wp2, 1, mpi_real8, mstrid, mpicom, ierr)
1065 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2")
1066 1536 : call mpi_bcast(clubb_C_invrs_tau_N2_xp2, 1, mpi_real8, mstrid, mpicom, ierr)
1067 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2")
1068 1536 : call mpi_bcast(clubb_C_invrs_tau_N2_wpxp, 1, mpi_real8, mstrid, mpicom, ierr)
1069 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp")
1070 1536 : call mpi_bcast(clubb_C_invrs_tau_N2_clear_wp3, 1, mpi_real8, mstrid, mpicom, ierr)
1071 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3")
1072 1536 : call mpi_bcast(clubb_lmin_coef, 1, mpi_real8, mstrid, mpicom, ierr)
1073 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lmin_coef")
1074 1536 : call mpi_bcast(clubb_skw_max_mag, 1, mpi_real8, mstrid, mpicom, ierr)
1075 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_skw_max_mag")
1076 1536 : call mpi_bcast(clubb_l_stability_correct_tau_zm, 1, mpi_real8, mstrid, mpicom, ierr)
1077 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_tau_zm")
1078 1536 : call mpi_bcast(clubb_gamma_coefb, 1, mpi_real8, mstrid, mpicom, ierr)
1079 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coefb")
1080 1536 : call mpi_bcast(clubb_up2_sfc_coef, 1, mpi_real8, mstrid, mpicom, ierr)
1081 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_sfc_coef")
1082 1536 : call mpi_bcast(clubb_detliq_rad, 1, mpi_real8, mstrid, mpicom, ierr)
1083 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detliq_rad")
1084 1536 : call mpi_bcast(clubb_detice_rad, 1, mpi_real8, mstrid, mpicom, ierr)
1085 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detice_rad")
1086 1536 : call mpi_bcast(clubb_detphase_lowtemp, 1, mpi_real8, mstrid, mpicom, ierr)
1087 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detphase_lowtemp")
1088 1536 : call mpi_bcast(clubb_iiPDF_type, 1, mpi_integer, mstrid, mpicom, ierr)
1089 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_iiPDF_type")
1090 :
1091 1536 : call mpi_bcast(clubb_l_use_C7_Richardson, 1, mpi_logical, mstrid, mpicom, ierr)
1092 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C7_Richardson")
1093 1536 : call mpi_bcast(clubb_l_use_C11_Richardson, 1, mpi_logical, mstrid, mpicom, ierr)
1094 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C11_Richardson")
1095 1536 : call mpi_bcast(clubb_l_use_shear_Richardson, 1, mpi_logical, mstrid, mpicom, ierr)
1096 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_shear_Richardson")
1097 1536 : call mpi_bcast(clubb_l_brunt_vaisala_freq_moist, 1, mpi_logical, mstrid, mpicom, ierr)
1098 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_brunt_vaisala_freq_moist")
1099 1536 : call mpi_bcast(clubb_l_use_thvm_in_bv_freq, 1, mpi_logical, mstrid, mpicom, ierr)
1100 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_thvm_in_bv_freq")
1101 1536 : call mpi_bcast(clubb_l_rcm_supersat_adj, 1, mpi_logical, mstrid, mpicom, ierr)
1102 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_rcm_supersat_adj")
1103 1536 : call mpi_bcast(clubb_l_damp_wp3_Skw_squared, 1, mpi_logical, mstrid, mpicom, ierr)
1104 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp3_Skw_squared")
1105 1536 : call mpi_bcast(clubb_l_predict_upwp_vpwp, 1, mpi_logical, mstrid, mpicom, ierr)
1106 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_predict_upwp_vpwp")
1107 1536 : call mpi_bcast(clubb_l_min_wp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr)
1108 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_wp2_from_corr_wx")
1109 1536 : call mpi_bcast(clubb_l_min_xp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr)
1110 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_xp2_from_corr_wx")
1111 1536 : call mpi_bcast(clubb_l_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr)
1112 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xpyp_ta")
1113 1536 : call mpi_bcast(clubb_l_godunov_upwind_wpxp_ta, 1, mpi_logical, mstrid, mpicom, ierr)
1114 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_wpxp_ta")
1115 1536 : call mpi_bcast(clubb_l_godunov_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr)
1116 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_xpyp_ta")
1117 1536 : call mpi_bcast(clubb_l_vert_avg_closure, 1, mpi_logical, mstrid, mpicom, ierr)
1118 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vert_avg_closure")
1119 1536 : call mpi_bcast(clubb_l_trapezoidal_rule_zt, 1, mpi_logical, mstrid, mpicom, ierr)
1120 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_trapezoidal_rule_zt")
1121 1536 : call mpi_bcast(clubb_l_trapezoidal_rule_zm, 1, mpi_logical, mstrid, mpicom, ierr)
1122 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_trapezoidal_rule_zm")
1123 1536 : call mpi_bcast(clubb_l_call_pdf_closure_twice, 1, mpi_logical, mstrid, mpicom, ierr)
1124 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_call_pdf_closure_twice")
1125 1536 : call mpi_bcast(clubb_l_use_cloud_cover, 1, mpi_logical, mstrid, mpicom, ierr)
1126 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_cloud_cover")
1127 1536 : call mpi_bcast(clubb_l_diag_Lscale_from_tau, 1, mpi_logical, mstrid, mpicom, ierr)
1128 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diag_Lscale_from_tau")
1129 1536 : call mpi_bcast(clubb_l_damp_wp2_using_em, 1, mpi_logical, mstrid, mpicom, ierr)
1130 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp2_using_em")
1131 1536 : call mpi_bcast(clubb_l_do_expldiff_rtm_thlm, 1, mpi_logical, mstrid, mpicom, ierr)
1132 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_do_expldiff_rtm_thlm")
1133 1536 : call mpi_bcast(clubb_l_lmm_stepping, 1, mpi_logical, mstrid, mpicom, ierr)
1134 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lmm_stepping")
1135 1536 : call mpi_bcast(clubb_l_e3sm_config, 1, mpi_logical, mstrid, mpicom, ierr)
1136 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_e3sm_config")
1137 1536 : call mpi_bcast(clubb_l_enable_relaxed_clipping, 1, mpi_logical, mstrid, mpicom, ierr)
1138 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_enable_relaxed_clipping")
1139 1536 : call mpi_bcast(clubb_l_use_tke_in_wp3_pr_turb_term, 1, mpi_logical, mstrid, mpicom, ierr)
1140 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp3_pr_turb_term")
1141 1536 : call mpi_bcast(clubb_l_use_tke_in_wp2_wp3_K_dfsn, 1, mpi_logical, mstrid, mpicom, ierr)
1142 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp2_wp3_K_dfsn")
1143 1536 : call mpi_bcast(clubb_l_use_wp3_lim_with_smth_Heaviside, 1, mpi_logical, mstrid, mpicom, ierr)
1144 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_wp3_lim_with_smth_Heaviside")
1145 1536 : call mpi_bcast(clubb_l_smooth_Heaviside_tau_wpxp, 1, mpi_logical, mstrid, mpicom, ierr)
1146 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_smooth_Heaviside_tau_wpxp")
1147 1536 : call mpi_bcast(clubb_l_modify_limiters_for_cnvg_test, 1, mpi_logical, mstrid, mpicom, ierr)
1148 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_modify_limiters_for_cnvg_test")
1149 1536 : call mpi_bcast(clubb_ipdf_call_placement, 1, mpi_integer, mstrid, mpicom, ierr)
1150 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_ipdf_call_placement")
1151 1536 : call mpi_bcast(clubb_l_mono_flux_lim_thlm, 1, mpi_logical, mstrid, mpicom, ierr)
1152 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_thlm")
1153 1536 : call mpi_bcast(clubb_l_mono_flux_lim_rtm, 1, mpi_logical, mstrid, mpicom, ierr)
1154 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_rtm")
1155 1536 : call mpi_bcast(clubb_l_mono_flux_lim_um, 1, mpi_logical, mstrid, mpicom, ierr)
1156 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_um")
1157 1536 : call mpi_bcast(clubb_l_mono_flux_lim_vm, 1, mpi_logical, mstrid, mpicom, ierr)
1158 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_vm")
1159 1536 : call mpi_bcast(clubb_l_mono_flux_lim_spikefix, 1, mpi_logical, mstrid, mpicom, ierr)
1160 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_spikefix")
1161 1536 : call mpi_bcast(clubb_penta_solve_method, 1, mpi_integer, mstrid, mpicom, ierr)
1162 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_penta_solve_method")
1163 1536 : call mpi_bcast(clubb_tridiag_solve_method, 1, mpi_integer, mstrid, mpicom, ierr)
1164 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_tridiag_solve_method")
1165 1536 : call mpi_bcast(clubb_l_intr_sfc_flux_smooth, 1, mpi_logical, mstrid, mpicom, ierr)
1166 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_intr_sfc_flux_smooth")
1167 1536 : call mpi_bcast(clubb_l_vary_convect_depth, 1, mpi_logical, mstrid, mpicom, ierr)
1168 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vary_convect_depth")
1169 1536 : call mpi_bcast(clubb_l_standard_term_ta, 1, mpi_logical, mstrid, mpicom, ierr)
1170 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_standard_term_ta")
1171 1536 : call mpi_bcast(clubb_l_partial_upwind_wp3, 1, mpi_logical, mstrid, mpicom, ierr)
1172 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_partial_upwind_wp3")
1173 1536 : call mpi_bcast(clubb_l_C2_cloud_frac, 1, mpi_logical, mstrid, mpicom, ierr)
1174 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_C2_cloud_frac")
1175 1536 : call mpi_bcast(clubb_l_calc_thlp2_rad, 1, mpi_logical, mstrid, mpicom, ierr)
1176 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_thlp2_rad")
1177 1536 : call mpi_bcast(clubb_l_calc_w_corr, 1, mpi_logical, mstrid, mpicom, ierr)
1178 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_w_corr")
1179 1536 : call mpi_bcast(clubb_l_const_Nc_in_cloud, 1, mpi_logical, mstrid, mpicom, ierr)
1180 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_const_Nc_in_cloud")
1181 1536 : call mpi_bcast(clubb_l_diagnose_correlations, 1, mpi_logical, mstrid, mpicom, ierr)
1182 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diagnose_correlations")
1183 1536 : call mpi_bcast(clubb_l_diffuse_rtm_and_thlm, 1, mpi_logical, mstrid, mpicom, ierr)
1184 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diffuse_rtm_and_thlm")
1185 1536 : call mpi_bcast(clubb_l_fix_w_chi_eta_correlations, 1, mpi_logical, mstrid, mpicom, ierr)
1186 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_fix_w_chi_eta_correlations")
1187 1536 : call mpi_bcast(clubb_l_prescribed_avg_deltaz, 1, mpi_logical, mstrid, mpicom, ierr)
1188 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_prescribed_avg_deltaz")
1189 1536 : call mpi_bcast(clubb_l_rtm_nudge, 1, mpi_logical, mstrid, mpicom, ierr)
1190 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_rtm_nudge")
1191 1536 : call mpi_bcast(clubb_l_stability_correct_Kh_N2_zm, 1, mpi_logical, mstrid, mpicom, ierr)
1192 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_Kh_N2_zm")
1193 1536 : call mpi_bcast(clubb_l_tke_aniso, 1, mpi_logical, mstrid, mpicom, ierr)
1194 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_tke_aniso")
1195 1536 : call mpi_bcast(clubb_l_upwind_xm_ma, 1, mpi_logical, mstrid, mpicom, ierr)
1196 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xm_ma")
1197 1536 : call mpi_bcast(clubb_l_use_precip_frac, 1, mpi_logical, mstrid, mpicom, ierr)
1198 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_precip_frac")
1199 1536 : call mpi_bcast(clubb_l_uv_nudge, 1, mpi_logical, mstrid, mpicom, ierr)
1200 1536 : if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_uv_nudge")
1201 :
1202 : ! Overwrite defaults if they are true
1203 1536 : if (clubb_history) stats_metadata%l_stats = .true.
1204 1536 : if (clubb_rad_history) stats_metadata%l_output_rad_files = .true.
1205 1536 : if (clubb_cloudtop_cooling) do_cldcool = .true.
1206 1536 : if (clubb_rainevap_turb) do_rainturb = .true.
1207 :
1208 : ! Check that all namelists have been set
1209 1536 : if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set")
1210 1536 : if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set")
1211 :
1212 1536 : if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set")
1213 1536 : if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set")
1214 1536 : if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set")
1215 1536 : if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set")
1216 1536 : if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set")
1217 1536 : if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set")
1218 1536 : if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set")
1219 1536 : if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set")
1220 1536 : if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set")
1221 1536 : if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set")
1222 1536 : if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set")
1223 1536 : if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set")
1224 1536 : if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set")
1225 1536 : if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set")
1226 1536 : if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set")
1227 1536 : if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set")
1228 1536 : if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set")
1229 1536 : if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set")
1230 1536 : if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set")
1231 1536 : if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set")
1232 1536 : if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set")
1233 1536 : if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set")
1234 1536 : if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set")
1235 1536 : if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set")
1236 1536 : if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set")
1237 1536 : if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set")
1238 1536 : if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set")
1239 1536 : if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set")
1240 1536 : if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set")
1241 1536 : if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set")
1242 1536 : if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set")
1243 1536 : if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set")
1244 1536 : if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set")
1245 1536 : if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set")
1246 1536 : if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set")
1247 1536 : if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set")
1248 1536 : if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set")
1249 1536 : if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set")
1250 1536 : if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set")
1251 1536 : if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set")
1252 1536 : if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set")
1253 1536 : if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set")
1254 1536 : if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set")
1255 1536 : if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set")
1256 1536 : if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set")
1257 1536 : if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set")
1258 1536 : if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set")
1259 1536 : if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set")
1260 1536 : if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splat is not set")
1261 1536 : if(clubb_bv_efold == unset_r8) call endrun(sub//": FATAL: clubb_bv_efold is not set")
1262 1536 : if(clubb_wpxp_Ri_exp == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_Ri_exp is not set")
1263 1536 : if(clubb_z_displace == unset_r8) call endrun(sub//": FATAL: clubb_z_displace is not set")
1264 1536 : if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set")
1265 1536 : if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set")
1266 1536 : if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set")
1267 1536 : if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set")
1268 1536 : if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set")
1269 1536 : if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set")
1270 1536 : if(clubb_detphase_lowtemp >= meltpt_temp) &
1271 0 : call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K")
1272 :
1273 : call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In
1274 : clubb_ipdf_call_placement, & ! In
1275 : clubb_penta_solve_method, & ! In
1276 : clubb_tridiag_solve_method, & ! In
1277 : clubb_l_use_precip_frac, & ! In
1278 : clubb_l_predict_upwp_vpwp, & ! In
1279 : clubb_l_min_wp2_from_corr_wx, & ! In
1280 : clubb_l_min_xp2_from_corr_wx, & ! In
1281 : clubb_l_C2_cloud_frac, & ! In
1282 : clubb_l_diffuse_rtm_and_thlm, & ! In
1283 : clubb_l_stability_correct_Kh_N2_zm, & ! In
1284 : clubb_l_calc_thlp2_rad, & ! In
1285 : clubb_l_upwind_xpyp_ta, & ! In
1286 : clubb_l_upwind_xm_ma, & ! In
1287 : clubb_l_uv_nudge, & ! In
1288 : clubb_l_rtm_nudge, & ! In
1289 : clubb_l_tke_aniso, & ! In
1290 : clubb_l_vert_avg_closure, & ! In
1291 : clubb_l_trapezoidal_rule_zt, & ! In
1292 : clubb_l_trapezoidal_rule_zm, & ! In
1293 : clubb_l_call_pdf_closure_twice, & ! In
1294 : clubb_l_standard_term_ta, & ! In
1295 : clubb_l_partial_upwind_wp3, & ! In
1296 : clubb_l_godunov_upwind_wpxp_ta, & ! In
1297 : clubb_l_godunov_upwind_xpyp_ta, & ! In
1298 : clubb_l_use_cloud_cover, & ! In
1299 : clubb_l_diagnose_correlations, & ! In
1300 : clubb_l_calc_w_corr, & ! In
1301 : clubb_l_const_Nc_in_cloud, & ! In
1302 : clubb_l_fix_w_chi_eta_correlations, & ! In
1303 : clubb_l_stability_correct_tau_zm, & ! In
1304 : clubb_l_damp_wp2_using_em, & ! In
1305 : clubb_l_do_expldiff_rtm_thlm, & ! In
1306 : clubb_l_Lscale_plume_centered, & ! In
1307 : clubb_l_diag_Lscale_from_tau, & ! In
1308 : clubb_l_use_C7_Richardson, & ! In
1309 : clubb_l_use_C11_Richardson, & ! In
1310 : clubb_l_use_shear_Richardson, & ! In
1311 : clubb_l_brunt_vaisala_freq_moist, & ! In
1312 : clubb_l_use_thvm_in_bv_freq, & ! In
1313 : clubb_l_rcm_supersat_adj, & ! In
1314 : clubb_l_damp_wp3_Skw_squared, & ! In
1315 : clubb_l_prescribed_avg_deltaz, & ! In
1316 : clubb_l_lmm_stepping, & ! In
1317 : clubb_l_e3sm_config, & ! In
1318 : clubb_l_vary_convect_depth, & ! In
1319 : clubb_l_use_tke_in_wp3_pr_turb_term, & ! In
1320 : clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In
1321 : clubb_l_use_wp3_lim_with_smth_Heaviside, & ! In
1322 : clubb_l_smooth_Heaviside_tau_wpxp, & ! In
1323 : clubb_l_modify_limiters_for_cnvg_test, & ! In
1324 : clubb_l_enable_relaxed_clipping, & ! In
1325 : clubb_l_linearize_pbl_winds, & ! In
1326 : clubb_l_mono_flux_lim_thlm, & ! In
1327 : clubb_l_mono_flux_lim_rtm, & ! In
1328 : clubb_l_mono_flux_lim_um, & ! In
1329 : clubb_l_mono_flux_lim_vm, & ! In
1330 : clubb_l_mono_flux_lim_spikefix, & ! In
1331 1536 : clubb_config_flags ) ! Out
1332 :
1333 : #endif
1334 1536 : end subroutine clubb_readnl
1335 :
1336 : ! =============================================================================== !
1337 : ! !
1338 : ! =============================================================================== !
1339 :
1340 1536 : subroutine clubb_ini_cam(pbuf2d)
1341 : !-------------------------------------------------------------------------------
1342 : ! Description:
1343 : ! Initialize UWM CLUBB.
1344 : ! Author: Cheryl Craig March 2011
1345 : ! Modifications: Pete Bogenschutz 2011 March and onward
1346 : ! Modifications: K Thayer-Calder 2013 July and onward
1347 : ! Origin: Based heavily on UWM clubb_init.F90
1348 : ! References:
1349 : ! None
1350 : !-------------------------------------------------------------------------------
1351 :
1352 :
1353 :
1354 : #ifdef CLUBB_SGS
1355 :
1356 : ! From CAM libraries
1357 : use cam_history, only: addfld, add_default, horiz_only
1358 : use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx
1359 : use cam_abortutils, only: endrun
1360 :
1361 : ! These are needed to set parameters
1362 : use clubb_api_module, only: &
1363 : core_rknd, em_min, &
1364 : ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, iC_uu_shr, iC_uu_buoy, &
1365 : iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_sfc_coef, iwpxp_L_thresh, &
1366 : iC14, iC_wp3_pr_turb, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, &
1367 : iSkw_denom_coef, ibeta, iskw_max_mag, &
1368 : iC_invrs_tau_bkgnd,iC_invrs_tau_sfc,iC_invrs_tau_shear,iC_invrs_tau_N2,iC_invrs_tau_N2_wp2, &
1369 : iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3, &
1370 : iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, ibv_efold, &
1371 : iwpxp_Ri_exp, iz_displace, &
1372 : params_list
1373 :
1374 : use clubb_api_module, only: &
1375 : print_clubb_config_flags_api, &
1376 : setup_clubb_core_api, &
1377 : init_pdf_params_api, &
1378 : time_precision, &
1379 : core_rknd, &
1380 : set_clubb_debug_level_api, &
1381 : clubb_fatal_error, & ! Error code value to indicate a fatal error
1382 : nparams, &
1383 : set_default_parameters_api, &
1384 : read_parameters_api, &
1385 : w_tol_sqd, &
1386 : rt_tol, &
1387 : thl_tol
1388 :
1389 : ! These are only needed if we're using a passive scalar
1390 : use clubb_api_module, only: &
1391 : iisclr_rt, &
1392 : iisclr_thl, &
1393 : iisclr_CO2, &
1394 : iiedsclr_rt, &
1395 : iiedsclr_thl, &
1396 : iiedsclr_CO2
1397 :
1398 : use time_manager, only: is_first_step
1399 : use clubb_api_module, only: hydromet_dim
1400 : use constituents, only: cnst_get_ind
1401 : use phys_control, only: phys_getopts
1402 : use spmd_utils, only: iam
1403 : use cam_logfile, only: iulog
1404 : #endif
1405 :
1406 : use physics_buffer, only: pbuf_get_index, pbuf_set_field, physics_buffer_desc
1407 : implicit none
1408 : ! Input Variables
1409 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
1410 :
1411 : #ifdef CLUBB_SGS
1412 :
1413 : real(kind=time_precision) :: dum1, dum2, dum3
1414 :
1415 : ! The similar name to clubb_history is unfortunate...
1416 : logical :: history_amwg, history_clubb
1417 :
1418 : integer :: err_code ! Code for when CLUBB fails
1419 : integer :: i, j, k, l ! Indices
1420 : integer :: nmodes, nspec, m
1421 : integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice
1422 : integer :: lptr
1423 :
1424 : logical, parameter :: l_input_fields = .false. ! Always false for CAM-CLUBB.
1425 : logical, parameter :: l_update_pressure = .false. ! Always false for CAM-CLUBB.
1426 :
1427 : integer :: nlev, ierr=0
1428 :
1429 : real(r8) :: &
1430 : C1, C1b, C1c, C2rt, C2thl, C2rtthl, &
1431 : C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, &
1432 : C7, C7b, C7c, C8, C8b, C10, &
1433 : C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, &
1434 : C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, &
1435 : C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, &
1436 : c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, &
1437 : c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, &
1438 : slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, &
1439 : coef_spread_DG_means_rt, coef_spread_DG_means_thl, &
1440 : gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, &
1441 : omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, &
1442 : lambda0_stability_coef, mult_coef, taumin, taumax, Lscale_mu_coef, &
1443 : Lscale_pert_coef, alpha_corr, Skw_denom_coef, c_K10, c_K10h, &
1444 : thlp2_rad_coef, thlp2_rad_cloud_frac_thresh, up2_sfc_coef, &
1445 : Skw_max_mag, xp3_coef_base, xp3_coef_slope, altitude_threshold, &
1446 : rtp2_clip_coef, C_invrs_tau_bkgnd, C_invrs_tau_sfc, &
1447 : C_invrs_tau_shear, C_invrs_tau_N2, C_invrs_tau_N2_wp2, &
1448 : C_invrs_tau_N2_xp2, C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, &
1449 : C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, &
1450 : Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, wpxp_Ri_exp, &
1451 : a3_coef_min, a_const, bv_efold, z_displace
1452 :
1453 : !----- Begin Code -----
1454 :
1455 1536 : nlev = pver + 1 - top_lev
1456 :
1457 : if (core_rknd /= r8) then
1458 : call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not')
1459 : end if
1460 :
1461 : ! Allocate PDF parameters across columns and chunks
1462 : allocate( &
1463 : pdf_params_chnk(begchunk:endchunk), &
1464 : pdf_params_zm_chnk(begchunk:endchunk), &
1465 29328 : pdf_implicit_coefs_terms_chnk(begchunk:endchunk), stat=ierr )
1466 1536 : if( ierr /= 0 ) call endrun(' clubb_ini_cam: failed to allocate pdf_params')
1467 :
1468 : ! ----------------------------------------------------------------- !
1469 : ! Determine how many constituents CLUBB will transport. Note that
1470 : ! CLUBB does not transport aerosol consituents. Therefore, need to
1471 : ! determine how many aerosols constituents there are and subtract that
1472 : ! off of pcnst (the total consituents)
1473 : ! ----------------------------------------------------------------- !
1474 :
1475 : call phys_getopts(prog_modal_aero_out=prog_modal_aero, &
1476 : history_amwg_out=history_amwg, &
1477 : history_clubb_out=history_clubb, &
1478 1536 : do_hb_above_clubb_out=do_hb_above_clubb)
1479 :
1480 : ! Select variables to apply tendencies back to CAM
1481 :
1482 : ! Initialize all consituents to true to start
1483 64512 : lq(1:pcnst) = .true.
1484 1536 : edsclr_dim = pcnst
1485 :
1486 1536 : call cnst_get_ind('Q',ixq)
1487 1536 : call cnst_get_ind('NUMICE',ixnumice)
1488 1536 : call cnst_get_ind('NUMLIQ',ixnumliq)
1489 1536 : call cnst_get_ind('CLDLIQ',ixcldliq)
1490 1536 : call cnst_get_ind('CLDICE',ixcldice)
1491 :
1492 1536 : if (prog_modal_aero) then
1493 : ! Turn off modal aerosols and decrement edsclr_dim accordingly
1494 1536 : call rad_cnst_get_info(0, nmodes=nmodes)
1495 :
1496 7680 : do m = 1, nmodes
1497 6144 : call rad_cnst_get_mode_num_idx(m, lptr)
1498 6144 : lq(lptr)=.false.
1499 6144 : edsclr_dim = edsclr_dim-1
1500 :
1501 6144 : call rad_cnst_get_info(0, m, nspec=nspec)
1502 36864 : do l = 1, nspec
1503 23040 : call rad_cnst_get_mam_mmr_idx(m, l, lptr)
1504 23040 : lq(lptr)=.false.
1505 52224 : edsclr_dim = edsclr_dim-1
1506 : end do
1507 : end do
1508 :
1509 : ! In addition, if running with MAM, droplet number is transported
1510 : ! in dropmixnuc, therefore we do NOT want CLUBB to apply transport
1511 : ! tendencies to avoid double counted. Else, we apply tendencies.
1512 1536 : lq(ixnumliq) = .false.
1513 1536 : edsclr_dim = edsclr_dim-1
1514 : endif
1515 :
1516 : ! ----------------------------------------------------------------- !
1517 : ! Set the debug level. Level 2 has additional computational expense since
1518 : ! it checks the array variables in CLUBB for invalid values.
1519 : ! ----------------------------------------------------------------- !
1520 1536 : call set_clubb_debug_level_api( 0 )
1521 :
1522 : ! ----------------------------------------------------------------- !
1523 : ! use pbuf_get_fld_idx to get existing physics buffer fields from other
1524 : ! physics packages (e.g. tke)
1525 : ! ----------------------------------------------------------------- !
1526 :
1527 :
1528 : ! Defaults
1529 1536 : stats_metadata%l_stats_samp = .false.
1530 1536 : stats_metadata%l_grads = .false.
1531 :
1532 : ! Overwrite defaults if needbe
1533 1536 : if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true.
1534 :
1535 : ! Define physics buffers indexes
1536 1536 : cld_idx = pbuf_get_index('CLD') ! Cloud fraction
1537 1536 : concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover
1538 1536 : ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction
1539 1536 : alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction
1540 1536 : aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction
1541 1536 : qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC
1542 1536 : qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC
1543 1536 : dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction
1544 1536 : icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio
1545 1536 : sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction
1546 1536 : relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance
1547 1536 : accre_enhan_idx = pbuf_get_index('ACCRE_ENHAN') ! accretion enhancement for MG
1548 1536 : prer_evap_idx = pbuf_get_index('PRER_EVAP')
1549 1536 : qrl_idx = pbuf_get_index('QRL')
1550 1536 : cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
1551 1536 : naai_idx = pbuf_get_index('NAAI')
1552 1536 : npccn_idx = pbuf_get_index('NPCCN')
1553 :
1554 :
1555 1536 : iisclr_rt = -1
1556 1536 : iisclr_thl = -1
1557 1536 : iisclr_CO2 = -1
1558 :
1559 1536 : iiedsclr_rt = -1
1560 1536 : iiedsclr_thl = -1
1561 1536 : iiedsclr_CO2 = -1
1562 :
1563 : ! ----------------------------------------------------------------- !
1564 : ! Define number of tracers for CLUBB to diffuse
1565 : ! ----------------------------------------------------------------- !
1566 :
1567 1536 : if (clubb_l_do_expldiff_rtm_thlm) then
1568 1536 : offset = 2 ! diffuse temperature and moisture explicitly
1569 1536 : edsclr_dim = edsclr_dim + offset
1570 : endif
1571 :
1572 : ! ----------------------------------------------------------------- !
1573 : ! Setup CLUBB core
1574 : ! ----------------------------------------------------------------- !
1575 :
1576 : ! Read in parameters for CLUBB. Just read in default values
1577 : call set_default_parameters_api( &
1578 : C1, C1b, C1c, C2rt, C2thl, C2rtthl, &
1579 : C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, &
1580 : C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, &
1581 : C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, &
1582 : C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, &
1583 : C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, &
1584 : c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, &
1585 : c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, &
1586 : slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, &
1587 : coef_spread_DG_means_rt, coef_spread_DG_means_thl, &
1588 : gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, &
1589 : omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, &
1590 : lambda0_stability_coef, mult_coef, taumin, taumax, &
1591 : Lscale_mu_coef, Lscale_pert_coef, alpha_corr, &
1592 : Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, &
1593 : thlp2_rad_cloud_frac_thresh, up2_sfc_coef, &
1594 : Skw_max_mag, xp3_coef_base, xp3_coef_slope, &
1595 : altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, &
1596 : C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, &
1597 : C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, &
1598 : C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, &
1599 : C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, &
1600 : Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, &
1601 1536 : wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace )
1602 :
1603 : call read_parameters_api( -99, "", &
1604 : C1, C1b, C1c, C2rt, C2thl, C2rtthl, &
1605 : C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, &
1606 : C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, &
1607 : C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, &
1608 : C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, &
1609 : C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, &
1610 : c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, &
1611 : c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, &
1612 : slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, &
1613 : coef_spread_DG_means_rt, coef_spread_DG_means_thl, &
1614 : gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, &
1615 : omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, &
1616 : lambda0_stability_coef, mult_coef, taumin, taumax, &
1617 : Lscale_mu_coef, Lscale_pert_coef, alpha_corr, &
1618 : Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, &
1619 : thlp2_rad_cloud_frac_thresh, up2_sfc_coef, &
1620 : Skw_max_mag, xp3_coef_base, xp3_coef_slope, &
1621 : altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, &
1622 : C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, &
1623 : C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, &
1624 : C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, &
1625 : C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, &
1626 : Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, &
1627 : wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, &
1628 1536 : clubb_params )
1629 :
1630 1536 : clubb_params(iC2rtthl) = clubb_C2rtthl
1631 1536 : clubb_params(iC8) = clubb_C8
1632 1536 : clubb_params(iC11) = clubb_c11
1633 1536 : clubb_params(iC11b) = clubb_c11b
1634 1536 : clubb_params(iC14) = clubb_c14
1635 1536 : clubb_params(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb
1636 1536 : clubb_params(ic_K10) = clubb_c_K10
1637 1536 : clubb_params(imult_coef) = clubb_mult_coef
1638 1536 : clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef
1639 1536 : clubb_params(iC2rt) = clubb_C2rt
1640 1536 : clubb_params(iC2thl) = clubb_C2thl
1641 1536 : clubb_params(ibeta) = clubb_beta
1642 1536 : clubb_params(iC6rt) = clubb_c6rt
1643 1536 : clubb_params(iC6rtb) = clubb_c6rtb
1644 1536 : clubb_params(iC6rtc) = clubb_c6rtc
1645 1536 : clubb_params(iC6thl) = clubb_c6thl
1646 1536 : clubb_params(iC6thlb) = clubb_c6thlb
1647 1536 : clubb_params(iC6thlc) = clubb_c6thlc
1648 1536 : clubb_params(iwpxp_L_thresh) = clubb_wpxp_L_thresh
1649 1536 : clubb_params(iC7) = clubb_C7
1650 1536 : clubb_params(iC7b) = clubb_C7b
1651 1536 : clubb_params(igamma_coef) = clubb_gamma_coef
1652 1536 : clubb_params(ic_K10h) = clubb_c_K10h
1653 1536 : clubb_params(ilambda0_stability_coef) = clubb_lambda0_stability_coef
1654 1536 : clubb_params(ilmin_coef) = clubb_lmin_coef
1655 1536 : clubb_params(iC8b) = clubb_C8b
1656 1536 : clubb_params(iskw_max_mag) = clubb_skw_max_mag
1657 1536 : clubb_params(iC1) = clubb_C1
1658 1536 : clubb_params(iC1b) = clubb_C1b
1659 1536 : clubb_params(igamma_coefb) = clubb_gamma_coefb
1660 1536 : clubb_params(iup2_sfc_coef) = clubb_up2_sfc_coef
1661 1536 : clubb_params(iC4) = clubb_C4
1662 1536 : clubb_params(iC_uu_shr) = clubb_C_uu_shr
1663 1536 : clubb_params(iC_uu_buoy) = clubb_C_uu_buoy
1664 1536 : clubb_params(ic_K1) = clubb_c_K1
1665 1536 : clubb_params(ic_K2) = clubb_c_K2
1666 1536 : clubb_params(inu2) = clubb_nu2
1667 1536 : clubb_params(ic_K8) = clubb_c_K8
1668 1536 : clubb_params(ic_K9) = clubb_c_K9
1669 1536 : clubb_params(inu9) = clubb_nu9
1670 1536 : clubb_params(iC_wp2_splat) = clubb_C_wp2_splat
1671 1536 : clubb_params(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd
1672 1536 : clubb_params(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc
1673 1536 : clubb_params(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear
1674 1536 : clubb_params(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2
1675 1536 : clubb_params(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2
1676 1536 : clubb_params(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2
1677 1536 : clubb_params(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp
1678 1536 : clubb_params(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3
1679 1536 : clubb_params(ibv_efold) = clubb_bv_efold
1680 1536 : clubb_params(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp
1681 1536 : clubb_params(iz_displace) = clubb_z_displace
1682 :
1683 : ! Set up CLUBB core. Note that some of these inputs are overwritten
1684 : ! when clubb_tend_cam is called. The reason is that heights can change
1685 : ! at each time step, which is why dummy arrays are read in here for heights
1686 : ! as they are immediately overwrote.
1687 : !$OMP PARALLEL
1688 : call setup_clubb_core_api( &
1689 : nlev+1, theta0, ts_nudge, & ! In
1690 : hydromet_dim, sclr_dim, & ! In
1691 : sclr_tol, edsclr_dim, clubb_params, & ! In
1692 : l_host_applies_sfc_fluxes, & ! In
1693 : saturation_equation, & ! In
1694 : l_input_fields, & ! In
1695 : clubb_config_flags, & ! In
1696 1536 : err_code ) ! Out
1697 :
1698 1536 : if ( err_code == clubb_fatal_error ) then
1699 0 : call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE')
1700 : end if
1701 : !$OMP END PARALLEL
1702 :
1703 : ! Print the list of CLUBB parameters
1704 1536 : if ( masterproc ) then
1705 206 : do j = 1, nparams, 1
1706 206 : write(iulog,*) params_list(j), " = ", clubb_params(j)
1707 : enddo
1708 : endif
1709 :
1710 : ! Print configurable CLUBB flags
1711 1536 : if ( masterproc ) then
1712 2 : write(iulog,'(a,i0,a)') " CLUBB configurable flags "
1713 2 : call print_clubb_config_flags_api( iulog, clubb_config_flags ) ! Intent(in)
1714 : end if
1715 :
1716 : ! ----------------------------------------------------------------- !
1717 : ! Add output fields for the history files
1718 : ! ----------------------------------------------------------------- !
1719 :
1720 : ! These are default CLUBB output. Not the higher order history budgets
1721 3072 : call addfld ('RHO_CLUBB', (/ 'lev' /), 'A', 'kg/m3', 'Air Density')
1722 3072 : call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance')
1723 3072 : call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance')
1724 3072 : call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance')
1725 3072 : call addfld ('WP2_ZT_CLUBB', (/ 'lev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid')
1726 3072 : call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux')
1727 3072 : call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux')
1728 3072 : call addfld ('WP3_CLUBB', (/ 'lev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity')
1729 3072 : call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux')
1730 3072 : call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux')
1731 3072 : call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance')
1732 3072 : call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid')
1733 3072 : call addfld ('PDFP_RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance')
1734 3072 : call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance')
1735 3072 : call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid')
1736 3072 : call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance')
1737 3072 : call addfld ('RCM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio')
1738 3072 : call addfld ('RTM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Total Water Mixing Ratio')
1739 3072 : call addfld ('THLM_CLUBB', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature')
1740 3072 : call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux')
1741 3072 : call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction')
1742 3072 : call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer')
1743 3072 : call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover')
1744 3072 : call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux')
1745 3072 : call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency')
1746 3072 : call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency')
1747 3072 : call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency')
1748 3072 : call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency')
1749 3072 : call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency')
1750 3072 : call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency')
1751 3072 : call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights')
1752 3072 : call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights')
1753 3072 : call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind')
1754 3072 : call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind')
1755 3072 : call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity')
1756 1536 : call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height')
1757 3072 : call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction')
1758 3072 : call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection')
1759 3072 : call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment')
1760 3072 : call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment')
1761 3072 : call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment')
1762 3072 : call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment')
1763 :
1764 :
1765 3072 : call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment')
1766 3072 : call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment')
1767 3072 : call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment')
1768 :
1769 3072 : call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection')
1770 3072 : call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection')
1771 3072 : call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment')
1772 3072 : call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance')
1773 1536 : call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB')
1774 :
1775 :
1776 3072 : call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection')
1777 3072 : call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover')
1778 3072 : call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud')
1779 3072 : call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water')
1780 :
1781 3072 : call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor')
1782 3072 : call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels')
1783 1536 : call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak')
1784 1536 : call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy')
1785 :
1786 : ! ---------------------------------------------------------------------------- !
1787 : ! Below are for detailed analysis of EDMF Scheme !
1788 : ! ---------------------------------------------------------------------------- !
1789 1536 : if (do_clubb_mf) then
1790 0 : call addfld ( 'edmf_DRY_A' , (/ 'ilev' /), 'A', 'fraction', 'Dry updraft area fraction (EDMF)' )
1791 0 : call addfld ( 'edmf_MOIST_A' , (/ 'ilev' /), 'A', 'fraction', 'Moist updraft area fraction (EDMF)' )
1792 0 : call addfld ( 'edmf_DRY_W' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft vertical velocity (EDMF)' )
1793 0 : call addfld ( 'edmf_MOIST_W' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft vertical velocity (EDMF)' )
1794 0 : call addfld ( 'edmf_DRY_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Dry updraft total water mixing ratio (EDMF)' )
1795 0 : call addfld ( 'edmf_MOIST_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft total water mixing ratio (EDMF)' )
1796 0 : call addfld ( 'edmf_DRY_THL' , (/ 'ilev' /), 'A', 'K' , 'Dry updraft liquid-ice potential temperature (EDMF)' )
1797 0 : call addfld ( 'edmf_MOIST_THL', (/ 'ilev' /), 'A', 'K' , 'Moist updraft liquid-ice potential temperature (EDMF)' )
1798 0 : call addfld ( 'edmf_DRY_U' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft zonal velocity (EDMF)' )
1799 0 : call addfld ( 'edmf_MOIST_U' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft zonal velocity (EDMF)' )
1800 0 : call addfld ( 'edmf_DRY_V' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft meridional velocity (EDMF)' )
1801 0 : call addfld ( 'edmf_MOIST_V' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft meridional velocity (EDMF)' )
1802 0 : call addfld ( 'edmf_MOIST_QC' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft condensate mixing ratio (EDMF)' )
1803 0 : call addfld ( 'edmf_S_AE' , (/ 'ilev' /), 'A', 'fraction', '1 minus sum of a_i*w_i (EDMF)' )
1804 0 : call addfld ( 'edmf_S_AW' , (/ 'ilev' /), 'A', 'm/s' , 'Sum of a_i*w_i (EDMF)' )
1805 0 : call addfld ( 'edmf_S_AWTHL' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*thl_i (EDMF)' )
1806 0 : call addfld ( 'edmf_S_AWQT' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_ti (EDMF)' )
1807 0 : call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)' )
1808 0 : call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)' )
1809 0 : call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)' )
1810 0 : call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)' )
1811 : end if
1812 :
1813 : ! Initialize statistics, below are dummy variables
1814 1536 : dum1 = 300._r8
1815 1536 : dum2 = 1200._r8
1816 1536 : dum3 = 300._r8
1817 :
1818 :
1819 1536 : if (stats_metadata%l_stats) then
1820 :
1821 : call stats_init_clubb( .true., dum1, dum2, &
1822 : nlev+1, nlev+1, nlev+1, dum3, &
1823 : stats_zt(:), stats_zm(:), stats_sfc(:), &
1824 0 : stats_rad_zt(:), stats_rad_zm(:))
1825 :
1826 0 : allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields), stat=ierr)
1827 0 : if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zt' )
1828 0 : allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields), stat=ierr)
1829 0 : if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zm' )
1830 0 : allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields), stat=ierr)
1831 0 : if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_sfc' )
1832 :
1833 0 : if ( stats_metadata%l_output_rad_files ) then
1834 0 : allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields), stat=ierr)
1835 0 : if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzt' )
1836 0 : allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields), stat=ierr)
1837 0 : if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzm' )
1838 : end if
1839 :
1840 : endif
1841 :
1842 : ! ----------------------------------------------------------------- !
1843 : ! Make all of this output default, this is not CLUBB history
1844 : ! ----------------------------------------------------------------- !
1845 :
1846 1536 : if (clubb_do_adv .or. history_clubb) then
1847 1536 : call add_default('RELVAR', 1, ' ')
1848 1536 : call add_default('RHO_CLUBB', 1, ' ')
1849 1536 : call add_default('UP2_CLUBB', 1, ' ')
1850 1536 : call add_default('VP2_CLUBB', 1, ' ')
1851 1536 : call add_default('WP2_CLUBB', 1, ' ')
1852 1536 : call add_default('WP2_ZT_CLUBB', 1, ' ')
1853 1536 : call add_default('WP3_CLUBB', 1, ' ')
1854 1536 : call add_default('UPWP_CLUBB', 1, ' ')
1855 1536 : call add_default('VPWP_CLUBB', 1, ' ')
1856 1536 : call add_default('WPTHLP_CLUBB', 1, ' ')
1857 1536 : call add_default('WPRTP_CLUBB', 1, ' ')
1858 1536 : call add_default('RTP2_CLUBB', 1, ' ')
1859 1536 : call add_default('RTP2_ZT_CLUBB', 1, ' ')
1860 1536 : call add_default('PDFP_RTP2_CLUBB', 1, ' ')
1861 1536 : call add_default('THLP2_CLUBB', 1, ' ')
1862 1536 : call add_default('THLP2_ZT_CLUBB', 1, ' ')
1863 1536 : call add_default('RTPTHLP_CLUBB', 1, ' ')
1864 1536 : call add_default('RCM_CLUBB', 1, ' ')
1865 1536 : call add_default('RTM_CLUBB', 1, ' ')
1866 1536 : call add_default('THLM_CLUBB', 1, ' ')
1867 1536 : call add_default('WPRCP_CLUBB', 1, ' ')
1868 1536 : call add_default('CLOUDFRAC_CLUBB', 1, ' ')
1869 1536 : call add_default('RCMINLAYER_CLUBB', 1, ' ')
1870 1536 : call add_default('CLOUDCOVER_CLUBB', 1, ' ')
1871 1536 : call add_default('WPTHVP_CLUBB', 1, ' ')
1872 1536 : call add_default('RVMTEND_CLUBB', 1, ' ')
1873 1536 : call add_default('STEND_CLUBB', 1, ' ')
1874 1536 : call add_default('RCMTEND_CLUBB', 1, ' ')
1875 1536 : call add_default('RIMTEND_CLUBB', 1, ' ')
1876 1536 : call add_default('UTEND_CLUBB', 1, ' ')
1877 1536 : call add_default('VTEND_CLUBB', 1, ' ')
1878 1536 : call add_default('ZT_CLUBB', 1, ' ')
1879 1536 : call add_default('ZM_CLUBB', 1, ' ')
1880 1536 : call add_default('UM_CLUBB', 1, ' ')
1881 1536 : call add_default('VM_CLUBB', 1, ' ')
1882 1536 : call add_default('WM_ZT_CLUBB', 1, ' ')
1883 1536 : call add_default('PBLH', 1, ' ')
1884 1536 : call add_default('CONCLD', 1, ' ')
1885 : endif
1886 :
1887 1536 : if (history_amwg) then
1888 1536 : call add_default('PBLH', 1, ' ')
1889 : end if
1890 :
1891 1536 : if (do_clubb_mf_diag) then
1892 0 : call add_default( 'edmf_DRY_A' , 1, ' ')
1893 0 : call add_default( 'edmf_MOIST_A' , 1, ' ')
1894 0 : call add_default( 'edmf_DRY_W' , 1, ' ')
1895 0 : call add_default( 'edmf_MOIST_W' , 1, ' ')
1896 0 : call add_default( 'edmf_DRY_QT' , 1, ' ')
1897 0 : call add_default( 'edmf_MOIST_QT' , 1, ' ')
1898 0 : call add_default( 'edmf_DRY_THL' , 1, ' ')
1899 0 : call add_default( 'edmf_MOIST_THL', 1, ' ')
1900 0 : call add_default( 'edmf_DRY_U' , 1, ' ')
1901 0 : call add_default( 'edmf_MOIST_U' , 1, ' ')
1902 0 : call add_default( 'edmf_DRY_V' , 1, ' ')
1903 0 : call add_default( 'edmf_MOIST_V' , 1, ' ')
1904 0 : call add_default( 'edmf_MOIST_QC' , 1, ' ')
1905 0 : call add_default( 'edmf_S_AE' , 1, ' ')
1906 0 : call add_default( 'edmf_S_AW' , 1, ' ')
1907 0 : call add_default( 'edmf_S_AWTHL' , 1, ' ')
1908 0 : call add_default( 'edmf_S_AWQT' , 1, ' ')
1909 0 : call add_default( 'edmf_S_AWU' , 1, ' ')
1910 0 : call add_default( 'edmf_S_AWV' , 1, ' ')
1911 0 : call add_default( 'edmf_thlflx' , 1, ' ')
1912 0 : call add_default( 'edmf_qtflx' , 1, ' ')
1913 : end if
1914 :
1915 1536 : if (history_budget) then
1916 0 : call add_default('DPDLFLIQ', history_budget_histfile_num, ' ')
1917 0 : call add_default('DPDLFICE', history_budget_histfile_num, ' ')
1918 0 : call add_default('DPDLFT', history_budget_histfile_num, ' ')
1919 0 : call add_default('STEND_CLUBB', history_budget_histfile_num, ' ')
1920 0 : call add_default('RCMTEND_CLUBB', history_budget_histfile_num, ' ')
1921 0 : call add_default('RIMTEND_CLUBB', history_budget_histfile_num, ' ')
1922 0 : call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ')
1923 0 : call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ')
1924 0 : call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ')
1925 : endif
1926 :
1927 :
1928 : ! --------------- !
1929 : ! First step? !
1930 : ! Initialization !
1931 : ! --------------- !
1932 :
1933 : ! Is this the first time step? If so then initialize CLUBB variables as follows
1934 1536 : if (is_first_step()) then
1935 :
1936 768 : call pbuf_set_field(pbuf2d, wp2_idx, w_tol_sqd)
1937 768 : call pbuf_set_field(pbuf2d, wp3_idx, 0.0_r8)
1938 768 : call pbuf_set_field(pbuf2d, wpthlp_idx, 0.0_r8)
1939 768 : call pbuf_set_field(pbuf2d, wprtp_idx, 0.0_r8)
1940 768 : call pbuf_set_field(pbuf2d, rtpthlp_idx, 0.0_r8)
1941 768 : call pbuf_set_field(pbuf2d, rtp2_idx, rt_tol**2)
1942 768 : call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2)
1943 768 : call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd)
1944 768 : call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd)
1945 :
1946 768 : call pbuf_set_field(pbuf2d, rtp3_idx, 0.0_r8)
1947 768 : call pbuf_set_field(pbuf2d, thlp3_idx, 0.0_r8)
1948 768 : call pbuf_set_field(pbuf2d, up3_idx, 0.0_r8)
1949 768 : call pbuf_set_field(pbuf2d, vp3_idx, 0.0_r8)
1950 :
1951 768 : call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8)
1952 768 : call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8)
1953 768 : call pbuf_set_field(pbuf2d, wpthvp_idx, 0.0_r8)
1954 768 : call pbuf_set_field(pbuf2d, wp2thvp_idx, 0.0_r8)
1955 768 : call pbuf_set_field(pbuf2d, rtpthvp_idx, 0.0_r8)
1956 768 : call pbuf_set_field(pbuf2d, thlpthvp_idx,0.0_r8)
1957 768 : call pbuf_set_field(pbuf2d, rcm_idx, 0.0_r8)
1958 768 : call pbuf_set_field(pbuf2d, cloud_frac_idx, 0.0_r8)
1959 768 : call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8)
1960 768 : call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8)
1961 768 : call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8)
1962 768 : call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8)
1963 768 : call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8)
1964 768 : call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8)
1965 768 : call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8)
1966 768 : call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8)
1967 768 : call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8)
1968 768 : call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8)
1969 768 : call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8)
1970 768 : call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8)
1971 768 : call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8)
1972 768 : call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8)
1973 :
1974 : ! Initialize SILHS covariance contributions
1975 768 : call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8)
1976 768 : call pbuf_set_field(pbuf2d, thlp2_mc_zt_idx, 0.0_r8)
1977 768 : call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8)
1978 768 : call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8)
1979 768 : call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8)
1980 :
1981 768 : call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8)
1982 768 : call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8)
1983 768 : call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8)
1984 768 : call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8)
1985 768 : call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8)
1986 :
1987 : endif
1988 :
1989 : ! The following is physpkg, so it needs to be initialized every time
1990 1536 : call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8)
1991 :
1992 : ! --------------- !
1993 : ! End !
1994 : ! Initialization !
1995 : ! --------------- !
1996 :
1997 : #endif
1998 6144 : end subroutine clubb_ini_cam
1999 :
2000 :
2001 : ! =============================================================================== !
2002 : ! !
2003 : ! =============================================================================== !
2004 7411824 : subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, &
2005 : cmfmc, cam_in, &
2006 : macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice)
2007 :
2008 : !-------------------------------------------------------------------------------
2009 : ! Description: Provide tendencies of shallow convection, turbulence, and
2010 : ! macrophysics from CLUBB to CAM
2011 : !
2012 : ! Author: Cheryl Craig, March 2011
2013 : ! Modifications: Pete Bogenschutz, March 2011 and onward
2014 : ! Origin: Based heavily on UWM clubb_init.F90
2015 : ! References:
2016 : ! None
2017 : !-------------------------------------------------------------------------------
2018 :
2019 : use physics_types, only: physics_state, physics_ptend, &
2020 : physics_state_copy, physics_ptend_init, &
2021 1536 : physics_ptend_sum, physics_update, set_wet_to_dry
2022 :
2023 : use physics_buffer, only: pbuf_old_tim_idx, pbuf_get_field, physics_buffer_desc
2024 : use physics_buffer, only: pbuf_set_field
2025 :
2026 : use constituents, only: cnst_get_ind, cnst_type
2027 : use camsrfexch, only: cam_in_t
2028 : use time_manager, only: is_first_step
2029 : use cam_abortutils, only: endrun
2030 : use cam_logfile, only: iulog
2031 : use tropopause, only: tropopause_findChemTrop
2032 : use time_manager, only: get_nstep, is_first_restart_step
2033 :
2034 : #ifdef CLUBB_SGS
2035 : use hb_diff, only: pblintd
2036 : use scamMOD, only: single_column,scm_clubb_iop_name
2037 : use clubb_api_module, only: &
2038 : nparams, &
2039 : setup_parameters_api, &
2040 : time_precision, &
2041 : advance_clubb_core_api, &
2042 : zt2zm_api, zm2zt_api, &
2043 : setup_grid_heights_api, &
2044 : em_min, &
2045 : w_tol_sqd, &
2046 : rt_tol, &
2047 : thl_tol, &
2048 : stats_begin_timestep_api, &
2049 : hydromet_dim, calculate_thlp2_rad_api, update_xp2_mc_api, &
2050 : sat_mixrat_liq_api, &
2051 : fstderr, &
2052 : ipdf_post_advance_fields, &
2053 : copy_single_pdf_params_to_multi, &
2054 : copy_multi_pdf_params_to_single, &
2055 : pdf_parameter, &
2056 : init_pdf_params_api, &
2057 : init_pdf_implicit_coefs_terms_api, &
2058 : setup_grid_api
2059 :
2060 : use clubb_api_module, only: &
2061 : clubb_fatal_error ! Error code value to indicate a fatal error
2062 :
2063 : use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const
2064 : use cam_history, only: outfld
2065 :
2066 : use macrop_driver, only: liquid_macro_tend
2067 : use clubb_mf, only: integrate_mf
2068 :
2069 : use perf_mod
2070 :
2071 : #endif
2072 :
2073 : implicit none
2074 :
2075 : ! ---------------------------------------------------- !
2076 : ! Input Auguments !
2077 : ! ---------------------------------------------------- !
2078 :
2079 : type(physics_state), intent(in) :: state ! Physics state variables [vary]
2080 : type(cam_in_t), intent(in) :: cam_in
2081 : real(r8), intent(in) :: hdtime ! Host model timestep [s]
2082 : real(r8), intent(in) :: dlf(pcols,pver) ! Detraining cld H20 from deep convection [kg/ks/s]
2083 : real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s]
2084 : integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations
2085 : integer, intent(in) :: macmic_it ! number of mac-mic iterations
2086 :
2087 : ! ---------------------------------------------------- !
2088 : ! Input-Output Auguments !
2089 : ! ---------------------------------------------------- !
2090 :
2091 : type(physics_buffer_desc), pointer :: pbuf(:)
2092 :
2093 : ! ---------------------------------------------------- !
2094 : ! Output Auguments !
2095 : ! ---------------------------------------------------- !
2096 :
2097 : type(physics_ptend), intent(out) :: ptend_all ! package tendencies
2098 :
2099 : ! These two variables are needed for energy check
2100 : real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice
2101 : real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check
2102 :
2103 :
2104 : ! ---------------------------------------------------- !
2105 : ! Local Variables !
2106 : ! ---------------------------------------------------- !
2107 :
2108 : #ifdef CLUBB_SGS
2109 :
2110 176472 : type(physics_state) :: state1 ! Local copy of state variable
2111 7411824 : type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all
2112 :
2113 : integer :: i, j, k, t, ixind, nadv
2114 : integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq
2115 : integer :: itim_old
2116 : integer :: ncol, lchnk ! # of columns, and chunk identifier
2117 : integer :: err_code ! Diagnostic, for if some calculation goes amiss.
2118 : integer :: icnt
2119 : logical :: lq2(pcnst)
2120 :
2121 : integer :: iter
2122 :
2123 : integer :: clubbtop(pcols)
2124 :
2125 : real(r8) :: frac_limit, ic_limit
2126 :
2127 : real(r8) :: dtime ! CLUBB time step [s]
2128 : real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m]
2129 : real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m]
2130 : real(r8) :: ubar ! surface wind [m/s]
2131 : real(r8) :: ustar ! surface stress [m/s]
2132 : real(r8) :: z0 ! roughness height [m]
2133 : real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s]
2134 : real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2]
2135 : real(r8) :: zo(pcols) ! roughness height [m]
2136 : real(r8) :: dz_g(pcols,pver) ! thickness of layer [m]
2137 : real(r8) :: relvarmax
2138 : real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols)
2139 : real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols)
2140 :
2141 : ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api
2142 : ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES
2143 : real(r8), dimension(state%ncol) :: &
2144 352944 : fcor, & ! Coriolis forcing [s^-1]
2145 352944 : sfc_elevation, & ! Elevation of ground [m AMSL][m]
2146 352944 : wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s]
2147 352944 : wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)]
2148 352944 : upwp_sfc, & ! u'w' at surface [m^2/s^2]
2149 352944 : vpwp_sfc, & ! v'w' at surface [m^2/s^2]
2150 352944 : upwp_sfc_pert, & ! perturbed u'w' at surface [m^2/s^2]
2151 352944 : vpwp_sfc_pert, & ! perturbed v'w' at surface [m^2/s^2]
2152 352944 : grid_dx, grid_dy ! CAM grid [m]
2153 :
2154 : real(r8), dimension(state%ncol,sclr_dim) :: &
2155 352944 : wpsclrp_sfc ! Scalar flux at surface [{units vary} m/s]
2156 :
2157 : real(r8), dimension(state%ncol,edsclr_dim) :: &
2158 352944 : wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s]
2159 :
2160 : ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api
2161 : ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES
2162 : real(r8), dimension(state%ncol,pverp+1-top_lev) :: &
2163 352944 : thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s]
2164 352944 : rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s]
2165 352944 : um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s]
2166 352944 : vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s]
2167 352944 : wprtp_forcing, &
2168 352944 : wpthlp_forcing, &
2169 352944 : rtp2_forcing, &
2170 352944 : thlp2_forcing, &
2171 352944 : rtpthlp_forcing, &
2172 352944 : wm_zm, & ! w mean wind component on momentum levels [m/s]
2173 352944 : wm_zt, & ! w mean wind component on thermo. levels [m/s]
2174 352944 : rtm_ref, & ! Initial profile of rtm [kg/kg]
2175 352944 : thlm_ref, & ! Initial profile of thlm [K]
2176 352944 : um_ref, & ! Initial profile of um [m/s]
2177 352944 : vm_ref, & ! Initial profile of vm [m/s]
2178 352944 : ug, & ! U geostrophic wind [m/s]
2179 352944 : vg, & ! V geostrophic wind [m/s]
2180 352944 : p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa]
2181 352944 : rho_zm, & ! Air density on momentum levels [kg/m^3]
2182 352944 : rho_zt, & ! Air density on thermo levels [kg/m^3]
2183 352944 : exner, & ! Exner function (thermodynamic levels) [-]
2184 352944 : rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3]
2185 352944 : rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3]
2186 352944 : invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg]
2187 352944 : invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg]
2188 352944 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K]
2189 352944 : thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K]
2190 352944 : rfrzm, &
2191 352944 : radf, &
2192 352944 : um_in, & ! meridional wind [m/s]
2193 352944 : vm_in, & ! zonal wind [m/s]
2194 352944 : upwp_in, & ! meridional wind flux [m^2/s^2]
2195 352944 : vpwp_in, & ! zonal wind flux [m^2/s^2]
2196 352944 : up2_in, & ! meridional wind variance [m^2/s^2]
2197 352944 : vp2_in, & ! zonal wind variance [m^2/s^2]
2198 352944 : up3_in, & ! meridional wind third-order [m^3/s^3]
2199 352944 : vp3_in, & ! zonal wind third-order [m^3/s^3]
2200 352944 : thlm_in, & ! liquid water potential temperature (thetal) [K]
2201 352944 : rvm_in, & ! water vapor mixing ratio [kg/kg]
2202 352944 : rtm_in, & ! total water mixing ratio [kg/kg]
2203 352944 : wprtp_in, & ! turbulent flux of total water [kg/kg m/s]
2204 352944 : wpthlp_in, & ! turbulent flux of thetal [K m/s]
2205 352944 : wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2]
2206 352944 : wp3_in, & ! third moment vertical velocity [m^3/s^3]
2207 352944 : rtp2_in, & ! total water variance [kg^2/kg^2]
2208 352944 : rtp2_zt, & ! CLUBB R-tot variance on thermo levs
2209 352944 : thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2]
2210 352944 : wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2]
2211 352944 : rtp3_in, & ! total water 3rd order [kg^3/kg^3]
2212 352944 : thlp2_in, & ! thetal variance [K^2]
2213 352944 : thlp3_in, & ! thetal 3rd order [K^3]
2214 352944 : rtpthlp_in, & ! covariance of thetal and qt [kg/kg K]
2215 352944 : rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg]
2216 352944 : rcm_out_zm, &
2217 352944 : cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction]
2218 352944 : wpthvp_in, & ! w'th_v' (momentum levels) [m/s K]
2219 352944 : wp2thvp_in, & ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K]
2220 352944 : rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K]
2221 352944 : thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2]
2222 352944 : ice_supersat_frac_inout, &
2223 352944 : um_pert_inout, & ! Perturbed U wind [m/s]
2224 352944 : vm_pert_inout, & ! Perturbed V wind [m/s]
2225 352944 : upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2]
2226 352944 : vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2]
2227 352944 : khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s]
2228 352944 : khzt_out, & ! eddy diffusivity on thermo grids [m^2/s]
2229 352944 : qclvar_out, & ! cloud water variance [kg^2/kg^2]
2230 352944 : thlprcp_out, &
2231 352944 : wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s]
2232 352944 : w_up_in_cloud_out, &
2233 352944 : w_down_in_cloud_out, &
2234 352944 : cloudy_updraft_frac_out, &
2235 352944 : cloudy_downdraft_frac_out,&
2236 352944 : rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg]
2237 352944 : cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction]
2238 352944 : invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s]
2239 352944 : rtp2_mc_out, & ! total water tendency from rain evap
2240 352944 : thlp2_mc_out, & ! thetal tendency from rain evap
2241 352944 : wprtp_mc_out, &
2242 352944 : wpthlp_mc_out, &
2243 352944 : rtpthlp_mc_out, &
2244 352944 : pre_in, & ! input for precip evaporation
2245 352944 : qrl_clubb, &
2246 352944 : qrl_zm, &
2247 352944 : wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels)
2248 352944 : wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels)
2249 352944 : uprcp_inout, & ! < u' r_c' > (momentum levels)
2250 352944 : vprcp_inout, & ! < v' r_c' > (momentum levels)
2251 352944 : rc_coef_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.)
2252 352944 : wp4_inout, & ! w'^4 (momentum levels
2253 352944 : wpup2_inout, & ! w'u'^2 (thermodynamic levels)
2254 352944 : wpvp2_inout, & ! w'v'^2 (thermodynamic levels)
2255 352944 : wp2up2_inout, & ! w'^2 u'^2 (momentum levels)
2256 352944 : wp2vp2_inout, & ! w'^2 v'^2 (momentum levels)
2257 352944 : zt_g, & ! Thermodynamic grid of CLUBB [m]
2258 352944 : zi_g ! Momentum grid of CLUBB [m]
2259 :
2260 : ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api
2261 : ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES
2262 : real(r8), dimension(state%ncol,pverp+1-top_lev,sclr_dim) :: &
2263 352944 : sclrm_forcing, & ! Passive scalar forcing [{units vary}/s]
2264 352944 : sclrm, & ! Passive scalar mean (thermo. levels) [units vary]
2265 352944 : sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2]
2266 352944 : sclrp3, & ! sclr'^3 (thermo. levels) [{units vary}^3]
2267 352944 : sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)]
2268 352944 : sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)]
2269 352944 : wpsclrp ! w'sclr' (momentum levels) [{units vary} m/s]
2270 :
2271 : real(r8), dimension(state%ncol,pverp,sclr_dim) :: &
2272 352944 : sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)]
2273 :
2274 : real(r8), dimension(state%ncol,pverp+1-top_lev,edsclr_dim) :: &
2275 352944 : edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s]
2276 352944 : edsclr_in ! Scalars to be diffused through CLUBB [units vary]
2277 :
2278 : ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api
2279 : ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES
2280 : real(r8), dimension(state%ncol,pverp+1-top_lev,hydromet_dim) :: &
2281 352944 : hydromet, &
2282 352944 : wphydrometp, &
2283 352944 : wp2hmp, &
2284 352944 : rtphmp_zt, &
2285 352944 : thlphmp_zt
2286 :
2287 : ! Variables below are needed to compute energy integrals for conservation
2288 : ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines
2289 : real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols)
2290 : real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols)
2291 : real(r8) :: se_dis(pcols), se_a(pcols), se_b(pcols), clubb_s(pcols,pver)
2292 : real(r8) :: eleak(pcols)
2293 :
2294 : real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-]
2295 : real(r8) :: inv_exner_clubb_surf(pcols) ! Inverse exner function at the surface
2296 : real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2]
2297 : real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2]
2298 : real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3]
2299 : real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg]
2300 : real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg]
2301 : real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K]
2302 : real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg]
2303 : real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2]
2304 : real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3]
2305 : real(r8) :: thv(pcols,pverp) ! virtual potential temperature [K]
2306 352944 : real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary]
2307 : real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg]
2308 : real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction]
2309 : real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg]
2310 : real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2]
2311 : real(r8) :: rvm(pcols,pverp)
2312 : real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2]
2313 : real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2]
2314 : real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs
2315 : real(r8) :: wp2_zt_out(pcols, pverp)
2316 : real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s]
2317 : real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s]
2318 : real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s]
2319 : real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg]
2320 : real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day]
2321 : real(r8) :: eps ! Rv/Rd [-]
2322 : real(r8) :: dum1 ! dummy variable [units vary]
2323 : real(r8) :: obklen(pcols) ! Obukov length [m]
2324 : real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s]
2325 : real(r8) :: th(pcols,pver) ! potential temperature [K]
2326 : real(r8) :: dummy2(pcols) ! dummy variable [units vary]
2327 : real(r8) :: dummy3(pcols) ! dummy variable [units vary]
2328 : real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s]
2329 : real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3]
2330 : real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s]
2331 : real(r8) :: latsub
2332 352944 : real(r8) :: thlp2_rad_out(pcols,pverp+1-top_lev)
2333 : real(r8) :: apply_const, rtm_test
2334 : real(r8) :: dl_rad, di_rad, dt_low
2335 :
2336 : character(len=200) :: temp1, sub ! Strings needed for CLUBB output
2337 : real(kind=time_precision) :: time_elapsed ! time keep track of stats [s]
2338 : integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep]
2339 :
2340 : real(r8) :: rtm_integral_vtend(pcols), &
2341 : rtm_integral_ltend(pcols)
2342 :
2343 :
2344 : real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing
2345 :
2346 : ! ---------------------------------------------------- !
2347 : ! Pointers !
2348 : ! ---------------------------------------------------- !
2349 :
2350 176472 : real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2]
2351 176472 : real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3]
2352 176472 : real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K]
2353 176472 : real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg]
2354 176472 : real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K]
2355 176472 : real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2]
2356 176472 : real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2]
2357 176472 : real(r8), pointer, dimension(:,:) :: rtp3 ! moisture 3rd order [kg^3/kg^3]
2358 176472 : real(r8), pointer, dimension(:,:) :: thlp3 ! temperature 3rd order [K^3]
2359 176472 : real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2]
2360 176472 : real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2]
2361 176472 : real(r8), pointer, dimension(:,:) :: up3 ! east-west wind 3rd order [m^3/s^3]
2362 176472 : real(r8), pointer, dimension(:,:) :: vp3 ! north-south wind 3rd order [m^3/s^3]
2363 176472 : real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2]
2364 176472 : real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2]
2365 176472 : real(r8), pointer, dimension(:,:) :: wpthvp ! w'th_v' (momentum levels) [m/s K]
2366 176472 : real(r8), pointer, dimension(:,:) :: wp2thvp ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K]
2367 176472 : real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K]
2368 176472 : real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2]
2369 176472 : real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2]
2370 176472 : real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm
2371 176472 : real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm
2372 176472 : real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm
2373 176472 : real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm
2374 176472 : real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm
2375 176472 : real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels)
2376 176472 : real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels)
2377 176472 : real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels)
2378 176472 : real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels)
2379 176472 : real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.)
2380 176472 : real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels
2381 176472 : real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels)
2382 176472 : real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels)
2383 176472 : real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels)
2384 176472 : real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels)
2385 176472 : real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K]
2386 176472 : real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg]
2387 176472 : real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg]
2388 176472 : real(r8), pointer, dimension(:) :: ztodtptr ! timestep to send to SILHS
2389 176472 : real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s]
2390 176472 : real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s]
2391 176472 : real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction]
2392 176472 : real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction]
2393 176472 : real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction]
2394 176472 : real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction]
2395 176472 : real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction]
2396 176472 : real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg]
2397 176472 : real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg]
2398 176472 : real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction]
2399 176472 : real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction]
2400 176472 : real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s]
2401 176472 : real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m]
2402 176472 : real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2]
2403 176472 : real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg]
2404 176472 : real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction]
2405 176472 : real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-]
2406 176472 : real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-]
2407 176472 : real(r8), pointer, dimension(:,:) :: naai
2408 176472 : real(r8), pointer, dimension(:,:) :: cmeliq
2409 176472 : real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/]
2410 :
2411 176472 : real(r8), pointer, dimension(:,:) :: qsatfac
2412 176472 : real(r8), pointer, dimension(:,:) :: npccn
2413 176472 : real(r8), pointer, dimension(:,:) :: prer_evap
2414 176472 : real(r8), pointer, dimension(:,:) :: qrl
2415 176472 : real(r8), pointer, dimension(:,:) :: radf_clubb
2416 :
2417 : ! SILHS covariance contributions
2418 176472 : real(r8), pointer, dimension(:,:) :: rtp2_mc_zt
2419 176472 : real(r8), pointer, dimension(:,:) :: thlp2_mc_zt
2420 176472 : real(r8), pointer, dimension(:,:) :: wprtp_mc_zt
2421 176472 : real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt
2422 176472 : real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt
2423 :
2424 : real(r8) qitend(pcols,pver)
2425 : real(r8) initend(pcols,pver) ! Needed for ice supersaturation adjustment calculation
2426 :
2427 : ! ZM microphysics
2428 : real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
2429 : real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio.
2430 : real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen.
2431 : real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen.
2432 :
2433 : real(r8) :: stend(pcols,pver)
2434 : real(r8) :: qvtend(pcols,pver)
2435 : real(r8) :: qctend(pcols,pver)
2436 : real(r8) :: inctend(pcols,pver)
2437 : real(r8) :: fqtend(pcols,pver)
2438 : real(r8) :: rhmini(pcols)
2439 : real(r8) :: rhmaxi(pcols)
2440 : integer :: troplev(pcols)
2441 : logical :: lqice(pcnst)
2442 : logical :: apply_to_surface(pcols)
2443 :
2444 : ! MF outputs to outfld
2445 : ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines
2446 : real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, &
2447 : mf_dry_w_output, mf_moist_w_output, &
2448 : mf_dry_qt_output, mf_moist_qt_output, &
2449 : mf_dry_thl_output, mf_moist_thl_output, &
2450 : mf_dry_u_output, mf_moist_u_output, &
2451 : mf_dry_v_output, mf_moist_v_output, &
2452 : mf_moist_qc_output, &
2453 : s_ae_output, s_aw_output, &
2454 : s_awthl_output, s_awqt_output, &
2455 : s_awql_output, s_awqi_output, &
2456 : s_awu_output, s_awv_output, &
2457 : mf_thlflx_output, mf_qtflx_output
2458 : ! MF Plume
2459 : ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines
2460 : real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, &
2461 : mf_dry_w, mf_moist_w, &
2462 : mf_dry_qt, mf_moist_qt, &
2463 : mf_dry_thl, mf_moist_thl, &
2464 : mf_dry_u, mf_moist_u, &
2465 : mf_dry_v, mf_moist_v, &
2466 : mf_moist_qc, &
2467 : s_ae, s_aw, &
2468 : s_awthl, s_awqt, &
2469 : s_awql, s_awqi, &
2470 : s_awu, s_awv, &
2471 : mf_thlflx, mf_qtflx
2472 :
2473 : real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend
2474 :
2475 : ! MF local vars
2476 : real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid
2477 : dzt, invrs_dzt, & ! thermodynamic grid
2478 : invrs_exner_zt,& ! thermodynamic grid
2479 : kappa_zt, qc_zt, & ! thermodynamic grid
2480 : kappa_zm, p_in_Pa_zm, & ! momentum grid
2481 : invrs_exner_zm ! momentum grid
2482 :
2483 : real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs
2484 :
2485 : integer :: nlev
2486 :
2487 : intrinsic :: max
2488 :
2489 : character(len=*), parameter :: subr='clubb_tend_cam'
2490 : real(r8), parameter :: rad2deg=180.0_r8/pi
2491 : real(r8) :: tmp_lon1, tmp_lonN
2492 :
2493 176472 : type(grid) :: gr
2494 :
2495 176472 : type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values
2496 : real(r8) :: lmin
2497 :
2498 : #endif
2499 176472 : det_s(:) = 0.0_r8
2500 176472 : det_ice(:) = 0.0_r8
2501 :
2502 : #ifdef CLUBB_SGS
2503 :
2504 : !-----------------------------------------------------------------------------------!
2505 : ! MAIN COMPUTATION BEGINS HERE !
2506 : !-----------------------------------------------------------------------------------!
2507 :
2508 176472 : call t_startf("clubb_tend_cam")
2509 :
2510 176472 : nlev = pver + 1 - top_lev
2511 :
2512 176472 : rtp2_zt_out = 0._r8
2513 176472 : thl2_zt_out = 0._r8
2514 176472 : wp2_zt_out = 0._r8
2515 176472 : pdfp_rtp2 = 0._r8
2516 176472 : wm_zt_out = 0._r8
2517 :
2518 176472 : temp2d = 0._r8
2519 176472 : temp2dp = 0._r8
2520 :
2521 176472 : dl_rad = clubb_detliq_rad
2522 176472 : di_rad = clubb_detice_rad
2523 176472 : dt_low = clubb_detphase_lowtemp
2524 :
2525 176472 : frac_limit = 0.01_r8
2526 176472 : ic_limit = 1.e-12_r8
2527 176472 : inv_rh2o = 1._r8/rh2o
2528 :
2529 176472 : if (clubb_do_adv) then
2530 : apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected
2531 : else
2532 176472 : apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected
2533 : endif
2534 :
2535 : ! Get indicees for cloud and ice mass and cloud and ice number
2536 176472 : call cnst_get_ind('Q',ixq)
2537 176472 : call cnst_get_ind('CLDLIQ',ixcldliq)
2538 176472 : call cnst_get_ind('CLDICE',ixcldice)
2539 176472 : call cnst_get_ind('NUMLIQ',ixnumliq)
2540 176472 : call cnst_get_ind('NUMICE',ixnumice)
2541 :
2542 176472 : if (clubb_do_icesuper) then
2543 0 : call pbuf_get_field(pbuf, naai_idx, naai)
2544 : end if
2545 :
2546 : ! Initialize physics tendency arrays, copy the state to state1 array to use in this routine
2547 176472 : call physics_ptend_init(ptend_all, state%psetcols, 'clubb')
2548 :
2549 : ! Copy the state to state1 array to use in this routine
2550 176472 : call physics_state_copy(state, state1)
2551 :
2552 : ! constituents are all treated as dry mmr by clubb
2553 176472 : call set_wet_to_dry(state1)
2554 :
2555 176472 : if (clubb_do_liqsupersat) then
2556 0 : call pbuf_get_field(pbuf, npccn_idx, npccn)
2557 : endif
2558 :
2559 : ! Determine number of columns and which chunk computation is to be performed on
2560 176472 : ncol = state%ncol
2561 176472 : lchnk = state%lchnk
2562 :
2563 : ! Determine time step of physics buffer
2564 176472 : itim_old = pbuf_old_tim_idx()
2565 :
2566 : ! Establish associations between pointers and physics buffer fields
2567 705888 : call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2568 705888 : call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2569 705888 : call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2570 705888 : call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2571 705888 : call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2572 705888 : call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2573 705888 : call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2574 705888 : call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2575 705888 : call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2576 :
2577 705888 : call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2578 705888 : call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2579 705888 : call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2580 705888 : call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2581 :
2582 705888 : call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2583 705888 : call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2584 176472 : call pbuf_get_field(pbuf, wpthvp_idx, wpthvp)
2585 176472 : call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp)
2586 176472 : call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp)
2587 176472 : call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp)
2588 176472 : call pbuf_get_field(pbuf, rcm_idx, rcm)
2589 176472 : call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac)
2590 :
2591 705888 : call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2592 705888 : call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2593 705888 : call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2594 705888 : call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2595 705888 : call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2596 :
2597 176472 : call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp)
2598 176472 : call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp)
2599 176472 : call pbuf_get_field(pbuf, uprcp_idx, uprcp)
2600 176472 : call pbuf_get_field(pbuf, vprcp_idx, vprcp)
2601 176472 : call pbuf_get_field(pbuf, rc_coef_idx, rc_coef)
2602 176472 : call pbuf_get_field(pbuf, wp4_idx, wp4)
2603 176472 : call pbuf_get_field(pbuf, wpup2_idx, wpup2)
2604 176472 : call pbuf_get_field(pbuf, wpvp2_idx, wpvp2)
2605 176472 : call pbuf_get_field(pbuf, wp2up2_idx, wp2up2)
2606 176472 : call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2)
2607 705888 : call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2608 705888 : call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2609 705888 : call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2610 705888 : call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
2611 :
2612 176472 : call pbuf_get_field(pbuf, tke_idx, tke)
2613 176472 : call pbuf_get_field(pbuf, qrl_idx, qrl)
2614 176472 : call pbuf_get_field(pbuf, radf_idx, radf_clubb)
2615 :
2616 705888 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2617 705888 : call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2618 705888 : call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2619 705888 : call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2620 705888 : call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2621 705888 : call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2622 705888 : call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2623 :
2624 176472 : call pbuf_get_field(pbuf, qsatfac_idx, qsatfac)
2625 :
2626 176472 : call pbuf_get_field(pbuf, prer_evap_idx, prer_evap)
2627 176472 : call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan)
2628 176472 : call pbuf_get_field(pbuf, cmeliq_idx, cmeliq)
2629 176472 : call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac)
2630 176472 : call pbuf_get_field(pbuf, ztodt_idx, ztodtptr)
2631 176472 : call pbuf_get_field(pbuf, relvar_idx, relvar)
2632 176472 : call pbuf_get_field(pbuf, dp_frac_idx, deepcu)
2633 176472 : call pbuf_get_field(pbuf, sh_frac_idx, shalcu)
2634 176472 : call pbuf_get_field(pbuf, kvh_idx, khzm)
2635 176472 : call pbuf_get_field(pbuf, pblh_idx, pblh)
2636 176472 : call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr)
2637 176472 : call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh)
2638 :
2639 : ! SILHS covariance contributions
2640 176472 : call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt)
2641 176472 : call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt)
2642 176472 : call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt)
2643 176472 : call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt)
2644 176472 : call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt)
2645 :
2646 : ! Allocate pdf_params only if they aren't allocated already.
2647 176472 : if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then
2648 6192 : call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_chnk(lchnk) )
2649 6192 : call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_zm_chnk(lchnk) )
2650 : end if
2651 :
2652 176472 : if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then
2653 : call init_pdf_implicit_coefs_terms_api( pverp+1-top_lev, ncol, sclr_dim, &
2654 6192 : pdf_implicit_coefs_terms_chnk(lchnk) )
2655 : end if
2656 :
2657 : ! Initialize the apply_const variable (note special logic is due to eularian backstepping)
2658 33933960 : if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then
2659 0 : apply_const = 0._r8 ! On first time through do not remove constant
2660 : ! from moments since it has not been added yet
2661 : endif
2662 :
2663 : ! Set the ztodt timestep in pbuf for SILHS
2664 3000024 : ztodtptr(:) = 1.0_r8*hdtime
2665 :
2666 : ! Define the grid box size. CLUBB needs this information to determine what
2667 : ! the maximum length scale should be. This depends on the column for
2668 : ! variable mesh grids and lat-lon grids
2669 176472 : if (single_column) then
2670 : ! If single column specify grid box size to be something
2671 : ! similar to a GCM run
2672 0 : grid_dx(:) = 100000._r8
2673 0 : grid_dy(:) = 100000._r8
2674 : else
2675 :
2676 176472 : call grid_size(state1, grid_dx, grid_dy)
2677 :
2678 : end if
2679 :
2680 176472 : if (clubb_do_icesuper) then
2681 :
2682 : ! -------------------------------------- !
2683 : ! Ice Saturation Adjustment Computation !
2684 : ! -------------------------------------- !
2685 :
2686 0 : lq2(:) = .FALSE.
2687 0 : lq2(1) = .TRUE.
2688 0 : lq2(ixcldice) = .TRUE.
2689 0 : lq2(ixnumice) = .TRUE.
2690 :
2691 0 : latsub = latvap + latice
2692 :
2693 0 : call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 )
2694 :
2695 0 : stend(:ncol,:)=0._r8
2696 0 : qvtend(:ncol,:)=0._r8
2697 0 : qitend(:ncol,:)=0._r8
2698 0 : initend(:ncol,:)=0._r8
2699 :
2700 0 : call ice_macro_tend(naai(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), &
2701 0 : state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), &
2702 0 : state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), &
2703 0 : latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), &
2704 0 : qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1))
2705 :
2706 : ! update local copy of state with the tendencies
2707 0 : ptend_loc%q(:ncol,top_lev:pver,1)=qvtend(:ncol,top_lev:pver)
2708 0 : ptend_loc%q(:ncol,top_lev:pver,ixcldice)=qitend(:ncol,top_lev:pver)
2709 0 : ptend_loc%q(:ncol,top_lev:pver,ixnumice)=initend(:ncol,top_lev:pver)
2710 0 : ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver)
2711 :
2712 : ! Add the ice tendency to the output tendency
2713 0 : call physics_ptend_sum(ptend_loc, ptend_all, ncol)
2714 :
2715 : ! ptend_loc is reset to zero by this call
2716 0 : call physics_update(state1, ptend_loc, hdtime)
2717 :
2718 : !Write output for tendencies:
2719 0 : temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk)
2720 0 : call outfld( 'TTENDICE', temp2d, pcols, lchnk )
2721 0 : call outfld( 'QVTENDICE', qvtend, pcols, lchnk )
2722 0 : call outfld( 'QITENDICE', qitend, pcols, lchnk )
2723 0 : call outfld( 'NITENDICE', initend, pcols, lchnk )
2724 :
2725 : endif
2726 :
2727 :
2728 : ! Determine CLUBB time step and make it sub-step friendly
2729 : ! For now we want CLUBB time step to be 5 min since that is
2730 : ! what has been scientifically validated. However, there are certain
2731 : ! instances when a 5 min time step will not be possible (based on
2732 : ! host model time step or on macro-micro sub-stepping
2733 176472 : dtime = clubb_timestep
2734 :
2735 : ! Now check to see if dtime is greater than the host model
2736 : ! (or sub stepped) time step. If it is, then simply
2737 : ! set it equal to the host (or sub step) time step.
2738 : ! This section is mostly to deal with small host model
2739 : ! time steps (or small sub-steps)
2740 176472 : if (dtime > hdtime) then
2741 0 : dtime = hdtime
2742 : endif
2743 :
2744 : ! Now check to see if CLUBB time step divides evenly into
2745 : ! the host model time step. If not, force it to divide evenly.
2746 : ! We also want it to be 5 minutes or less. This section is
2747 : ! mainly for host model time steps that are not evenly divisible
2748 : ! by 5 minutes
2749 176472 : if (mod(hdtime,dtime) .ne. 0) then
2750 0 : dtime = hdtime/2._r8
2751 0 : do while (dtime > clubb_timestep)
2752 0 : dtime = dtime/2._r8
2753 : end do
2754 : endif
2755 :
2756 : ! If resulting host model time step and CLUBB time step do not divide evenly
2757 : ! into each other, have model throw a fit.
2758 176472 : if (mod(hdtime,dtime) .ne. 0) then
2759 0 : call endrun(subr//': CLUBB time step and HOST time step NOT compatible')
2760 : endif
2761 :
2762 : ! determine number of timesteps CLUBB core should be advanced,
2763 : ! host time step divided by CLUBB time step
2764 176472 : nadv = max(hdtime/dtime,1._r8)
2765 :
2766 : ! Initialize forcings for transported scalars to zero
2767 176472 : sclrm_forcing(:,:,:) = 0._r8
2768 5764979088 : edsclrm_forcing(:,:,:) = 0._r8
2769 : sclrm(:,:,:) = 0._r8
2770 :
2771 : ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant
2772 : ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent
2773 : ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables
2774 : ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state
2775 16588368 : do k=1,pver
2776 274216968 : do i=1,ncol
2777 274040496 : inv_exner_clubb(i,k) = 1._r8/((state1%pmid(i,k)/p0_clubb)**(rairv(i,k,lchnk)/cpairv(i,k,lchnk)))
2778 : enddo
2779 : enddo
2780 :
2781 : ! Compute exner at the surface for converting the sensible heat fluxes
2782 : ! to a flux of potential temperature for use as clubb's boundary conditions
2783 2946672 : do i=1,ncol
2784 2946672 : inv_exner_clubb_surf(i) = 1._r8/((state1%pmid(i,pver)/p0_clubb)**(rairv(i,pver,lchnk)/cpairv(i,pver,lchnk)))
2785 : enddo
2786 :
2787 : ! At each CLUBB call, initialize mean momentum and thermo CLUBB state
2788 : ! from the CAM state
2789 16588368 : do k=1,pver ! loop over levels
2790 274216968 : do i=1,ncol ! loop over columns
2791 :
2792 257628600 : rtm(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)
2793 257628600 : rvm(i,k) = state1%q(i,k,ixq)
2794 257628600 : um(i,k) = state1%u(i,k)
2795 257628600 : vm(i,k) = state1%v(i,k)
2796 0 : thlm(i,k) = ( state1%t(i,k) &
2797 0 : - (latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) ) &
2798 257628600 : * inv_exner_clubb(i,k)
2799 :
2800 274040496 : if (clubb_do_adv) then
2801 0 : if (macmic_it == 1) then
2802 :
2803 : ! Note that some of the moments below can be positive or negative.
2804 : ! Remove a constant that was added to prevent dynamics from clipping
2805 : ! them to prevent dynamics from making them positive.
2806 0 : thlp2(i,k) = state1%q(i,k,ixthlp2)
2807 0 : rtp2(i,k) = state1%q(i,k,ixrtp2)
2808 0 : rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - (rtpthlp_const*apply_const)
2809 0 : wpthlp(i,k) = state1%q(i,k,ixwpthlp) - (wpthlp_const*apply_const)
2810 0 : wprtp(i,k) = state1%q(i,k,ixwprtp) - (wprtp_const*apply_const)
2811 0 : wp2(i,k) = state1%q(i,k,ixwp2)
2812 0 : wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const)
2813 0 : up2(i,k) = state1%q(i,k,ixup2)
2814 0 : vp2(i,k) = state1%q(i,k,ixvp2)
2815 : endif
2816 : endif
2817 :
2818 : enddo
2819 : enddo
2820 :
2821 176472 : if (clubb_do_adv) then
2822 : ! If not last step of macmic loop then set apply_const back to
2823 : ! zero to prevent output from being corrupted.
2824 0 : if (macmic_it == cld_macmic_num_steps) then
2825 : apply_const = 1._r8
2826 : else
2827 0 : apply_const = 0._r8
2828 : endif
2829 : endif
2830 :
2831 2946672 : rtm(1:ncol,pverp) = rtm(1:ncol,pver)
2832 2946672 : um(1:ncol,pverp) = state1%u(1:ncol,pver)
2833 2946672 : vm(1:ncol,pverp) = state1%v(1:ncol,pver)
2834 2946672 : thlm(1:ncol,pverp) = thlm(1:ncol,pver)
2835 :
2836 176472 : if (clubb_do_adv) then
2837 0 : thlp2(1:ncol,pverp) = thlp2(1:ncol,pver)
2838 0 : rtp2(1:ncol,pverp) = rtp2(1:ncol,pver)
2839 0 : rtpthlp(1:ncol,pverp) = rtpthlp(1:ncol,pver)
2840 0 : wpthlp(1:ncol,pverp) = wpthlp(1:ncol,pver)
2841 0 : wprtp(1:ncol,pverp) = wprtp(1:ncol,pver)
2842 0 : wp2(1:ncol,pverp) = wp2(1:ncol,pver)
2843 0 : wp3(1:ncol,pverp) = wp3(1:ncol,pver)
2844 0 : up2(1:ncol,pverp) = up2(1:ncol,pver)
2845 0 : vp2(1:ncol,pverp) = vp2(1:ncol,pver)
2846 : endif
2847 :
2848 : ! Compute virtual potential temperature, which is needed for CLUBB
2849 16588368 : do k=1,pver
2850 274216968 : do i=1,ncol
2851 515257200 : thv(i,k) = state1%t(i,k)*inv_exner_clubb(i,k)*(1._r8+zvir*state1%q(i,k,ixq)&
2852 789297696 : -state1%q(i,k,ixcldliq))
2853 : enddo
2854 : enddo
2855 :
2856 176472 : call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq)
2857 :
2858 176472 : call tropopause_findChemTrop(state, troplev)
2859 :
2860 : ! Initialize EDMF outputs
2861 176472 : if (do_clubb_mf) then
2862 0 : mf_dry_a_output(:,:) = 0._r8
2863 0 : mf_moist_a_output(:,:) = 0._r8
2864 0 : mf_dry_w_output(:,:) = 0._r8
2865 0 : mf_moist_w_output(:,:) = 0._r8
2866 0 : mf_dry_qt_output(:,:) = 0._r8
2867 0 : mf_moist_qt_output(:,:) = 0._r8
2868 0 : mf_dry_thl_output(:,:) = 0._r8
2869 0 : mf_moist_thl_output(:,:) = 0._r8
2870 0 : mf_dry_u_output(:,:) = 0._r8
2871 0 : mf_moist_u_output(:,:) = 0._r8
2872 0 : mf_dry_v_output(:,:) = 0._r8
2873 0 : mf_moist_v_output(:,:) = 0._r8
2874 0 : mf_moist_qc_output(:,:) = 0._r8
2875 0 : s_ae_output(:,:) = 0._r8
2876 0 : s_aw_output(:,:) = 0._r8
2877 0 : s_awthl_output(:,:) = 0._r8
2878 0 : s_awqt_output(:,:) = 0._r8
2879 0 : s_awql_output(:,:) = 0._r8
2880 0 : s_awqi_output(:,:) = 0._r8
2881 0 : s_awu_output(:,:) = 0._r8
2882 0 : s_awv_output(:,:) = 0._r8
2883 0 : mf_thlflx_output(:,:) = 0._r8
2884 0 : mf_qtflx_output(:,:) = 0._r8
2885 : end if
2886 :
2887 176472 : call t_startf("clubb_tend_cam_i_loop")
2888 :
2889 : ! Determine Coriolis force at given latitude. This is never used
2890 : ! when CLUBB is implemented in a host model, therefore just set
2891 : ! to zero.
2892 2946672 : fcor(:) = 0._r8
2893 :
2894 : ! Define the CLUBB momentum grid (in height, units of m)
2895 15176592 : do k=1, nlev+1
2896 250643592 : do i=1, ncol
2897 250467120 : zi_g(i,k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1)
2898 : end do
2899 : end do
2900 :
2901 : ! Define the CLUBB thermodynamic grid (in units of m)
2902 15000120 : do k=1, nlev
2903 247696920 : do i=1, ncol
2904 247520448 : zt_g(i,k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1)
2905 : end do
2906 : end do
2907 :
2908 16588368 : do k=1, pver
2909 274216968 : do i=1, ncol
2910 274040496 : dz_g(i,k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness
2911 : end do
2912 : end do
2913 :
2914 : ! Thermodynamic ghost point is below surface
2915 2946672 : do i=1, ncol
2916 2946672 : zt_g(i,1) = -1._r8*zt_g(i,2)
2917 : end do
2918 :
2919 2946672 : do i=1, ncol
2920 : ! Set the elevation of the surface
2921 2946672 : sfc_elevation(i) = state1%zi(i,pver+1)
2922 : end do
2923 :
2924 : ! Compute thermodynamic stuff needed for CLUBB on thermo levels.
2925 : ! Inputs for the momentum levels are set below setup_clubb core
2926 15000120 : do k=1,nlev
2927 247696920 : do i=1, ncol
2928 : ! base state (dry) variables
2929 232696800 : rho_ds_zt(i,k+1) = rga*(state1%pdeldry(i,pver-k+1)/dz_g(i,pver-k+1))
2930 232696800 : invrs_rho_ds_zt(i,k+1) = 1._r8/(rho_ds_zt(i,k+1))
2931 :
2932 : ! full state (moist) variables
2933 232696800 : p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1)
2934 232696800 : exner(i,k+1) = 1._r8/inv_exner_clubb(i,pver-k+1)
2935 232696800 : thv(i,k+1) = state1%t(i,pver-k+1)*inv_exner_clubb(i,pver-k+1)*(1._r8+zvir*state1%q(i,pver-k+1,ixq) &
2936 232696800 : -state1%q(i,pver-k+1,ixcldliq))
2937 232696800 : rho_zt(i,k+1) = rga*state1%pdel(i,pver-k+1)/dz_g(i,pver-k+1)
2938 :
2939 : ! exception - setting this to moist thv
2940 232696800 : thv_ds_zt(i,k+1) = thv(i,k+1)
2941 :
2942 232696800 : rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice)
2943 232696800 : radf(i,k+1) = radf_clubb(i,pver-k+1)
2944 247520448 : qrl_clubb(i,k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdeldry(i,pver-k+1))
2945 : end do
2946 : end do
2947 :
2948 : ! Compute mean w wind on thermo grid, convert from omega to w
2949 15000120 : do k=1,nlev
2950 247696920 : do i=1,ncol
2951 247520448 : wm_zt(i,k+1) = -1._r8*(state1%omega(i,pver-k+1)-state1%omega(i,pver))/(rho_zt(i,k+1)*gravit)
2952 : end do
2953 : end do
2954 :
2955 : ! Below computes the same stuff for the ghost point. May or may
2956 : ! not be needed, just to be safe to avoid NaN's
2957 2946672 : do i=1, ncol
2958 2770200 : thv_ds_zt(i,1) = thv_ds_zt(i,2)
2959 2770200 : rho_ds_zt(i,1) = rho_ds_zt(i,2)
2960 2770200 : invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2)
2961 2770200 : p_in_Pa(i,1) = p_in_Pa(i,2)
2962 2770200 : exner(i,1) = exner(i,2)
2963 2770200 : thv(i,1) = thv(i,2)
2964 2770200 : rho_zt(i,1) = rho_zt(i,2)
2965 2770200 : rfrzm(i,1) = rfrzm(i,2)
2966 2770200 : radf(i,1) = radf(i,2)
2967 2770200 : qrl_clubb(i,1) = qrl_clubb(i,2)
2968 2946672 : wm_zt(i,1) = wm_zt(i,2)
2969 : end do
2970 :
2971 :
2972 : ! ------------------------------------------------- !
2973 : ! Begin case specific code for SCAM cases. !
2974 : ! This section of code block is NOT called in !
2975 : ! global simulations !
2976 : ! ------------------------------------------------- !
2977 176472 : if (single_column) then
2978 :
2979 : ! Initialize zo if variable ustar is used
2980 0 : if (cam_in%landfrac(1) >= 0.5_r8) then
2981 0 : zo(1) = 0.035_r8
2982 : else
2983 0 : zo(1) = 0.0001_r8
2984 : endif
2985 :
2986 : ! Compute surface wind (ubar)
2987 0 : ubar = sqrt(um(1,pver)**2+vm(1,pver)**2)
2988 0 : if (ubar < 0.25_r8) ubar = 0.25_r8
2989 :
2990 : ! Below denotes case specifics for surface momentum
2991 : ! and thermodynamic fluxes, depending on the case
2992 :
2993 : ! Define ustar (based on case, if not variable)
2994 0 : ustar = 0.25_r8 ! Initialize ustar in case no case
2995 :
2996 0 : if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then
2997 0 : ustar = 0.28_r8
2998 : endif
2999 :
3000 0 : if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then
3001 0 : ustar = 0.30_r8
3002 : endif
3003 :
3004 0 : if(trim(scm_clubb_iop_name) == 'RICO_3day') then
3005 0 : ustar = 0.28_r8
3006 : endif
3007 :
3008 : if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. &
3009 0 : trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. &
3010 : trim(scm_clubb_iop_name) == 'ARM_CC') then
3011 :
3012 0 : bflx22(1) = (gravit/theta0)*wpthlp_sfc(1)
3013 0 : ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1))
3014 : endif
3015 :
3016 : ! Compute the surface momentum fluxes, if this is a SCAM simulation
3017 0 : upwp_sfc(1) = -um(1,pver)*ustar**2/ubar
3018 0 : vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar
3019 :
3020 : end if
3021 :
3022 : ! Define surface sources for transported variables for diffusion, will
3023 : ! be zero as these tendencies are done in vertical_diffusion
3024 4235328 : do ixind=1,edsclr_dim
3025 67949928 : do i=1,ncol
3026 67773456 : wpedsclrp_sfc(i,ixind) = 0._r8
3027 : end do
3028 : end do
3029 :
3030 : ! Set stats output and increment equal to CLUBB and host dt
3031 176472 : stats_metadata%stats_tsamp = dtime
3032 176472 : stats_metadata%stats_tout = hdtime
3033 :
3034 176472 : stats_nsamp = nint(stats_metadata%stats_tsamp/dtime)
3035 176472 : stats_nout = nint(stats_metadata%stats_tout/dtime)
3036 :
3037 : ! Heights need to be set at each timestep. Therefore, recall
3038 : ! setup_grid and setup_parameters for this.
3039 :
3040 : ! Set-up CLUBB core at each CLUBB call because heights can change
3041 : ! Important note: do not make any calls that use CLUBB grid-height
3042 : ! operators (such as zt2zm_api, etc.) until AFTER the
3043 : ! call to setup_grid_heights_api.
3044 : call setup_grid_api( nlev+1, ncol, sfc_elevation, l_implemented, & ! intent(in)
3045 : grid_type, zi_g(:,2), zi_g(:,1), zi_g(:,nlev+1), & ! intent(in)
3046 : zi_g, zt_g, & ! intent(in)
3047 176472 : gr ) ! intent(out)
3048 :
3049 : call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in)
3050 : clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in)
3051 176472 : lmin, nu_vert_res_dep, err_code ) ! intent(out)
3052 176472 : if ( err_code == clubb_fatal_error ) then
3053 0 : call endrun(subr//': Fatal error in CLUBB setup_parameters')
3054 : end if
3055 :
3056 :
3057 : ! Define forcings from CAM to CLUBB as zero for momentum and thermo,
3058 : ! forcings already applied through CAM
3059 250643592 : thlm_forcing(:,:) = 0._r8
3060 250643592 : rtm_forcing(:,:) = 0._r8
3061 250643592 : um_forcing(:,:) = 0._r8
3062 250643592 : vm_forcing(:,:) = 0._r8
3063 :
3064 :
3065 250643592 : rtm_ref(:,:) = 0.0_r8
3066 250643592 : thlm_ref(:,:) = 0.0_r8
3067 250643592 : um_ref(:,:) = 0.0_r8
3068 250643592 : vm_ref(:,:) = 0.0_r8
3069 250643592 : ug(:,:) = 0.0_r8
3070 250643592 : vg(:,:) = 0.0_r8
3071 :
3072 : ! Add forcings for SILHS covariance contributions
3073 176472 : rtp2_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, rtp2_mc_zt(1:ncol,:) )
3074 176472 : thlp2_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, thlp2_mc_zt(1:ncol,:) )
3075 176472 : wprtp_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, wprtp_mc_zt(1:ncol,:) )
3076 176472 : wpthlp_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, wpthlp_mc_zt(1:ncol,:) )
3077 176472 : rtpthlp_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, rtpthlp_mc_zt(1:ncol,:) )
3078 :
3079 : ! Zero out SILHS covariance contribution terms
3080 282178728 : rtp2_mc_zt(:,:) = 0.0_r8
3081 282178728 : thlp2_mc_zt(:,:) = 0.0_r8
3082 282178728 : wprtp_mc_zt(:,:) = 0.0_r8
3083 282178728 : wpthlp_mc_zt(:,:) = 0.0_r8
3084 282178728 : rtpthlp_mc_zt(:,:) = 0.0_r8
3085 :
3086 :
3087 : ! Compute some inputs from the thermodynamic grid
3088 : ! to the momentum grid
3089 176472 : rho_ds_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_ds_zt )
3090 176472 : rho_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_zt )
3091 176472 : invrs_rho_ds_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, invrs_rho_ds_zt )
3092 176472 : thv_ds_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, thv_ds_zt )
3093 176472 : wm_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, wm_zt )
3094 :
3095 : ! Surface fluxes provided by host model
3096 2946672 : do i=1,ncol
3097 2770200 : wpthlp_sfc(i) = cam_in%shf(i)/(cpairv(i,pver,lchnk)*rho_ds_zm(i,1)) ! Sensible heat flux
3098 2770200 : wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb_surf(i) ! Potential temperature flux
3099 2946672 : wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux
3100 : end do
3101 :
3102 : ! Implementation after Thomas Toniazzo (NorESM) and Colin Zarzycki (PSU)
3103 : ! Other Surface fluxes provided by host model
3104 176472 : if( (cld_macmic_num_steps > 1) .and. clubb_l_intr_sfc_flux_smooth ) then
3105 : ! Adjust surface stresses using winds from the prior macmic iteration
3106 2946672 : do i=1,ncol
3107 2770200 : ubar = sqrt(state1%u(i,pver)**2+state1%v(i,pver)**2)
3108 2770200 : if (ubar < 0.25_r8) ubar = 0.25_r8
3109 :
3110 2770200 : call calc_ustar( state1%t(i,pver), state1%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), &
3111 2770200 : rrho(i), ustar )
3112 :
3113 2770200 : upwp_sfc(i) = -state1%u(i,pver)*ustar**2/ubar
3114 5716872 : vpwp_sfc(i) = -state1%v(i,pver)*ustar**2/ubar
3115 : end do
3116 : else
3117 0 : do i=1,ncol
3118 0 : upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux
3119 0 : vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux
3120 : end do
3121 : endif
3122 :
3123 : ! Perturbed winds are not used in CAM
3124 2946672 : upwp_sfc_pert = 0.0_r8
3125 2946672 : vpwp_sfc_pert = 0.0_r8
3126 :
3127 : ! Need to flip arrays around for CLUBB core
3128 15176592 : do k=1,nlev+1
3129 250643592 : do i=1,ncol
3130 235467000 : um_in(i,k) = um(i,pverp-k+1)
3131 235467000 : vm_in(i,k) = vm(i,pverp-k+1)
3132 235467000 : upwp_in(i,k) = upwp(i,pverp-k+1)
3133 235467000 : vpwp_in(i,k) = vpwp(i,pverp-k+1)
3134 235467000 : wpthvp_in(i,k) = wpthvp(i,pverp-k+1)
3135 235467000 : wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1)
3136 235467000 : rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1)
3137 235467000 : thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1)
3138 235467000 : up2_in(i,k) = up2(i,pverp-k+1)
3139 235467000 : vp2_in(i,k) = vp2(i,pverp-k+1)
3140 235467000 : up3_in(i,k) = up3(i,pverp-k+1)
3141 235467000 : vp3_in(i,k) = vp3(i,pverp-k+1)
3142 235467000 : wp2_in(i,k) = wp2(i,pverp-k+1)
3143 235467000 : wp3_in(i,k) = wp3(i,pverp-k+1)
3144 235467000 : rtp2_in(i,k) = rtp2(i,pverp-k+1)
3145 235467000 : thlp2_in(i,k) = thlp2(i,pverp-k+1)
3146 235467000 : rtp3_in(i,k) = rtp3(i,pverp-k+1)
3147 235467000 : thlp3_in(i,k) = thlp3(i,pverp-k+1)
3148 235467000 : thlm_in(i,k) = thlm(i,pverp-k+1)
3149 235467000 : rtm_in(i,k) = rtm(i,pverp-k+1)
3150 235467000 : rvm_in(i,k) = rvm(i,pverp-k+1)
3151 235467000 : wprtp_in(i,k) = wprtp(i,pverp-k+1)
3152 235467000 : wpthlp_in(i,k) = wpthlp(i,pverp-k+1)
3153 235467000 : rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1)
3154 235467000 : cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1)
3155 235467000 : if (k>1) then
3156 232696800 : rcm_inout(i,k) = state1%q(i,pverp-k+1,ixcldliq)
3157 : end if
3158 :
3159 : ! We only need to copy pdf_params from pbuf if this is a restart and
3160 : ! we're calling pdf_closure at the end of advance_clubb_core
3161 : if ( is_first_restart_step() &
3162 235467000 : .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then
3163 12393000 : pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1)
3164 12393000 : pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1)
3165 12393000 : pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1)
3166 12393000 : pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1)
3167 12393000 : pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1)
3168 : end if
3169 :
3170 235467000 : sclrpthvp_inout(i,k,:) = 0._r8
3171 235467000 : wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1)
3172 235467000 : wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1)
3173 235467000 : uprcp_inout(i,k) = uprcp(i,pverp-k+1)
3174 235467000 : vprcp_inout(i,k) = vprcp(i,pverp-k+1)
3175 235467000 : rc_coef_inout(i,k) = rc_coef(i,pverp-k+1)
3176 235467000 : wp4_inout(i,k) = wp4(i,pverp-k+1)
3177 235467000 : wpup2_inout(i,k) = wpup2(i,pverp-k+1)
3178 235467000 : wpvp2_inout(i,k) = wpvp2(i,pverp-k+1)
3179 235467000 : wp2up2_inout(i,k) = wp2up2(i,pverp-k+1)
3180 235467000 : wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1)
3181 250467120 : ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1)
3182 : end do
3183 : end do
3184 :
3185 : ! Perturbed winds are not used in CAM
3186 250643592 : um_pert_inout = 0.0_r8
3187 250643592 : vm_pert_inout = 0.0_r8
3188 250643592 : upwp_pert_inout = 0.0_r8
3189 250643592 : vpwp_pert_inout = 0.0_r8
3190 :
3191 15000120 : do k=2,nlev+1
3192 247696920 : do i=1,ncol
3193 247520448 : pre_in(i,k) = prer_evap(i,pverp-k+1)
3194 : end do
3195 : end do
3196 :
3197 2946672 : do i=1,ncol
3198 2946672 : pre_in(i,1) = pre_in(i,2)
3199 : end do
3200 :
3201 2946672 : do i=1,ncol
3202 2946672 : rcm_inout(i,1) = rcm_inout(i,2)
3203 : end do
3204 :
3205 : ! Initialize these to prevent crashing behavior
3206 15176592 : do k=1,nlev+1
3207 250643592 : do i=1,ncol
3208 235467000 : wprcp_out(i,k) = 0._r8
3209 235467000 : rcm_in_layer_out(i,k) = 0._r8
3210 235467000 : cloud_cover_out(i,k) = 0._r8
3211 5651208000 : edsclr_in(i,k,:) = 0._r8
3212 235467000 : khzm_out(i,k) = 0._r8
3213 250467120 : khzt_out(i,k) = 0._r8
3214 : end do
3215 : end do
3216 :
3217 : ! higher order scalar stuff, put to zero
3218 : do ixind=1, sclr_dim
3219 : do k=1, nlev+1
3220 : do i=1, ncol
3221 : sclrm(i,k,ixind) = 0._r8
3222 : wpsclrp(i,k,ixind) = 0._r8
3223 : sclrp2(i,k,ixind) = 0._r8
3224 : sclrp3(i,k,ixind) = 0._r8
3225 : sclrprtp(i,k,ixind) = 0._r8
3226 : sclrpthlp(i,k,ixind) = 0._r8
3227 : wpsclrp_sfc(i,ixind) = 0._r8
3228 : end do
3229 : end do
3230 : end do
3231 :
3232 176472 : do ixind=1, hydromet_dim
3233 176472 : do k=1, nlev+1
3234 0 : do i=1, ncol
3235 0 : hydromet(i,k,ixind) = 0._r8
3236 0 : wphydrometp(i,k,ixind) = 0._r8
3237 0 : wp2hmp(i,k,ixind) = 0._r8
3238 0 : rtphmp_zt(i,k,ixind) = 0._r8
3239 0 : thlphmp_zt(i,k,ixind) = 0._r8
3240 : end do
3241 : end do
3242 : end do
3243 :
3244 : ! pressure,exner on momentum grid needed for mass flux calc.
3245 176472 : if (do_clubb_mf) then
3246 :
3247 0 : do k=1,pver
3248 0 : do i=1,ncol
3249 0 : kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk))
3250 0 : qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq)
3251 0 : invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1)
3252 : end do
3253 : end do
3254 :
3255 0 : do i=1,ncol
3256 0 : kappa_zt(i,1) = kappa_zt(i,2)
3257 0 : qc_zt(i,1) = qc_zt(i,2)
3258 0 : invrs_exner_zt(i,1) = invrs_exner_zt(i,2)
3259 : end do
3260 :
3261 0 : kappa_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, kappa_zt(1:ncol,:))
3262 :
3263 0 : do k=1,pverp
3264 0 : do i=1,ncol
3265 0 : p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1)
3266 0 : invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k)))
3267 : end do
3268 : end do
3269 :
3270 : end if
3271 :
3272 :
3273 176472 : if (clubb_do_adv) then
3274 0 : if (macmic_it == 1) then
3275 :
3276 0 : wp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wp2_in )
3277 0 : wpthlp_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wpthlp_in )
3278 0 : wprtp_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wprtp_in )
3279 0 : up2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, up2_in )
3280 0 : vp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, vp2_in )
3281 0 : thlp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, thlp2_in )
3282 0 : rtp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, rtp2_in )
3283 0 : rtpthlp_in = zt2zm_api(pverp+1-top_lev, ncol, gr, rtpthlp_in )
3284 :
3285 0 : do k=1,nlev+1
3286 0 : do i=1,ncol
3287 0 : thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k))
3288 0 : rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k))
3289 0 : wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k))
3290 0 : up2_in(i,k) = max(w_tol_sqd,up2_in(i,k))
3291 0 : vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k))
3292 : end do
3293 : end do
3294 :
3295 : end if
3296 : end if
3297 :
3298 : ! Do the same for tracers
3299 : icnt=0
3300 7411824 : do ixind=1,pcnst
3301 7411824 : if (lq(ixind)) then
3302 :
3303 3705912 : icnt = icnt+1
3304 :
3305 315002520 : do k=1,nlev
3306 5201635320 : do i=1,ncol
3307 5197929408 : edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind)
3308 : end do
3309 : end do
3310 :
3311 61880112 : do i=1,ncol
3312 61880112 : edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt)
3313 : end do
3314 :
3315 : end if
3316 : end do
3317 :
3318 :
3319 176472 : if (clubb_l_do_expldiff_rtm_thlm) then
3320 15000120 : do k=1,nlev
3321 247696920 : do i=1, ncol
3322 232696800 : edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1)
3323 247520448 : edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1)
3324 : end do
3325 : end do
3326 :
3327 2946672 : do i=1, ncol
3328 2770200 : edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1)
3329 2946672 : edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2)
3330 : end do
3331 :
3332 : endif
3333 :
3334 :
3335 529416 : do t=1,nadv ! do needed number of "sub" timesteps for each CAM step
3336 :
3337 : ! Increment the statistics then begin stats timestep
3338 352944 : if (stats_metadata%l_stats) then
3339 : call stats_begin_timestep_api( t, stats_nsamp, stats_nout, &
3340 0 : stats_metadata )
3341 : endif
3342 :
3343 : !#######################################################################
3344 : !###################### CALL MF DIAGNOSTIC PLUMES ######################
3345 : !#######################################################################
3346 352944 : if (do_clubb_mf) then
3347 :
3348 0 : do k=2,pverp
3349 0 : do i=1, ncol
3350 0 : dzt(i,k) = zi_g(i,k) - zi_g(i,k-1)
3351 : end do
3352 : end do
3353 :
3354 0 : do i=1, ncol
3355 0 : dzt(i,1) = dzt(i,2)
3356 0 : invrs_dzt(i,:) = 1._r8/dzt(i,:)
3357 : end do
3358 :
3359 0 : rtm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtm_in(1:ncol,:) )
3360 0 : thlm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlm_in(1:ncol,:) )
3361 :
3362 0 : do i=1, ncol
3363 0 : call integrate_mf( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input
3364 0 : p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input
3365 0 : um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,:), & ! input
3366 0 : thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input
3367 0 : wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input
3368 0 : mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics
3369 0 : mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics
3370 0 : mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics
3371 0 : mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - plume diagnostics
3372 0 : mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics
3373 0 : mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics
3374 0 : mf_moist_qc(i,:), & ! output - plume diagnostics
3375 0 : s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics
3376 0 : s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics
3377 0 : s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics
3378 0 : s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics
3379 0 : mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver
3380 : end do
3381 :
3382 : ! pass MF turbulent advection term as CLUBB explicit forcing term
3383 0 : do i=1, ncol
3384 0 : rtm_forcing(i,1) = 0._r8
3385 0 : thlm_forcing(i,1)= 0._r8
3386 : end do
3387 :
3388 0 : do k=2,pverp
3389 0 : do i=1, ncol
3390 0 : rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * &
3391 0 : ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1)))
3392 :
3393 : thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * &
3394 0 : ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1)))
3395 : end do
3396 : end do
3397 :
3398 : end if
3399 :
3400 : ! Advance CLUBB CORE one timestep in the future
3401 : call advance_clubb_core_api( gr, pverp+1-top_lev, ncol, &
3402 : l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, &
3403 : thlm_forcing, rtm_forcing, um_forcing, vm_forcing, &
3404 : sclrm_forcing, edsclrm_forcing, wprtp_forcing, &
3405 : wpthlp_forcing, rtp2_forcing, thlp2_forcing, &
3406 : rtpthlp_forcing, wm_zm, wm_zt, &
3407 : wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &
3408 : wpsclrp_sfc, wpedsclrp_sfc, &
3409 : upwp_sfc_pert, vpwp_sfc_pert, &
3410 : rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, &
3411 : p_in_Pa, rho_zm, rho_zt, exner, &
3412 : rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, &
3413 : invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, &
3414 : rfrzm, radf, &
3415 : wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, &
3416 : grid_dx, grid_dy, &
3417 : clubb_params, nu_vert_res_dep, lmin, &
3418 : clubb_config_flags, &
3419 : stats_metadata, &
3420 0 : stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), &
3421 : um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, &
3422 : thlm_in, rtm_in, wprtp_in, wpthlp_in, &
3423 : wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, &
3424 : sclrm, &
3425 : sclrp2, sclrp3, sclrprtp, sclrpthlp, &
3426 : wpsclrp, edsclr_in, err_code, &
3427 : rcm_inout, cloud_frac_inout, &
3428 : wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, &
3429 : sclrpthvp_inout, &
3430 : wp2rtp_inout, wp2thlp_inout, uprcp_inout, &
3431 : vprcp_inout, rc_coef_inout, &
3432 : wp4_inout, wpup2_inout, wpvp2_inout, &
3433 : wp2up2_inout, wp2vp2_inout, ice_supersat_frac_inout, &
3434 : um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, &
3435 0 : pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), &
3436 0 : pdf_implicit_coefs_terms_chnk(lchnk), &
3437 : khzm_out, khzt_out, &
3438 : qclvar_out, thlprcp_out, &
3439 : wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, &
3440 : cloudy_updraft_frac_out, cloudy_downdraft_frac_out, &
3441 352944 : rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out )
3442 :
3443 : ! Note that CLUBB does not produce an error code specific to any column, and
3444 : ! one value only for the entire chunk
3445 352944 : if ( err_code == clubb_fatal_error ) then
3446 0 : write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep()
3447 0 : write(fstderr,*) "LAT Range: ", state1%lat(1)*rad2deg, &
3448 0 : " -- ", state1%lat(ncol)*rad2deg
3449 0 : tmp_lon1 = state1%lon(1)*rad2deg
3450 0 : tmp_lon1 = state1%lon(ncol)*rad2deg
3451 0 : if(tmp_lon1.gt.180.0_r8) tmp_lon1=tmp_lon1-360.0_r8
3452 0 : if(tmp_lonN.gt.180.0_r8) tmp_lonN=tmp_lonN-360.0_r8
3453 0 : write(fstderr,*) "LON: Range:", tmp_lon1, " -- ", tmp_lonN
3454 0 : call endrun(subr//': Fatal error in CLUBB library')
3455 : end if
3456 :
3457 352944 : if (do_rainturb) then
3458 :
3459 0 : do k=1,nlev+1
3460 0 : do i=1,ncol
3461 0 : rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k)
3462 : end do
3463 : end do
3464 :
3465 : call update_xp2_mc_api( gr, nlev+1, ncol, dtime, cloud_frac_inout, &
3466 : rcm_inout, rvm_in, thlm_in, wm_zt, &
3467 0 : exner, pre_in, pdf_params_chnk(lchnk), &
3468 : rtp2_mc_out, thlp2_mc_out, &
3469 : wprtp_mc_out, wpthlp_mc_out, &
3470 0 : rtpthlp_mc_out)
3471 :
3472 0 : do k=1,nlev+1
3473 0 : do i=1,ncol
3474 0 : dum1 = (1._r8 - cam_in%landfrac(i))
3475 :
3476 : ! update turbulent moments based on rain evaporation
3477 0 : rtp2_in(i,k) = rtp2_in(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime
3478 0 : thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime
3479 0 : wprtp_in(i,k) = wprtp_in(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime
3480 0 : wpthlp_in(i,k) = wpthlp_in(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime
3481 : end do
3482 : end do
3483 :
3484 : end if
3485 :
3486 :
3487 352944 : if (do_cldcool) then
3488 :
3489 0 : rcm_out_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, rcm_inout )
3490 0 : qrl_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, qrl_clubb )
3491 0 : thlp2_rad_out(:,:) = 0._r8
3492 :
3493 0 : do i=1, ncol
3494 0 : call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, &
3495 0 : thlp2_rad_out(i,:))
3496 : end do
3497 :
3498 0 : do i=1, ncol
3499 0 : thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime
3500 0 : thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:))
3501 : end do
3502 :
3503 : end if
3504 :
3505 : ! Check to see if stats should be output, here stats are read into
3506 : ! output arrays to make them conformable to CAM output
3507 529416 : if (stats_metadata%l_stats) then
3508 0 : do i=1, ncol
3509 0 : call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), &
3510 0 : out_zt, out_zm, out_radzt, out_radzm, out_sfc)
3511 : end do
3512 : end if
3513 :
3514 : enddo ! end time loop
3515 :
3516 176472 : if (clubb_do_adv) then
3517 0 : if (macmic_it == cld_macmic_num_steps) then
3518 :
3519 0 : wp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in )
3520 0 : wpthlp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wpthlp_in )
3521 0 : wprtp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wprtp_in )
3522 0 : up2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, up2_in )
3523 0 : vp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, vp2_in )
3524 0 : thlp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, thlp2_in )
3525 0 : rtp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, rtp2_in )
3526 0 : rtpthlp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, rtpthlp_in )
3527 :
3528 0 : do k=1,nlev+1
3529 0 : do i=1, ncol
3530 0 : thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k))
3531 0 : rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k))
3532 0 : wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k))
3533 0 : up2_in(i,k) = max(w_tol_sqd, up2_in(i,k))
3534 0 : vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k))
3535 : end do
3536 : end do
3537 :
3538 : end if
3539 : end if
3540 :
3541 : ! Convert RTP2 and THLP2 to thermo grid for output
3542 176472 : rtp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, rtp2_in )
3543 176472 : thl2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, thlp2_in )
3544 176472 : wp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in )
3545 :
3546 : ! Arrays need to be "flipped" to CAM grid
3547 15176592 : do k=1, nlev+1
3548 250643592 : do i=1, ncol
3549 235467000 : um(i,pverp-k+1) = um_in(i,k)
3550 235467000 : vm(i,pverp-k+1) = vm_in(i,k)
3551 235467000 : upwp(i,pverp-k+1) = upwp_in(i,k)
3552 235467000 : vpwp(i,pverp-k+1) = vpwp_in(i,k)
3553 235467000 : wpthvp(i,pverp-k+1) = wpthvp_in(i,k)
3554 235467000 : wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k)
3555 235467000 : rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k)
3556 235467000 : thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k)
3557 235467000 : up2(i,pverp-k+1) = up2_in(i,k)
3558 235467000 : vp2(i,pverp-k+1) = vp2_in(i,k)
3559 235467000 : up3(i,pverp-k+1) = up3_in(i,k)
3560 235467000 : vp3(i,pverp-k+1) = vp3_in(i,k)
3561 235467000 : thlm(i,pverp-k+1) = thlm_in(i,k)
3562 235467000 : rtm(i,pverp-k+1) = rtm_in(i,k)
3563 235467000 : wprtp(i,pverp-k+1) = wprtp_in(i,k)
3564 235467000 : wpthlp(i,pverp-k+1) = wpthlp_in(i,k)
3565 235467000 : wp2(i,pverp-k+1) = wp2_in(i,k)
3566 235467000 : wp3(i,pverp-k+1) = wp3_in(i,k)
3567 235467000 : rtp2(i,pverp-k+1) = rtp2_in(i,k)
3568 235467000 : thlp2(i,pverp-k+1) = thlp2_in(i,k)
3569 235467000 : rtp3(i,pverp-k+1) = rtp3_in(i,k)
3570 235467000 : thlp3(i,pverp-k+1) = thlp3_in(i,k)
3571 235467000 : rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k)
3572 235467000 : rcm(i,pverp-k+1) = rcm_inout(i,k)
3573 235467000 : wprcp(i,pverp-k+1) = wprcp_out(i,k)
3574 235467000 : cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8)
3575 235467000 : pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k)
3576 235467000 : pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k)
3577 235467000 : pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k)
3578 235467000 : pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k)
3579 235467000 : pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k)
3580 235467000 : rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k)
3581 235467000 : cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8)
3582 235467000 : zt_out(i,pverp-k+1) = zt_g(i,k)
3583 235467000 : zi_out(i,pverp-k+1) = zi_g(i,k)
3584 235467000 : khzm(i,pverp-k+1) = khzm_out(i,k)
3585 235467000 : qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k))
3586 235467000 : wm_zt_out(i,pverp-k+1) = wm_zt(i,k)
3587 235467000 : wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k)
3588 235467000 : wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k)
3589 235467000 : uprcp(i,pverp-k+1) = uprcp_inout(i,k)
3590 235467000 : vprcp(i,pverp-k+1) = vprcp_inout(i,k)
3591 235467000 : rc_coef(i,pverp-k+1) = rc_coef_inout(i,k)
3592 235467000 : wp4(i,pverp-k+1) = wp4_inout(i,k)
3593 235467000 : wpup2(i,pverp-k+1) = wpup2_inout(i,k)
3594 235467000 : wpvp2(i,pverp-k+1) = wpvp2_inout(i,k)
3595 235467000 : wp2up2(i,pverp-k+1) = wp2up2_inout(i,k)
3596 235467000 : wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k)
3597 235467000 : ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k)
3598 :
3599 235467000 : rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k)
3600 235467000 : thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k)
3601 250467120 : wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k)
3602 :
3603 : end do
3604 : end do
3605 :
3606 15176592 : do k=1, nlev+1
3607 250643592 : do i=1, ncol
3608 :
3609 0 : mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) &
3610 0 : * pdf_params_chnk(lchnk)%rt_1(i,k) &
3611 : + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) &
3612 235467000 : * pdf_params_chnk(lchnk)%rt_2(i,k)
3613 :
3614 235467000 : pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) &
3615 : * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 &
3616 0 : + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) &
3617 : + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) &
3618 : * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 &
3619 485934120 : + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) )
3620 : end do
3621 : end do
3622 :
3623 4235328 : do ixind=1,edsclr_dim
3624 349238088 : do k=1, nlev+1
3625 5764802616 : do i=1, ncol
3626 5760743760 : edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind)
3627 : end do
3628 : end do
3629 : end do
3630 :
3631 176472 : if (do_clubb_mf) then
3632 0 : do k=1, nlev+1
3633 0 : do i=1, ncol
3634 0 : mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k)
3635 0 : mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k)
3636 0 : mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k)
3637 0 : mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k)
3638 0 : mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k)
3639 0 : mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k)
3640 0 : mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k)
3641 0 : mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k)
3642 0 : mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k)
3643 0 : mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k)
3644 0 : mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k)
3645 0 : mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k)
3646 0 : mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k)
3647 0 : mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k)
3648 0 : mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k)
3649 0 : s_ae_output(i,pverp-k+1) = s_ae(i,k)
3650 0 : s_aw_output(i,pverp-k+1) = s_aw(i,k)
3651 0 : s_awthl_output(i,pverp-k+1) = s_awthl(i,k)
3652 0 : s_awqt_output(i,pverp-k+1) = s_awqt(i,k)
3653 0 : s_awql_output(i,pverp-k+1) = s_awql(i,k)
3654 0 : s_awqi_output(i,pverp-k+1) = s_awqi(i,k)
3655 0 : s_awu_output(i,pverp-k+1) = s_awu(i,k)
3656 0 : s_awv_output(i,pverp-k+1) = s_awv(i,k)
3657 : mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k)
3658 0 : mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k)
3659 : end do
3660 : end do
3661 : end if
3662 :
3663 : ! Values to use above top_lev, for variables that have not already been
3664 : ! set up there. These are mostly fill values that should not actually be
3665 : ! used in the run, but may end up in diagnostic output.
3666 1764720 : do k=1, top_lev-1
3667 26696520 : do i=1, ncol
3668 24931800 : upwp(i,k) = 0._r8
3669 24931800 : vpwp(i,k) = 0._r8
3670 24931800 : rcm(i,k) = 0._r8
3671 24931800 : wprcp(i,k) = 0._r8
3672 24931800 : cloud_frac(i,k) = 0._r8
3673 24931800 : rcm_in_layer(i,k) = 0._r8
3674 24931800 : zt_out(i,k) = 0._r8
3675 24931800 : zi_out(i,k) = 0._r8
3676 24931800 : khzm(i,k) = 0._r8
3677 26520048 : qclvar(i,k) = 2._r8
3678 : end do
3679 : end do
3680 :
3681 : ! enforce zero tracer tendencies above the top_lev level -- no change
3682 : icnt=0
3683 7411824 : do ixind=1,pcnst
3684 7411824 : if (lq(ixind)) then
3685 3705912 : icnt=icnt+1
3686 :
3687 61880112 : do i=1, ncol
3688 585447912 : edsclr_out(i,:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind)
3689 : end do
3690 :
3691 : end if
3692 : end do
3693 :
3694 : ! Fill up arrays needed for McICA. Note we do not want the ghost point,
3695 : ! thus why the second loop is needed.
3696 3000024 : zi_out(:,1) = 0._r8
3697 :
3698 : ! Compute static energy using CLUBB's variables
3699 16588368 : do k=1,pver
3700 274216968 : do i=1, ncol
3701 772885800 : clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) &
3702 0 : + latvap * rcm(i,k) &
3703 1046926296 : + gravit * state1%zm(i,k) + state1%phis(i)
3704 : end do
3705 : end do
3706 :
3707 : ! Section below is concentrated on energy fixing for conservation.
3708 : ! because CLUBB and CAM's thermodynamic variables are different.
3709 :
3710 : ! Initialize clubbtop to top_lev, for finding the highlest level CLUBB is
3711 : ! active for informing where to apply the energy fixer.
3712 2946672 : do i=1, ncol
3713 2770200 : clubbtop(i) = top_lev
3714 141460012 : do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver)
3715 138513340 : clubbtop(i) = clubbtop(i) + 1
3716 : end do
3717 : end do
3718 : !
3719 : ! set pbuf field so that HB scheme is only applied above CLUBB top
3720 : !
3721 176472 : if (do_hb_above_clubb) then
3722 176472 : call pbuf_set_field(pbuf, clubbtop_idx, clubbtop)
3723 : endif
3724 :
3725 :
3726 : ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water
3727 : ! after CLUBB is called. This is for energy conservation purposes.
3728 176472 : se_a(:) = 0._r8
3729 176472 : ke_a(:) = 0._r8
3730 176472 : wv_a(:) = 0._r8
3731 176472 : wl_a(:) = 0._r8
3732 :
3733 16588368 : do k=1,pver
3734 274216968 : do i=1, ncol
3735 257628600 : se_a(i) = se_a(i) + clubb_s(i,k)*state1%pdel(i,k)*rga
3736 257628600 : ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)*rga
3737 257628600 : wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdeldry(i,k)*rga
3738 274040496 : wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdeldry(i,k)*rga
3739 : end do
3740 : end do
3741 :
3742 : ! Do the same as above, but for before CLUBB was called.
3743 176472 : se_b(:) = 0._r8
3744 176472 : ke_b(:) = 0._r8
3745 176472 : wv_b(:) = 0._r8
3746 176472 : wl_b(:) = 0._r8
3747 :
3748 16588368 : do k=1, pver
3749 274216968 : do i=1, ncol
3750 257628600 : se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)*rga
3751 257628600 : ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga
3752 257628600 : wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga
3753 274040496 : wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga
3754 : end do
3755 : end do
3756 :
3757 :
3758 2946672 : do i=1, ncol
3759 : ! Based on these integrals, compute the total energy before and after CLUBB call
3760 2770200 : te_a(i) = se_a(i) + ke_a(i) + (latvap+latice) * wv_a(i) + latice * wl_a(i)
3761 2770200 : te_b(i) = se_b(i) + ke_b(i) + (latvap+latice) * wv_b(i) + latice * wl_b(i)
3762 :
3763 : ! Take into account the surface fluxes of heat and moisture
3764 : ! Use correct qflux from cam_in, not lhf/latvap as was done previously
3765 2770200 : te_b(i) = te_b(i) + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime
3766 :
3767 : ! Compute the disbalance of total energy, over depth where CLUBB is active
3768 2946672 : se_dis(i) = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)))
3769 : end do
3770 :
3771 : ! Fix the total energy coming out of CLUBB so it achieves energy conservation.
3772 : ! Apply this fixer throughout the column evenly, but only at layers where
3773 : ! CLUBB is active.
3774 : !
3775 : ! NOTE: The energy fixer seems to cause the climate to change significantly
3776 : ! when using specified dynamics, so allow this to be turned off via a namelist
3777 : ! variable.
3778 176472 : if (clubb_do_energyfix) then
3779 2946672 : do i=1, ncol
3780 96953660 : do k=clubbtop(i),pver
3781 96953660 : clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit
3782 : end do
3783 : ! convert to units of +ve [K]
3784 2946672 : se_dis(i) = -1._r8*se_dis(i)*gravit/cpairv(i,pver,lchnk)
3785 : end do
3786 : endif
3787 :
3788 :
3789 : ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point
3790 : ! for all variables and therefore is never called in this loop
3791 176472 : rtm_integral_vtend(:) = 0._r8
3792 176472 : rtm_integral_ltend(:) = 0._r8
3793 :
3794 16588368 : do k=1, pver
3795 274216968 : do i=1, ncol
3796 :
3797 257628600 : ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind
3798 257628600 : ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind
3799 257628600 : ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor
3800 257628600 : ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water
3801 257628600 : ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy
3802 :
3803 257628600 : rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)
3804 274040496 : rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)
3805 :
3806 : end do
3807 : end do
3808 :
3809 3000024 : rtm_integral_ltend(:) = rtm_integral_ltend(:)/gravit
3810 3000024 : rtm_integral_vtend(:) = rtm_integral_vtend(:)/gravit
3811 :
3812 176472 : if (clubb_do_adv) then
3813 0 : if (macmic_it == cld_macmic_num_steps) then
3814 :
3815 0 : do k=1, pver
3816 0 : do i=1, ncol
3817 :
3818 : ! Here add a constant to moments which can be either positive or
3819 : ! negative. This is to prevent clipping when dynamics tries to
3820 : ! make all constituents positive
3821 0 : wp3(i,k) = wp3(i,k) + wp3_const
3822 0 : rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const
3823 0 : wpthlp(i,k) = wpthlp(i,k) + wpthlp_const
3824 0 : wprtp(i,k) = wprtp(i,k) + wprtp_const
3825 :
3826 0 : ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance
3827 0 : ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance
3828 0 : ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance
3829 0 : ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP
3830 0 : ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP
3831 0 : ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2
3832 0 : ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3
3833 0 : ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2
3834 0 : ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2
3835 :
3836 : end do
3837 : end do
3838 :
3839 : else
3840 :
3841 0 : do k=1, pver
3842 0 : do i=1, ncol
3843 0 : ptend_loc%q(i,k,ixthlp2) = 0._r8
3844 0 : ptend_loc%q(i,k,ixrtp2) = 0._r8
3845 0 : ptend_loc%q(i,k,ixrtpthlp) = 0._r8
3846 0 : ptend_loc%q(i,k,ixwpthlp) = 0._r8
3847 0 : ptend_loc%q(i,k,ixwprtp) = 0._r8
3848 0 : ptend_loc%q(i,k,ixwp2) = 0._r8
3849 0 : ptend_loc%q(i,k,ixwp3) = 0._r8
3850 0 : ptend_loc%q(i,k,ixup2) = 0._r8
3851 0 : ptend_loc%q(i,k,ixvp2) = 0._r8
3852 : end do
3853 : end do
3854 :
3855 : end if
3856 : end if
3857 :
3858 :
3859 : ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents.
3860 : ! Loading up this array doesn't mean the tendencies are applied.
3861 : ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed
3862 : icnt=0
3863 7411824 : do ixind=1,pcnst
3864 7411824 : if (lq(ixind)) then
3865 3705912 : icnt=icnt+1
3866 : if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.&
3867 : (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.&
3868 : (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.&
3869 : (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.&
3870 3705912 : (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then
3871 :
3872 315178992 : do k=1, pver
3873 5210122392 : do i=1, ncol
3874 5206769424 : ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents
3875 : end do
3876 : end do
3877 :
3878 : end if
3879 : end if
3880 : end do
3881 :
3882 176472 : call t_stopf("clubb_tend_cam_i_loop")
3883 :
3884 176472 : call outfld('KVH_CLUBB', khzm, pcols, lchnk)
3885 :
3886 2946672 : eleak(:ncol) = (te_a(:ncol) - te_b(:ncol))/hdtime
3887 176472 : call outfld('ELEAK_CLUBB', eleak, pcols, lchnk)
3888 176472 : call outfld('TFIX_CLUBB', se_dis, pcols, lchnk)
3889 :
3890 : ! Add constant to ghost point so that output is not corrupted
3891 176472 : if (clubb_do_adv) then
3892 0 : if (macmic_it == cld_macmic_num_steps) then
3893 0 : wp3(:,pverp) = wp3(:,pverp) + wp3_const
3894 0 : rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const
3895 0 : wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const
3896 0 : wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const
3897 : end if
3898 : end if
3899 :
3900 : ! ------------------------------------------------- !
3901 : ! End column computation of CLUBB, begin to apply !
3902 : ! and compute output, etc !
3903 : ! ------------------------------------------------- !
3904 :
3905 : ! Output CLUBB tendencies (convert dry basis to wet for consistency with history variable definition)
3906 274216968 : temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
3907 176472 : call outfld( 'RVMTEND_CLUBB', temp2d, pcols, lchnk)
3908 :
3909 274216968 : temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
3910 176472 : call outfld( 'RCMTEND_CLUBB', temp2d, pcols, lchnk)
3911 :
3912 274216968 : temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
3913 176472 : call outfld( 'RIMTEND_CLUBB', temp2d, pcols, lchnk)
3914 :
3915 176472 : call outfld( 'STEND_CLUBB', ptend_loc%s,pcols, lchnk)
3916 176472 : call outfld( 'UTEND_CLUBB', ptend_loc%u,pcols, lchnk)
3917 176472 : call outfld( 'VTEND_CLUBB', ptend_loc%v,pcols, lchnk)
3918 :
3919 274216968 : cmeliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
3920 176472 : call outfld( 'CMELIQ', cmeliq, pcols, lchnk)
3921 :
3922 176472 : call physics_ptend_sum(ptend_loc,ptend_all,ncol)
3923 176472 : call physics_update(state1,ptend_loc,hdtime)
3924 :
3925 : ! Due to the order of operation of CLUBB, which closes on liquid first,
3926 : ! then advances it's predictive equations second, this can lead to
3927 : ! RHliq > 1 directly before microphysics is called. Therefore, we use
3928 : ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called.
3929 :
3930 176472 : if (clubb_do_liqsupersat) then
3931 :
3932 : ! -------------------------------------- !
3933 : ! Ice Saturation Adjustment Computation !
3934 : ! -------------------------------------- !
3935 :
3936 0 : latsub = latvap + latice
3937 :
3938 0 : lq2(:) = .FALSE.
3939 0 : lq2(ixq) = .TRUE.
3940 0 : lq2(ixcldliq) = .TRUE.
3941 0 : lq2(ixnumliq) = .TRUE.
3942 :
3943 0 : call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 )
3944 :
3945 0 : stend(:ncol,:)=0._r8
3946 0 : qvtend(:ncol,:)=0._r8
3947 0 : qctend(:ncol,:)=0._r8
3948 0 : inctend(:ncol,:)=0._r8
3949 :
3950 0 : call liquid_macro_tend(npccn(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), &
3951 0 : state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), &
3952 0 : state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), &
3953 0 : latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), &
3954 0 : qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1))
3955 :
3956 : ! update local copy of state with the tendencies
3957 0 : ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver)
3958 0 : ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver)
3959 0 : ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver)
3960 0 : ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver)
3961 :
3962 : ! Add the ice tendency to the output tendency
3963 0 : call physics_ptend_sum(ptend_loc, ptend_all, ncol)
3964 :
3965 : ! ptend_loc is reset to zero by this call
3966 0 : call physics_update(state1, ptend_loc, hdtime)
3967 :
3968 : ! Write output for tendencies:
3969 : ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE
3970 0 : temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk)
3971 0 : call outfld( 'TTENDICE', temp2d, pcols, lchnk )
3972 0 : call outfld( 'QVTENDICE', qvtend, pcols, lchnk )
3973 0 : call outfld( 'QCTENDICE', qctend, pcols, lchnk )
3974 0 : call outfld( 'NCTENDICE', inctend, pcols, lchnk )
3975 :
3976 0 : where(qctend .ne. 0._r8)
3977 : fqtend = 1._r8
3978 : elsewhere
3979 : fqtend = 0._r8
3980 : end where
3981 :
3982 0 : call outfld( 'FQTENDICE', fqtend, pcols, lchnk )
3983 : end if
3984 :
3985 : ! ------------------------------------------------------------ !
3986 : ! The rest of the code deals with diagnosing variables !
3987 : ! for microphysics/radiation computation and macrophysics !
3988 : ! ------------------------------------------------------------ !
3989 :
3990 : ! --------------------------------------------------------------------------------- !
3991 : ! COMPUTE THE ICE CLOUD DETRAINMENT !
3992 : ! Detrainment of convective condensate into the environment or stratiform cloud !
3993 : ! --------------------------------------------------------------------------------- !
3994 :
3995 : ! Initialize the shallow convective detrainment rate, will always be zero
3996 176472 : dlf2(:,:) = 0.0_r8
3997 176472 : dlf_liq_out(:,:) = 0.0_r8
3998 176472 : dlf_ice_out(:,:) = 0.0_r8
3999 :
4000 176472 : lqice(:) = .false.
4001 176472 : lqice(ixcldliq) = .true.
4002 176472 : lqice(ixcldice) = .true.
4003 176472 : lqice(ixnumliq) = .true.
4004 176472 : lqice(ixnumice) = .true.
4005 :
4006 176472 : call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice)
4007 :
4008 16588368 : do k=1,pver
4009 274216968 : do i=1,ncol
4010 257628600 : if( state1%t(i,k) > meltpt_temp ) then
4011 : dum1 = 0.0_r8
4012 204293979 : elseif ( state1%t(i,k) < dt_low ) then
4013 : dum1 = 1.0_r8
4014 : else
4015 56069330 : dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low )
4016 : endif
4017 :
4018 257628600 : ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 )
4019 257628600 : ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1
4020 0 : ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) &
4021 : / (4._r8*3.14_r8*dl_rad**3*997._r8) + & ! Deep Convection
4022 : 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
4023 257628600 : / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
4024 0 : ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) &
4025 : / (4._r8*3.14_r8*di_rad**3*500._r8) + & ! Deep Convection
4026 : 3._r8 * ( dlf2(i,k) * dum1 ) &
4027 257628600 : / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
4028 257628600 : ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
4029 :
4030 257628600 : dlf_liq_out(i,k) = dlf(i,k) * ( 1._r8 - dum1 )
4031 257628600 : dlf_ice_out(i,k) = dlf(i,k) * dum1
4032 :
4033 : ! convert moist dlf tendencies to dry
4034 257628600 : ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/state1%pdeldry(i,k)
4035 257628600 : ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/state1%pdeldry(i,k)
4036 :
4037 : ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep
4038 : ! track of the integrals of ice and static energy that is effected from conversion to ice
4039 : ! so that the energy checker doesn't complain.
4040 257628600 : det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)*rga
4041 274040496 : det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdeldry(i,k)*rga
4042 : enddo
4043 : enddo
4044 :
4045 2946672 : det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water
4046 :
4047 : ! output moist basis to be consistent with history variable definition
4048 274216968 : temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
4049 176472 : call outfld( 'DPDLFLIQ', temp2d, pcols, lchnk)
4050 :
4051 : ! output moist basis to be consistent with history variable definition
4052 274216968 : temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver)
4053 176472 : call outfld( 'DPDLFICE', temp2d, pcols, lchnk)
4054 :
4055 274216968 : temp2d(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk)
4056 176472 : call outfld( 'DPDLFT', temp2d, pcols, lchnk)
4057 :
4058 176472 : call outfld( 'DETNLIQTND', ptend_loc%q(:,:,ixnumliq),pcols, lchnk )
4059 :
4060 176472 : call physics_ptend_sum(ptend_loc,ptend_all,ncol)
4061 176472 : call physics_update(state1,ptend_loc,hdtime)
4062 :
4063 : ! ptend_all now has all accumulated tendencies. Convert the tendencies for the
4064 : ! wet constituents to wet air basis.
4065 7411824 : do ixind = 1, pcnst
4066 7411824 : if (lq(ixind) .and. cnst_type(ixind) == 'wet') then
4067 165883680 : do k = 1, pver
4068 2742169680 : do i = 1, ncol
4069 2740404960 : ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state1%pdeldry(i,k)/state1%pdel(i,k)
4070 : end do
4071 : end do
4072 : end if
4073 : end do
4074 :
4075 : ! ------------------------------------------------- !
4076 : ! Diagnose relative cloud water variance !
4077 : ! ------------------------------------------------- !
4078 :
4079 176472 : if (deep_scheme == 'CLUBB_SGS') then
4080 : relvarmax = 2.0_r8
4081 : else
4082 176472 : relvarmax = 10.0_r8
4083 : endif
4084 :
4085 279178704 : relvar(:,:) = relvarmax ! default
4086 :
4087 176472 : if (deep_scheme .ne. 'CLUBB_SGS') then
4088 176472 : where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) &
4089 822474432 : relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver)))
4090 : endif
4091 :
4092 : ! ------------------------------------------------- !
4093 : ! Optional Accretion enhancement factor !
4094 : ! ------------------------------------------------- !
4095 274216968 : accre_enhan(:ncol,:pver) = 1._r8
4096 :
4097 : ! ------------------------------------------------- !
4098 : ! Diagnose some output variables !
4099 : ! ------------------------------------------------- !
4100 :
4101 : ! density
4102 274216968 : rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp))
4103 2946672 : rho(1:ncol,pverp) = rho(1:ncol,pver)
4104 :
4105 176472 : wpthvp_diag(:,:) = 0.0_r8
4106 16588368 : do k=1,pver
4107 274216968 : do i=1,ncol
4108 257628600 : eps = rairv(i,k,lchnk)*inv_rh2o
4109 : ! buoyancy flux
4110 257628600 : wpthvp_diag(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* &
4111 0 : (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpairv(i,k,lchnk))* &
4112 257628600 : state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k)
4113 :
4114 : ! total water mixing ratio
4115 257628600 : qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice)
4116 : ! liquid water potential temperature
4117 257628600 : thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq)
4118 : ! liquid water static energy
4119 274040496 : sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq)
4120 : enddo
4121 : enddo
4122 :
4123 16764840 : do k=1,pverp
4124 277163640 : do i=1,ncol
4125 260398800 : wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux
4126 260398800 : wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux
4127 260398800 : rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output
4128 260398800 : wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output
4129 260398800 : tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy
4130 276987168 : if (do_clubb_mf) then
4131 0 : mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair
4132 0 : mf_qtflx_output(i,k) = mf_qtflx_output(i,k)*rho(i,k)*latvap
4133 : end if
4134 : enddo
4135 : enddo
4136 :
4137 : ! --------------------------------------------------------------------------------- !
4138 : ! Diagnose some quantities that are computed in macrop_tend here. !
4139 : ! These are inputs required for the microphysics calculation. !
4140 : ! !
4141 : ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION !
4142 : ! --------------------------------------------------------------------------------- !
4143 :
4144 : ! initialize variables
4145 279178704 : alst(:,:) = 0.0_r8
4146 279178704 : qlst(:,:) = 0.0_r8
4147 :
4148 16588368 : do k=1,pver
4149 274216968 : do i=1,ncol
4150 257628600 : alst(i,k) = cloud_frac(i,k)
4151 274040496 : qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio
4152 : enddo
4153 : enddo
4154 :
4155 : ! --------------------------------------------------------------------------------- !
4156 : ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION !
4157 : ! --------------------------------------------------------------------------------- !
4158 :
4159 279178704 : deepcu(:,:) = 0.0_r8
4160 279178704 : shalcu(:,:) = 0.0_r8
4161 :
4162 16411896 : do k=1,pver-1
4163 271270296 : do i=1,ncol
4164 : ! diagnose the deep convective cloud fraction, as done in macrophysics based on the
4165 : ! deep convective mass flux, read in from pbuf. Since shallow convection is never
4166 : ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud
4167 : ! fraction is purely from deep convection scheme.
4168 254858400 : deepcu(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8))
4169 254858400 : shalcu(i,k) = 0._r8
4170 :
4171 254858400 : if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then
4172 249016494 : deepcu(i,k) = 0._r8
4173 : endif
4174 :
4175 : ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable
4176 : ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation
4177 : ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud
4178 : ! from CLUBB plus the deep convective cloud fraction
4179 271093824 : concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8)
4180 : enddo
4181 : enddo
4182 :
4183 176472 : if (single_column) then
4184 : if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. &
4185 : trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. &
4186 : trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. &
4187 : trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. &
4188 0 : trim(scm_clubb_iop_name) == 'RICO_3day' .or. &
4189 : trim(scm_clubb_iop_name) == 'ARM_CC') then
4190 :
4191 0 : deepcu(:,:) = 0.0_r8
4192 0 : concld(:,:) = 0.0_r8
4193 :
4194 : endif
4195 : endif
4196 :
4197 : ! --------------------------------------------------------------------------------- !
4198 : ! COMPUTE THE ICE CLOUD FRACTION PORTION !
4199 : ! use the aist_vector function to compute the ice cloud fraction !
4200 : ! --------------------------------------------------------------------------------- !
4201 :
4202 27176688 : aist(:,:top_lev-1) = 0._r8
4203 279178704 : qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below
4204 :
4205 15000120 : do k = top_lev, pver
4206 :
4207 : ! For Type II PSC and for thin cirrus, the clouds can be thin, but
4208 : ! extensive and they should start forming when the gridbox mean saturation
4209 : ! reaches 1.0.
4210 : !
4211 : ! For now, use the tropopause diagnostic to determine where the Type II
4212 : ! PSC should be, but in the future wold like a better metric that can also
4213 : ! identify the level for thin cirrus. Include the tropopause level so that
4214 : ! the cold point tropopause will use the stratospheric values.
4215 1200715488 : where (k <= troplev)
4216 : rhmini = rhminis_const
4217 : rhmaxi = rhmaxis_const
4218 : elsewhere
4219 : rhmini = rhmini_const
4220 : rhmaxi = rhmaxi_const
4221 : end where
4222 :
4223 15000120 : if ( trim(subcol_scheme) == 'SILHS' ) then
4224 : call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), &
4225 0 : state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol )
4226 : else
4227 : call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), &
4228 : state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,&
4229 14823648 : qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi)
4230 : endif
4231 : enddo
4232 :
4233 : ! --------------------------------------------------------------------------------- !
4234 : ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION !
4235 : ! !
4236 : ! For now leave the computation of ice stratus fraction from macrop_driver intact !
4237 : ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus !
4238 : ! fraction that was coded in macrop_driver !
4239 : ! --------------------------------------------------------------------------------- !
4240 :
4241 : ! Recompute net stratus fraction using maximum over-lapping assumption, as done
4242 : ! in macrophysics code, using alst computed above and aist read in from physics buffer
4243 :
4244 16588368 : do k=1,pver
4245 274216968 : do i=1,ncol
4246 257628600 : ast(i,k) = max(alst(i,k),aist(i,k))
4247 274040496 : qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k))
4248 : enddo
4249 : enddo
4250 :
4251 : ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just
4252 : ! be outputting the shallow convective cloud fraction
4253 16588368 : do k=1,pver
4254 274216968 : do i=1,ncol
4255 274040496 : cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8)
4256 : enddo
4257 : enddo
4258 :
4259 : ! --------------------------------------------------------------------------------- !
4260 : ! DIAGNOSE THE PBL DEPTH !
4261 : ! this is needed for aerosol code !
4262 : ! --------------------------------------------------------------------------------- !
4263 2946672 : do i=1,ncol
4264 260575272 : do k=1,pver
4265 : !use local exner since state%exner is not a proper exner
4266 257628600 : th(i,k) = state1%t(i,k)*inv_exner_clubb(i,k)
4267 : !thv should have condensate loading to be consistent with earlier def's in this module
4268 260398800 : thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq) - state1%q(i,k,ixcldliq))
4269 : enddo
4270 : enddo
4271 :
4272 : ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth)
4273 2946672 : rrho(1:ncol) = (rga)*(state1%pdel(1:ncol,pver)/dz_g(1:ncol,pver))
4274 352944 : call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), &
4275 529416 : rrho(1:ncol), ustar2(1:ncol))
4276 : ! use correct qflux from coupler
4277 0 : call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%cflx(1:ncol,1), cam_in%shf(1:ncol), &
4278 : rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), &
4279 176472 : obklen(1:ncol))
4280 :
4281 176472 : dummy2(:) = 0._r8
4282 176472 : dummy3(:) = 0._r8
4283 :
4284 2946672 : where (kbfs(:ncol) == -0.0_r8) kbfs(:ncol) = 0.0_r8
4285 :
4286 : ! Compute PBL depth according to Holtslag-Boville Scheme
4287 : call pblintd(ncol, thv, state1%zm, state1%u, state1%v, &
4288 : ustar2, obklen, kbfs, pblh, dummy2, &
4289 3000024 : state1%zi, cloud_frac(:,1:pver), 1._r8-cam_in%landfrac, dummy3)
4290 :
4291 : ! Output the PBL depth
4292 176472 : call outfld('PBLH', pblh, pcols, lchnk)
4293 :
4294 : ! Assign the first pver levels of cloud_frac back to cld
4295 558180936 : cld(:,1:pver) = cloud_frac(:,1:pver)
4296 :
4297 : ! --------------------------------------------------------------------------------- !
4298 : ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer !
4299 : ! --------------------------------------------------------------------------------- !
4300 :
4301 : ! Output calls of variables goes here
4302 176472 : call outfld( 'RELVAR', relvar, pcols, lchnk )
4303 176472 : call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk )
4304 176472 : call outfld( 'WP2_CLUBB', wp2, pcols, lchnk )
4305 176472 : call outfld( 'UP2_CLUBB', up2, pcols, lchnk )
4306 176472 : call outfld( 'VP2_CLUBB', vp2, pcols, lchnk )
4307 176472 : call outfld( 'WP3_CLUBB', wp3_output(:,1:pver), pcols, lchnk )
4308 176472 : call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk )
4309 176472 : call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk )
4310 176472 : call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk )
4311 176472 : call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk )
4312 176472 : call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk )
4313 176472 : call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk )
4314 176472 : call outfld( 'RCM_CLUBB', rcm(:,1:pver), pcols, lchnk )
4315 176472 : call outfld( 'RTM_CLUBB', rtm(:,1:pver), pcols, lchnk )
4316 176472 : call outfld( 'THLM_CLUBB', thlm(:,1:pver), pcols, lchnk )
4317 :
4318 277163640 : temp2dp(:ncol,:) = wprcp(:ncol,:) * latvap
4319 176472 : call outfld( 'WPRCP_CLUBB', temp2dp, pcols, lchnk )
4320 :
4321 277163640 : temp2dp(:ncol,:) = wpthvp(:ncol,:) * cpair
4322 176472 : call outfld( 'WPTHVP_CLUBB', temp2dp, pcols, lchnk )
4323 :
4324 176472 : call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out(:,1:pver), pcols, lchnk )
4325 176472 : call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out(:,1:pver), pcols, lchnk )
4326 176472 : call outfld( 'WP2_ZT_CLUBB', wp2_zt_out(:,1:pver), pcols, lchnk )
4327 176472 : call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk )
4328 176472 : call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk )
4329 176472 : call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer(:,1:pver), pcols, lchnk )
4330 176472 : call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk )
4331 176472 : call outfld( 'CLOUDCOVER_CLUBB', cloud_frac(:,1:pver), pcols, lchnk )
4332 176472 : call outfld( 'ZT_CLUBB', zt_out(:,1:pver), pcols, lchnk )
4333 176472 : call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk )
4334 176472 : call outfld( 'UM_CLUBB', um(:,1:pver), pcols, lchnk )
4335 176472 : call outfld( 'VM_CLUBB', vm(:,1:pver), pcols, lchnk )
4336 176472 : call outfld( 'WM_ZT_CLUBB', wm_zt_out(:,1:pver), pcols, lchnk )
4337 176472 : call outfld( 'CONCLD', concld, pcols, lchnk )
4338 176472 : call outfld( 'DP_CLD', deepcu, pcols, lchnk )
4339 176472 : call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk )
4340 176472 : call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk )
4341 176472 : call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk )
4342 176472 : call outfld( 'QSATFAC', qsatfac, pcols, lchnk)
4343 :
4344 :
4345 : ! --------------------------------------------------------------- !
4346 : ! Writing state variables after EDMF scheme for detailed analysis !
4347 : ! --------------------------------------------------------------- !
4348 176472 : if (do_clubb_mf) then
4349 0 : call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk )
4350 0 : call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk )
4351 0 : call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk )
4352 0 : call outfld( 'edmf_MOIST_W' , mf_moist_w_output, pcols, lchnk )
4353 0 : call outfld( 'edmf_DRY_QT' , mf_dry_qt_output, pcols, lchnk )
4354 0 : call outfld( 'edmf_MOIST_QT' , mf_moist_qt_output, pcols, lchnk )
4355 0 : call outfld( 'edmf_DRY_THL' , mf_dry_thl_output, pcols, lchnk )
4356 0 : call outfld( 'edmf_MOIST_THL', mf_moist_thl_output, pcols, lchnk )
4357 0 : call outfld( 'edmf_DRY_U' , mf_dry_u_output, pcols, lchnk )
4358 0 : call outfld( 'edmf_MOIST_U' , mf_moist_u_output, pcols, lchnk )
4359 0 : call outfld( 'edmf_DRY_V' , mf_dry_v_output, pcols, lchnk )
4360 0 : call outfld( 'edmf_MOIST_V' , mf_moist_v_output, pcols, lchnk )
4361 0 : call outfld( 'edmf_MOIST_QC' , mf_moist_qc_output, pcols, lchnk )
4362 0 : call outfld( 'edmf_S_AE' , s_ae_output, pcols, lchnk )
4363 0 : call outfld( 'edmf_S_AW' , s_aw_output, pcols, lchnk )
4364 0 : call outfld( 'edmf_S_AWTHL' , s_awthl_output, pcols, lchnk )
4365 0 : call outfld( 'edmf_S_AWQT' , s_awqt_output, pcols, lchnk )
4366 0 : call outfld( 'edmf_S_AWU' , s_awu_output, pcols, lchnk )
4367 0 : call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk )
4368 0 : call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk )
4369 0 : call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk )
4370 : end if
4371 :
4372 : ! Output CLUBB history here
4373 176472 : if (stats_metadata%l_stats) then
4374 :
4375 0 : do j=1,stats_zt(1)%num_output_fields
4376 :
4377 0 : temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name)
4378 0 : sub = temp1
4379 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
4380 :
4381 0 : call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk )
4382 : enddo
4383 :
4384 0 : do j=1,stats_zm(1)%num_output_fields
4385 :
4386 0 : temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name)
4387 0 : sub = temp1
4388 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
4389 :
4390 0 : call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk)
4391 : enddo
4392 :
4393 0 : if (stats_metadata%l_output_rad_files) then
4394 0 : do j=1,stats_rad_zt(1)%num_output_fields
4395 0 : call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk)
4396 : enddo
4397 :
4398 0 : do j=1,stats_rad_zm(1)%num_output_fields
4399 0 : call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk)
4400 : enddo
4401 : endif
4402 :
4403 0 : do j=1,stats_sfc(1)%num_output_fields
4404 0 : call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk)
4405 : enddo
4406 :
4407 : endif
4408 :
4409 176472 : call t_stopf("clubb_tend_cam")
4410 :
4411 176472 : return
4412 : #endif
4413 529416 : end subroutine clubb_tend_cam
4414 :
4415 2470608 : subroutine clubb_emissions_cam (state, cam_in, ptend)
4416 :
4417 : !-------------------------------------------------------------------------------
4418 : ! Description: Apply surface fluxes of constituents to lowest model level
4419 : ! except water vapor (applied in clubb_tend_cam)
4420 : !
4421 : ! Author: Adam Herrington, November 2022
4422 : ! Origin: Based on E3SM's clubb_surface subroutine
4423 : ! References:
4424 : ! None
4425 : !-------------------------------------------------------------------------------
4426 176472 : use physics_types, only: physics_ptend, physics_ptend_init, physics_state
4427 : use constituents, only: cnst_type
4428 : use camsrfexch, only: cam_in_t
4429 :
4430 : ! --------------- !
4431 : ! Input Arguments !
4432 : ! --------------- !
4433 : type(physics_state), intent(in) :: state ! Physics state variables
4434 : type(cam_in_t), intent(in) :: cam_in ! Surface inputs
4435 :
4436 : ! ---------------------- !
4437 : ! Output Arguments !
4438 : ! ---------------------- !
4439 : type(physics_ptend), intent(out) :: ptend ! Individual parameterization tendencies
4440 :
4441 : ! --------------- !
4442 : ! Local Variables !
4443 : ! --------------- !
4444 : integer :: m, ncol
4445 : logical :: lq(pcnst)
4446 :
4447 : ! ----------------------- !
4448 : ! Main Computation Begins !
4449 : ! ----------------------- !
4450 58824 : ncol = state%ncol
4451 :
4452 58824 : lq(1) = .false.
4453 2411784 : lq(2:) = .true.
4454 58824 : call physics_ptend_init(ptend,state%psetcols, "clubb emissions", lq=lq)
4455 :
4456 : ! Apply tracer fluxes to lowest model level (except water vapor)
4457 2411784 : do m = 2,pcnst
4458 39347784 : ptend%q(:ncol,pver,m) = cam_in%cflx(:ncol,m)*state%rpdel(:ncol,pver)*gravit
4459 : end do
4460 :
4461 : ! Convert tendencies of dry constituents to dry basis.
4462 2411784 : do m = 2,pcnst
4463 2411784 : if (cnst_type(m).eq.'dry') then
4464 29466720 : ptend%q(:ncol,pver,m) = ptend%q(:ncol,pver,m)*state%pdel(:ncol,pver)*state%rpdeldry(:ncol,pver)
4465 : endif
4466 : end do
4467 :
4468 58824 : end subroutine clubb_emissions_cam
4469 :
4470 : ! =============================================================================== !
4471 : ! !
4472 : ! =============================================================================== !
4473 :
4474 : ! Saturation adjustment for ice
4475 : ! Add ice mass if supersaturated
4476 0 : subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen)
4477 :
4478 58824 : use wv_sat_methods, only: wv_sat_qsat_ice
4479 :
4480 : integer, intent(in) :: vlen
4481 : real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei
4482 : real(r8), dimension(vlen), intent(in) :: t !temperature (k)
4483 : real(r8), dimension(vlen), intent(in) :: p !pressure (pa)
4484 : real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio
4485 : real(r8), dimension(vlen), intent(in) :: qi !ice mixing ratio
4486 : real(r8), dimension(vlen), intent(in) :: ni !ice number concentration
4487 : real(r8), intent(in) :: xxls !latent heat of freezing
4488 : real(r8), intent(in) :: deltat !timestep
4489 : real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency
4490 : real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency
4491 : real(r8), dimension(vlen), intent(out) :: qitend !ice mass tendency
4492 : real(r8), dimension(vlen), intent(out) :: nitend !ice number tendency
4493 :
4494 0 : real(r8) :: ESI(vlen)
4495 0 : real(r8) :: QSI(vlen)
4496 : integer :: i
4497 :
4498 0 : do i = 1, vlen
4499 0 : stend(i) = 0._r8
4500 0 : qvtend(i) = 0._r8
4501 0 : qitend(i) = 0._r8
4502 0 : nitend(i) = 0._r8
4503 : end do
4504 :
4505 : ! calculate qsati from t,p,q
4506 0 : do i = 1, vlen
4507 0 : call wv_sat_qsat_ice(t(i), p(i), ESI(i), QSI(i))
4508 : end do
4509 :
4510 0 : do i = 1, vlen
4511 0 : if (naai(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then
4512 :
4513 0 : qitend(i) = (qv(i)-QSI(i))/deltat
4514 0 : qvtend(i) = 0._r8 - qitend(i)
4515 0 : stend(i) = qitend(i) * xxls ! moist static energy tend...[J/kg/s] !
4516 :
4517 : ! if ice exists (more than 1 L-1) and there is condensation, do not add to number (= growth), else, add 10um ice
4518 0 : if (ni(i) < 1.e3_r8 .and. (qi(i)+qitend(i)*deltat) > 1.e-18_r8) then
4519 0 : nitend(i) = nitend(i) + 3._r8 * qitend(i)/(4._r8*3.14_r8* 10.e-6_r8**3*997._r8)
4520 : end if
4521 :
4522 : end if
4523 : end do
4524 :
4525 0 : end subroutine ice_macro_tend
4526 :
4527 : #ifdef CLUBB_SGS
4528 : ! ----------------------------------------------------------------------
4529 : !
4530 : ! DISCLAIMER : this code appears to be correct but has not been
4531 : ! very thouroughly tested. If you do notice any
4532 : ! anomalous behaviour then please contact Andy and/or
4533 : ! Bjorn
4534 : !
4535 : ! Function diag_ustar: returns value of ustar using the below
4536 : ! similarity functions and a specified buoyancy flux (bflx) given in
4537 : ! kinematic units
4538 : !
4539 : ! phi_m (zeta > 0) = (1 + am * zeta)
4540 : ! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4)
4541 : !
4542 : ! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar)
4543 : !
4544 : ! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface
4545 : ! Layer, in Workshop on Micormeteorology, pages 67-100.
4546 : !
4547 : ! Code writen March, 1999 by Bjorn Stevens
4548 : !
4549 :
4550 0 : real(r8) function diag_ustar( z, bflx, wnd, z0 )
4551 :
4552 : use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g
4553 :
4554 : implicit none
4555 :
4556 : real(r8), parameter :: am = 4.8_r8 ! " " "
4557 : real(r8), parameter :: bm = 19.3_r8 ! " " "
4558 :
4559 : real(r8), parameter :: grav = shr_const_g
4560 : real(r8), parameter :: vonk = shr_const_karman
4561 : real(r8), parameter :: pi = shr_const_pi
4562 :
4563 : real(r8), intent (in) :: z ! height where u locates
4564 : real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3)
4565 : real(r8), intent (in) :: wnd ! wind speed at z
4566 : real(r8), intent (in) :: z0 ! momentum roughness height
4567 :
4568 :
4569 : integer :: iterate
4570 : real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar
4571 :
4572 0 : lnz = log( z / z0 )
4573 0 : klnz = vonk/lnz
4574 0 : c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 )
4575 :
4576 0 : ustar = wnd*klnz
4577 0 : if (abs(bflx) > 1.e-6_r8) then
4578 0 : do iterate=1,4
4579 :
4580 0 : if (ustar > 1.e-6_r8) then
4581 0 : lmo = -ustar**3 / ( vonk * bflx )
4582 0 : zeta = z/lmo
4583 0 : if (zeta > 0._r8) then
4584 0 : ustar = vonk*wnd /(lnz + am*zeta)
4585 : else
4586 0 : x = sqrt( sqrt( 1.0_r8 - bm*zeta ) )
4587 0 : psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1
4588 0 : ustar = wnd*vonk/(lnz - psi1)
4589 : end if
4590 :
4591 : endif
4592 :
4593 : end do
4594 : end if
4595 :
4596 :
4597 0 : diag_ustar = ustar
4598 :
4599 : return
4600 :
4601 :
4602 : end function diag_ustar
4603 : #endif
4604 :
4605 : ! =============================================================================== !
4606 : ! !
4607 : ! =============================================================================== !
4608 :
4609 : #ifdef CLUBB_SGS
4610 :
4611 0 : subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, &
4612 : nnzp, nnrad_zt,nnrad_zm, delt, &
4613 : stats_zt, stats_zm, stats_sfc, &
4614 : stats_rad_zt, stats_rad_zm)
4615 : !
4616 : ! Description: Initializes the statistics saving functionality of
4617 : ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here
4618 : ! the traditional stats_init of CLUBB is not called, as it is not compatible
4619 : ! with CAM output.
4620 :
4621 : !-----------------------------------------------------------------------
4622 :
4623 : use clubb_api_module, only: time_precision, & !
4624 : nvarmax_zm, stats_init_zm_api, & !
4625 : nvarmax_zt, stats_init_zt_api, & !
4626 : nvarmax_rad_zt, stats_init_rad_zt_api, & !
4627 : nvarmax_rad_zm, stats_init_rad_zm_api, & !
4628 : nvarmax_sfc, stats_init_sfc_api, & !
4629 : fstderr, var_length !
4630 : use cam_abortutils, only: endrun
4631 : use cam_history, only: addfld, horiz_only
4632 : use namelist_utils, only: find_group_name
4633 : use units, only: getunit, freeunit
4634 : use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character
4635 :
4636 : implicit none
4637 :
4638 : !----------------------- Input Variables -----------------------
4639 :
4640 : logical, intent(in) :: l_stats_in ! Stats on? T/F
4641 :
4642 : real(kind=time_precision), intent(in) :: &
4643 : stats_tsamp_in, & ! Sampling interval [s]
4644 : stats_tout_in ! Output interval [s]
4645 :
4646 : integer, intent(in) :: nnzp ! Grid points in the vertical [count]
4647 : integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count]
4648 : integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count]
4649 :
4650 : real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s]
4651 :
4652 : !----------------------- Output Variables -----------------------
4653 : type (stats), intent(out), dimension(pcols) :: &
4654 : stats_zt, & ! stats_zt grid
4655 : stats_zm, & ! stats_zm grid
4656 : stats_rad_zt, & ! stats_rad_zt grid
4657 : stats_rad_zm, & ! stats_rad_zm grid
4658 : stats_sfc ! stats_sfc
4659 :
4660 :
4661 : !----------------------- Local Variables -----------------------
4662 :
4663 : ! Namelist Variables
4664 :
4665 : character(len=*), parameter :: subr = 'stats_init_clubb'
4666 :
4667 : character(len=var_length), dimension(nvarmax_zt) :: clubb_vars_zt ! Variables on the thermodynamic levels
4668 : character(len=var_length), dimension(nvarmax_zm) :: clubb_vars_zm ! Variables on the momentum levels
4669 : character(len=var_length), dimension(nvarmax_rad_zt) :: clubb_vars_rad_zt ! Variables on the radiation levels
4670 : character(len=var_length), dimension(nvarmax_rad_zm) :: clubb_vars_rad_zm ! Variables on the radiation levels
4671 : character(len=var_length), dimension(nvarmax_sfc) :: clubb_vars_sfc ! Variables at the model surface
4672 :
4673 : namelist /clubb_stats_nl/ &
4674 : clubb_vars_zt, &
4675 : clubb_vars_zm, &
4676 : clubb_vars_rad_zt, &
4677 : clubb_vars_rad_zm, &
4678 : clubb_vars_sfc
4679 :
4680 : logical :: l_error
4681 :
4682 : character(len=200) :: temp1, sub
4683 :
4684 : integer :: i, ntot, read_status, j
4685 : integer :: iunit, ierr
4686 :
4687 : !----------------------- Begin Code -----------------------
4688 :
4689 : ! Initialize
4690 0 : l_error = .false.
4691 :
4692 : ! Set stats_variables variables with inputs from calling subroutine
4693 0 : stats_metadata%l_stats = l_stats_in
4694 :
4695 0 : stats_metadata%stats_tsamp = stats_tsamp_in
4696 0 : stats_metadata%stats_tout = stats_tout_in
4697 :
4698 0 : if ( .not. stats_metadata%l_stats ) then
4699 0 : stats_metadata%l_stats_samp = .false.
4700 0 : stats_metadata%l_stats_last = .false.
4701 0 : return
4702 : end if
4703 :
4704 : ! Initialize namelist variables
4705 :
4706 0 : clubb_vars_zt = ''
4707 0 : clubb_vars_zm = ''
4708 0 : clubb_vars_rad_zt = ''
4709 0 : clubb_vars_rad_zm = ''
4710 0 : clubb_vars_sfc = ''
4711 :
4712 : ! Read variables to compute from the namelist
4713 0 : if (masterproc) then
4714 0 : iunit= getunit()
4715 0 : open(unit=iunit,file="atm_in",status='old')
4716 0 : call find_group_name(iunit, 'clubb_stats_nl', status=read_status)
4717 0 : if (read_status == 0) then
4718 0 : read(unit=iunit, nml=clubb_stats_nl, iostat=read_status)
4719 0 : if (read_status /= 0) then
4720 0 : call endrun('stats_init_clubb: error reading namelist')
4721 : end if
4722 : end if
4723 0 : close(unit=iunit)
4724 0 : call freeunit(iunit)
4725 : end if
4726 :
4727 : ! Broadcast namelist variables
4728 0 : call mpi_bcast(clubb_vars_zt, var_length*nvarmax_zt, mpi_character, mstrid, mpicom, ierr)
4729 0 : if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zt")
4730 0 : call mpi_bcast(clubb_vars_zm, var_length*nvarmax_zm, mpi_character, mstrid, mpicom, ierr)
4731 0 : if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zm")
4732 0 : call mpi_bcast(clubb_vars_rad_zt, var_length*nvarmax_rad_zt, mpi_character, mstrid, mpicom, ierr)
4733 0 : if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zt")
4734 0 : call mpi_bcast(clubb_vars_rad_zm, var_length*nvarmax_rad_zm, mpi_character, mstrid, mpicom, ierr)
4735 0 : if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zm")
4736 0 : call mpi_bcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpi_character, mstrid, mpicom, ierr)
4737 0 : if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_sfc")
4738 :
4739 :
4740 : ! Hardcode these for use in CAM-CLUBB, don't want either
4741 0 : stats_metadata%l_netcdf = .false.
4742 0 : stats_metadata%l_grads = .false.
4743 :
4744 : ! Check sampling and output frequencies
4745 0 : do j = 1, pcols
4746 :
4747 : ! The model time step length, delt (which is dtmain), should multiply
4748 : ! evenly into the statistical sampling time step length, stats_tsamp.
4749 0 : if ( abs( stats_metadata%stats_tsamp/delt - floor(stats_metadata%stats_tsamp/delt) ) > 1.e-8_r8 ) then
4750 0 : l_error = .true. ! This will cause the run to stop.
4751 0 : write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', &
4752 0 : 'the clubb time step (delt below)'
4753 0 : write(fstderr,*) 'stats_tsamp = ', stats_metadata%stats_tsamp
4754 0 : write(fstderr,*) 'delt = ', delt
4755 0 : call endrun ("stats_init_clubb: CLUBB stats_tsamp must be an even multiple of the timestep")
4756 : endif
4757 :
4758 : ! Initialize zt (mass points)
4759 :
4760 0 : i = 1
4761 0 : do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. &
4762 0 : len_trim(clubb_vars_zt(i)) /= 0 .and. &
4763 0 : i <= nvarmax_zt )
4764 0 : i = i + 1
4765 : enddo
4766 0 : ntot = i - 1
4767 0 : if ( ntot == nvarmax_zt ) then
4768 0 : l_error = .true.
4769 0 : write(fstderr,*) "There are more statistical variables listed in ", &
4770 0 : "clubb_vars_zt than allowed for by nvarmax_zt."
4771 0 : write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", &
4772 0 : "in the stats namelist, or change nvarmax_zt."
4773 0 : write(fstderr,*) "nvarmax_zt = ", nvarmax_zt
4774 0 : call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit")
4775 : endif
4776 :
4777 0 : stats_zt(j)%num_output_fields = ntot
4778 0 : stats_zt(j)%kk = nnzp
4779 :
4780 0 : allocate( stats_zt(j)%z( stats_zt(j)%kk ), stat=ierr )
4781 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%z")
4782 :
4783 0 : allocate( stats_zt(j)%accum_field_values( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr )
4784 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_field_values")
4785 0 : allocate( stats_zt(j)%accum_num_samples( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr )
4786 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_num_samples")
4787 0 : allocate( stats_zt(j)%l_in_update( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr )
4788 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%l_in_update")
4789 : call stats_zero( stats_zt(j)%kk, stats_zt(j)%num_output_fields, stats_zt(j)%accum_field_values, &
4790 0 : stats_zt(j)%accum_num_samples, stats_zt(j)%l_in_update )
4791 :
4792 0 : allocate( stats_zt(j)%file%grid_avg_var( stats_zt(j)%num_output_fields ), stat=ierr )
4793 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%grid_avg_var")
4794 0 : allocate( stats_zt(j)%file%z( stats_zt(j)%kk ), stat=ierr )
4795 0 : if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%z")
4796 :
4797 : ! Default initialization for array indices for zt
4798 : call stats_init_zt_api( clubb_vars_zt, &
4799 : l_error, &
4800 : stats_metadata, stats_zt(j) )
4801 :
4802 : ! Initialize zm (momentum points)
4803 :
4804 0 : i = 1
4805 0 : do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. &
4806 0 : len_trim(clubb_vars_zm(i)) /= 0 .and. &
4807 0 : i <= nvarmax_zm )
4808 0 : i = i + 1
4809 : end do
4810 0 : ntot = i - 1
4811 0 : if ( ntot == nvarmax_zm ) then
4812 0 : l_error = .true. ! This will cause the run to stop.
4813 0 : write(fstderr,*) "There are more statistical variables listed in ", &
4814 0 : "clubb_vars_zm than allowed for by nvarmax_zm."
4815 0 : write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", &
4816 0 : "in the stats namelist, or change nvarmax_zm."
4817 0 : write(fstderr,*) "nvarmax_zm = ", nvarmax_zm
4818 0 : call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit")
4819 : endif
4820 :
4821 0 : stats_zm(j)%num_output_fields = ntot
4822 0 : stats_zm(j)%kk = nnzp
4823 :
4824 0 : allocate( stats_zm(j)%z( stats_zm(j)%kk ) )
4825 :
4826 0 : allocate( stats_zm(j)%accum_field_values( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) )
4827 0 : allocate( stats_zm(j)%accum_num_samples( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) )
4828 0 : allocate( stats_zm(j)%l_in_update( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) )
4829 : call stats_zero( stats_zm(j)%kk, stats_zm(j)%num_output_fields, stats_zm(j)%accum_field_values, &
4830 : stats_zm(j)%accum_num_samples, stats_zm(j)%l_in_update )
4831 :
4832 0 : allocate( stats_zm(j)%file%grid_avg_var( stats_zm(j)%num_output_fields ) )
4833 0 : allocate( stats_zm(j)%file%z( stats_zm(j)%kk ) )
4834 :
4835 : call stats_init_zm_api( clubb_vars_zm, &
4836 : l_error, &
4837 : stats_metadata, stats_zm(j) )
4838 :
4839 : ! Initialize rad_zt (radiation points)
4840 :
4841 0 : if (stats_metadata%l_output_rad_files) then
4842 :
4843 : i = 1
4844 0 : do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. &
4845 0 : len_trim(clubb_vars_rad_zt(i)) /= 0 .and. &
4846 0 : i <= nvarmax_rad_zt )
4847 0 : i = i + 1
4848 : end do
4849 0 : ntot = i - 1
4850 0 : if ( ntot == nvarmax_rad_zt ) then
4851 0 : write(fstderr,*) "There are more statistical variables listed in ", &
4852 0 : "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt."
4853 0 : write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", &
4854 0 : "in the stats namelist, or change nvarmax_rad_zt."
4855 0 : write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt
4856 0 : call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit")
4857 : endif
4858 :
4859 0 : stats_rad_zt(j)%num_output_fields = ntot
4860 0 : stats_rad_zt(j)%kk = nnrad_zt
4861 :
4862 0 : allocate( stats_rad_zt(j)%z( stats_rad_zt(j)%kk ) )
4863 :
4864 0 : allocate( stats_rad_zt(j)%accum_field_values( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) )
4865 0 : allocate( stats_rad_zt(j)%accum_num_samples( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) )
4866 0 : allocate( stats_rad_zt(j)%l_in_update( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) )
4867 :
4868 : call stats_zero( stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields, stats_rad_zt(j)%accum_field_values, &
4869 : stats_rad_zt(j)%accum_num_samples, stats_rad_zt(j)%l_in_update )
4870 :
4871 0 : allocate( stats_rad_zt(j)%file%grid_avg_var( stats_rad_zt(j)%num_output_fields ) )
4872 0 : allocate( stats_rad_zt(j)%file%z( stats_rad_zt(j)%kk ) )
4873 :
4874 : call stats_init_rad_zt_api( clubb_vars_rad_zt, &
4875 : l_error, &
4876 : stats_metadata, stats_rad_zt(j) )
4877 :
4878 : ! Initialize rad_zm (radiation points)
4879 :
4880 0 : i = 1
4881 0 : do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. &
4882 0 : len_trim(clubb_vars_rad_zm(i)) /= 0 .and. &
4883 0 : i <= nvarmax_rad_zm )
4884 0 : i = i + 1
4885 : end do
4886 0 : ntot = i - 1
4887 0 : if ( ntot == nvarmax_rad_zm ) then
4888 0 : l_error = .true. ! This will cause the run to stop.
4889 0 : write(fstderr,*) "There are more statistical variables listed in ", &
4890 0 : "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm."
4891 0 : write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", &
4892 0 : "in the stats namelist, or change nvarmax_rad_zm."
4893 0 : write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm
4894 0 : call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit")
4895 : endif
4896 :
4897 0 : stats_rad_zm(j)%num_output_fields = ntot
4898 0 : stats_rad_zm(j)%kk = nnrad_zm
4899 :
4900 0 : allocate( stats_rad_zm(j)%z( stats_rad_zm(j)%kk ) )
4901 :
4902 0 : allocate( stats_rad_zm(j)%accum_field_values( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) )
4903 0 : allocate( stats_rad_zm(j)%accum_num_samples( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) )
4904 0 : allocate( stats_rad_zm(j)%l_in_update( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) )
4905 :
4906 : call stats_zero( stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields, stats_rad_zm(j)%accum_field_values, &
4907 : stats_rad_zm(j)%accum_num_samples, stats_rad_zm(j)%l_in_update )
4908 :
4909 0 : allocate( stats_rad_zm(j)%file%grid_avg_var( stats_rad_zm(j)%num_output_fields ) )
4910 0 : allocate( stats_rad_zm(j)%file%z( stats_rad_zm(j)%kk ) )
4911 :
4912 : call stats_init_rad_zm_api( clubb_vars_rad_zm, &
4913 : l_error, &
4914 0 : stats_metadata, stats_rad_zm(j) )
4915 : end if ! l_output_rad_files
4916 :
4917 :
4918 : ! Initialize sfc (surface point)
4919 :
4920 0 : i = 1
4921 0 : do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. &
4922 0 : len_trim(clubb_vars_sfc(i)) /= 0 .and. &
4923 0 : i <= nvarmax_sfc )
4924 0 : i = i + 1
4925 : end do
4926 0 : ntot = i - 1
4927 0 : if ( ntot == nvarmax_sfc ) then
4928 0 : l_error = .true. ! This will cause the run to stop.
4929 0 : write(fstderr,*) "There are more statistical variables listed in ", &
4930 0 : "clubb_vars_sfc than allowed for by nvarmax_sfc."
4931 0 : write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", &
4932 0 : "in the stats namelist, or change nvarmax_sfc."
4933 0 : write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc
4934 0 : call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit")
4935 : endif
4936 :
4937 0 : stats_sfc(j)%num_output_fields = ntot
4938 0 : stats_sfc(j)%kk = 1
4939 :
4940 0 : allocate( stats_sfc(j)%z( stats_sfc(j)%kk ) )
4941 :
4942 0 : allocate( stats_sfc(j)%accum_field_values( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) )
4943 0 : allocate( stats_sfc(j)%accum_num_samples( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) )
4944 0 : allocate( stats_sfc(j)%l_in_update( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) )
4945 :
4946 : call stats_zero( stats_sfc(j)%kk, stats_sfc(j)%num_output_fields, stats_sfc(j)%accum_field_values, &
4947 : stats_sfc(j)%accum_num_samples, stats_sfc(j)%l_in_update )
4948 :
4949 0 : allocate( stats_sfc(j)%file%grid_avg_var( stats_sfc(j)%num_output_fields ) )
4950 0 : allocate( stats_sfc(j)%file%z( stats_sfc(j)%kk ) )
4951 :
4952 : call stats_init_sfc_api( clubb_vars_sfc, &
4953 : l_error, &
4954 0 : stats_metadata, stats_sfc(j) )
4955 : end do
4956 :
4957 : ! Check for errors
4958 :
4959 0 : if ( l_error ) then
4960 0 : call endrun ('stats_init: errors found')
4961 : endif
4962 :
4963 : ! Now call add fields
4964 :
4965 0 : do i = 1, stats_zt(1)%num_output_fields
4966 :
4967 0 : temp1 = trim(stats_zt(1)%file%grid_avg_var(i)%name)
4968 0 : sub = temp1
4969 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
4970 :
4971 : call addfld( trim(sub), (/ 'ilev' /), 'A', &
4972 0 : trim(stats_zt(1)%file%grid_avg_var(i)%units), &
4973 0 : trim(stats_zt(1)%file%grid_avg_var(i)%description) )
4974 : enddo
4975 :
4976 0 : do i = 1, stats_zm(1)%num_output_fields
4977 :
4978 0 : temp1 = trim(stats_zm(1)%file%grid_avg_var(i)%name)
4979 0 : sub = temp1
4980 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
4981 :
4982 : call addfld( trim(sub), (/ 'ilev' /), 'A', &
4983 0 : trim(stats_zm(1)%file%grid_avg_var(i)%units), &
4984 0 : trim(stats_zm(1)%file%grid_avg_var(i)%description) )
4985 : enddo
4986 :
4987 0 : if (stats_metadata%l_output_rad_files) then
4988 :
4989 0 : do i = 1, stats_rad_zt(1)%num_output_fields
4990 0 : temp1 = trim(stats_rad_zt(1)%file%grid_avg_var(i)%name)
4991 0 : sub = temp1
4992 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
4993 : call addfld( trim(sub), (/ 'ilev' /), 'A', &
4994 0 : trim(stats_rad_zt(1)%file%grid_avg_var(i)%units), &
4995 0 : trim(stats_rad_zt(1)%file%grid_avg_var(i)%description) )
4996 : enddo
4997 :
4998 0 : do i = 1, stats_rad_zm(1)%num_output_fields
4999 0 : temp1 = trim(stats_rad_zm(1)%file%grid_avg_var(i)%name)
5000 0 : sub = temp1
5001 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
5002 : call addfld( trim(sub), (/ 'ilev' /), 'A', &
5003 0 : trim(stats_rad_zm(1)%file%grid_avg_var(i)%units), &
5004 0 : trim(stats_rad_zm(1)%file%grid_avg_var(i)%description) )
5005 : enddo
5006 : endif
5007 :
5008 0 : do i = 1, stats_sfc(1)%num_output_fields
5009 0 : temp1 = trim(stats_sfc(1)%file%grid_avg_var(i)%name)
5010 0 : sub = temp1
5011 0 : if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len)
5012 : call addfld( trim(sub), horiz_only, 'A', &
5013 0 : trim(stats_sfc(1)%file%grid_avg_var(i)%units), &
5014 0 : trim(stats_sfc(1)%file%grid_avg_var(i)%description) )
5015 : enddo
5016 :
5017 :
5018 : return
5019 :
5020 0 : end subroutine stats_init_clubb
5021 :
5022 : #endif
5023 :
5024 : ! =============================================================================== !
5025 : ! !
5026 : ! =============================================================================== !
5027 :
5028 : #ifdef CLUBB_SGS
5029 0 : subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc, &
5030 0 : out_zt, out_zm, out_radzt, out_radzm, out_sfc)
5031 : !-----------------------------------------------------------------------
5032 : ! Description: Called when the stats timestep has ended. This subroutine
5033 : ! is responsible for calling statistics to be written to the output
5034 : ! format.
5035 : !-----------------------------------------------------------------------
5036 :
5037 :
5038 :
5039 0 : use shr_infnan_mod, only: is_nan => shr_infnan_isnan
5040 :
5041 : use clubb_api_module, only: &
5042 : fstderr, & ! Constant(s)
5043 : clubb_at_least_debug_level_api ! Procedure(s)
5044 :
5045 : use cam_abortutils, only: endrun
5046 :
5047 : implicit none
5048 :
5049 : integer :: thecol
5050 :
5051 : ! Input Variables
5052 : type (stats), intent(inout) :: stats_zt, & ! stats_zt grid
5053 : stats_zm, & ! stats_zm grid
5054 : stats_rad_zt, & ! stats_rad_zt grid
5055 : stats_rad_zm, & ! stats_rad_zm grid
5056 : stats_sfc ! stats_sfc
5057 :
5058 : ! Inout variables
5059 : real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields)
5060 : real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields)
5061 : real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields)
5062 : real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields)
5063 : real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields)
5064 :
5065 : ! Local Variables
5066 :
5067 : integer :: i, k
5068 : logical :: l_error
5069 :
5070 : ! Check if it is time to write to file
5071 :
5072 0 : if ( .not. stats_metadata%l_stats_last ) return
5073 :
5074 : ! Initialize
5075 0 : l_error = .false.
5076 :
5077 : ! Compute averages
5078 0 : call stats_avg( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, stats_zt%accum_num_samples )
5079 0 : call stats_avg( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, stats_zm%accum_num_samples )
5080 0 : if (stats_metadata%l_output_rad_files) then
5081 : call stats_avg( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, &
5082 0 : stats_rad_zt%accum_num_samples )
5083 : call stats_avg( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, &
5084 0 : stats_rad_zm%accum_num_samples )
5085 : end if
5086 0 : call stats_avg( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, stats_sfc%accum_num_samples )
5087 :
5088 : ! Here we are not outputting the data, rather reading the stats into
5089 : ! arrays which are conformable to CAM output. Also, the data is "flipped"
5090 : ! in the vertical level to be the same as CAM output.
5091 0 : do i = 1, stats_zt%num_output_fields
5092 0 : do k = 1, stats_zt%kk
5093 0 : out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i)
5094 0 : if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8
5095 : enddo
5096 : enddo
5097 :
5098 0 : do i = 1, stats_zm%num_output_fields
5099 0 : do k = 1, stats_zt%kk
5100 0 : out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i)
5101 0 : if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8
5102 : enddo
5103 : enddo
5104 :
5105 0 : if (stats_metadata%l_output_rad_files) then
5106 0 : do i = 1, stats_rad_zt%num_output_fields
5107 0 : do k = 1, stats_rad_zt%kk
5108 0 : out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i)
5109 0 : if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8
5110 : enddo
5111 : enddo
5112 :
5113 0 : do i = 1, stats_rad_zm%num_output_fields
5114 0 : do k = 1, stats_rad_zm%kk
5115 0 : out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i)
5116 0 : if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8
5117 : enddo
5118 : enddo
5119 :
5120 : ! Fill in values above the CLUBB top.
5121 0 : out_zt(thecol,:top_lev-1,:) = 0.0_r8
5122 0 : out_zm(thecol,:top_lev-1,:) = 0.0_r8
5123 0 : out_radzt(thecol,:top_lev-1,:) = 0.0_r8
5124 0 : out_radzm(thecol,:top_lev-1,:) = 0.0_r8
5125 :
5126 : endif ! l_output_rad_files
5127 :
5128 0 : do i = 1, stats_sfc%num_output_fields
5129 0 : out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i)
5130 0 : if(is_nan(out_sfc(thecol,1,i))) out_sfc(thecol,1,i) = 0.0_r8
5131 : enddo
5132 :
5133 : ! Reset sample fields
5134 : call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, &
5135 0 : stats_zt%accum_num_samples, stats_zt%l_in_update )
5136 : call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, &
5137 0 : stats_zm%accum_num_samples, stats_zm%l_in_update )
5138 0 : if (stats_metadata%l_output_rad_files) then
5139 : call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, &
5140 0 : stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update )
5141 : call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, &
5142 0 : stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update )
5143 : end if
5144 : call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, &
5145 0 : stats_sfc%accum_num_samples, stats_sfc%l_in_update )
5146 :
5147 0 : return
5148 :
5149 : end subroutine stats_end_timestep_clubb
5150 : #endif
5151 :
5152 : ! =============================================================================== !
5153 : ! !
5154 : ! =============================================================================== !
5155 :
5156 : #ifdef CLUBB_SGS
5157 :
5158 : !-----------------------------------------------------------------------
5159 0 : subroutine stats_zero( kk, num_output_fields, x, n, l_in_update )
5160 :
5161 : ! Description:
5162 : ! Initialize stats to zero
5163 : !-----------------------------------------------------------------------
5164 :
5165 : use clubb_api_module, only: &
5166 : stat_rknd, & ! Variable(s)
5167 : stat_nknd
5168 :
5169 :
5170 : implicit none
5171 :
5172 : ! Input
5173 : integer, intent(in) :: kk, num_output_fields
5174 :
5175 : ! Output
5176 : real(kind=stat_rknd), dimension(1,1,kk,num_output_fields), intent(out) :: x
5177 : integer(kind=stat_nknd), dimension(1,1,kk,num_output_fields), intent(out) :: n
5178 : logical, dimension(1,1,kk,num_output_fields), intent(out) :: l_in_update
5179 :
5180 : ! Zero out arrays
5181 :
5182 0 : if ( num_output_fields > 0 ) then
5183 0 : x(:,:,:,:) = 0.0_r8
5184 0 : n(:,:,:,:) = 0
5185 0 : l_in_update(:,:,:,:) = .false.
5186 : end if
5187 :
5188 0 : return
5189 :
5190 : end subroutine stats_zero
5191 :
5192 : #endif
5193 :
5194 : ! =============================================================================== !
5195 : ! !
5196 : ! =============================================================================== !
5197 :
5198 :
5199 : #ifdef CLUBB_SGS
5200 : !-----------------------------------------------------------------------
5201 0 : subroutine stats_avg( kk, num_output_fields, x, n )
5202 :
5203 : ! Description:
5204 : ! Compute the average of stats fields
5205 : !-----------------------------------------------------------------------
5206 : use clubb_api_module, only: &
5207 : stat_rknd, & ! Variable(s)
5208 : stat_nknd
5209 :
5210 : implicit none
5211 :
5212 : ! Input
5213 : integer, intent(in) :: num_output_fields, kk
5214 : integer(kind=stat_nknd), dimension(1,1,kk,num_output_fields), intent(in) :: n
5215 :
5216 : ! Output
5217 : real(kind=stat_rknd), dimension(1,1,kk,num_output_fields), intent(inout) :: x
5218 :
5219 : ! Internal
5220 :
5221 : integer k,m
5222 :
5223 : ! Compute averages
5224 :
5225 0 : do m=1,num_output_fields
5226 0 : do k=1,kk
5227 :
5228 0 : if ( n(1,1,k,m) > 0 ) then
5229 0 : x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m) )
5230 : end if
5231 :
5232 : end do
5233 : end do
5234 :
5235 0 : return
5236 :
5237 : end subroutine stats_avg
5238 :
5239 176472 : subroutine grid_size(state, grid_dx, grid_dy)
5240 : ! Determine the size of the grid for each of the columns in state
5241 :
5242 : use phys_grid, only: get_area_p
5243 : use shr_const_mod, only: shr_const_pi
5244 : use physics_types, only: physics_state
5245 :
5246 :
5247 : type(physics_state), intent(in) :: state
5248 : real(r8), intent(out) :: grid_dx(state%ncol), grid_dy(state%ncol) ! CAM grid [m]
5249 :
5250 : real(r8), parameter :: earth_ellipsoid1 = 111132.92_r8 ! first coefficient, meters per degree longitude at equator
5251 : real(r8), parameter :: earth_ellipsoid2 = 559.82_r8 ! second expansion coefficient for WGS84 ellipsoid
5252 : real(r8), parameter :: earth_ellipsoid3 = 1.175_r8 ! third expansion coefficient for WGS84 ellipsoid
5253 :
5254 : real(r8) :: mpdeglat, column_area, degree
5255 : integer :: i
5256 :
5257 : ! determine the column area in radians
5258 2946672 : do i=1,state%ncol
5259 2770200 : column_area = get_area_p(state%lchnk,i)
5260 2770200 : degree = sqrt(column_area)*(180._r8/shr_const_pi)
5261 :
5262 : ! Now find meters per degree latitude
5263 : ! Below equation finds distance between two points on an ellipsoid, derived from expansion
5264 : ! taking into account ellipsoid using World Geodetic System (WGS84) reference
5265 2770200 : mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*state%lat(i)) + earth_ellipsoid3 * cos(4._r8*state%lat(i))
5266 2770200 : grid_dx(i) = mpdeglat * degree
5267 2946672 : grid_dy(i) = grid_dx(i) ! Assume these are the same
5268 : enddo
5269 :
5270 176472 : end subroutine grid_size
5271 :
5272 : #endif
5273 :
5274 : end module clubb_intr
|
