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