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