diff --git a/physics/MP/GFDL/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 index 2176cd5e7..19c3c4242 100644 --- a/physics/MP/GFDL/fv_sat_adj.F90 +++ b/physics/MP/GFDL/fv_sat_adj.F90 @@ -60,9 +60,12 @@ module fv_sat_adj hlf => con_hfus_dyn, & cp_air => con_cp_dyn ! *DH - use machine, only: kind_grid, kind_dyn - use module_gfdlmp_param, only: cfg - + use machine, only: kind_grid, kind_dyn + use module_gfdlmp_param, only: ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt + use module_gfdlmp_param, only: icloud_f, sat_adj0, t_sub, cld_min + use module_gfdlmp_param, only: tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r + use module_gfdlmp_param, only: rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs + use module_gfdlmp_param, only: display_gfdlmp_param #ifdef MULTI_GASES use ccpp_multi_gases_mod, only: multi_gases_init, & multi_gases_finalize, & @@ -156,6 +159,10 @@ subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & if (is_initialized) return + if (mpirank==mpiroot) then + write(*,*) 'In fv_sat_adj init()' + call display_gfdlmp_param() + endif ! generate es table (dt = 0.1 deg c) allocate (table (length)) @@ -454,16 +461,16 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, !> - Define conversion scalar / factor. ! ----------------------------------------------------------------------- - fac_i2s = 1. - exp (- mdt / cfg%tau_i2s) - fac_v2l = 1. - exp (- sdt / cfg%tau_v2l) - fac_r2g = 1. - exp (- mdt / cfg%tau_r2g) - fac_l2r = 1. - exp (- mdt / cfg%tau_l2r) + fac_i2s = 1. - exp (- mdt / tau_i2s) + fac_v2l = 1. - exp (- sdt / tau_v2l) + fac_r2g = 1. - exp (- mdt / tau_r2g) + fac_l2r = 1. - exp (- mdt / tau_l2r) - fac_l2v = 1. - exp (- sdt / cfg%tau_l2v) - fac_l2v = min (cfg%sat_adj0, fac_l2v) + fac_l2v = 1. - exp (- sdt / tau_l2v) + fac_l2v = min (sat_adj0, fac_l2v) - fac_imlt = 1. - exp (- sdt / cfg%tau_imlt) - fac_smlt = 1. - exp (- mdt / cfg%tau_smlt) + fac_imlt = 1. - exp (- sdt / tau_imlt) + fac_smlt = 1. - exp (- mdt / tau_smlt) ! ----------------------------------------------------------------------- !> - Define heat capacity of dry air and water vapor based on hydrostatical property. @@ -578,7 +585,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, sink (i) = min (qi (i, j), fac_imlt * (pt1 (i) - tice) / icp2 (i)) qi (i, j) = qi (i, j) - sink (i) ! sjl, may 17, 2017 - ! tmp = min (sink (i), dim (cfg%ql_mlt, ql (i, j))) ! max ql amount + ! tmp = min (sink (i), dim (ql_mlt, ql (i, j))) ! max ql amount ! ql (i, j) = ql (i, j) + tmp ! qr (i, j) = qr (i, j) + sink (i) - tmp ! sjl, may 17, 2017 @@ -667,11 +674,11 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, call wqs2_vect (is, ie, pt1, den, wqsat, dq2dt) - adj_fac = cfg%sat_adj0 + adj_fac = sat_adj0 do i = is, ie dq0 = (qv (i, j) - wqsat (i)) / (1. + tcp3 (i) * dq2dt (i)) if (dq0 > 0.) then ! whole grid - box saturated - src (i) = min (adj_fac * dq0, max (cfg%ql_gen - ql (i, j), fac_v2l * dq0)) + src (i) = min (adj_fac * dq0, max (ql_gen - ql (i, j), fac_v2l * dq0)) else ! evaporation of ql ! sjl 20170703 added ql factor to prevent the situation of high ql and rh<1 ! factor = - min (1., fac_l2v * sqrt (max (0., ql (i, j)) / 1.e-5) * 10. * (1. - qv (i, j) / wqsat (i))) @@ -836,7 +843,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, if (qs (i, j) > 1.e-7 .and. dtmp > 0.) then tmp = min (1., (dtmp * 0.1) ** 2) * qs (i, j) ! no limter on melting above 10 deg c sink (i) = min (tmp, fac_smlt * dtmp / icp2 (i)) - tmp = min (sink (i), dim (cfg%qs_mlt, ql (i, j))) ! max ql due to snow melt + tmp = min (sink (i), dim (qs_mlt, ql (i, j))) ! max ql due to snow melt qs (i, j) = qs (i, j) - sink (i) ql (i, j) = ql (i, j) + tmp qr (i, j) = qr (i, j) + sink (i) - tmp @@ -853,8 +860,8 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, ! ----------------------------------------------------------------------- do i = is, ie - if (ql (i, j) > cfg%ql0_max) then - sink (i) = fac_l2r * (ql (i, j) - cfg%ql0_max) + if (ql (i, j) > ql0_max) then + sink (i) = fac_l2r * (ql (i, j) - ql0_max) qr (i, j) = qr (i, j) + sink (i) ql (i, j) = ql (i, j) - sink (i) endif @@ -878,7 +885,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, do i = is, ie src (i) = 0. - if (pt1 (i) < cfg%t_sub) then ! too cold to be accurate; freeze qv as a fix + if (pt1 (i) < t_sub) then ! too cold to be accurate; freeze qv as a fix src (i) = dim (qv (i, j), 1.e-6) elseif (pt1 (i) < tice0) then qsi = iqs2 (pt1 (i), den (i), dqsdt) @@ -892,10 +899,10 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, endif if (dq > 0.) then ! vapor - > ice tmp = tice - pt1 (i) - qi_crt = cfg%qi_gen * min (cfg%qi_lim, 0.1 * tmp) / den (i) + qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den (i) src (i) = min (sink (i), max (qi_crt - qi (i, j), pidep), tmp / tcp2 (i)) else - pidep = pidep * min (1., dim (pt1 (i), cfg%t_sub) * 0.2) + pidep = pidep * min (1., dim (pt1 (i), t_sub) * 0.2) src (i) = max (pidep, sink (i), - qi (i, j)) endif endif @@ -951,7 +958,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, ! ----------------------------------------------------------------------- do i = is, ie - qim = cfg%qi0_max / den (i) + qim = qi0_max / den (i) if (qi (i, j) > qim) then sink (i) = fac_i2s * (qi (i, j) - qim) qi (i, j) = qi (i, j) - sink (i) @@ -1011,8 +1018,8 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, !> - If it is the last step, combine water species. ! ----------------------------------------------------------------------- - if (cfg%rad_snow) then - if (cfg%rad_graupel) then + if (rad_snow) then + if (rad_graupel) then do i = is, ie q_sol (i) = qi (i, j) + qs (i, j) + qg (i, j) enddo @@ -1026,7 +1033,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, q_sol (i) = qi (i, j) enddo endif - if (cfg%rad_rain) then + if (rad_rain) then do i = is, ie q_liq (i) = ql (i, j) + qr (i, j) enddo @@ -1045,7 +1052,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, do i = is, ie - if(cfg%tintqs) then + if(tintqs) then tin = pt1(i) else tin = pt1 (i) - (lcp2 (i) * q_cond (i) + icp2 (i) * q_sol (i)) ! minimum temperature @@ -1076,7 +1083,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, qstar (i) = rqi * qsi + (1. - rqi) * qsw endif !> - higher than 10 m is considered "land" and will have higher subgrid variability - dw = cfg%dw_ocean + (cfg%dw_land - cfg%dw_ocean) * min (1., abs (hs (i, j)) / (10. * grav)) + dw = dw_ocean + (dw_land - dw_ocean) * min (1., abs (hs (i, j)) / (10. * grav)) !> - "scale - aware" subgrid variability: 100 - km as the base hvar (i) = min (0.2, max (0.01, dw * sqrt (sqrt (area (i, j)) / 100.e3))) @@ -1089,16 +1096,16 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, rh = qpz (i) / qstar (i) ! ----------------------------------------------------------------------- - ! cfg%icloud_f = 0: bug - fixed - ! cfg%icloud_f = 1: old fvgfs gfdl) mp implementation - ! cfg%icloud_f = 2: binary cloud scheme (0 / 1) + ! icloud_f = 0: bug - fixed + ! icloud_f = 1: old fvgfs gfdl) mp implementation + ! icloud_f = 2: binary cloud scheme (0 / 1) ! ----------------------------------------------------------------------- if (rh > 0.75 .and. qpz (i) > 1.e-8) then dq = hvar (i) * qpz (i) q_plus = qpz (i) + dq q_minus = qpz (i) - dq - if (cfg%icloud_f == 2) then + if (icloud_f == 2) then if (qpz (i) > qstar (i)) then qa (i, j) = 1. elseif (qstar (i) < q_plus .and. q_cond (i) > 1.e-8) then @@ -1112,7 +1119,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, qa (i, j) = 1. else if (qstar (i) < q_plus) then - if (cfg%icloud_f == 0) then + if (icloud_f == 0) then qa (i, j) = (q_plus - qstar (i)) / (dq + dq) else qa (i, j) = (q_plus - qstar (i)) / (2. * dq * (1. - q_cond (i))) @@ -1122,7 +1129,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, endif ! impose minimum cloudiness if substantial q_cond (i) exist if (q_cond (i) > 1.e-8) then - qa (i, j) = max (cfg%cld_min, qa (i, j)) + qa (i, j) = max (cld_min, qa (i, j)) endif qa (i, j) = min (1., qa (i, j)) endif diff --git a/physics/MP/GFDL/module_gfdlmp_param.F90 b/physics/MP/GFDL/module_gfdlmp_param.F90 index 53d248de2..b591c459b 100644 --- a/physics/MP/GFDL/module_gfdlmp_param.F90 +++ b/physics/MP/GFDL/module_gfdlmp_param.F90 @@ -1,176 +1,119 @@ ! ######################################################################################### ! ######################################################################################### module module_gfdlmp_param - use machine, only: wp => kind_dbl_prec + use machine, only: kind_phys => kind_dbl_prec implicit none + public :: read_gfdlmp_nml, display_gfdlmp_param private - - ! ####################################################################################### - ! Data container for GFDL MP runtime configurations information (i.e. Namelist) - ! ####################################################################################### - type ty_gfdlmp_config - ! GFDL MP Version 1 parameters. - real(wp) :: tau_g2r, tau_g2v, tau_v2g, qc_crt, qr0_crt, c_piacr, c_cracw, alin, clin - logical :: fast_sat_adj, use_ccn, use_ppm, mono_prof, mp_print, de_ice, sedi_transport - - ! GFDL MP common (v1/v3) parameters - real(wp) :: cld_min, tice, t_min, t_sub, mp_time, rh_inc, rh_inr, rh_ins, tau_r2g, & - tau_smlt, tau_imlt, tau_i2s, tau_l2r, tau_v2l, tau_l2v, dw_land, dw_ocean, & - ccn_o, ccn_l, rthresh, sat_adj0, qi_lim, ql_mlt, ql_gen, qi_gen, ql0_max, & - qi0_max, qi0_crt, qs0_crt, c_paut, c_psaci, c_pgacs, vi_fac, vs_fac, vg_fac, & - vr_fac, vi_max, vs_max, vg_max, vr_max, rewmin, rewmax, reimin, reimax, rermin, & - rermax, resmin, resmax, regmin, regmax, qs_mlt - logical :: const_vi, const_vs, const_vg, const_vr, z_slope_liq, z_slope_ice, do_hail,& - do_sedi_w, do_sedi_heat, prog_ccn, do_qa, rad_snow, rad_graupel, rad_rain, & - fix_negative, tintqs - ! GFDL MP Version 3 parameters - integer :: reiflag, icloud_f, irain_f - real(wp) :: c_psacw, c_pracw, c_praci, c_pgacw, c_pgaci, c_pracs, c_psacr, c_pgacr, & - alinw, alini, alinr, alins, aling, alinh, blinw, blini, blinr, blins, bling, & - blinh, vw_fac, vw_max, tice_mlt, tau_gmlt, tau_wbf, tau_revp, is_fac, ss_fac, & - gs_fac, rh_fac_evap, rh_fac_cond, sed_fac, xr_a, xr_b, xr_c, te_err, tw_err, & - rh_thres, rhc_cevap, rhc_revap, f_dq_p, f_dq_m, fi2s_fac, fi2g_fac, fs2g_fac, & - n0w_sig, n0i_sig, n0r_sig, n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp,& - n0s_exp, n0g_exp, n0h_exp, muw, mui, mur, mus, mug, muh, beta, rewfac, reifac - logical :: const_vw, do_sedi_uv, do_sedi_melt, liq_ice_combine, snow_grauple_combine,& - use_rhc_cevap, use_rhc_revap, do_cld_adj, do_evap_timescale, do_cond_timescale, & - consv_checker, do_warm_rain_mp, do_wbf, do_psd_water_fall, do_psd_ice_fall, & - do_psd_water_num, do_psd_ice_num, do_new_acc_water, do_new_acc_ice, cp_heating, & - delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub - integer :: ntimes, nconds, inflag, igflag, ifflag, rewflag, rerflag, resflag, & - regflag, radr_flag, rads_flag, radg_flag, sedflag, vdiffflag - contains - procedure :: register => register_gfdlmp_param - procedure :: display => display_gfdlmp_param - end type ty_gfdlmp_config + ! ##################################################################################### + ! GFDL MP Version 1 parameters. + ! ##################################################################################### + real(kind_phys) :: tau_g2r = 600. !< graupel melting to rain time scale (s) + real(kind_phys) :: tau_g2v = 900. !< graupel sublimation time scale (s) + real(kind_phys) :: tau_v2g = 21600. !< graupel deposition -- make it a slow process time scale (s) + real(kind_phys) :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness + real(kind_phys) :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold + !< lfo used * mixing ratio * = 1.e-4 (hail in lfo) + real(kind_phys) :: c_piacr = 5.0 !< accretion: rain to ice: + real(kind_phys) :: c_cracw = 0.9 !< rain accretion efficiency + real(kind_phys) :: alin = 842.0 !< "a" in lin1983 + real(kind_phys) :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) + logical :: fast_sat_adj = .false. !< has fast saturation adjustments + logical :: use_ccn = .false. !< must be true when prog_ccn is false + logical :: use_ppm = .false. !< use ppm fall scheme + logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme + logical :: mp_print = .false. !< cloud microphysics debugging printout + logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources + logical :: sedi_transport = .true. !< transport of momentum in sedimentation - public :: cfg - - type(ty_gfdlmp_config), save, target :: cfg - -contains - - ! ####################################################################################### - ! Procedure (type-bound) to setup GFDL MP parameters. - ! Reads in namelist if associated file fields are provided, otherwise, set parameters - ! to their default values. - ! ####################################################################################### - subroutine register_gfdlmp_param(self, errmsg, errflg, unit, input_nml_file, fn_nml, & - version, iostat) - class(ty_gfdlmp_config), intent(inout) :: self - character(len = *), intent(in ), optional :: input_nml_file(:) - character(len = *), intent(in ), optional :: fn_nml - integer, intent(in ), optional :: unit - integer, intent(in ), optional :: version - integer, intent(out), optional :: iostat - character(len=*), intent(out), optional :: errmsg - integer, intent(out), optional :: errflg - logical :: exists - - ! ##################################################################################### - ! GFDL MP Version 1 parameters. - ! ##################################################################################### - real(wp) :: tau_g2r = 600. !< graupel melting to rain time scale (s) - real(wp) :: tau_g2v = 900. !< graupel sublimation time scale (s) - real(wp) :: tau_v2g = 21600. !< graupel deposition -- make it a slow process time scale (s) - real(wp) :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness - real(wp) :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold - !< lfo used * mixing ratio * = 1.e-4 (hail in lfo) - real(wp) :: c_piacr = 5.0 !< accretion: rain to ice: - real(wp) :: c_cracw = 0.9 !< rain accretion efficiency - real(wp) :: alin = 842.0 !< "a" in lin1983 - real(wp) :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) - logical :: fast_sat_adj = .false. !< has fast saturation adjustments - logical :: use_ccn = .false. !< must be true when prog_ccn is false - logical :: use_ppm = .false. !< use ppm fall scheme - logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme - logical :: mp_print = .false. !< cloud microphysics debugging printout - logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources - logical :: sedi_transport = .true. !< transport of momentum in sedimentation - - ! ##################################################################################### - ! GFDL MP common (v1/v3) parameters - ! ##################################################################################### - real(wp) :: cld_min = 0.05 !< (v1/v3) minimum cloud fraction - real(wp) :: tice = 273.16 !< (DIF for v3) freezing temperature (K): ref: GFDL, GFS (DJS: V3=273.15) - real(wp) :: t_min = 178. !< (v1/v3) min temp to freeze - dry all water vapor - real(wp) :: t_sub = 184. !< (v1/v3) min temp for sublimation of cloud ice - real(wp) :: mp_time = 150. !< (v1/v3) maximum micro - physics time step (sec) - real(wp) :: rh_inc = 0.25 !< (v1/v3) rh increment for complete evaporation of cloud water and cloud ice - real(wp) :: rh_inr = 0.25 !< (v1/v3) rh increment for minimum evaporation of rain - real(wp) :: rh_ins = 0.25 !< (v1/v3) rh increment for sublimation of snow - real(wp) :: tau_r2g = 900. !< (v1/v3) rain freezing during fast_sat time scale (s) - real(wp) :: tau_smlt = 900. !< (v1/v3) snow melting time scale (s) - real(wp) :: tau_imlt = 600. !< (DIF for v3) cloud ice melting time scale (s) (DJS: V3=1200.) - real(wp) :: tau_i2s = 1000. !< (v1/v3) cloud ice to snow auto-conversion time scale (s) - real(wp) :: tau_l2r = 900. !< (v1/v3) cloud water to rain auto-conversion time scale (s) - real(wp) :: tau_v2l = 150. !< (v1/v3) water vapor to cloud water (condensation) time scale (s) - real(wp) :: tau_l2v = 300. !< (v1/v3) cloud water to water vapor (evaporation) time scale (s) - real(wp) :: dw_land = 0.20 !< (v1/v3) value for subgrid deviation / variability over land - real(wp) :: dw_ocean = 0.10 !< (v1/v3) base value for ocean - real(wp) :: ccn_o = 90. !< (v1/v3) ccn over ocean (cm^ - 3) - real(wp) :: ccn_l = 270. !< (v1/v3) ccn over land (cm^ - 3) - real(wp) :: rthresh = 10.0e-6 !< (DIF for v3) critical cloud drop radius (micro m) (DJS: v3=20.0e-6) - real(wp) :: sat_adj0 = 0.90 !< (v1/v3) adjustment factor (0: no, 1: full) during fast_sat_adj - real(wp) :: qi_lim = 1. !< (v1/v3) cloud ice limiter (0: no, 1: full, >1: extra) to prevent large ice build up - real(wp) :: ql_mlt = 2.0e-3 !< (v1/v3) max value of cloud water allowed from melted cloud ice - real(wp) :: qs_mlt = 1.0e-6 !< (v1/v3) max cloud water due to snow melt - real(wp) :: ql_gen = 1.0e-3 !< (v1/v3) max cloud water generation during remapping step if fast_sat_adj = .t. - real(wp) :: qi_gen = 1.82e-6 !< (v1/v3) max cloud ice generation during remapping step (V1 ONLY. Computed internally in V3) - real(wp) :: ql0_max = 2.0e-3 !< (v1/v3) max cloud water value (auto converted to rain) - real(wp) :: qi0_max = 1.0e-4 !< (v1/v3) max cloud ice value (by other sources) - real(wp) :: qi0_crt = 1.0e-4 !< (v1/v3) cloud ice to snow autoconversion threshold (was 1.e-4); - !< qi0_crt is highly dependent on horizontal resolution - real(wp) :: qs0_crt = 1.0e-3 !< (v1/v3) snow to graupel density threshold (0.6e-3 in purdue lin scheme) - real(wp) :: c_paut = 0.55 !< (v1/v3) autoconversion cloud water to rain (use 0.5 to reduce autoconversion) - real(wp) :: c_psaci = 0.02 !< (DIF for v3) accretion: cloud ice to snow (was 0.1 in zetac) (DJS: v3=0.05) - real(wp) :: c_pgacs = 2.0e-3 !< (DIF for v3) snow to graupel "accretion" eff. (was 0.1 in zetac) (DJS: v3=0.01) - real(wp) :: vi_fac = 1. !< (v1/v3) if const_vi: 1 / 3 - real(wp) :: vs_fac = 1. !< (v1/v3) if const_vs: 1. - real(wp) :: vg_fac = 1. !< (v1/v3) if const_vg: 2. - real(wp) :: vr_fac = 1. !< (v1/v3) if const_vr: 4. - real(wp) :: vi_max = 0.5 !< (DIF for v3) max fall speed for ice (DJS: v3=1.0) - real(wp) :: vs_max = 5.0 !< (DIF for v3) max fall speed for snow (DJS: v3=2.0) - real(wp) :: vg_max = 8.0 !< (DIF for v3) max fall speed for graupel (DJS: v3=12.0) - real(wp) :: vr_max = 12. !< (v1/v3) max fall speed for rain - real(wp) :: rewmin = 5.0 !< (v1/v3) minimum effective radii (liquid) - real(wp) :: rewmax = 10.0 !< (DIF for v3) maximum effective radii (liquid) (DJS: v3=15.0) - real(wp) :: reimin = 10.0 !< (v1/v3) minimum effective radii (ice) - real(wp) :: reimax = 150.0 !< (v1/v3) maximum effective radii (ice) - real(wp) :: rermin = 10.0 !< (DIF for v3) minimum effective radii (rain) (DJS: v3=15.0) - real(wp) :: rermax = 10000.0 !< (v1/v3) maximum effective radii (rain) - real(wp) :: resmin = 150.0 !< (v1/v3) minimum effective radii (snow) - real(wp) :: resmax = 10000.0 !< (v1/v3) maximum effective radii (snow) - real(wp) :: regmin = 300.0 !< (DIF for v3) minimum effective radii (graupel) (DJS: v3=150.0) - real(wp) :: regmax = 10000.0 !< (v1/v3) maximum effective radii (graupel) - ! - logical :: const_vi = .false. !< (v1/v3) if .t. the constants are specified by v * _fac - logical :: const_vs = .false. !< (v1/v3) if .t. the constants are specified by v * _fac - logical :: const_vg = .false. !< (v1/v3) if .t. the constants are specified by v * _fac - logical :: const_vr = .false. !< (v1/v3) if .t. the constants are specified by v * _fac - logical :: z_slope_liq = .true. !< (v1/v3) use linear mono slope for autocconversions - logical :: z_slope_ice = .false. !< (DIF for v3) use linear mono slope for autocconversions (DJS: v3=.true.) - logical :: do_hail = .false. !< (v1/v3) use hail parameters instead of graupel - logical :: do_qa = .true. !< (v1/v3) do inline cloud fraction - logical :: rad_snow = .true. !< (v1/v3) consider snow in cloud fraciton calculation - logical :: rad_graupel = .true. !< (v1/v3) consider graupel in cloud fraction calculation - logical :: rad_rain = .true. !< (v1/v3) consider rain in cloud fraction calculation - logical :: do_sedi_w = .false. !< (DIF for v3) transport of vertical motion in sedimentation (DJS: v3=.true.) - logical :: do_sedi_heat = .true. !< (v1/v3) transport of heat in sedimentation - logical :: prog_ccn = .false. !< (v1/v3) do prognostic ccn (yi ming's method) - logical :: fix_negative = .false. !< (DIF for v3) fix negative water species (DJS: v3=.true.) - logical :: tintqs = .false. !< (v1/v3) - ! - integer :: icloud_f = 0 !< (v1/v3) GFDL cloud scheme + ! ##################################################################################### + ! GFDL MP common (v1/v3) parameters + ! ##################################################################################### + real(kind_phys) :: cld_min = 0.05 !< (v1/v3) minimum cloud fraction + real(kind_phys) :: t_min = 178. !< (v1/v3) min temp to freeze - dry all water vapor + real(kind_phys) :: t_sub = 184. !< (v1/v3) min temp for sublimation of cloud ice + real(kind_phys) :: mp_time = 150. !< (v1/v3) maximum micro - physics time step (sec) + real(kind_phys) :: rh_inc = 0.25 !< (v1/v3) rh increment for complete evaporation of cloud water and cloud ice + real(kind_phys) :: rh_inr = 0.25 !< (v1/v3) rh increment for minimum evaporation of rain + real(kind_phys) :: rh_ins = 0.25 !< (v1/v3) rh increment for sublimation of snow + real(kind_phys) :: tau_r2g = 900. !< (v1/v3) rain freezing during fast_sat time scale (s) + real(kind_phys) :: tau_smlt = 900. !< (v1/v3) snow melting time scale (s) + real(kind_phys) :: tau_i2s = 1000. !< (v1/v3) cloud ice to snow auto-conversion time scale (s) + real(kind_phys) :: tau_l2r = 900. !< (v1/v3) cloud water to rain auto-conversion time scale (s) + real(kind_phys) :: tau_v2l = 150. !< (v1/v3) water vapor to cloud water (condensation) time scale (s) + real(kind_phys) :: tau_l2v = 300. !< (v1/v3) cloud water to water vapor (evaporation) time scale (s) + real(kind_phys) :: dw_land = 0.20 !< (v1/v3) value for subgrid deviation / variability over land + real(kind_phys) :: dw_ocean = 0.10 !< (v1/v3) base value for ocean + real(kind_phys) :: ccn_o = 90. !< (v1/v3) ccn over ocean (cm^ - 3) + real(kind_phys) :: ccn_l = 270. !< (v1/v3) ccn over land (cm^ - 3) + real(kind_phys) :: sat_adj0 = 0.90 !< (v1/v3) adjustment factor (0: no, 1: full) during fast_sat_adj + real(kind_phys) :: qi_lim = 1. !< (v1/v3) cloud ice limiter (0: no, 1: full, >1: extra) to prevent large ice build up + real(kind_phys) :: ql_mlt = 2.0e-3 !< (v1/v3) max value of cloud water allowed from melted cloud ice + real(kind_phys) :: qs_mlt = 1.0e-6 !< (v1/v3) max cloud water due to snow melt + real(kind_phys) :: ql_gen = 1.0e-3 !< (v1/v3) max cloud water generation during remapping step if fast_sat_adj = .t. + real(kind_phys) :: qi_gen = 1.82e-6 !< (v1/v3) max cloud ice generation during remapping step (V1 ONLY. Computed internally in V3) + real(kind_phys) :: ql0_max = 2.0e-3 !< (v1/v3) max cloud water value (auto converted to rain) + real(kind_phys) :: qi0_max = 1.0e-4 !< (v1/v3) max cloud ice value (by other sources) + real(kind_phys) :: qi0_crt = 1.0e-4 !< (v1/v3) cloud ice to snow autoconversion threshold (was 1.e-4); + !< qi0_crt is highly dependent on horizontal resolution + real(kind_phys) :: qs0_crt = 1.0e-3 !< (v1/v3) snow to graupel density threshold (0.6e-3 in purdue lin scheme) + real(kind_phys) :: c_paut = 0.55 !< (v1/v3) autoconversion cloud water to rain (use 0.5 to reduce autoconversion) + real(kind_phys) :: vi_fac = 1. !< (v1/v3) if const_vi: 1 / 3 + real(kind_phys) :: vs_fac = 1. !< (v1/v3) if const_vs: 1. + real(kind_phys) :: vg_fac = 1. !< (v1/v3) if const_vg: 2. + real(kind_phys) :: vr_fac = 1. !< (v1/v3) if const_vr: 4. + real(kind_phys) :: vr_max = 12. !< (v1/v3) max fall speed for rain + real(kind_phys) :: rewmin = 5.0 !< (v1/v3) minimum effective radii (liquid) + real(kind_phys) :: reimin = 10.0 !< (v1/v3) minimum effective radii (ice) + real(kind_phys) :: reimax = 150.0 !< (v1/v3) maximum effective radii (ice) + real(kind_phys) :: rermax = 10000.0 !< (v1/v3) maximum effective radii (rain) + real(kind_phys) :: resmin = 150.0 !< (v1/v3) minimum effective radii (snow) + real(kind_phys) :: resmax = 10000.0 !< (v1/v3) maximum effective radii (snow) + real(kind_phys) :: regmax = 10000.0 !< (v1/v3) maximum effective radii (graupel) + ! + logical :: const_vi = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vs = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vg = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vr = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: z_slope_liq = .true. !< (v1/v3) use linear mono slope for autocconversions + logical :: do_hail = .false. !< (v1/v3) use hail parameters instead of graupel + logical :: do_qa = .true. !< (v1/v3) do inline cloud fraction + logical :: rad_snow = .true. !< (v1/v3) consider snow in cloud fraciton calculation + logical :: rad_graupel = .true. !< (v1/v3) consider graupel in cloud fraction calculation + logical :: rad_rain = .true. !< (v1/v3) consider rain in cloud fraction calculation + logical :: do_sedi_heat = .true. !< (v1/v3) transport of heat in sedimentation + logical :: prog_ccn = .false. !< (v1/v3) do prognostic ccn (yi ming's method) + logical :: tintqs = .false. !< (v1/v3) + ! + integer :: icloud_f = 0 !< (v1/v3) GFDL cloud scheme !< 0: subgrid variability based scheme !< 1: same as 0, but for old fvgfs implementation !< 2: binary cloud scheme !< 3: extension of 0 - integer :: irain_f = 0 !< (v1/v3) cloud water to rain auto conversion scheme + integer :: irain_f = 0 !< (v1/v3) cloud water to rain auto conversion scheme !< 0: subgrid variability based scheme !< 1: no subgrid varaibility - integer :: reiflag = 1 !< (DIF for v3) cloud ice effective radius scheme (DJS: v3=5) + + ! ##################################################################################### + ! GFDL MP common (v1/v3) parameters, with different default values + ! ##################################################################################### +#ifdef GFDLMP_V3 + real(kind_phys) :: tice = 273.15 !< freezing temperature (K): ref: GFDL, GFS (DJS: V3=273.15) + real(kind_phys) :: tau_imlt = 1200. !< cloud ice melting time scale (s) (DJS: V3=1200.) + real(kind_phys) :: rthresh = 20.0e-6 !< critical cloud drop radius (micro m) (DJS: v3=20.0e-6) + real(kind_phys) :: c_psaci = 0.05 !< accretion: cloud ice to snow (was 0.1 in zetac) (DJS: v3=0.05) + real(kind_phys) :: c_pgacs = 0.01 !< snow to graupel "accretion" eff. (was 0.1 in zetac) (DJS: v3=0.01) + real(kind_phys) :: vi_max = 1.0 !< max fall speed for ice (DJS: v3=1.0) + real(kind_phys) :: vs_max = 2.0 !< max fall speed for snow (DJS: v3=2.0) + real(kind_phys) :: vg_max = 12.0 !< max fall speed for graupel (DJS: v3=12.0) + real(kind_phys) :: rewmax = 15.0 !< maximum effective radii (liquid) (DJS: v3=15.0) + real(kind_phys) :: rermin = 16.0 !< minimum effective radii (rain) (DJS: v3=15.0) + real(kind_phys) :: regmin = 150.0 !< minimum effective radii (graupel) (DJS: v3=150.0) + logical :: z_slope_ice = .true. !< use linear mono slope for autocconversions (DJS: v3=.true.) + logical :: do_sedi_w = .true. !< transport of vertical motion in sedimentation (DJS: v3=.true.) + logical :: fix_negative = .true. !< fix negative water species (DJS: v3=.true.) + integer :: reiflag = 5 !< cloud ice effective radius scheme (DJS: v3=5) !< 1: Heymsfield and Mcfarquhar (1996) !< 2: Donner et al. (1997) !< 3: Fu (2007) @@ -178,197 +121,248 @@ subroutine register_gfdlmp_param(self, errmsg, errflg, unit, input_nml_file, fn_ !< 5: Wyser (1998) !< 6: Sun and Rikus (1999), Sun (2001) !< 7: effective radius - ! ##################################################################################### - ! GFDL MP Version 3 parameters - ! ##################################################################################### - logical :: const_vw = .false. !< if .ture., the constants are specified by v * _fac - logical :: do_sedi_uv = .true. !< transport of horizontal momentum in sedimentation - logical :: do_sedi_melt = .true. !< melt cloud ice, snow, and graupel during sedimentation - logical :: liq_ice_combine = .false. !< combine all liquid water, combine all solid water - logical :: snow_grauple_combine = .true. !< combine snow and graupel - logical :: use_rhc_cevap = .false. !< cap of rh for cloud water evaporation - logical :: use_rhc_revap = .false. !< cap of rh for rain evaporation - logical :: do_cld_adj = .false. !< do cloud fraction adjustment - logical :: do_evap_timescale = .true. !< whether to apply a timescale to evaporation - logical :: do_cond_timescale = .false. !< whether to apply a timescale to condensation - logical :: consv_checker = .false. !< turn on energy and water conservation checker - logical :: do_warm_rain_mp = .false. !< do warm rain cloud microphysics only - logical :: do_wbf = .false. !< do Wegener Bergeron Findeisen process - logical :: do_psd_water_fall = .false. !< calculate cloud water terminal velocity based on PSD - logical :: do_psd_ice_fall = .false. !< calculate cloud ice terminal velocity based on PSD - logical :: do_psd_water_num = .false. !< calculate cloud water number concentration based on PSD - logical :: do_psd_ice_num = .false. !< calculate cloud ice number concentration based on PSD - logical :: do_new_acc_water = .false. !< perform the new accretion for cloud water - logical :: do_new_acc_ice = .false. !< perform the new accretion for cloud ice - logical :: cp_heating = .false. !< update temperature based on constant pressure - logical :: delay_cond_evap = .false. !< do condensation evaporation only at the last time step - logical :: do_subgrid_proc = .true. !< do temperature sentive high vertical resolution processes - logical :: fast_fr_mlt = .true. !< do freezing and melting in fast microphysics - logical :: fast_dep_sub = .true. !< do deposition and sublimation in fast microphysics - ! - integer :: ntimes = 1 !< cloud microphysics sub cycles - integer :: nconds = 1 !< condensation sub cycles - integer :: inflag = 1 !< ice nucleation scheme +#else + real(kind_phys) :: tice = 273.16 !< freezing temperature (K): ref: GFDL, GFS (DJS: V3=273.15) + real(kind_phys) :: tau_imlt = 600. !< cloud ice melting time scale (s) (DJS: V3=1200.) + real(kind_phys) :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) (DJS: v3=20.0e-6) + real(kind_phys) :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) (DJS: v3=0.05) + real(kind_phys) :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) (DJS: v3=0.01) + real(kind_phys) :: vi_max = 0.5 !< max fall speed for ice (DJS: v3=1.0) + real(kind_phys) :: vs_max = 5.0 !< max fall speed for snow (DJS: v3=2.0) + real(kind_phys) :: vg_max = 8.0 !< max fall speed for graupel (DJS: v3=12.0) + real(kind_phys) :: rewmax = 10.0 !< maximum effective radii (liquid) (DJS: v3=15.0) + real(kind_phys) :: rermin = 10.0 !< minimum effective radii (rain) (DJS: v3=15.0) + real(kind_phys) :: regmin = 300.0 !< minimum effective radii (graupel) (DJS: v3=150.0) + logical :: z_slope_ice = .false. !< use linear mono slope for autocconversions (DJS: v3=.true.) + logical :: do_sedi_w = .false. !< transport of vertical motion in sedimentation (DJS: v3=.true.) + logical :: fix_negative = .false. !< fix negative water species (DJS: v3=.true.) + integer :: reiflag = 1 !< cloud ice effective radius scheme (DJS: v3=5) + !< 1: Heymsfield and Mcfarquhar (1996) + !< 2: Donner et al. (1997) + !< 3: Fu (2007) + !< 4: Kristjansson et al. (2000) + !< 5: Wyser (1998) + !< 6: Sun and Rikus (1999), Sun (2001) + !< 7: effective radius +#endif + + ! ##################################################################################### + ! GFDL MP Version 3 parameters + ! ##################################################################################### + logical :: const_vw = .false. !< if .ture., the constants are specified by v * _fac + logical :: do_sedi_uv = .true. !< transport of horizontal momentum in sedimentation + logical :: do_sedi_melt = .true. !< melt cloud ice, snow, and graupel during sedimentation + logical :: liq_ice_combine = .false. !< combine all liquid water, combine all solid water + logical :: snow_grauple_combine = .true. !< combine snow and graupel + logical :: use_rhc_cevap = .false. !< cap of rh for cloud water evaporation + logical :: use_rhc_revap = .false. !< cap of rh for rain evaporation + logical :: do_cld_adj = .false. !< do cloud fraction adjustment + logical :: do_evap_timescale = .true. !< whether to apply a timescale to evaporation + logical :: do_cond_timescale = .false. !< whether to apply a timescale to condensation + logical :: consv_checker = .false. !< turn on energy and water conservation checker + logical :: do_warm_rain_mp = .false. !< do warm rain cloud microphysics only + logical :: do_wbf = .false. !< do Wegener Bergeron Findeisen process + logical :: do_psd_water_fall = .false. !< calculate cloud water terminal velocity based on PSD + logical :: do_psd_ice_fall = .false. !< calculate cloud ice terminal velocity based on PSD + logical :: do_psd_water_num = .false. !< calculate cloud water number concentration based on PSD + logical :: do_psd_ice_num = .false. !< calculate cloud ice number concentration based on PSD + logical :: do_new_acc_water = .false. !< perform the new accretion for cloud water + logical :: do_new_acc_ice = .false. !< perform the new accretion for cloud ice + logical :: cp_heating = .false. !< update temperature based on constant pressure + logical :: delay_cond_evap = .false. !< do condensation evaporation only at the last time step + logical :: do_subgrid_proc = .true. !< do temperature sentive high vertical resolution processes + logical :: fast_fr_mlt = .true. !< do freezing and melting in fast microphysics + logical :: fast_dep_sub = .true. !< do deposition and sublimation in fast microphysics + integer :: ntimes = 1 !< cloud microphysics sub cycles + integer :: nconds = 1 !< condensation sub cycles + integer :: inflag = 1 !< ice nucleation scheme !< 1: Hong et al. (2004) !< 2: Meyers et al. (1992) !< 3: Meyers et al. (1992) !< 4: Cooper (1986) !< 5: Fletcher (1962) - integer :: igflag = 3 !< ice generation scheme + integer :: igflag = 3 !< ice generation scheme !< 1: WSM6 !< 2: WSM6 with 0 at 0 C !< 3: WSM6 with 0 at 0 C and fixed value at - 10 C !< 4: combination of 1 and 3 - integer :: ifflag = 1 !< ice fall scheme + integer :: ifflag = 1 !< ice fall scheme !< 1: Deng and Mace (2008) !< 2: Heymsfield and Donner (1990) - integer :: rewflag = 1 !< cloud water effective radius scheme + integer :: rewflag = 1 !< cloud water effective radius scheme !< 1: Martin et al. (1994) !< 2: Martin et al. (1994), GFDL revision !< 3: Kiehl et al. (1994) !< 4: effective radius - integer :: rerflag = 1 !< rain effective radius scheme + integer :: rerflag = 1 !< rain effective radius scheme !< 1: effective radius - integer :: resflag = 1 !< snow effective radius scheme + integer :: resflag = 1 !< snow effective radius scheme !< 1: effective radius - integer :: regflag = 1 !< graupel effective radius scheme + integer :: regflag = 1 !< graupel effective radius scheme !< 1: effective radius - integer :: radr_flag = 1 !< radar reflectivity for rain + integer :: radr_flag = 1 !< radar reflectivity for rain !< 1: Mark Stoelinga (2005) !< 2: Smith et al. (1975), Tong and Xue (2005) !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) - integer :: rads_flag = 1 !< radar reflectivity for snow + integer :: rads_flag = 1 !< radar reflectivity for snow !< 1: Mark Stoelinga (2005) !< 2: Smith et al. (1975), Tong and Xue (2005) !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) - integer :: radg_flag = 1 !< radar reflectivity for graupel + integer :: radg_flag = 1 !< radar reflectivity for graupel !< 1: Mark Stoelinga (2005) !< 2: Smith et al. (1975), Tong and Xue (2005) !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) - integer :: sedflag = 1 !< sedimentation scheme + integer :: sedflag = 1 !< sedimentation scheme !< 1: implicit scheme !< 2: explicit scheme !< 3: lagrangian scheme !< 4: combined implicit and lagrangian scheme - integer :: vdiffflag = 1 !< wind difference scheme in accretion + integer :: vdiffflag = 1 !< wind difference scheme in accretion !< 1: Wisner et al. (1972) !< 2: Mizuno (1990) !< 3: Murakami (1990) + real(kind_phys) :: c_psacw = 1.0 !< cloud water to snow accretion efficiency + real(kind_phys) :: c_pracw = 0.8 !< cloud water to rain accretion efficiency + real(kind_phys) :: c_praci = 1.0 !< cloud ice to rain accretion efficiency + real(kind_phys) :: c_pgacw = 1.0 !< cloud water to graupel accretion efficiency + real(kind_phys) :: c_pgaci = 0.05 !< cloud ice to graupel accretion efficiency (was 0.1 in ZETAC) + real(kind_phys) :: c_pracs = 1.0 !< snow to rain accretion efficiency + real(kind_phys) :: c_psacr = 1.0 !< rain to snow accretion efficiency + real(kind_phys) :: c_pgacr = 1.0 !< rain to graupel accretion efficiency + real(kind_phys) :: alinw = 3.e7 !< "a" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) + real(kind_phys) :: alini = 7.e2 !< "a" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) + real(kind_phys) :: alinr = 842.0 !< "a" in Lin et al. (1983) for rain (Liu and Orville 1969) + real(kind_phys) :: alins = 4.8 !< "a" in Lin et al. (1983) for snow (straka 2009) + real(kind_phys) :: aling = 1.0 !< "a" in Lin et al. (1983), similar to a, but for graupel (Pruppacher and Klett 2010) + real(kind_phys) :: alinh = 1.0 !< "a" in Lin et al. (1983), similar to a, but for hail (Pruppacher and Klett 2010) + real(kind_phys) :: blinw = 2.0 !< "b" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) + real(kind_phys) :: blini = 1.0 !< "b" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) + real(kind_phys) :: blinr = 0.8 !< "b" in Lin et al. (1983) for rain (Liu and Orville 1969) + real(kind_phys) :: blins = 0.25 !< "b" in Lin et al. (1983) for snow (straka 2009) + real(kind_phys) :: bling = 0.5 !< "b" in Lin et al. (1983), similar to b, but for graupel (Pruppacher and Klett 2010) + real(kind_phys) :: blinh = 0.5 !< "b" in Lin et al. (1983), similar to b, but for hail (Pruppacher and Klett 2010) + real(kind_phys) :: vw_fac = 1.0 !< + real(kind_phys) :: vw_max = 0.01 !< maximum fall speed for cloud water (m/s) + real(kind_phys) :: tice_mlt = 273.16 !< can set ice melting temperature to 268 based on observation (Kay et al. 2016) (K) + real(kind_phys) :: tau_gmlt = 600.0 !< graupel melting time scale (s) + real(kind_phys) :: tau_wbf = 300.0 !< graupel melting time scale (s) + real(kind_phys) :: tau_revp = 0.0 !< rain evaporation time scale (s) + real(kind_phys) :: is_fac = 0.2 !< cloud ice sublimation temperature factor + real(kind_phys) :: ss_fac = 0.2 !< snow sublimation temperature factor + real(kind_phys) :: gs_fac = 0.2 !< graupel sublimation temperature factor + real(kind_phys) :: rh_fac_evap = 10.0 !< cloud water evaporation relative humidity factor + real(kind_phys) :: rh_fac_cond = 10.0 !< cloud water condensation relative humidity factor + real(kind_phys) :: sed_fac = 1.0 !< coefficient for sedimentation fall, scale from 1.0 (implicit) to 0.0 (lagrangian) + real(kind_phys) :: xr_a = 0.25 !< p value in Xu and Randall (1996) + real(kind_phys) :: xr_b = 100.0 !< alpha_0 value in Xu and Randall (1996) + real(kind_phys) :: xr_c = 0.49 !< gamma value in Xu and Randall (1996) + real(kind_phys) :: te_err = 1.e-5 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time + real(kind_phys) :: tw_err = 1.e-8 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time + real(kind_phys) :: rh_thres = 0.75 !< minimum relative humidity for cloud fraction + real(kind_phys) :: rhc_cevap = 0.85 !< maximum relative humidity for cloud water evaporation + real(kind_phys) :: rhc_revap = 0.85 !< maximum relative humidity for rain evaporation + real(kind_phys) :: f_dq_p = 1.0 !< cloud fraction adjustment for supersaturation + real(kind_phys) :: f_dq_m = 1.0 !< cloud fraction adjustment for undersaturation + real(kind_phys) :: fi2s_fac = 1.0 !< maximum sink of cloud ice to form snow: 0-1 + real(kind_phys) :: fi2g_fac = 1.0 !< maximum sink of cloud ice to form graupel: 0-1 + real(kind_phys) :: fs2g_fac = 1.0 !< maximum sink of snow to form graupel: 0-1 + real(kind_phys) :: n0w_sig = 1.1 !< intercept parameter (significand) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) + real(kind_phys) :: n0i_sig = 1.3 !< intercept parameter (significand) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) + real(kind_phys) :: n0r_sig = 8.0 !< intercept parameter (significand) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) + real(kind_phys) :: n0s_sig = 3.0 !< intercept parameter (significand) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) + real(kind_phys) :: n0g_sig = 4.0 !< intercept parameter (significand) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) + real(kind_phys) :: n0h_sig = 4.0 !< intercept parameter (significand) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) + real(kind_phys) :: n0w_exp = 41 !< intercept parameter (exponent) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) + real(kind_phys) :: n0i_exp = 18 !< intercept parameter (exponent) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) + real(kind_phys) :: n0r_exp = 6 !< intercept parameter (exponent) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) + real(kind_phys) :: n0s_exp = 6 !< intercept parameter (exponent) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) + real(kind_phys) :: n0g_exp = 6 !< intercept parameter (exponent) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) + real(kind_phys) :: n0h_exp = 4 !< intercept parameter (exponent) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) + real(kind_phys) :: muw = 6.0 !< shape parameter of cloud water in Gamma distribution (Martin et al. 1994) + real(kind_phys) :: mui = 3.35 !< shape parameter of cloud ice in Gamma distribution (McFarquhar et al. 2015) + real(kind_phys) :: mur = 1.0 !< shape parameter of rain in Gamma distribution (Marshall and Palmer 1948) + real(kind_phys) :: mus = 1.0 !< shape parameter of snow in Gamma distribution (Gunn and Marshall 1958) + real(kind_phys) :: mug = 1.0 !< shape parameter of graupel in Gamma distribution (Houze et al. 1979) + real(kind_phys) :: muh = 1.0 !< shape parameter of hail in Gamma distribution (Federer and Waldvogel 1975) + real(kind_phys) :: beta = 1.22 !< defined in Heymsfield and Mcfarquhar (1996) + real(kind_phys) :: rewfac = 1.0 !< this is a tuning parameter to compromise the inconsistency between + !< GFDL MP's PSD and cloud water radiative property's PSD assumption. + !< after the cloud water radiative property's PSD is rebuilt, + !< this parameter should be 1.0. + real(kind_phys) :: reifac = 1.0 !< this is a tuning parameter to compromise the inconsistency between + !< GFDL MP's PSD and cloud ice radiative property's PSD assumption. + !< after the cloud ice radiative property's PSD is rebuilt, + !< this parameter should be 1.0. - real(wp) :: c_psacw = 1.0 !< cloud water to snow accretion efficiency - real(wp) :: c_pracw = 0.8 !< cloud water to rain accretion efficiency - real(wp) :: c_praci = 1.0 !< cloud ice to rain accretion efficiency - real(wp) :: c_pgacw = 1.0 !< cloud water to graupel accretion efficiency - real(wp) :: c_pgaci = 0.05 !< cloud ice to graupel accretion efficiency (was 0.1 in ZETAC) - real(wp) :: c_pracs = 1.0 !< snow to rain accretion efficiency - real(wp) :: c_psacr = 1.0 !< rain to snow accretion efficiency - real(wp) :: c_pgacr = 1.0 !< rain to graupel accretion efficiency - real(wp) :: alinw = 3.e7 !< "a" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) - real(wp) :: alini = 7.e2 !< "a" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) - real(wp) :: alinr = 842.0 !< "a" in Lin et al. (1983) for rain (Liu and Orville 1969) - real(wp) :: alins = 4.8 !< "a" in Lin et al. (1983) for snow (straka 2009) - real(wp) :: aling = 1.0 !< "a" in Lin et al. (1983), similar to a, but for graupel (Pruppacher and Klett 2010) - real(wp) :: alinh = 1.0 !< "a" in Lin et al. (1983), similar to a, but for hail (Pruppacher and Klett 2010) - real(wp) :: blinw = 2.0 !< "b" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) - real(wp) :: blini = 1.0 !< "b" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) - real(wp) :: blinr = 0.8 !< "b" in Lin et al. (1983) for rain (Liu and Orville 1969) - real(wp) :: blins = 0.25 !< "b" in Lin et al. (1983) for snow (straka 2009) - real(wp) :: bling = 0.5 !< "b" in Lin et al. (1983), similar to b, but for graupel (Pruppacher and Klett 2010) - real(wp) :: blinh = 0.5 !< "b" in Lin et al. (1983), similar to b, but for hail (Pruppacher and Klett 2010) - real(wp) :: vw_fac = 1.0 !< - real(wp) :: vw_max = 0.01 !< maximum fall speed for cloud water (m/s) - real(wp) :: tice_mlt = 273.16 !< can set ice melting temperature to 268 based on observation (Kay et al. 2016) (K) - real(wp) :: tau_gmlt = 600.0 !< graupel melting time scale (s) - real(wp) :: tau_wbf = 300.0 !< graupel melting time scale (s) - real(wp) :: tau_revp = 0.0 !< rain evaporation time scale (s) - real(wp) :: is_fac = 0.2 !< cloud ice sublimation temperature factor - real(wp) :: ss_fac = 0.2 !< snow sublimation temperature factor - real(wp) :: gs_fac = 0.2 !< graupel sublimation temperature factor - real(wp) :: rh_fac_evap = 10.0 !< cloud water evaporation relative humidity factor - real(wp) :: rh_fac_cond = 10.0 !< cloud water condensation relative humidity factor - real(wp) :: sed_fac = 1.0 !< coefficient for sedimentation fall, scale from 1.0 (implicit) to 0.0 (lagrangian) - real(wp) :: xr_a = 0.25 !< p value in Xu and Randall (1996) - real(wp) :: xr_b = 100.0 !< alpha_0 value in Xu and Randall (1996) - real(wp) :: xr_c = 0.49 !< gamma value in Xu and Randall (1996) - real(wp) :: te_err = 1.e-5 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time - real(wp) :: tw_err = 1.e-8 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time - real(wp) :: rh_thres = 0.75 !< minimum relative humidity for cloud fraction - real(wp) :: rhc_cevap = 0.85 !< maximum relative humidity for cloud water evaporation - real(wp) :: rhc_revap = 0.85 !< maximum relative humidity for rain evaporation - real(wp) :: f_dq_p = 1.0 !< cloud fraction adjustment for supersaturation - real(wp) :: f_dq_m = 1.0 !< cloud fraction adjustment for undersaturation - real(wp) :: fi2s_fac = 1.0 !< maximum sink of cloud ice to form snow: 0-1 - real(wp) :: fi2g_fac = 1.0 !< maximum sink of cloud ice to form graupel: 0-1 - real(wp) :: fs2g_fac = 1.0 !< maximum sink of snow to form graupel: 0-1 - real(wp) :: n0w_sig = 1.1 !< intercept parameter (significand) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) - real(wp) :: n0i_sig = 1.3 !< intercept parameter (significand) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) - real(wp) :: n0r_sig = 8.0 !< intercept parameter (significand) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) - real(wp) :: n0s_sig = 3.0 !< intercept parameter (significand) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) - real(wp) :: n0g_sig = 4.0 !< intercept parameter (significand) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) - real(wp) :: n0h_sig = 4.0 !< intercept parameter (significand) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) - real(wp) :: n0w_exp = 41 !< intercept parameter (exponent) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) - real(wp) :: n0i_exp = 18 !< intercept parameter (exponent) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) - real(wp) :: n0r_exp = 6 !< intercept parameter (exponent) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) - real(wp) :: n0s_exp = 6 !< intercept parameter (exponent) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) - real(wp) :: n0g_exp = 6 !< intercept parameter (exponent) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) - real(wp) :: n0h_exp = 4 !< intercept parameter (exponent) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) - real(wp) :: muw = 6.0 !< shape parameter of cloud water in Gamma distribution (Martin et al. 1994) - real(wp) :: mui = 3.35 !< shape parameter of cloud ice in Gamma distribution (McFarquhar et al. 2015) - real(wp) :: mur = 1.0 !< shape parameter of rain in Gamma distribution (Marshall and Palmer 1948) - real(wp) :: mus = 1.0 !< shape parameter of snow in Gamma distribution (Gunn and Marshall 1958) - real(wp) :: mug = 1.0 !< shape parameter of graupel in Gamma distribution (Houze et al. 1979) - real(wp) :: muh = 1.0 !< shape parameter of hail in Gamma distribution (Federer and Waldvogel 1975) - real(wp) :: beta = 1.22 !< defined in Heymsfield and Mcfarquhar (1996) - real(wp) :: rewfac = 1.0 !< this is a tuning parameter to compromise the inconsistency between - !< GFDL MP's PSD and cloud water radiative property's PSD assumption. - !< after the cloud water radiative property's PSD is rebuilt, - !< this parameter should be 1.0. - real(wp) :: reifac = 1.0 !< this is a tuning parameter to compromise the inconsistency between - !< GFDL MP's PSD and cloud ice radiative property's PSD assumption. - !< after the cloud ice radiative property's PSD is rebuilt, - !< this parameter should be 1.0. + ! ####################################################################################### + ! V1 namelist + ! ####################################################################################### + namelist / gfdl_cloud_microphysics_nml / & + mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, vs_max, vg_max, & + vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, qi0_crt, qr0_crt, fast_sat_adj, & + rh_inc, rh_ins, rh_inr, const_vi, const_vs, const_vg, const_vr, use_ccn, rthresh, & + ccn_l, ccn_o, qc_crt, tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, & + tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, z_slope_liq, & + z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, rad_snow, rad_graupel, rad_rain, & + cld_min, use_ppm, mono_prof, do_sedi_heat, sedi_transport, do_sedi_w, de_ice, & + icloud_f, irain_f, mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, & + rermax, resmin, resmax, regmin, regmax, tintqs, do_hail - ! ####################################################################################### - ! V1 namelist - ! ####################################################################################### - namelist / gfdl_cloud_microphysics_nml / & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, vi_fac, & - vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, vs_max, vg_max, & - vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, qi0_crt, qr0_crt, fast_sat_adj, & - rh_inc, rh_ins, rh_inr, const_vi, const_vs, const_vg, const_vr, use_ccn, rthresh, & - ccn_l, ccn_o, qc_crt, tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, & - tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, z_slope_liq, & - z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, rad_snow, rad_graupel, rad_rain, & - cld_min, use_ppm, mono_prof, do_sedi_heat, sedi_transport, do_sedi_w, de_ice, & - icloud_f, irain_f, mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, & - rermax, resmin, resmax, regmin, regmax, tintqs, do_hail + ! ####################################################################################### + ! V3 Namelist + ! ####################################################################################### + namelist / gfdl_cloud_microphysics_v3_nml / & + t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& + rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & + igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & + do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & + c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & + rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & + do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & + do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & + use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & + rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & + regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & + regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & + radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & + n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & + muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & + blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & + ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & + do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & + delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub - ! ####################################################################################### - ! V3 Namelist - ! ####################################################################################### - namelist / gfdl_cloud_microphysics_v3_nml / & - t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & - vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & - vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& - rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & - igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & - do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & - c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & - rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & - do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & - do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & - use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & - rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & - regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & - regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & - radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & - n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & - muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & - blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & - ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & - do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & - delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub + public & + mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & + vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & + vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & + qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & + const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & + tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & + tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & + z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & + rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & + do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & + mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & + resmin, resmax, regmin, regmax, tintqs, do_hail +contains + ! ####################################################################################### + ! Procedure to read GFDLMP namelists + ! ####################################################################################### + subroutine read_gfdlmp_nml(errmsg, errflg, unit, input_nml_file, fn_nml, version, iostat) + + character(len = *), intent(in ), optional :: input_nml_file(:) + character(len = *), intent(in ), optional :: fn_nml + integer, intent(in ), optional :: unit + integer, intent(in ), optional :: version + integer, intent(out), optional :: iostat + character(len=*), intent(out), optional :: errmsg + integer, intent(out), optional :: errflg + logical :: exists ! Make sure that all inputs to read appropriate NML are provided, if not use default ! parameters if (present(unit) .and. present(iostat) .and. & @@ -402,190 +396,96 @@ subroutine register_gfdlmp_param(self, errmsg, errflg, unit, input_nml_file, fn_ close (unit) #endif endif - - ! ##################################################################################### - ! Populate parameter type - ! ##################################################################################### - self%mp_time = mp_time - self%t_min = t_min - self%t_sub = t_sub - self%tau_r2g = tau_r2g - self%tau_smlt = tau_smlt - self%tau_g2r = tau_g2r - self%dw_land = dw_land - self%dw_ocean = dw_ocean - self%vi_fac = vi_fac - self%vr_fac = vr_fac - self%vs_fac = vs_fac - self%vg_fac = vg_fac - self%ql_mlt = ql_mlt - self%do_qa = do_qa - self%fix_negative = fix_negative - self%vi_max = vi_max - self%vs_max = vs_max - self%vg_max = vg_max - self%vr_max = vr_max - self%qs_mlt = qs_mlt - self%qs0_crt = qs0_crt - self%qi_gen = qi_gen - self%ql0_max = ql0_max - self%qi0_max = qi0_max - self%qi0_crt = qi0_crt - self%qr0_crt = qr0_crt - self%fast_sat_adj = fast_sat_adj - self%rh_inc = rh_inc - self%rh_ins = rh_ins - self%rh_inr = rh_inr - self%const_vi = const_vi - self%const_vs = const_vs - self%const_vg = const_vg - self%const_vr = const_vr - self%use_ccn = use_ccn - self%rthresh = rthresh - self%ccn_l = ccn_l - self%ccn_o = ccn_o - self%qc_crt = qc_crt - self%tau_g2v = tau_g2v - self%tau_v2g = tau_v2g - self%sat_adj0 = sat_adj0 - self%c_piacr = c_piacr - self%tau_imlt = tau_imlt - self%tau_v2l = tau_v2l - self%tau_l2v = tau_l2v - self%tau_i2s = tau_i2s - self%tau_l2r = tau_l2r - self%qi_lim = qi_lim - self%ql_gen = ql_gen - self%c_paut = c_paut - self%c_psaci = c_psaci - self%c_pgacs = c_pgacs - self%z_slope_liq = z_slope_liq - self%z_slope_ice = z_slope_ice - self%prog_ccn = prog_ccn - self%c_cracw = c_cracw - self%alin = alin - self%clin = clin - self%tice = tice - self%rad_snow = rad_snow - self%rad_graupel = rad_graupel - self%rad_rain = rad_rain - self%cld_min = cld_min - self%use_ppm = use_ppm - self%mono_prof = mono_prof - self%do_sedi_heat = do_sedi_heat - self%sedi_transport = sedi_transport - self%do_sedi_w = do_sedi_w - self%de_ice = de_ice - self%icloud_f = icloud_f - self%irain_f = irain_f - self%mp_print = mp_print - self%reiflag = reiflag - self%rewmin = rewmin - self%rewmax = rewmax - self%reimin = reimin - self%reimax = reimax - self%rermin = rermin - self%rermax = rermax - self%resmin = resmin - self%resmax = resmax - self%regmin = regmin - self%regmax = regmax - self%tintqs = tintqs - self%do_hail = do_hail - - end subroutine register_gfdlmp_param + end subroutine read_gfdlmp_nml - subroutine display_gfdlmp_param(self) - class(ty_gfdlmp_config), intent(in) :: self - - write(*,*) '---------- GFDL MP Configurations ----------' - write(*,*) 'self%mp_time = ',self%mp_time - write(*,*) 'self%t_min = ',self%t_min - write(*,*) 'self%t_sub = ',self%t_sub - write(*,*) 'self%tau_r2g = ',self%tau_r2g - write(*,*) 'self%tau_smlt = ',self%tau_smlt - write(*,*) 'self%tau_g2r = ',self%tau_g2r - write(*,*) 'self%dw_land = ',self%dw_land - write(*,*) 'self%dw_ocean = ',self%dw_ocean - write(*,*) 'self%vi_fac = ',self%vi_fac - write(*,*) 'self%vr_fac = ',self%vr_fac - write(*,*) 'self%vs_fac = ',self%vs_fac - write(*,*) 'self%vg_fac = ',self%vg_fac - write(*,*) 'self%ql_mlt = ',self%ql_mlt - write(*,*) 'self%do_qa = ',self%do_qa - write(*,*) 'self%fix_negative = ',self%fix_negative - write(*,*) 'self%vi_max = ',self%vi_max - write(*,*) 'self%vs_max = ',self%vs_max - write(*,*) 'self%vg_max = ',self%vg_max - write(*,*) 'self%vr_max = ',self%vr_max - write(*,*) 'self%qs_mlt = ',self%qs_mlt - write(*,*) 'self%qs0_crt = ',self%qs0_crt - write(*,*) 'self%qi_gen = ',self%qi_gen - write(*,*) 'self%ql0_max = ',self%ql0_max - write(*,*) 'self%qi0_max = ',self%qi0_max - write(*,*) 'self%qi0_crt = ',self%qi0_crt - write(*,*) 'self%qr0_crt = ',self%qr0_crt - write(*,*) 'self%fast_sat_adj = ',self%fast_sat_adj - write(*,*) 'self%rh_inc = ',self%rh_inc - write(*,*) 'self%rh_ins = ',self%rh_ins - write(*,*) 'self%rh_inr = ',self%rh_inr - write(*,*) 'self%const_vi = ',self%const_vi - write(*,*) 'self%const_vs = ',self%const_vs - write(*,*) 'self%const_vg = ',self%const_vg - write(*,*) 'self%const_vr = ',self%const_vr - write(*,*) 'self%use_ccn = ',self%use_ccn - write(*,*) 'self%rthresh = ',self%rthresh - write(*,*) 'self%ccn_l = ',self%ccn_l - write(*,*) 'self%ccn_o = ',self%ccn_o - write(*,*) 'self%qc_crt = ',self%qc_crt - write(*,*) 'self%tau_g2v = ',self%tau_g2v - write(*,*) 'self%tau_v2g = ',self%tau_v2g - write(*,*) 'self%sat_adj0 = ',self%sat_adj0 - write(*,*) 'self%c_piacr = ',self%c_piacr - write(*,*) 'self%tau_imlt = ',self%tau_imlt - write(*,*) 'self%tau_v2l = ',self%tau_v2l - write(*,*) 'self%tau_l2v = ',self%tau_l2v - write(*,*) 'self%tau_i2s = ',self%tau_i2s - write(*,*) 'self%tau_l2r = ',self%tau_l2r - write(*,*) 'self%qi_lim = ',self%qi_lim - write(*,*) 'self%ql_gen = ',self%ql_gen - write(*,*) 'self%c_paut = ',self%c_paut - write(*,*) 'self%c_psaci = ',self%c_psaci - write(*,*) 'self%c_pgacs = ',self%c_pgacs - write(*,*) 'self%z_slope_liq = ',self%z_slope_liq - write(*,*) 'self%z_slope_ice = ',self%z_slope_ice - write(*,*) 'self%prog_ccn = ',self%prog_ccn - write(*,*) 'self%c_cracw = ',self%c_cracw - write(*,*) 'self%alin = ',self%alin - write(*,*) 'self%clin = ',self%clin - write(*,*) 'self%tice = ',self%tice - write(*,*) 'self%rad_snow = ',self%rad_snow - write(*,*) 'self%rad_graupel = ',self%rad_graupel - write(*,*) 'self%rad_rain = ',self%rad_rain - write(*,*) 'self%cld_min = ',self%cld_min - write(*,*) 'self%use_ppm = ',self%use_ppm - write(*,*) 'self%mono_prof = ',self%mono_prof - write(*,*) 'self%do_sedi_heat = ',self%do_sedi_heat - write(*,*) 'self%sedi_transport = ',self%sedi_transport - write(*,*) 'self%do_sedi_w = ',self%do_sedi_w - write(*,*) 'self%de_ice = ',self%de_ice - write(*,*) 'self%icloud_f = ',self%icloud_f - write(*,*) 'self%irain_f = ',self%irain_f - write(*,*) 'self%mp_print = ',self%mp_print - write(*,*) 'self%reiflag = ',self%reiflag - write(*,*) 'self%rewmin = ',self%rewmin - write(*,*) 'self%rewmax = ',self%rewmax - write(*,*) 'self%reimin = ',self%reimin - write(*,*) 'self%reimax = ',self%reimax - write(*,*) 'self%rermin = ',self%rermin - write(*,*) 'self%rermax = ',self%rermax - write(*,*) 'self%resmin = ',self%resmin - write(*,*) 'self%resmax = ',self%resmax - write(*,*) 'self%regmin = ',self%regmin - write(*,*) 'self%regmax = ',self%regmax - write(*,*) 'self%tintqs = ',self%tintqs - write(*,*) 'self%do_hail = ',self%do_hail - + subroutine display_gfdlmp_param() + write(*,*) '---------- GFDL MP Configuration ----------' + write(*,*) 'mp_time = ',mp_time + write(*,*) 't_min = ',t_min + write(*,*) 't_sub = ',t_sub + write(*,*) 'tau_r2g = ',tau_r2g + write(*,*) 'tau_smlt = ',tau_smlt + write(*,*) 'tau_g2r = ',tau_g2r + write(*,*) 'dw_land = ',dw_land + write(*,*) 'dw_ocean = ',dw_ocean + write(*,*) 'vi_fac = ',vi_fac + write(*,*) 'vr_fac = ',vr_fac + write(*,*) 'vs_fac = ',vs_fac + write(*,*) 'vg_fac = ',vg_fac + write(*,*) 'ql_mlt = ',ql_mlt + write(*,*) 'do_qa = ',do_qa + write(*,*) 'fix_negative = ',fix_negative + write(*,*) 'vi_max = ',vi_max + write(*,*) 'vs_max = ',vs_max + write(*,*) 'vg_max = ',vg_max + write(*,*) 'vr_max = ',vr_max + write(*,*) 'qs_mlt = ',qs_mlt + write(*,*) 'qs0_crt = ',qs0_crt + write(*,*) 'qi_gen = ',qi_gen + write(*,*) 'ql0_max = ',ql0_max + write(*,*) 'qi0_max = ',qi0_max + write(*,*) 'qi0_crt = ',qi0_crt + write(*,*) 'qr0_crt = ',qr0_crt + write(*,*) 'fast_sat_adj = ',fast_sat_adj + write(*,*) 'rh_inc = ',rh_inc + write(*,*) 'rh_ins = ',rh_ins + write(*,*) 'rh_inr = ',rh_inr + write(*,*) 'const_vi = ',const_vi + write(*,*) 'const_vs = ',const_vs + write(*,*) 'const_vg = ',const_vg + write(*,*) 'const_vr = ',const_vr + write(*,*) 'use_ccn = ',use_ccn + write(*,*) 'rthresh = ',rthresh + write(*,*) 'ccn_l = ',ccn_l + write(*,*) 'ccn_o = ',ccn_o + write(*,*) 'qc_crt = ',qc_crt + write(*,*) 'tau_g2v = ',tau_g2v + write(*,*) 'tau_v2g = ',tau_v2g + write(*,*) 'sat_adj0 = ',sat_adj0 + write(*,*) 'c_piacr = ',c_piacr + write(*,*) 'tau_imlt = ',tau_imlt + write(*,*) 'tau_v2l = ',tau_v2l + write(*,*) 'tau_l2v = ',tau_l2v + write(*,*) 'tau_i2s = ',tau_i2s + write(*,*) 'tau_l2r = ',tau_l2r + write(*,*) 'qi_lim = ',qi_lim + write(*,*) 'ql_gen = ',ql_gen + write(*,*) 'c_paut = ',c_paut + write(*,*) 'c_psaci = ',c_psaci + write(*,*) 'c_pgacs = ',c_pgacs + write(*,*) 'z_slope_liq = ',z_slope_liq + write(*,*) 'z_slope_ice = ',z_slope_ice + write(*,*) 'prog_ccn = ',prog_ccn + write(*,*) 'c_cracw = ',c_cracw + write(*,*) 'alin = ',alin + write(*,*) 'clin = ',clin + write(*,*) 'tice = ',tice + write(*,*) 'rad_snow = ',rad_snow + write(*,*) 'rad_graupel = ',rad_graupel + write(*,*) 'rad_rain = ',rad_rain + write(*,*) 'cld_min = ',cld_min + write(*,*) 'use_ppm = ',use_ppm + write(*,*) 'mono_prof = ',mono_prof + write(*,*) 'do_sedi_heat = ',do_sedi_heat + write(*,*) 'sedi_transport = ',sedi_transport + write(*,*) 'do_sedi_w = ',do_sedi_w + write(*,*) 'de_ice = ',de_ice + write(*,*) 'icloud_f = ',icloud_f + write(*,*) 'irain_f = ',irain_f + write(*,*) 'mp_print = ',mp_print + write(*,*) 'reiflag = ',reiflag + write(*,*) 'rewmin = ',rewmin + write(*,*) 'rewmax = ',rewmax + write(*,*) 'reimin = ',reimin + write(*,*) 'reimax = ',reimax + write(*,*) 'rermin = ',rermin + write(*,*) 'rermax = ',rermax + write(*,*) 'resmin = ',resmin + write(*,*) 'resmax = ',resmax + write(*,*) 'regmin = ',regmin + write(*,*) 'regmax = ',regmax + write(*,*) 'tintqs = ',tintqs + write(*,*) 'do_hail = ',do_hail end subroutine display_gfdlmp_param ! end module module_gfdlmp_param diff --git a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 index 841b4fcba..d40251184 100644 --- a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 @@ -39,8 +39,22 @@ module gfdl_cloud_microphys_mod ! use fms_mod, only: write_version_number, open_namelist_file, & ! check_nml_error, file_exist, close_file + ! ----------------------------------------------------------------------- use module_mp_radar - use module_gfdlmp_param, only: cfg + use module_gfdlmp_param, only: read_gfdlmp_nml, mp_time, t_min, t_sub, & + tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, vi_fac, vr_fac, & + vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & + qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & + const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, & + qc_crt, tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, & + tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, & + c_pgacs, z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, & + tice, rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, & + mono_prof, do_sedi_heat, sedi_transport, do_sedi_w, de_ice, & + icloud_f, irain_f, mp_print, reiflag, rewmin, rewmax, reimin, & + reimax, rermin, rermax, resmin, resmax, regmin, regmax, tintqs, & + do_hail, display_gfdlmp_param implicit none @@ -265,7 +279,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & d0_vap = c_vap - c_liq lv00 = hlv0 - d0_vap * t_ice - if (hydrostatic) cfg%do_sedi_w = .false. + if (hydrostatic) do_sedi_w = .false. ! ----------------------------------------------------------------------- ! define latent heat coefficient used in wet bulb and Bigg mechanism @@ -286,7 +300,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! define cloud microphysics sub time step ! ----------------------------------------------------------------------- - mpdt = min (dt_in, cfg%mp_time) + mpdt = min (dt_in, mp_time) rdt = 1. / dt_in ntimes = nint (dt_in / mpdt) @@ -337,7 +351,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & if (ks < ktop) then do k = ks, ktop - if (cfg%do_qa) then + if (do_qa) then do j = js, je do i = is, ie qa_dt (i, j, k) = 0. @@ -407,7 +421,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! if (id_snow > 0) then ! used = send_data (id_snow, snow, time, iis, jjs) ! used = send_data (id_snow, snow, time, is_in = iis, js_in = jjs) - ! if (cfg%mp_print .and. seconds == 0) then + ! if (mp_print .and. seconds == 0) then ! tot_prec = g_sum (snow, is, ie, js, je, area, 1) ! if (master) write (*, *) 'mean snow = ', tot_prec ! endif @@ -416,7 +430,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! if (id_graupel > 0) then ! used = send_data (id_graupel, graupel, time, iis, jjs) ! used = send_data (id_graupel, graupel, time, is_in = iis, js_in = jjs) - ! if (cfg%mp_print .and. seconds == 0) then + ! if (mp_print .and. seconds == 0) then ! tot_prec = g_sum (graupel, is, ie, js, je, area, 1) ! if (master) write (*, *) 'mean graupel = ', tot_prec ! endif @@ -425,7 +439,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! if (id_ice > 0) then ! used = send_data (id_ice, ice, time, iis, jjs) ! used = send_data (id_ice, ice, time, is_in = iis, js_in = jjs) - ! if (cfg%mp_print .and. seconds == 0) then + ! if (mp_print .and. seconds == 0) then ! tot_prec = g_sum (ice, is, ie, js, je, area, 1) ! if (master) write (*, *) 'mean ice_mp = ', tot_prec ! endif @@ -434,7 +448,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! if (id_rain > 0) then ! used = send_data (id_rain, rain, time, iis, jjs) ! used = send_data (id_rain, rain, time, is_in = iis, js_in = jjs) - ! if (cfg%mp_print .and. seconds == 0) then + ! if (mp_print .and. seconds == 0) then ! tot_prec = g_sum (rain, is, ie, js, je, area, 1) ! if (master) write (*, *) 'mean rain = ', tot_prec ! endif @@ -451,7 +465,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( & ! used = send_data (id_prec, prec_mp, time, is_in = iis, js_in = jjs) ! endif - ! if (cfg%mp_print) then + ! if (mp_print) then ! prec1 (:, :) = prec1 (:, :) + prec_mp (:, :) ! if (seconds == 0) then ! prec1 (:, :) = prec1 (:, :) * dt_in / 86400. @@ -576,10 +590,10 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !> - Prevent excessive build-up of cloud ice from external sources. ! ----------------------------------------------------------------------- - if (cfg%de_ice) then + if (de_ice) then do k = ktop, kbot qio = qiz (k) - dt_in * qi_dt (i, j, k) ! original qi before phys - qin = max (qio, cfg%qi0_max) ! adjusted value + qin = max (qio, qi0_max) ! adjusted value if (qiz (k) > qin) then qsz (k) = qsz (k) + qiz (k) - qin qiz (k) = qin @@ -650,7 +664,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & enddo - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot w1 (k) = w (i, j, k) enddo @@ -664,18 +678,18 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !! following klein eq. 15 ! ----------------------------------------------------------------------- - cpaut = cfg%c_paut * 0.104 * grav / 1.717e-5 + cpaut = c_paut * 0.104 * grav / 1.717e-5 - if (cfg%prog_ccn) then + if (prog_ccn) then do k = ktop, kbot ! convert # / cc to # / m^3 ccn (k) = qn (i, j, k) * 1.e6 c_praut (k) = cpaut * (ccn (k) * rhor) ** (- 1. / 3.) enddo - cfg%use_ccn = .false. + use_ccn = .false. else - ccn0 = (cfg%ccn_l * land (i) + cfg%ccn_o * (1. - land (i))) * 1.e6 - if (cfg%use_ccn) then + ccn0 = (ccn_l * land (i) + ccn_o * (1. - land (i))) * 1.e6 + if (use_ccn) then ! ----------------------------------------------------------------------- ! ccn is formulted as ccn = ccn_surface * (den / den_surface) ! ----------------------------------------------------------------------- @@ -715,8 +729,8 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & ! ----------------------------------------------------------------------- s_leng = sqrt (sqrt (area1 (i) / 1.e10)) - t_land = cfg%dw_land * s_leng - t_ocean = cfg%dw_ocean * s_leng + t_land = dw_land * s_leng + t_ocean = dw_ocean * s_leng h_var = t_land * land (i) + t_ocean * (1. - land (i)) h_var = min (0.20, max (0.01, h_var)) ! if (id_var > 0) w_var (i, j) = h_var @@ -725,14 +739,14 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !> - Calculate relative humidity increment. ! ----------------------------------------------------------------------- - rh_adj = 1. - h_var - cfg%rh_inc - rh_rain = max (0.35, rh_adj - cfg%rh_inr) ! cfg%rh_inr = 0.25 + rh_adj = 1. - h_var - rh_inc + rh_rain = max (0.35, rh_adj - rh_inr) ! rh_inr = 0.25 ! ----------------------------------------------------------------------- !> - If requested, call neg_adj() and fix all negative water species. ! ----------------------------------------------------------------------- - if (cfg%fix_negative) & + if (fix_negative) & call neg_adj (ktop, kbot, tz, dp1, qvz, qlz, qrz, qiz, qsz, qgz) m2_rain (i, :) = 0. @@ -794,7 +808,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !> - Call sedi_heat() to calculate heat transportation during sedimentation. ! ----------------------------------------------------------------------- - if (cfg%do_sedi_heat) & + if (do_sedi_heat) & call sedi_heat (ktop, kbot, dp1, m1_sol, dz1, tz, qvz, qlz, qrz, qiz, & qsz, qgz, c_ice) @@ -831,7 +845,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & ! note: dp1 is dry mass; dp0 is the old moist (total) mass ! ----------------------------------------------------------------------- - if (cfg%sedi_transport) then + if (sedi_transport) then do k = ktop + 1, kbot u1 (k) = (dp0 (k) * u1 (k) + m1 (k - 1) * u1 (k - 1)) / (dp0 (k) + m1 (k - 1)) v1 (k) = (dp0 (k) * v1 (k) + m1 (k - 1) * v1 (k - 1)) / (dp0 (k) + m1 (k - 1)) @@ -840,7 +854,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot w (i, j, k) = w1 (k) enddo @@ -868,7 +882,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & ! ----------------------------------------------------------------------- do k = ktop, kbot - if (cfg%do_qa) then + if (do_qa) then qa_dt (i, j, k) = 0. else qa_dt (i, j, k) = qa_dt (i, j, k) + rdt * (qaz (k) / real (ntimes) - qa0 (k)) @@ -1035,17 +1049,17 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & !> - Calculate fall speed of rain. ! ----------------------------------------------------------------------- - if (cfg%const_vr) then - vtr (:) = cfg%vr_fac ! ifs_2016: 4.0 + if (const_vr) then + vtr (:) = vr_fac ! ifs_2016: 4.0 else do k = ktop, kbot qden = qr (k) * den (k) if (qr (k) < thr) then vtr (k) = vr_min else - vtr (k) = cfg%vr_fac * vconr * sqrt (min (10., sfcrho / den (k))) * & + vtr (k) = vr_fac * vconr * sqrt (min (10., sfcrho / den (k))) * & exp (0.2 * log (qden / normr)) - vtr (k) = min (cfg%vr_max, max (vr_min, vtr (k))) + vtr (k) = min (vr_max, max (vr_min, vtr (k))) endif enddo endif @@ -1060,10 +1074,10 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & !! of rain for the first 1/2 time step. ! ----------------------------------------------------------------------- - ! if (.not. cfg%fast_sat_adj) & + ! if (.not. fast_sat_adj) & call revap_racc (ktop, kbot, dt5, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) enddo @@ -1071,10 +1085,10 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & ! ----------------------------------------------------------------------- !> - Calculate mass flux induced by falling rain - !! ( cfg%use_ppm =.false, call implicit_fall(): time-implicit monotonic fall scheme.) + !! ( use_ppm =.false, call implicit_fall(): time-implicit monotonic fall scheme.) ! ----------------------------------------------------------------------- - if (cfg%use_ppm) then + if (use_ppm) then zt (ktop) = ze (ktop) do k = ktop + 1, kbot zt (k) = ze (k) - dt5 * (vtr (k - 1) + vtr (k)) @@ -1084,18 +1098,18 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & do k = ktop, kbot if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min enddo - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qr, r1, m1_rain, cfg%mono_prof) + call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qr, r1, m1_rain, mono_prof) else call implicit_fall (dt, ktop, kbot, ze, vtr, dp, qr, r1, m1_rain) endif ! ----------------------------------------------------------------------- ! - Calculate vertical velocity transportation during sedimentation. - ! (cfg%do_sedi_w =.true. to turn on vertical motion tranport during sedimentation + ! (do_sedi_w =.true. to turn on vertical motion tranport during sedimentation ! .false. by default) ! ----------------------------------------------------------------------- - if (cfg%do_sedi_w) then + if (do_sedi_w) then w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_rain (ktop) * vtr (ktop)) / (dm (ktop) - m1_rain (ktop)) do k = ktop + 1, kbot w1 (k) = (dm (k) * w1 (k) - m1_rain (k - 1) * vtr (k - 1) + m1_rain (k) * vtr (k)) & @@ -1107,7 +1121,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & !> - Call sedi_heat() to calculate heat transportation during sedimentation. ! ----------------------------------------------------------------------- - if (cfg%do_sedi_heat) & + if (do_sedi_heat) & call sedi_heat (ktop, kbot, dp, m1_rain, dz, tz, qv, ql, qr, qi, qs, qg, c_liq) ! ----------------------------------------------------------------------- @@ -1125,7 +1139,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & !! following Lin et al. (1994) \cite lin_et_al_1994.) ! ----------------------------------------------------------------------- - if (cfg%irain_f /= 0) then + if (irain_f /= 0) then ! ----------------------------------------------------------------------- ! no subgrid varaibility @@ -1134,7 +1148,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & do k = ktop, kbot qc0 = fac_rc * ccn (k) if (tz (k) > t_wfr) then - if (cfg%use_ccn) then + if (use_ccn) then ! ----------------------------------------------------------------------- ! ccn is formulted as ccn = ccn_surface * (den / den_surface) ! ----------------------------------------------------------------------- @@ -1157,7 +1171,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & !> - Call linear_prof() to calculate vertical subgrid variability of cloud water. ! ----------------------------------------------------------------------- - call linear_prof (kbot - ktop + 1, ql (ktop), dl (ktop), cfg%z_slope_liq, h_var) + call linear_prof (kbot - ktop + 1, ql (ktop), dl (ktop), z_slope_liq, h_var) do k = ktop, kbot qc0 = fac_rc * ccn (k) @@ -1166,7 +1180,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & ! -------------------------------------------------------------------- ! as in klein's gfdl am2 stratiform scheme (with subgrid variations) ! -------------------------------------------------------------------- - if (cfg%use_ccn) then + if (use_ccn) then ! -------------------------------------------------------------------- ! ccn is formulted as ccn = ccn_surface * (den / den_surface) ! -------------------------------------------------------------------- @@ -1400,11 +1414,11 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & !> - Define conversion scalar/factor. ! ----------------------------------------------------------------------- - fac_i2s = 1. - exp (- dts / cfg%tau_i2s) - fac_g2v = 1. - exp (- dts / cfg%tau_g2v) - fac_v2g = 1. - exp (- dts / cfg%tau_v2g) + fac_i2s = 1. - exp (- dts / tau_i2s) + fac_g2v = 1. - exp (- dts / tau_g2v) + fac_v2g = 1. - exp (- dts / tau_v2g) - fac_imlt = 1. - exp (- dt5 / cfg%tau_imlt) + fac_imlt = 1. - exp (- dt5 / tau_imlt) ! ----------------------------------------------------------------------- !> - Define heat capacity and latend heat coefficient. @@ -1426,14 +1440,14 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & ! ----------------------------------------------------------------------- do k = ktop, kbot - if (tzk (k) > cfg%tice .and. qik (k) > qcmin) then + if (tzk (k) > tice .and. qik (k) > qcmin) then ! ----------------------------------------------------------------------- !> - Calculate \f$P_{imlt}\f$: instant melting of cloud ice. ! ----------------------------------------------------------------------- - melt = min (qik (k), fac_imlt * (tzk (k) - cfg%tice) / icpk (k)) - tmp = min (melt, dim (cfg%ql_mlt, qlk (k))) ! max ql amount + melt = min (qik (k), fac_imlt * (tzk (k) - tice) / icpk (k)) + tmp = min (melt, dim (ql_mlt, qlk (k))) ! max ql amount qlk (k) = qlk (k) + tmp qrk (k) = qrk (k) + melt - tmp qik (k) = qik (k) - melt @@ -1452,7 +1466,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & dtmp = t_wfr - tzk (k) factor = min (1., dtmp / dt_fr) sink = min (qlk (k) * factor, dtmp / icpk (k)) - qi_crt = cfg%qi_gen * min (cfg%qi_lim, 0.1 * (cfg%tice - tzk (k))) / den (k) + qi_crt = qi_gen * min (qi_lim, 0.1 * (tice - tzk (k))) / den (k) tmp = min (sink, dim (qi_crt, qik (k))) qlk (k) = qlk (k) - sink qsk (k) = qsk (k) + sink - tmp @@ -1469,7 +1483,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & !> - Call linear_prof() to calculate vertical subgrid variability of cloud ice. ! ----------------------------------------------------------------------- - call linear_prof (kbot - ktop + 1, qik (ktop), di (ktop), cfg%z_slope_ice, h_var) + call linear_prof (kbot - ktop + 1, qik (ktop), di (ktop), z_slope_ice, h_var) ! ----------------------------------------------------------------------- !> - Update capacity heat and latend heat coefficient. @@ -1501,7 +1515,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & pgacr = 0. pgacw = 0. - tc = tz - cfg%tice + tc = tz - tice if (tc .ge. 0.) then @@ -1549,7 +1563,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & sink = min (qs, dts * (psmlt + pracs), tc / icpk (k)) qs = qs - sink ! sjl, 20170321: - tmp = min (sink, dim (cfg%qs_mlt, ql)) ! max ql due to snow melt + tmp = min (sink, dim (qs_mlt, ql)) ! max ql due to snow melt ql = ql + tmp qr = qr + sink - tmp ! qr = qr + sink @@ -1558,7 +1572,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & q_sol (k) = q_sol (k) - sink cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice tz = tz - sink * lhi (k) / cvm (k) - tc = tz - cfg%tice + tc = tz - tice endif @@ -1637,17 +1651,17 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & !! threshold from wsm6 scheme, Hong et al. (2004) \cite hong_et_al_2004, !! eq (13) : qi0_crt ~0.8e-4. ! ----------------------------------------------------------------------- - if (cfg%qi0_crt < 0.) then - qim = - cfg%qi0_crt + if (qi0_crt < 0.) then + qim = - qi0_crt else - qim = cfg%qi0_crt / den (k) + qim = qi0_crt / den (k) endif ! ----------------------------------------------------------------------- ! assuming linear subgrid vertical distribution of cloud ice ! the mismatch computation following lin et al. 1994, mwr ! ----------------------------------------------------------------------- - if (cfg%const_vi) then + if (const_vi) then tmp = fac_i2s else tmp = fac_i2s * exp (0.025 * tc) @@ -1697,7 +1711,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & ! rain to ice, snow, graupel processes: ! ----------------------------------------------------------------------- - tc = tz - cfg%tice + tc = tz - tice if (qr > 1.e-7 .and. tc < 0.) then @@ -1775,9 +1789,9 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & !> - autoconversion: snow \f$\rightarrow\f$ graupel ! ----------------------------------------------------------------------- - qsm = cfg%qs0_crt / den (k) + qsm = qs0_crt / den (k) if (qs > qsm) then - factor = dts * 1.e-3 * exp (0.09 * (tz - cfg%tice)) + factor = dts * 1.e-3 * exp (0.09 * (tz - tice)) sink = sink + factor / (1. + factor) * (qs - qsm) endif sink = min (qs, sink) @@ -1812,7 +1826,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & endif sink = pgacr + pgacw - factor = min (sink, dim (cfg%tice, tz) / icpk (k)) / max (sink, qrmin) + factor = min (sink, dim (tice, tz) / icpk (k)) / max (sink, qrmin) pgacr = factor * pgacr pgacw = factor * pgacw @@ -1885,7 +1899,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & integer :: k - if (cfg%fast_sat_adj) then + if (fast_sat_adj) then dt_evap = 0.5 * dts else dt_evap = dts @@ -1895,11 +1909,11 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & !> - Define conversion scalar/factor. ! ----------------------------------------------------------------------- - fac_v2l = 1. - exp (- dt_evap / cfg%tau_v2l) - fac_l2v = 1. - exp (- dt_evap / cfg%tau_l2v) + fac_v2l = 1. - exp (- dt_evap / tau_v2l) + fac_l2v = 1. - exp (- dt_evap / tau_l2v) - fac_g2v = 1. - exp (- dts / cfg%tau_g2v) - fac_v2g = 1. - exp (- dts / cfg%tau_v2g) + fac_g2v = 1. - exp (- dts / tau_g2v) + fac_v2g = 1. - exp (- dts / tau_v2g) ! ----------------------------------------------------------------------- !> - Define heat capacity and latend heat coefficient. @@ -1914,7 +1928,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & lcpk (k) = lhl (k) / cvm (k) icpk (k) = lhi (k) / cvm (k) tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (cfg%tice, tz (k)) / (cfg%tice - t_wfr)) + tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) enddo do k = ktop, kbot @@ -1925,14 +1939,14 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & !> - Instant deposit all water vapor to cloud ice when temperature is super low. ! ----------------------------------------------------------------------- - if (tz (k) < cfg%t_min) then + if (tz (k) < t_min) then sink = dim (qv (k), 1.e-7) qv (k) = qv (k) - sink qi (k) = qi (k) + sink q_sol (k) = q_sol (k) + sink cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice tz (k) = tz (k) + sink * (lhl (k) + lhi (k)) / cvm (k) - if (.not. cfg%do_qa) qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover + if (.not. do_qa) qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover cycle endif @@ -1945,7 +1959,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & lcpk (k) = lhl (k) / cvm (k) icpk (k) = lhi (k) / cvm (k) tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (cfg%tice, tz (k)) / (cfg%tice - t_wfr)) + tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) ! ----------------------------------------------------------------------- !> - Instant evaporation/sublimation of all clouds if rh < rh_adj \f$\rightarrow\f$ cloud free. @@ -1954,7 +1968,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & qpz = qv (k) + ql (k) + qi (k) tin = tz (k) - (lhl (k) * (ql (k) + qi (k)) + lhi (k) * qi (k)) / (c_air + & qpz * c_vap + qr (k) * c_liq + (qs (k) + qg (k)) * c_ice) - if (tin > cfg%t_sub + 6.) then + if (tin > t_sub + 6.) then rh = qpz / iqs1 (tin, den (k)) if (rh < rh_adj) then ! qpz / rh_adj < qs tz (k) = tin @@ -2024,11 +2038,11 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & !> - Apply Bigg mechanism. ! ----------------------------------------------------------------------- - if (cfg%fast_sat_adj) then + if (fast_sat_adj) then dt_pisub = 0.5 * dts else dt_pisub = dts - tc = cfg%tice - tz (k) + tc = tice - tz (k) if (ql (k) > qrmin .and. tc > 0.) then sink = 3.3333e-10 * dts * (exp (0.66 * tc) - 1.) * den (k) * ql (k) * ql (k) sink = min (ql (k), tc / icpk (k), sink) @@ -2055,7 +2069,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & !> - Sublimation/deposition of ice. ! ----------------------------------------------------------------------- - if (tz (k) < cfg%tice) then + if (tz (k) < tice) then qsi = iqs2 (tz (k), den (k), dqsdt) dq = qv (k) - qsi sink = dq / (1. + tcpk (k) * dqsdt) @@ -2068,13 +2082,13 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & pidep = 0. endif if (dq > 0.) then ! vapor - > ice - tmp = cfg%tice - tz (k) + tmp = tice - tz (k) ! 20160912: the following should produce more ice at higher altitude ! qi_crt = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) / den (k) - qi_crt = cfg%qi_gen * min (cfg%qi_lim, 0.1 * tmp) / den (k) + qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den (k) sink = min (sink, max (qi_crt - qi (k), pidep), tmp / tcpk (k)) else ! ice -- > vapor - pidep = pidep * min (1., dim (tz (k), cfg%t_sub) * 0.2) + pidep = pidep * min (1., dim (tz (k), t_sub) * 0.2) sink = max (pidep, sink, - qi (k)) endif qv (k) = qv (k) - sink @@ -2109,12 +2123,12 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & sqrt (denfac (k))) / (cssub (4) * tsq + cssub (5) * qsi * den (k)) pssub = (qsi - qv (k)) * dts * pssub if (pssub > 0.) then ! qs -- > qv, sublimation - pssub = min (pssub * min (1., dim (tz (k), cfg%t_sub) * 0.2), qs (k)) + pssub = min (pssub * min (1., dim (tz (k), t_sub) * 0.2), qs (k)) else - if (tz (k) > cfg%tice) then + if (tz (k) > tice) then pssub = 0. ! no deposition else - pssub = max (pssub, dq, (tz (k) - cfg%tice) / tcpk (k)) + pssub = max (pssub, dq, (tz (k) - tice) / tcpk (k)) endif endif qs (k) = qs (k) - pssub @@ -2143,14 +2157,14 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & dq = (qv (k) - qsi) / (1. + tcpk (k) * dqsdt) pgsub = (qv (k) / qsi - 1.) * qg (k) if (pgsub > 0.) then ! deposition - if (tz (k) > cfg%tice) then + if (tz (k) > tice) then pgsub = 0. ! no deposition else pgsub = min (fac_v2g * pgsub, 0.2 * dq, ql (k) + qr (k), & - (cfg%tice - tz (k)) / tcpk (k)) + (tice - tz (k)) / tcpk (k)) endif else ! submilation - pgsub = max (fac_g2v * pgsub, dq) * min (1., dim (tz (k), cfg%t_sub) * 0.1) + pgsub = max (fac_g2v * pgsub, dq) * min (1., dim (tz (k), t_sub) * 0.1) endif qg (k) = qg (k) + pgsub qv (k) = qv (k) - pgsub @@ -2198,14 +2212,14 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & !> - Combine water species. ! ----------------------------------------------------------------------- - if (cfg%do_qa) cycle + if (do_qa) cycle - if (cfg%rad_snow) then + if (rad_snow) then q_sol (k) = qi (k) + qs (k) else q_sol (k) = qi (k) endif - if (cfg%rad_rain) then + if (rad_rain) then q_liq (k) = ql (k) + qr (k) else q_liq (k) = ql (k) @@ -2229,7 +2243,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & if (tin <= t_wfr) then ! ice phase: qstar = iqs1 (tin, den (k)) - elseif (tin >= cfg%tice) then + elseif (tin >= tice) then ! liquid phase: qstar = wqs1 (tin, den (k)) else @@ -2242,7 +2256,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & ! ----------------------------------------------------------------------- ! mostly liquid water q_cond (k) at initial cloud development stage ! ----------------------------------------------------------------------- - rqi = (cfg%tice - tin) / (cfg%tice - t_wfr) + rqi = (tice - tin) / (tice - t_wfr) endif qstar = rqi * qsi + (1. - rqi) * qsw endif @@ -2259,7 +2273,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & q_minus = qpz - dq if (qstar < q_minus) then qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover - elseif (qstar < q_plus .and. q_cond (k) > cfg%qc_crt) then + elseif (qstar < q_plus .and. q_cond (k) > qc_crt) then qa (k) = qa (k) + (q_plus - qstar) / (dq + dq) ! partial cloud cover ! qa (k) = sqrt (qa (k) + (q_plus - qstar) / (dq + dq)) endif @@ -2397,7 +2411,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & logical :: no_fall dt5 = 0.5 * dtm - fac_imlt = 1. - exp (- dt5 / cfg%tau_imlt) + fac_imlt = 1. - exp (- dt5 / tau_imlt) ! ----------------------------------------------------------------------- ! define heat capacity and latend heat coefficient @@ -2420,7 +2434,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & k0 = kbot do k = ktop, kbot - 1 - if (tz (k) > cfg%tice) then + if (tz (k) > tice) then k0 = k exit endif @@ -2431,10 +2445,10 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & ! ----------------------------------------------------------------------- do k = k0, kbot - tc = tz (k) - cfg%tice + tc = tz (k) - tice if (qi (k) > qcmin .and. tc > 0.) then sink = min (qi (k), fac_imlt * tc / icpk (k)) - tmp = min (sink, dim (cfg%ql_mlt, ql (k))) + tmp = min (sink, dim (ql_mlt, ql (k))) ql (k) = ql (k) + tmp qr (k) = qr (k) + sink - tmp qi (k) = qi (k) - sink @@ -2442,7 +2456,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & q_sol (k) = q_sol (k) - sink cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice tz (k) = tz (k) - sink * lhi (k) / cvm (k) - tc = tz (k) - cfg%tice + tc = tz (k) - tice endif enddo @@ -2478,7 +2492,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & call check_column (ktop, kbot, qi, no_fall) - if (cfg%vi_fac < 1.e-5 .or. no_fall) then + if (vi_fac < 1.e-5 .or. no_fall) then i1 = 0. else @@ -2496,10 +2510,10 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & if (qi (k) > qrmin) then do m = k + 1, kbot if (zt (k + 1) >= ze (m)) exit - if (zt (k) < ze (m + 1) .and. tz (m) > cfg%tice) then - dtime = min (1.0, (ze (m) - ze (m + 1)) / (max (vr_min, vti (k)) * cfg%tau_imlt)) - sink = min (qi (k) * dp (k) / dp (m), dtime * (tz (m) - cfg%tice) / icpk (m)) - tmp = min (sink, dim (cfg%ql_mlt, ql (m))) + if (zt (k) < ze (m + 1) .and. tz (m) > tice) then + dtime = min (1.0, (ze (m) - ze (m + 1)) / (max (vr_min, vti (k)) * tau_imlt)) + sink = min (qi (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) + tmp = min (sink, dim (ql_mlt, ql (m))) ql (m) = ql (m) + tmp qr (m) = qr (m) - tmp + sink tz (m) = tz (m) - sink * icpk (m) @@ -2510,19 +2524,19 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) enddo endif - if (cfg%use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qi, i1, m1_sol, cfg%mono_prof) + if (use_ppm) then + call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qi, i1, m1_sol, mono_prof) else call implicit_fall (dtm, ktop, kbot, ze, vti, dp, qi, i1, m1_sol) endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_sol (ktop) * vti (ktop)) / (dm (ktop) - m1_sol (ktop)) do k = ktop + 1, kbot w1 (k) = (dm (k) * w1 (k) - m1_sol (k - 1) * vti (k - 1) + m1_sol (k) * vti (k)) & @@ -2559,9 +2573,9 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & do m = k + 1, kbot if (zt (k + 1) >= ze (m)) exit dtime = min (dtm, (ze (m) - ze (m + 1)) / (vr_min + vts (k))) - if (zt (k) < ze (m + 1) .and. tz (m) > cfg%tice) then - dtime = min (1.0, dtime / cfg%tau_smlt) - sink = min (qs (k) * dp (k) / dp (m), dtime * (tz (m) - cfg%tice) / icpk (m)) + if (zt (k) < ze (m + 1) .and. tz (m) > tice) then + dtime = min (1.0, dtime / tau_smlt) + sink = min (qs (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) tz (m) = tz (m) - sink * icpk (m) qs (k) = qs (k) - sink * dp (m) / dp (k) if (zt (k) < zs) then @@ -2577,14 +2591,14 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) enddo endif - if (cfg%use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qs, s1, m1, cfg%mono_prof) + if (use_ppm) then + call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qs, s1, m1, mono_prof) else call implicit_fall (dtm, ktop, kbot, ze, vts, dp, qs, s1, m1) endif @@ -2593,7 +2607,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & m1_sol (k) = m1_sol (k) + m1 (k) enddo - if (cfg%do_sedi_w) then + if (do_sedi_w) then w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vts (ktop)) / (dm (ktop) - m1 (ktop)) do k = ktop + 1, kbot w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vts (k - 1) + m1 (k) * vts (k)) & @@ -2628,9 +2642,9 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & do m = k + 1, kbot if (zt (k + 1) >= ze (m)) exit dtime = min (dtm, (ze (m) - ze (m + 1)) / vtg (k)) - if (zt (k) < ze (m + 1) .and. tz (m) > cfg%tice) then - dtime = min (1., dtime / cfg%tau_g2r) - sink = min (qg (k) * dp (k) / dp (m), dtime * (tz (m) - cfg%tice) / icpk (m)) + if (zt (k) < ze (m + 1) .and. tz (m) > tice) then + dtime = min (1., dtime / tau_g2r) + sink = min (qg (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) tz (m) = tz (m) - sink * icpk (m) qg (k) = qg (k) - sink * dp (m) / dp (k) if (zt (k) < zs) then @@ -2645,14 +2659,14 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ktop, kbot dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) enddo endif - if (cfg%use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qg, g1, m1, cfg%mono_prof) + if (use_ppm) then + call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qg, g1, m1, mono_prof) else call implicit_fall (dtm, ktop, kbot, ze, vtg, dp, qg, g1, m1) endif @@ -2661,7 +2675,7 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & m1_sol (k) = m1_sol (k) + m1 (k) enddo - if (cfg%do_sedi_w) then + if (do_sedi_w) then w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vtg (ktop)) / (dm (ktop) - m1 (ktop)) do k = ktop + 1, kbot w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vtg (k - 1) + m1 (k) * vtg (k)) & @@ -3149,21 +3163,21 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) !! fall speed than Heymsfield and Donner (1990) \cite heymsfield_and_donner_1990. ! ----------------------------------------------------------------------- - if (cfg%const_vi) then - vti (:) = cfg%vi_fac + if (const_vi) then + vti (:) = vi_fac else ! ----------------------------------------------------------------------- ! use deng and mace (2008, grl), which gives smaller fall speed than hd90 formula ! ----------------------------------------------------------------------- - vi0 = 0.01 * cfg%vi_fac + vi0 = 0.01 * vi_fac do k = ktop, kbot if (qi (k) < thi) then ! this is needed as the fall - speed maybe problematic for small qi vti (k) = vf_min else - tc (k) = tk (k) - cfg%tice + tc (k) = tk (k) - tice vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee vti (k) = vi0 * exp (log_10 * vti (k)) * 0.9 - vti (k) = min (cfg%vi_max, max (vf_min, vti (k))) + vti (k) = min (vi_max, max (vf_min, vti (k))) endif enddo endif @@ -3172,15 +3186,15 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) !> - snow: ! ----------------------------------------------------------------------- - if (cfg%const_vs) then - vts (:) = cfg%vs_fac ! 1. ifs_2016 + if (const_vs) then + vts (:) = vs_fac ! 1. ifs_2016 else do k = ktop, kbot if (qs (k) < ths) then vts (k) = vf_min else - vts (k) = cfg%vs_fac * vcons * rhof (k) * exp (0.0625 * log (qs (k) * den (k) / norms)) - vts (k) = min (cfg%vs_max, max (vf_min, vts (k))) + vts (k) = vs_fac * vcons * rhof (k) * exp (0.0625 * log (qs (k) * den (k) / norms)) + vts (k) = min (vs_max, max (vf_min, vts (k))) endif enddo endif @@ -3188,16 +3202,16 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) ! ----------------------------------------------------------------------- !> - graupel: ! ----------------------------------------------------------------------- - if (cfg%const_vg) then - vtg (:) = cfg%vg_fac ! 2. + if (const_vg) then + vtg (:) = vg_fac ! 2. else - if (cfg%do_hail) then + if (do_hail) then do k = ktop, kbot if (qg (k) < thg) then vtg (k) = vf_min else - vtg (k) = cfg%vg_fac * vconh * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normh))) - vtg (k) = min (cfg%vg_max, max (vf_min, vtg (k))) + vtg (k) = vg_fac * vconh * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normh))) + vtg (k) = min (vg_max, max (vf_min, vtg (k))) endif enddo else @@ -3205,8 +3219,8 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) if (qg (k) < thg) then vtg (k) = vf_min else - vtg (k) = cfg%vg_fac * vcong * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normg))) - vtg (k) = min (cfg%vg_max, max (vf_min, vtg (k))) + vtg (k) = vg_fac * vcong * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normg))) + vtg (k) = min (vg_max, max (vf_min, vtg (k))) endif enddo endif @@ -3252,15 +3266,15 @@ subroutine setupm ! s. klein's formular (eq 16) from am2 - fac_rc = (4. / 3.) * pie * rhor * cfg%rthresh ** 3 + fac_rc = (4. / 3.) * pie * rhor * rthresh ** 3 - if (cfg%prog_ccn) then - ! if (master) write (*, *) 'cfg%prog_ccn option is .t.' + if (prog_ccn) then + ! if (master) write (*, *) 'prog_ccn option is .t.' else - den_rc = fac_rc * cfg%ccn_o * 1.e6 - ! if (master) write (*, *) 'mp: for cfg%ccn_o = ', cfg%ccn_o, 'ql_rc = ', den_rc - den_rc = fac_rc * cfg%ccn_l * 1.e6 - ! if (master) write (*, *) 'mp: for cfg%ccn_l = ', cfg%ccn_l, 'ql_rc = ', den_rc + den_rc = fac_rc * ccn_o * 1.e6 + ! if (master) write (*, *) 'mp: for ccn_o = ', ccn_o, 'ql_rc = ', den_rc + den_rc = fac_rc * ccn_l * 1.e6 + ! if (master) write (*, *) 'mp: for ccn_l = ', ccn_l, 'ql_rc = ', den_rc endif vdifu = 2.11e-5 @@ -3279,21 +3293,21 @@ subroutine setupm cracs = pisq * rnzr * rnzs * rhos csacr = pisq * rnzr * rnzs * rhor - if (cfg%do_hail) then + if (do_hail) then cgacr = pisq * rnzr * rnzh * rhor cgacs = pisq * rnzh * rnzs * rhos else cgacr = pisq * rnzr * rnzg * rhor cgacs = pisq * rnzg * rnzs * rhos endif - cgacs = cgacs * cfg%c_pgacs + cgacs = cgacs * c_pgacs ! act: 1 - 2:racs (s - r) ; 3 - 4:sacr (r - s) ; ! 5 - 6:gacr (r - g) ; 7 - 8:gacs (s - g) act (1) = pie * rnzs * rhos act (2) = pie * rnzr * rhor - if (cfg%do_hail) then + if (do_hail) then act (6) = pie * rnzh * rhoh else act (6) = pie * rnzg * rhog @@ -3312,13 +3326,13 @@ subroutine setupm gcon = 40.74 * sqrt (sfcrho) ! 44.628 - csacw = pie * rnzs * cfg%clin * gam325 / (4. * act (1) ** 0.8125) + csacw = pie * rnzs * clin * gam325 / (4. * act (1) ** 0.8125) ! decreasing csacw to reduce cloud water --- > snow - craci = pie * rnzr * cfg%alin * gam380 / (4. * act (2) ** 0.95) - csaci = csacw * cfg%c_psaci + craci = pie * rnzr * alin * gam380 / (4. * act (2) ** 0.95) + csaci = csacw * c_psaci - if (cfg%do_hail) then + if (do_hail) then cgacw = pie * rnzh * gam350 * gcon / (4. * act (6) ** 0.875) else cgacw = pie * rnzg * gam350 * gcon / (4. * act (6) ** 0.875) @@ -3330,12 +3344,12 @@ subroutine setupm ! sjl, may 28, 2012 cracw = craci ! cracw = 3.27206196043822 - cracw = cfg%c_cracw * cfg%c_cracw + cracw = c_cracw * c_cracw ! subl and revp: five constants for three separate processes cssub (1) = 2. * pie * vdifu * tcond * rvgas * rnzs - if (cfg%do_hail) then + if (do_hail) then cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzh else cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzg @@ -3344,9 +3358,9 @@ subroutine setupm cssub (2) = 0.78 / sqrt (act (1)) cgsub (2) = 0.78 / sqrt (act (6)) crevp (2) = 0.78 / sqrt (act (2)) - cssub (3) = 0.31 * scm3 * gam263 * sqrt (cfg%clin / visk) / act (1) ** 0.65625 + cssub (3) = 0.31 * scm3 * gam263 * sqrt (clin / visk) / act (1) ** 0.65625 cgsub (3) = 0.31 * scm3 * gam275 * sqrt (gcon / visk) / act (6) ** 0.6875 - crevp (3) = 0.31 * scm3 * gam290 * sqrt (cfg%alin / visk) / act (2) ** 0.725 + crevp (3) = 0.31 * scm3 * gam290 * sqrt (alin / visk) / act (2) ** 0.725 cssub (4) = tcond * rvgas cssub (5) = hlts ** 2 * vdifu cgsub (4) = cssub (4) @@ -3367,7 +3381,7 @@ subroutine setupm ! gmlt: five constants - if (cfg%do_hail) then + if (do_hail) then cgmlt (1) = 2. * pie * tcond * rnzh / hltf cgmlt (2) = 2. * pie * vdifu * rnzh * hltc / hltf else @@ -3414,16 +3428,17 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo ! Read namelist ! ----------------------------------------------------------------------- if (me == master) then - print*,'PRE NML' - call cfg%display() + write(*,*) 'Pre GFDLMP namelist read' + call display_gfdlmp_param() endif - call cfg%register(errmsg = errmsg, errflg = errflg, unit = nlunit, & + call read_gfdlmp_nml(errmsg = errmsg, errflg = errflg, unit = nlunit, & input_nml_file = input_nml_file, fn_nml = fn_nml, version=1, & iostat = ios) if (me == master) then - print*,'POST NML' - call cfg%display() + write(*,*) 'Post GFDLMP namelist read' + call display_gfdlmp_param() endif + ! write version number and namelist to log file if (me == master) then write (logunit, *) " ================================================================== " @@ -3439,8 +3454,8 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo log_10 = log (10.) - tice0 = cfg%tice - 0.01 - t_wfr = cfg%tice - 40.0 ! supercooled water can exist down to - 48 c, which is the "absolute" + tice0 = tice - 0.01 + t_wfr = tice - 40.0 ! supercooled water can exist down to - 48 c, which is the "absolute" ! if (master) write (logunit, nml = gfdl_cloud_microphys_nml) ! @@ -3482,11 +3497,11 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo ! if (mp_debug .and. master) then ! write (*, *) 'testing water vapor tables in gfdl_cloud_microphys' - ! tmp = cfg%tice - 90. + ! tmp = tice - 90. ! do k = 1, 25 ! q1 = wqsat_moist (tmp, 0., 1.e5) ! q2 = qs1d_m (tmp, 0., 1.e5) - ! write (*, *) nint (tmp - cfg%tice), q1, q2, 'dq = ', q1 - q2 + ! write (*, *) nint (tmp - tice), q1, q2, 'dq = ', q1 - q2 ! tmp = tmp + 5. ! enddo ! endif @@ -4611,19 +4626,19 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud water (Martin et al., 1994) ! ----------------------------------------------------------------------- - ccn = 0.80 * (- 1.15e-3 * (cfg%ccn_o ** 2) + 0.963 * cfg%ccn_o + 5.30) * abs (mask - 1.0) + & - 0.67 * (- 2.10e-4 * (cfg%ccn_l ** 2) + 0.568 * cfg%ccn_l - 27.9) * (1.0 - abs (mask - 1.0)) + ccn = 0.80 * (- 1.15e-3 * (ccn_o ** 2) + 0.963 * ccn_o + 5.30) * abs (mask - 1.0) + & + 0.67 * (- 2.10e-4 * (ccn_l ** 2) + 0.568 * ccn_l - 27.9) * (1.0 - abs (mask - 1.0)) if (qmw (i, k) .gt. qmin) then qcw (i, k) = dpg * qmw (i, k) * 1.0e3 rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * den (i, k) * qmw (i, k)) / (4.0 * pi * rhow * ccn))) * 1.0e4 - rew (i, k) = max (cfg%rewmin, min (cfg%rewmax, rew (i, k))) + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else qcw (i, k) = 0.0 - rew (i, k) = cfg%rewmin + rew (i, k) = rewmin endif - if (cfg%reiflag .eq. 1) then + if (reiflag .eq. 1) then ! ----------------------------------------------------------------------- ! cloud ice (Heymsfield and Mcfarquhar, 1996) @@ -4632,24 +4647,24 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) - if (t (i, k) - cfg%tice .lt. - 50) then + if (t (i, k) - tice .lt. - 50) then rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 - elseif (t (i, k) - cfg%tice .lt. - 40) then + elseif (t (i, k) - tice .lt. - 40) then rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 - elseif (t (i, k) - cfg%tice .lt. - 30) then + elseif (t (i, k) - tice .lt. - 30) then rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 else rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 endif - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 2) then + if (reiflag .eq. 2) then ! ----------------------------------------------------------------------- ! cloud ice (Wyser, 1998) @@ -4657,12 +4672,12 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 - bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, cfg%tice - t (i, k)) ** 1.5 + bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif @@ -4675,10 +4690,10 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qcr (i, k) = dpg * qmr (i, k) * 1.0e3 lambdar = exp (0.25 * log (pi * rhor * n0r / qmr (i, k) / den (i, k))) rer (i, k) = 0.5 * exp (log (gammar / 6) / alphar) / lambdar * 1.0e6 - rer (i, k) = max (cfg%rermin, min (cfg%rermax, rer (i, k))) + rer (i, k) = max (rermin, min (rermax, rer (i, k))) else qcr (i, k) = 0.0 - rer (i, k) = cfg%rermin + rer (i, k) = rermin endif ! ----------------------------------------------------------------------- @@ -4689,10 +4704,10 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qcs (i, k) = dpg * qms (i, k) * 1.0e3 lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 - res (i, k) = max (cfg%resmin, min (cfg%resmax, res (i, k))) + res (i, k) = max (resmin, min (resmax, res (i, k))) else qcs (i, k) = 0.0 - res (i, k) = cfg%resmin + res (i, k) = resmin endif ! ----------------------------------------------------------------------- @@ -4703,10 +4718,10 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qcg (i, k) = dpg * qmg (i, k) * 1.0e3 lambdag = exp (0.25 * log (pi * rhog * n0g / qmg (i, k) / den (i, k))) reg (i, k) = 0.5 * exp (log (gammag / 6) / alphag) / lambdag * 1.0e6 - reg (i, k) = max (cfg%regmin, min (cfg%regmax, reg (i, k))) + reg (i, k) = max (regmin, min (regmax, reg (i, k))) else qcg (i, k) = 0.0 - reg (i, k) = cfg%regmin + reg (i, k) = regmin endif enddo diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 index 7fd509e30..a4124723b 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 @@ -36,7 +36,28 @@ ! ======================================================================= module gfdl_cloud_microphys_v3_mod - use module_gfdlmp_param, only: cfg + use module_gfdlmp_param, only: read_gfdlmp_nml, & + t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& + rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & + igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & + do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & + c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & + rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & + do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & + do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & + use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & + rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & + regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & + regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & + radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & + n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & + muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & + blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & + ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & + do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & + delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub implicit none private @@ -263,7 +284,7 @@ subroutine gfdl_cloud_microphys_v3_mod_init (me, master, nlunit, input_nml_file, ! ----------------------------------------------------------------------- ! Read namelist ! ----------------------------------------------------------------------- - call cfg%register(errmsg = errmsg, errflg = errflg, unit = nlunit, & + call read_gfdlmp_nml(errmsg = errmsg, errflg = errflg, unit = nlunit, & input_nml_file = input_nml_file, fn_nml = fn_nml, version=3, & iostat = ios) @@ -382,8 +403,8 @@ subroutine setup_mp ! complete freezing temperature ! ----------------------------------------------------------------------- - if (cfg%do_warm_rain_mp) then - t_wfr = cfg%t_min + if (do_warm_rain_mp) then + t_wfr = t_min else t_wfr = tice - 40.0 endif @@ -392,10 +413,10 @@ subroutine setup_mp ! cloud water autoconversion, Hong et al. (2004) ! ----------------------------------------------------------------------- - fac_rc = (4. / 3.) * pi * rhow * cfg%rthresh ** 3 + fac_rc = (4. / 3.) * pi * rhow * rthresh ** 3 aone = 2. / 9. * (3. / 4.) ** (4. / 3.) / pi ** (1. / 3.) - cpaut = cfg%c_paut * aone * grav / visd + cpaut = c_paut * aone * grav / visd ! ----------------------------------------------------------------------- ! terminal velocities parameters, Lin et al. (1983) @@ -408,19 +429,19 @@ subroutine setup_mp ! part of the slope parameters ! ----------------------------------------------------------------------- - normw = pi * rhow * cfg%n0w_sig * gamma (cfg%muw + 3) - normi = pi * rhoi * cfg%n0i_sig * gamma (cfg%mui + 3) - normr = pi * rhor * cfg%n0r_sig * gamma (cfg%mur + 3) - norms = pi * rhos * cfg%n0s_sig * gamma (cfg%mus + 3) - normg = pi * rhog * cfg%n0g_sig * gamma (cfg%mug + 3) - normh = pi * rhoh * cfg%n0h_sig * gamma (cfg%muh + 3) + normw = pi * rhow * n0w_sig * gamma (muw + 3) + normi = pi * rhoi * n0i_sig * gamma (mui + 3) + normr = pi * rhor * n0r_sig * gamma (mur + 3) + norms = pi * rhos * n0s_sig * gamma (mus + 3) + normg = pi * rhog * n0g_sig * gamma (mug + 3) + normh = pi * rhoh * n0h_sig * gamma (muh + 3) - expow = exp (cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - expoi = exp (cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - expor = exp (cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - expos = exp (cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - expog = exp (cfg%n0g_exp / (cfg%mug + 3) * log (10.)) - expoh = exp (cfg%n0h_exp / (cfg%muh + 3) * log (10.)) + expow = exp (n0w_exp / (muw + 3) * log (10.)) + expoi = exp (n0i_exp / (mui + 3) * log (10.)) + expor = exp (n0r_exp / (mur + 3) * log (10.)) + expos = exp (n0s_exp / (mus + 3) * log (10.)) + expog = exp (n0g_exp / (mug + 3) * log (10.)) + expoh = exp (n0h_exp / (muh + 3) * log (10.)) ! ----------------------------------------------------------------------- ! parameters for particle concentration (pc), effective diameter (ed), @@ -428,93 +449,93 @@ subroutine setup_mp ! mass-weighted terminal velocity (tv) ! ----------------------------------------------------------------------- - pcaw = exp (3 / (cfg%muw + 3) * log (cfg%n0w_sig)) * gamma (cfg%muw) * exp (3 * cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - pcai = exp (3 / (cfg%mui + 3) * log (cfg%n0i_sig)) * gamma (cfg%mui) * exp (3 * cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - pcar = exp (3 / (cfg%mur + 3) * log (cfg%n0r_sig)) * gamma (cfg%mur) * exp (3 * cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - pcas = exp (3 / (cfg%mus + 3) * log (cfg%n0s_sig)) * gamma (cfg%mus) * exp (3 * cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - pcag = exp (3 / (cfg%mug + 3) * log (cfg%n0g_sig)) * gamma (cfg%mug) * exp (3 * cfg%n0g_exp / (cfg%mug + 3) * log (10.)) - pcah = exp (3 / (cfg%muh + 3) * log (cfg%n0h_sig)) * gamma (cfg%muh) * exp (3 * cfg%n0h_exp / (cfg%muh + 3) * log (10.)) - - pcbw = exp (cfg%muw / (cfg%muw + 3) * log (pi * rhow * gamma (cfg%muw + 3))) - pcbi = exp (cfg%mui / (cfg%mui + 3) * log (pi * rhoi * gamma (cfg%mui + 3))) - pcbr = exp (cfg%mur / (cfg%mur + 3) * log (pi * rhor * gamma (cfg%mur + 3))) - pcbs = exp (cfg%mus / (cfg%mus + 3) * log (pi * rhos * gamma (cfg%mus + 3))) - pcbg = exp (cfg%mug / (cfg%mug + 3) * log (pi * rhog * gamma (cfg%mug + 3))) - pcbh = exp (cfg%muh / (cfg%muh + 3) * log (pi * rhoh * gamma (cfg%muh + 3))) - - edaw = exp (- 1. / (cfg%muw + 3) * log (cfg%n0w_sig)) * (cfg%muw + 2) * exp (- cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - edai = exp (- 1. / (cfg%mui + 3) * log (cfg%n0i_sig)) * (cfg%mui + 2) * exp (- cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - edar = exp (- 1. / (cfg%mur + 3) * log (cfg%n0r_sig)) * (cfg%mur + 2) * exp (- cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - edas = exp (- 1. / (cfg%mus + 3) * log (cfg%n0s_sig)) * (cfg%mus + 2) * exp (- cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - edag = exp (- 1. / (cfg%mug + 3) * log (cfg%n0g_sig)) * (cfg%mug + 2) * exp (- cfg%n0g_exp / (cfg%mug + 3) * log (10.)) - edah = exp (- 1. / (cfg%muh + 3) * log (cfg%n0h_sig)) * (cfg%muh + 2) * exp (- cfg%n0h_exp / (cfg%muh + 3) * log (10.)) - - edbw = exp (1. / (cfg%muw + 3) * log (pi * rhow * gamma (cfg%muw + 3))) - edbi = exp (1. / (cfg%mui + 3) * log (pi * rhoi * gamma (cfg%mui + 3))) - edbr = exp (1. / (cfg%mur + 3) * log (pi * rhor * gamma (cfg%mur + 3))) - edbs = exp (1. / (cfg%mus + 3) * log (pi * rhos * gamma (cfg%mus + 3))) - edbg = exp (1. / (cfg%mug + 3) * log (pi * rhog * gamma (cfg%mug + 3))) - edbh = exp (1. / (cfg%muh + 3) * log (pi * rhoh * gamma (cfg%muh + 3))) - - oeaw = exp (1. / (cfg%muw + 3) * log (cfg%n0w_sig)) * pi * gamma (cfg%muw + 2) * & - exp (cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - oeai = exp (1. / (cfg%mui + 3) * log (cfg%n0i_sig)) * pi * gamma (cfg%mui + 2) * & - exp (cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - oear = exp (1. / (cfg%mur + 3) * log (cfg%n0r_sig)) * pi * gamma (cfg%mur + 2) * & - exp (cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - oeas = exp (1. / (cfg%mus + 3) * log (cfg%n0s_sig)) * pi * gamma (cfg%mus + 2) * & - exp (cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - oeag = exp (1. / (cfg%mug + 3) * log (cfg%n0g_sig)) * pi * gamma (cfg%mug + 2) * & - exp (cfg%n0g_exp / (cfg%mug + 3) * log (10.)) - oeah = exp (1. / (cfg%muh + 3) * log (cfg%n0h_sig)) * pi * gamma (cfg%muh + 2) * & - exp (cfg%n0h_exp / (cfg%muh + 3) * log (10.)) - - oebw = 2 * exp ((cfg%muw + 2) / (cfg%muw + 3) * log (pi * rhow * gamma (cfg%muw + 3))) - oebi = 2 * exp ((cfg%mui + 2) / (cfg%mui + 3) * log (pi * rhoi * gamma (cfg%mui + 3))) - oebr = 2 * exp ((cfg%mur + 2) / (cfg%mur + 3) * log (pi * rhor * gamma (cfg%mur + 3))) - oebs = 2 * exp ((cfg%mus + 2) / (cfg%mus + 3) * log (pi * rhos * gamma (cfg%mus + 3))) - oebg = 2 * exp ((cfg%mug + 2) / (cfg%mug + 3) * log (pi * rhog * gamma (cfg%mug + 3))) - oebh = 2 * exp ((cfg%muh + 2) / (cfg%muh + 3) * log (pi * rhoh * gamma (cfg%muh + 3))) - - rraw = exp (- 3 / (cfg%muw + 3) * log (cfg%n0w_sig)) * gamma (cfg%muw + 6) * & - exp (- 3 * cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - rrai = exp (- 3 / (cfg%mui + 3) * log (cfg%n0i_sig)) * gamma (cfg%mui + 6) * & - exp (- 3 * cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - rrar = exp (- 3 / (cfg%mur + 3) * log (cfg%n0r_sig)) * gamma (cfg%mur + 6) * & - exp (- 3 * cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - rras = exp (- 3 / (cfg%mus + 3) * log (cfg%n0s_sig)) * gamma (cfg%mus + 6) * & - exp (- 3 * cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - rrag = exp (- 3 / (cfg%mug + 3) * log (cfg%n0g_sig)) * gamma (cfg%mug + 6) * & - exp (- 3 * cfg%n0g_exp / (cfg%mug + 3) * log (10.)) - rrah = exp (- 3 / (cfg%muh + 3) * log (cfg%n0h_sig)) * gamma (cfg%muh + 6) * & - exp (- 3 * cfg%n0h_exp / (cfg%muh + 3) * log (10.)) - - rrbw = exp ((cfg%muw + 6) / (cfg%muw + 3) * log (pi * rhow * gamma (cfg%muw + 3))) - rrbi = exp ((cfg%mui + 6) / (cfg%mui + 3) * log (pi * rhoi * gamma (cfg%mui + 3))) - rrbr = exp ((cfg%mur + 6) / (cfg%mur + 3) * log (pi * rhor * gamma (cfg%mur + 3))) - rrbs = exp ((cfg%mus + 6) / (cfg%mus + 3) * log (pi * rhos * gamma (cfg%mus + 3))) - rrbg = exp ((cfg%mug + 6) / (cfg%mug + 3) * log (pi * rhog * gamma (cfg%mug + 3))) - rrbh = exp ((cfg%muh + 6) / (cfg%muh + 3) * log (pi * rhoh * gamma (cfg%muh + 3))) - - tvaw = exp (- cfg%blinw / (cfg%muw + 3) * log (cfg%n0w_sig)) * cfg%alinw * gamma (cfg%muw + cfg%blinw + 3) * & - exp (- cfg%blinw * cfg%n0w_exp / (cfg%muw + 3) * log (10.)) - tvai = exp (- cfg%blini / (cfg%mui + 3) * log (cfg%n0i_sig)) * cfg%alini * gamma (cfg%mui + cfg%blini + 3) * & - exp (- cfg%blini * cfg%n0i_exp / (cfg%mui + 3) * log (10.)) - tvar = exp (- cfg%blinr / (cfg%mur + 3) * log (cfg%n0r_sig)) * cfg%alinr * gamma (cfg%mur + cfg%blinr + 3) * & - exp (- cfg%blinr * cfg%n0r_exp / (cfg%mur + 3) * log (10.)) - tvas = exp (- cfg%blins / (cfg%mus + 3) * log (cfg%n0s_sig)) * cfg%alins * gamma (cfg%mus + cfg%blins + 3) * & - exp (- cfg%blins * cfg%n0s_exp / (cfg%mus + 3) * log (10.)) - tvag = exp (- cfg%bling / (cfg%mug + 3) * log (cfg%n0g_sig)) * cfg%aling * gamma (cfg%mug + cfg%bling + 3) * & - exp (- cfg%bling * cfg%n0g_exp / (cfg%mug + 3) * log (10.)) * gcon - tvah = exp (- cfg%blinh / (cfg%muh + 3) * log (cfg%n0h_sig)) * cfg%alinh * gamma (cfg%muh + cfg%blinh + 3) * & - exp (- cfg%blinh * cfg%n0h_exp / (cfg%muh + 3) * log (10.)) * hcon - - tvbw = exp (cfg%blinw / (cfg%muw + 3) * log (pi * rhow * gamma (cfg%muw + 3))) * gamma (cfg%muw + 3) - tvbi = exp (cfg%blini / (cfg%mui + 3) * log (pi * rhoi * gamma (cfg%mui + 3))) * gamma (cfg%mui + 3) - tvbr = exp (cfg%blinr / (cfg%mur + 3) * log (pi * rhor * gamma (cfg%mur + 3))) * gamma (cfg%mur + 3) - tvbs = exp (cfg%blins / (cfg%mus + 3) * log (pi * rhos * gamma (cfg%mus + 3))) * gamma (cfg%mus + 3) - tvbg = exp (cfg%bling / (cfg%mug + 3) * log (pi * rhog * gamma (cfg%mug + 3))) * gamma (cfg%mug + 3) - tvbh = exp (cfg%blinh / (cfg%muh + 3) * log (pi * rhoh * gamma (cfg%muh + 3))) * gamma (cfg%muh + 3) + pcaw = exp (3 / (muw + 3) * log (n0w_sig)) * gamma (muw) * exp (3 * n0w_exp / (muw + 3) * log (10.)) + pcai = exp (3 / (mui + 3) * log (n0i_sig)) * gamma (mui) * exp (3 * n0i_exp / (mui + 3) * log (10.)) + pcar = exp (3 / (mur + 3) * log (n0r_sig)) * gamma (mur) * exp (3 * n0r_exp / (mur + 3) * log (10.)) + pcas = exp (3 / (mus + 3) * log (n0s_sig)) * gamma (mus) * exp (3 * n0s_exp / (mus + 3) * log (10.)) + pcag = exp (3 / (mug + 3) * log (n0g_sig)) * gamma (mug) * exp (3 * n0g_exp / (mug + 3) * log (10.)) + pcah = exp (3 / (muh + 3) * log (n0h_sig)) * gamma (muh) * exp (3 * n0h_exp / (muh + 3) * log (10.)) + + pcbw = exp (muw / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + pcbi = exp (mui / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + pcbr = exp (mur / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + pcbs = exp (mus / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + pcbg = exp (mug / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + pcbh = exp (muh / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + edaw = exp (- 1. / (muw + 3) * log (n0w_sig)) * (muw + 2) * exp (- n0w_exp / (muw + 3) * log (10.)) + edai = exp (- 1. / (mui + 3) * log (n0i_sig)) * (mui + 2) * exp (- n0i_exp / (mui + 3) * log (10.)) + edar = exp (- 1. / (mur + 3) * log (n0r_sig)) * (mur + 2) * exp (- n0r_exp / (mur + 3) * log (10.)) + edas = exp (- 1. / (mus + 3) * log (n0s_sig)) * (mus + 2) * exp (- n0s_exp / (mus + 3) * log (10.)) + edag = exp (- 1. / (mug + 3) * log (n0g_sig)) * (mug + 2) * exp (- n0g_exp / (mug + 3) * log (10.)) + edah = exp (- 1. / (muh + 3) * log (n0h_sig)) * (muh + 2) * exp (- n0h_exp / (muh + 3) * log (10.)) + + edbw = exp (1. / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + edbi = exp (1. / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + edbr = exp (1. / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + edbs = exp (1. / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + edbg = exp (1. / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + edbh = exp (1. / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + oeaw = exp (1. / (muw + 3) * log (n0w_sig)) * pi * gamma (muw + 2) * & + exp (n0w_exp / (muw + 3) * log (10.)) + oeai = exp (1. / (mui + 3) * log (n0i_sig)) * pi * gamma (mui + 2) * & + exp (n0i_exp / (mui + 3) * log (10.)) + oear = exp (1. / (mur + 3) * log (n0r_sig)) * pi * gamma (mur + 2) * & + exp (n0r_exp / (mur + 3) * log (10.)) + oeas = exp (1. / (mus + 3) * log (n0s_sig)) * pi * gamma (mus + 2) * & + exp (n0s_exp / (mus + 3) * log (10.)) + oeag = exp (1. / (mug + 3) * log (n0g_sig)) * pi * gamma (mug + 2) * & + exp (n0g_exp / (mug + 3) * log (10.)) + oeah = exp (1. / (muh + 3) * log (n0h_sig)) * pi * gamma (muh + 2) * & + exp (n0h_exp / (muh + 3) * log (10.)) + + oebw = 2 * exp ((muw + 2) / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + oebi = 2 * exp ((mui + 2) / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + oebr = 2 * exp ((mur + 2) / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + oebs = 2 * exp ((mus + 2) / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + oebg = 2 * exp ((mug + 2) / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + oebh = 2 * exp ((muh + 2) / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + rraw = exp (- 3 / (muw + 3) * log (n0w_sig)) * gamma (muw + 6) * & + exp (- 3 * n0w_exp / (muw + 3) * log (10.)) + rrai = exp (- 3 / (mui + 3) * log (n0i_sig)) * gamma (mui + 6) * & + exp (- 3 * n0i_exp / (mui + 3) * log (10.)) + rrar = exp (- 3 / (mur + 3) * log (n0r_sig)) * gamma (mur + 6) * & + exp (- 3 * n0r_exp / (mur + 3) * log (10.)) + rras = exp (- 3 / (mus + 3) * log (n0s_sig)) * gamma (mus + 6) * & + exp (- 3 * n0s_exp / (mus + 3) * log (10.)) + rrag = exp (- 3 / (mug + 3) * log (n0g_sig)) * gamma (mug + 6) * & + exp (- 3 * n0g_exp / (mug + 3) * log (10.)) + rrah = exp (- 3 / (muh + 3) * log (n0h_sig)) * gamma (muh + 6) * & + exp (- 3 * n0h_exp / (muh + 3) * log (10.)) + + rrbw = exp ((muw + 6) / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + rrbi = exp ((mui + 6) / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + rrbr = exp ((mur + 6) / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + rrbs = exp ((mus + 6) / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + rrbg = exp ((mug + 6) / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + rrbh = exp ((muh + 6) / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + tvaw = exp (- blinw / (muw + 3) * log (n0w_sig)) * alinw * gamma (muw + blinw + 3) * & + exp (- blinw * n0w_exp / (muw + 3) * log (10.)) + tvai = exp (- blini / (mui + 3) * log (n0i_sig)) * alini * gamma (mui + blini + 3) * & + exp (- blini * n0i_exp / (mui + 3) * log (10.)) + tvar = exp (- blinr / (mur + 3) * log (n0r_sig)) * alinr * gamma (mur + blinr + 3) * & + exp (- blinr * n0r_exp / (mur + 3) * log (10.)) + tvas = exp (- blins / (mus + 3) * log (n0s_sig)) * alins * gamma (mus + blins + 3) * & + exp (- blins * n0s_exp / (mus + 3) * log (10.)) + tvag = exp (- bling / (mug + 3) * log (n0g_sig)) * aling * gamma (mug + bling + 3) * & + exp (- bling * n0g_exp / (mug + 3) * log (10.)) * gcon + tvah = exp (- blinh / (muh + 3) * log (n0h_sig)) * alinh * gamma (muh + blinh + 3) * & + exp (- blinh * n0h_exp / (muh + 3) * log (10.)) * hcon + + tvbw = exp (blinw / (muw + 3) * log (pi * rhow * gamma (muw + 3))) * gamma (muw + 3) + tvbi = exp (blini / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) * gamma (mui + 3) + tvbr = exp (blinr / (mur + 3) * log (pi * rhor * gamma (mur + 3))) * gamma (mur + 3) + tvbs = exp (blins / (mus + 3) * log (pi * rhos * gamma (mus + 3))) * gamma (mus + 3) + tvbg = exp (bling / (mug + 3) * log (pi * rhog * gamma (mug + 3))) * gamma (mug + 3) + tvbh = exp (blinh / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) * gamma (muh + 3) ! ----------------------------------------------------------------------- ! Schmidt number, Sc ** (1 / 3) in Lin et al. (1983) @@ -528,83 +549,83 @@ subroutine setup_mp ! accretion between cloud water, cloud ice, rain, snow, and graupel or hail, Lin et al. (1983) ! ----------------------------------------------------------------------- - cracw = pi * cfg%n0r_sig * cfg%alinr * gamma (2 + cfg%mur + cfg%blinr) / & - (4. * exp ((2 + cfg%mur + cfg%blinr) / (cfg%mur + 3) * log (normr))) * & - exp ((1 - cfg%blinr) * log (expor)) - craci = pi * cfg%n0r_sig * cfg%alinr * gamma (2 + cfg%mur + cfg%blinr) / & - (4. * exp ((2 + cfg%mur + cfg%blinr) / (cfg%mur + 3) * log (normr))) * & - exp ((1 - cfg%blinr) * log (expor)) - csacw = pi * cfg%n0s_sig * cfg%alins * gamma (2 + cfg%mus + cfg%blins) / & - (4. * exp ((2 + cfg%mus + cfg%blins) / (cfg%mus + 3) * log (norms))) * & - exp ((1 - cfg%blins) * log (expos)) - csaci = pi * cfg%n0s_sig * cfg%alins * gamma (2 + cfg%mus + cfg%blins) / & - (4. * exp ((2 + cfg%mus + cfg%blins) / (cfg%mus + 3) * log (norms))) * & - exp ((1 - cfg%blins) * log (expos)) - if (cfg%do_hail) then - cgacw = pi * cfg%n0h_sig * cfg%alinh * gamma (2 + cfg%muh + cfg%blinh) * hcon / & - (4. * exp ((2 + cfg%muh + cfg%blinh) / (cfg%muh + 3) * log (normh))) * & - exp ((1 - cfg%blinh) * log (expoh)) - cgaci = pi * cfg%n0h_sig * cfg%alinh * gamma (2 + cfg%muh + cfg%blinh) * hcon / & - (4. * exp ((2 + cfg%muh + cfg%blinh) / (cfg%muh + 3) * log (normh))) * & - exp ((1 - cfg%blinh) * log (expoh)) + cracw = pi * n0r_sig * alinr * gamma (2 + mur + blinr) / & + (4. * exp ((2 + mur + blinr) / (mur + 3) * log (normr))) * & + exp ((1 - blinr) * log (expor)) + craci = pi * n0r_sig * alinr * gamma (2 + mur + blinr) / & + (4. * exp ((2 + mur + blinr) / (mur + 3) * log (normr))) * & + exp ((1 - blinr) * log (expor)) + csacw = pi * n0s_sig * alins * gamma (2 + mus + blins) / & + (4. * exp ((2 + mus + blins) / (mus + 3) * log (norms))) * & + exp ((1 - blins) * log (expos)) + csaci = pi * n0s_sig * alins * gamma (2 + mus + blins) / & + (4. * exp ((2 + mus + blins) / (mus + 3) * log (norms))) * & + exp ((1 - blins) * log (expos)) + if (do_hail) then + cgacw = pi * n0h_sig * alinh * gamma (2 + muh + blinh) * hcon / & + (4. * exp ((2 + muh + blinh) / (muh + 3) * log (normh))) * & + exp ((1 - blinh) * log (expoh)) + cgaci = pi * n0h_sig * alinh * gamma (2 + muh + blinh) * hcon / & + (4. * exp ((2 + muh + blinh) / (muh + 3) * log (normh))) * & + exp ((1 - blinh) * log (expoh)) else - cgacw = pi * cfg%n0g_sig * cfg%aling * gamma (2 + cfg%mug + cfg%bling) * gcon / & - (4. * exp ((2 + cfg%mug + cfg%bling) / (cfg%mug + 3) * log (normg))) * & - exp ((1 - cfg%bling) * log (expog)) - cgaci = pi * cfg%n0g_sig * cfg%aling * gamma (2 + cfg%mug + cfg%bling) * gcon / & - (4. * exp ((2 + cfg%mug + cfg%bling) / (cfg%mug + 3) * log (normg))) * & - exp ((1 - cfg%bling) * log (expog)) + cgacw = pi * n0g_sig * aling * gamma (2 + mug + bling) * gcon / & + (4. * exp ((2 + mug + bling) / (mug + 3) * log (normg))) * & + exp ((1 - bling) * log (expog)) + cgaci = pi * n0g_sig * aling * gamma (2 + mug + bling) * gcon / & + (4. * exp ((2 + mug + bling) / (mug + 3) * log (normg))) * & + exp ((1 - bling) * log (expog)) endif - if (cfg%do_new_acc_water) then + if (do_new_acc_water) then - cracw = pisq * cfg%n0r_sig * cfg%n0w_sig * rhow / 24. - csacw = pisq * cfg%n0s_sig * cfg%n0w_sig * rhow / 24. - if (cfg%do_hail) then - cgacw = pisq * cfg%n0h_sig * cfg%n0w_sig * rhow / 24. + cracw = pisq * n0r_sig * n0w_sig * rhow / 24. + csacw = pisq * n0s_sig * n0w_sig * rhow / 24. + if (do_hail) then + cgacw = pisq * n0h_sig * n0w_sig * rhow / 24. else - cgacw = pisq * cfg%n0g_sig * cfg%n0w_sig * rhow / 24. + cgacw = pisq * n0g_sig * n0w_sig * rhow / 24. endif endif - if (cfg%do_new_acc_ice) then + if (do_new_acc_ice) then - craci = pisq * cfg%n0r_sig * cfg%n0i_sig * rhoi / 24. - csaci = pisq * cfg%n0s_sig * cfg%n0i_sig * rhoi / 24. - if (cfg%do_hail) then - cgaci = pisq * cfg%n0h_sig * cfg%n0i_sig * rhoi / 24. + craci = pisq * n0r_sig * n0i_sig * rhoi / 24. + csaci = pisq * n0s_sig * n0i_sig * rhoi / 24. + if (do_hail) then + cgaci = pisq * n0h_sig * n0i_sig * rhoi / 24. else - cgaci = pisq * cfg%n0g_sig * cfg%n0i_sig * rhoi / 24. + cgaci = pisq * n0g_sig * n0i_sig * rhoi / 24. endif endif - cracw = cracw * cfg%c_pracw - craci = craci * cfg%c_praci - csacw = csacw * cfg%c_psacw - csaci = csaci * cfg%c_psaci - cgacw = cgacw * cfg%c_pgacw - cgaci = cgaci * cfg%c_pgaci + cracw = cracw * c_pracw + craci = craci * c_praci + csacw = csacw * c_psacw + csaci = csaci * c_psaci + cgacw = cgacw * c_pgacw + cgaci = cgaci * c_pgaci ! ----------------------------------------------------------------------- ! accretion between cloud water, cloud ice, rain, snow, and graupel or hail, Lin et al. (1983) ! ----------------------------------------------------------------------- - cracs = pisq * cfg%n0r_sig * cfg%n0s_sig * rhos / 24. - csacr = pisq * cfg%n0s_sig * cfg%n0r_sig * rhor / 24. - if (cfg%do_hail) then - cgacr = pisq * cfg%n0h_sig * cfg%n0r_sig * rhor / 24. - cgacs = pisq * cfg%n0h_sig * cfg%n0s_sig * rhos / 24. + cracs = pisq * n0r_sig * n0s_sig * rhos / 24. + csacr = pisq * n0s_sig * n0r_sig * rhor / 24. + if (do_hail) then + cgacr = pisq * n0h_sig * n0r_sig * rhor / 24. + cgacs = pisq * n0h_sig * n0s_sig * rhos / 24. else - cgacr = pisq * cfg%n0g_sig * cfg%n0r_sig * rhor / 24. - cgacs = pisq * cfg%n0g_sig * cfg%n0s_sig * rhos / 24. + cgacr = pisq * n0g_sig * n0r_sig * rhor / 24. + cgacs = pisq * n0g_sig * n0s_sig * rhos / 24. endif - cracs = cracs * cfg%c_pracs - csacr = csacr * cfg%c_psacr - cgacr = cgacr * cfg%c_pgacr - cgacs = cgacs * cfg%c_pgacs + cracs = cracs * c_pracs + csacr = csacr * c_psacr + cgacr = cgacr * c_pgacr + cgacs = cgacs * c_pgacs ! act / ace / acc: ! 1 - 2: racs (s - r) @@ -623,7 +644,7 @@ subroutine setup_mp act (3) = act (2) act (4) = act (1) act (5) = act (2) - if (cfg%do_hail) then + if (do_hail) then act (6) = normh else act (6) = normg @@ -648,7 +669,7 @@ subroutine setup_mp ace (3) = ace (2) ace (4) = ace (1) ace (5) = ace (2) - if (cfg%do_hail) then + if (do_hail) then ace (6) = expoh else ace (6) = expog @@ -668,21 +689,21 @@ subroutine setup_mp ace (19) = ace (11) ace (20) = ace (6) - acc (1) = cfg%mus - acc (2) = cfg%mur + acc (1) = mus + acc (2) = mur acc (3) = acc (2) acc (4) = acc (1) acc (5) = acc (2) - if (cfg%do_hail) then - acc (6) = cfg%muh + if (do_hail) then + acc (6) = muh else - acc (6) = cfg%mug + acc (6) = mug endif acc (7) = acc (1) acc (8) = acc (6) - acc (9) = cfg%muw + acc (9) = muw acc (10) = acc (2) - acc (11) = cfg%mui + acc (11) = mui acc (12) = acc (2) acc (13) = acc (9) acc (14) = acc (1) @@ -710,42 +731,42 @@ subroutine setup_mp ! rain evaporation, snow sublimation, and graupel or hail sublimation, Lin et al. (1983) ! ----------------------------------------------------------------------- - crevp (1) = 2. * pi * vdifu * tcond * rvgas * cfg%n0r_sig * gamma (1 + cfg%mur) / & - exp ((1 + cfg%mur) / (cfg%mur + 3) * log (normr)) * exp (2.0 * log (expor)) + crevp (1) = 2. * pi * vdifu * tcond * rvgas * n0r_sig * gamma (1 + mur) / & + exp ((1 + mur) / (mur + 3) * log (normr)) * exp (2.0 * log (expor)) crevp (2) = 0.78 - crevp (3) = 0.31 * scm3 * sqrt (cfg%alinr / visk) * gamma ((3 + 2 * cfg%mur + cfg%blinr) / 2) / & - exp ((3 + 2 * cfg%mur + cfg%blinr) / (cfg%mur + 3) / 2 * log (normr)) * & - exp ((1 + cfg%mur) / (cfg%mur + 3) * log (normr)) / gamma (1 + cfg%mur) * & - exp ((- 1 - cfg%blinr) / 2. * log (expor)) + crevp (3) = 0.31 * scm3 * sqrt (alinr / visk) * gamma ((3 + 2 * mur + blinr) / 2) / & + exp ((3 + 2 * mur + blinr) / (mur + 3) / 2 * log (normr)) * & + exp ((1 + mur) / (mur + 3) * log (normr)) / gamma (1 + mur) * & + exp ((- 1 - blinr) / 2. * log (expor)) crevp (4) = tcond * rvgas crevp (5) = vdifu - cssub (1) = 2. * pi * vdifu * tcond * rvgas * cfg%n0s_sig * gamma (1 + cfg%mus) / & - exp ((1 + cfg%mus) / (cfg%mus + 3) * log (norms)) * exp (2.0 * log (expos)) + cssub (1) = 2. * pi * vdifu * tcond * rvgas * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) cssub (2) = 0.78 - cssub (3) = 0.31 * scm3 * sqrt (cfg%alins / visk) * gamma ((3 + 2 * cfg%mus + cfg%blins) / 2) / & - exp ((3 + 2 * cfg%mus + cfg%blins) / (cfg%mus + 3) / 2 * log (norms)) * & - exp ((1 + cfg%mus) / (cfg%mus + 3) * log (norms)) / gamma (1 + cfg%mus) * & - exp ((- 1 - cfg%blins) / 2. * log (expos)) + cssub (3) = 0.31 * scm3 * sqrt (alins / visk) * gamma ((3 + 2 * mus + blins) / 2) / & + exp ((3 + 2 * mus + blins) / (mus + 3) / 2 * log (norms)) * & + exp ((1 + mus) / (mus + 3) * log (norms)) / gamma (1 + mus) * & + exp ((- 1 - blins) / 2. * log (expos)) cssub (4) = tcond * rvgas cssub (5) = vdifu - if (cfg%do_hail) then - cgsub (1) = 2. * pi * vdifu * tcond * rvgas * cfg%n0h_sig * gamma (1 + cfg%muh) / & - exp ((1 + cfg%muh) / (cfg%muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + if (do_hail) then + cgsub (1) = 2. * pi * vdifu * tcond * rvgas * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) cgsub (2) = 0.78 - cgsub (3) = 0.31 * scm3 * sqrt (cfg%alinh * hcon / visk) * gamma ((3 + 2 * cfg%muh + cfg%blinh) / 2) / & - exp (1. / (cfg%muh + 3) * (3 + 2 * cfg%muh + cfg%blinh) / 2 * log (normh)) * & - exp (1. / (cfg%muh + 3) * (1 + cfg%muh) * log (normh)) / gamma (1 + cfg%muh) * & - exp ((- 1 - cfg%blinh) / 2. * log (expoh)) + cgsub (3) = 0.31 * scm3 * sqrt (alinh * hcon / visk) * gamma ((3 + 2 * muh + blinh) / 2) / & + exp (1. / (muh + 3) * (3 + 2 * muh + blinh) / 2 * log (normh)) * & + exp (1. / (muh + 3) * (1 + muh) * log (normh)) / gamma (1 + muh) * & + exp ((- 1 - blinh) / 2. * log (expoh)) else - cgsub (1) = 2. * pi * vdifu * tcond * rvgas * cfg%n0g_sig * gamma (1 + cfg%mug) / & - exp ((1 + cfg%mug) / (cfg%mug + 3) * log (normg)) * exp (2.0 * log (expog)) + cgsub (1) = 2. * pi * vdifu * tcond * rvgas * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) cgsub (2) = 0.78 - cgsub (3) = 0.31 * scm3 * sqrt (cfg%aling * gcon / visk) * gamma ((3 + 2 * cfg%mug + cfg%bling) / 2) / & - exp ((3 + 2 * cfg%mug + cfg%bling) / (cfg%mug + 3) / 2 * log (normg)) * & - exp ((1 + cfg%mug) / (cfg%mug + 3) * log (normg)) / gamma (1 + cfg%mug) * & - exp ((- 1 - cfg%bling) / 2. * log (expog)) + cgsub (3) = 0.31 * scm3 * sqrt (aling * gcon / visk) * gamma ((3 + 2 * mug + bling) / 2) / & + exp ((3 + 2 * mug + bling) / (mug + 3) / 2 * log (normg)) * & + exp ((1 + mug) / (mug + 3) * log (normg)) / gamma (1 + mug) * & + exp ((- 1 - bling) / 2. * log (expog)) endif cgsub (4) = tcond * rvgas cgsub (5) = vdifu @@ -754,10 +775,10 @@ subroutine setup_mp ! snow melting, Lin et al. (1983) ! ----------------------------------------------------------------------- - csmlt (1) = 2. * pi * tcond * cfg%n0s_sig * gamma (1 + cfg%mus) / & - exp ((1 + cfg%mus) / (cfg%mus + 3) * log (norms)) * exp (2.0 * log (expos)) - csmlt (2) = 2. * pi * vdifu * cfg%n0s_sig * gamma (1 + cfg%mus) / & - exp ((1 + cfg%mus) / (cfg%mus + 3) * log (norms)) * exp (2.0 * log (expos)) + csmlt (1) = 2. * pi * tcond * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) + csmlt (2) = 2. * pi * vdifu * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) csmlt (3) = cssub (2) csmlt (4) = cssub (3) @@ -765,16 +786,16 @@ subroutine setup_mp ! graupel or hail melting, Lin et al. (1983) ! ----------------------------------------------------------------------- - if (cfg%do_hail) then - cgmlt (1) = 2. * pi * tcond * cfg%n0h_sig * gamma (1 + cfg%muh) / & - exp ((1 + cfg%muh) / (cfg%muh + 3) * log (normh)) * exp (2.0 * log (expoh)) - cgmlt (2) = 2. * pi * vdifu * cfg%n0h_sig * gamma (1 + cfg%muh) / & - exp ((1 + cfg%muh) / (cfg%muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + if (do_hail) then + cgmlt (1) = 2. * pi * tcond * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + cgmlt (2) = 2. * pi * vdifu * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) else - cgmlt (1) = 2. * pi * tcond * cfg%n0g_sig * gamma (1 + cfg%mug) / & - exp ((1 + cfg%mug) / (cfg%mug + 3) * log (normg)) * exp (2.0 * log (expog)) - cgmlt (2) = 2. * pi * vdifu * cfg%n0g_sig * gamma (1 + cfg%mug) / & - exp ((1 + cfg%mug) / (cfg%mug + 3) * log (normg)) * exp (2.0 * log (expog)) + cgmlt (1) = 2. * pi * tcond * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) + cgmlt (2) = 2. * pi * vdifu * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) endif cgmlt (3) = cgsub (2) cgmlt (4) = cgsub (3) @@ -783,8 +804,8 @@ subroutine setup_mp ! rain freezing, Lin et al. (1983) ! ----------------------------------------------------------------------- - cgfr (1) = 1.e2 / 36 * pisq * cfg%n0r_sig * rhor * gamma (6 + cfg%mur) / & - exp ((6 + cfg%mur) / (cfg%mur + 3) * log (normr)) * exp (- 3.0 * log (expor)) + cgfr (1) = 1.e2 / 36 * pisq * n0r_sig * rhor * gamma (6 + mur) / & + exp ((6 + mur) / (mur + 3) * log (normr)) * exp (- 3.0 * log (expor)) cgfr (2) = 0.66 end subroutine setup_mp @@ -806,7 +827,7 @@ subroutine setup_mhc_lhc (hydrostatic) if (hydrostatic) then c_air = cp_air c_vap = cp_vap - cfg%do_sedi_w = .false. + do_sedi_w = .false. else c_air = cv_air c_vap = cv_vap @@ -903,8 +924,8 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! time steps ! ----------------------------------------------------------------------- - cfg%ntimes = max (cfg%ntimes, int (dtm / min (dtm, cfg%mp_time))) - dts = dtm / real (cfg%ntimes) + ntimes = max (ntimes, int (dtm / min (dtm, mp_time))) + dts = dtm / real (ntimes) ! ----------------------------------------------------------------------- ! initialization of total energy difference and condensation diag @@ -963,7 +984,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! total energy checker ! ----------------------------------------------------------------------- - if (cfg%consv_checker) then + if (consv_checker) then call mtetw (ks, ke, qv (i, :), ql (i, :), qr (i, :), qi (i, :), & qs (i, :), qg (i, :), tz, ua (i, :), va (i, :), wa (i, :), & delp (i, :), dte (i), 0.0, water (i), rain (i), ice (i), & @@ -1030,7 +1051,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! total energy checker ! ----------------------------------------------------------------------- - if (cfg%consv_checker) then + if (consv_checker) then call mtetw (ks, ke, qvz, qlz, qrz, qiz, qsz, qgz, tz, u, v, w, & dp, dte (i), 0.0, water (i), rain (i), ice (i), snow (i), & graupel (i), 0.0, 0.0, dtm, te_beg_d (i, :), tw_beg_d (i, :), & @@ -1041,7 +1062,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! cloud condensation nuclei (CCN), cloud ice nuclei (CIN) ! ----------------------------------------------------------------------- - if (cfg%prog_ccn) then + if (prog_ccn) then do k = ks, ke ! boucher and lohmann (1995) nl = min (1., abs (hs (i)) / (10. * grav)) * & @@ -1055,8 +1076,8 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & cin (k) = cin (k) / den (k) enddo else - ccn0 = (cfg%ccn_l * min (1., abs (hs (i)) / (10. * grav)) + & - cfg%ccn_o * (1. - min (1., abs (hs (i)) / (10. * grav)))) * 1.e6 + ccn0 = (ccn_l * min (1., abs (hs (i)) / (10. * grav)) + & + ccn_o * (1. - min (1., abs (hs (i)) / (10. * grav)))) * 1.e6 cin0 = 0.0 do k = ks, ke ccn (k) = ccn0 / den (k) @@ -1069,8 +1090,8 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! default area dependent form: use dx ~ 100 km as the base ! ----------------------------------------------------------------------- - t_lnd = cfg%dw_land * sqrt (gsize (i) / 1.e5) - t_ocn = cfg%dw_ocean * sqrt (gsize (i) / 1.e5) + t_lnd = dw_land * sqrt (gsize (i) / 1.e5) + t_ocn = dw_ocean * sqrt (gsize (i) / 1.e5) tmp = min (1., abs (hs (i)) / (10. * grav)) h_var = t_lnd * tmp + t_ocn * (1. - tmp) h_var = min (0.20, max (0.01, h_var)) @@ -1079,17 +1100,17 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! relative humidity thresholds ! ----------------------------------------------------------------------- - rh_adj = 1. - h_var - cfg%rh_inc - rh_rain = max (0.35, rh_adj - cfg%rh_inr) + rh_adj = 1. - h_var - rh_inc + rh_rain = max (0.35, rh_adj - rh_inr) ! ----------------------------------------------------------------------- ! fix negative water species from outside ! ----------------------------------------------------------------------- - if (cfg%fix_negative) & + if (fix_negative) & call neg_adj (ks, ke, tz, dp, qvz, qlz, qrz, qiz, qsz, qgz, cond) - condensation (i) = condensation (i) + cond * convt * cfg%ntimes + condensation (i) = condensation (i) + cond * convt * ntimes ! ----------------------------------------------------------------------- ! fast microphysics loop @@ -1109,7 +1130,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & if (do_mp_full) then - call mp_full (ks, ke, cfg%ntimes, tz, qvz, qlz, qrz, qiz, qsz, qgz, dp, dz, & + call mp_full (ks, ke, ntimes, tz, qvz, qlz, qrz, qiz, qsz, qgz, dp, dz, & u, v, w, den, denfac, ccn, cin, dts, rh_adj, rh_rain, h_var, dte (i), & water (i), rain (i), ice (i), snow (i), graupel (i), prefluxw (i, :), & prefluxr (i, :), prefluxi (i, :), prefluxs (i, :), prefluxg (i, :), & @@ -1122,7 +1143,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! cloud fraction diagnostic ! ----------------------------------------------------------------------- - if (cfg%do_qa .and. last_step) then + if (do_qa .and. last_step) then call cloud_fraction (ks, ke, pz, den, qvz, qlz, qrz, qiz, qsz, qgz, qaz, & tz, h_var, gsize (i)) endif @@ -1161,34 +1182,34 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & do k = ks, ke if (qlz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qlz (k), den (k), cfg%blinw, cfg%muw, pcaw, pcbw, pcw (i, k), & + call cal_pc_ed_oe_rr_tv (qlz (k), den (k), blinw, muw, pcaw, pcbw, pcw (i, k), & edaw, edbw, edw (i, k), oeaw, oebw, oew (i, k), rraw, rrbw, rrw (i, k), & tvaw, tvbw, tvw (i, k)) endif if (qiz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qiz (k), den (k), cfg%blini, cfg%mui, pcai, pcbi, pci (i, k), & + call cal_pc_ed_oe_rr_tv (qiz (k), den (k), blini, mui, pcai, pcbi, pci (i, k), & edai, edbi, edi (i, k), oeai, oebi, oei (i, k), rrai, rrbi, rri (i, k), & tvai, tvbi, tvi (i, k)) endif if (qrz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qrz (k), den (k), cfg%blinr, cfg%mur, pcar, pcbr, pcr (i, k), & + call cal_pc_ed_oe_rr_tv (qrz (k), den (k), blinr, mur, pcar, pcbr, pcr (i, k), & edar, edbr, edr (i, k), oear, oebr, oer (i, k), rrar, rrbr, rrr (i, k), & tvar, tvbr, tvr (i, k)) endif if (qsz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qsz (k), den (k), cfg%blins, cfg%mus, pcas, pcbs, pcs (i, k), & + call cal_pc_ed_oe_rr_tv (qsz (k), den (k), blins, mus, pcas, pcbs, pcs (i, k), & edas, edbs, eds (i, k), oeas, oebs, oes (i, k), rras, rrbs, rrs (i, k), & tvas, tvbs, tvs (i, k)) endif - if (cfg%do_hail) then + if (do_hail) then if (qgz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qgz (k), den (k), cfg%blinh, cfg%muh, pcah, pcbh, pcg (i, k), & + call cal_pc_ed_oe_rr_tv (qgz (k), den (k), blinh, muh, pcah, pcbh, pcg (i, k), & edah, edbh, edg (i, k), oeah, oebh, oeg (i, k), rrah, rrbh, rrg (i, k), & tvah, tvbh, tvg (i, k)) endif else if (qgz (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qgz (k), den (k), cfg%bling, cfg%mug, pcag, pcbg, pcg (i, k), & + call cal_pc_ed_oe_rr_tv (qgz (k), den (k), bling, mug, pcag, pcbg, pcg (i, k), & edag, edbg, edg (i, k), oeag, oebg, oeg (i, k), rrag, rrbg, rrg (i, k), & tvag, tvbg, tvg (i, k)) endif @@ -1200,7 +1221,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! update temperature before delp and q update ! ----------------------------------------------------------------------- - if (cfg%do_sedi_uv) then + if (do_sedi_uv) then do k = ks, ke c8 = mhc (qvz (k), qlz (k), qrz (k), qiz (k), qsz (k), qgz (k)) * c_air tzuv (k) = 0.5 * (ua (i, k) ** 2 + va (i, k) ** 2 - (u (k) ** 2 + v (k) ** 2)) / c8 @@ -1208,7 +1229,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ks, ke c8 = mhc (qvz (k), qlz (k), qrz (k), qiz (k), qsz (k), qgz (k)) * c_air tzw (k) = 0.5 * (wa (i, k) ** 2 - w (k) ** 2) / c8 @@ -1220,7 +1241,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! total energy checker ! ----------------------------------------------------------------------- - if (cfg%consv_checker) then + if (consv_checker) then call mtetw (ks, ke, qvz, qlz, qrz, qiz, qsz, qgz, tz, u, v, w, & dp, dte (i), 0.0, water (i), rain (i), ice (i), snow (i), & graupel (i), 0.0, 0.0, dtm, te_end_d (i, :), tw_end_d (i, :), & @@ -1286,7 +1307,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! update temperature after delp and q update ! ----------------------------------------------------------------------- - if (cfg%do_sedi_uv) then + if (do_sedi_uv) then do k = ks, ke tz (k) = tz (k) - tzuv (k) q_liq (k) = qlz (k) + qrz (k) @@ -1304,7 +1325,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & enddo endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ks, ke tz (k) = tz (k) - tzw (k) q_liq (k) = qlz (k) + qrz (k) @@ -1325,7 +1346,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! total energy checker ! ----------------------------------------------------------------------- - if (cfg%consv_checker) then + if (consv_checker) then call mtetw (ks, ke, qv (i, :), ql (i, :), qr (i, :), qi (i, :), & qs (i, :), qg (i, :), tz, ua (i, :), va (i, :), wa (i, :), & delp (i, :), dte (i), 0.0, water (i), rain (i), ice (i), & @@ -1357,7 +1378,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & if (do_inline_mp) then do k = ks, ke q_cond = qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k) - if (cfg%cp_heating) then + if (cp_heating) then con_r8 = one_r8 - (qvz (k) + q_cond) c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air cp8 = con_r8 * cp_air + qvz (k) * cp_vap + q_liq (k) * c_liq + q_sol (k) * c_ice @@ -1383,9 +1404,9 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & ! total energy checker ! ----------------------------------------------------------------------- - if (cfg%consv_checker) then + if (consv_checker) then if (abs (sum (te_end_d (i, :)) + te_b_end_d (i) - sum (te_beg_d (i, :)) - te_b_beg_d (i)) / & - (sum (te_beg_d (i, :)) + te_b_beg_d (i)) .gt. cfg%te_err) then + (sum (te_beg_d (i, :)) + te_b_beg_d (i)) .gt. te_err) then print*, "GFDL-MP-DRY TE: ", & !(sum (te_beg_d (i, :)) + te_b_beg_d (i)), & !(sum (te_end_d (i, :)) + te_b_end_d (i)), & @@ -1393,7 +1414,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & (sum (te_beg_d (i, :)) + te_b_beg_d (i)) endif if (abs (sum (tw_end_d (i, :)) + tw_b_end_d (i) - sum (tw_beg_d (i, :)) - tw_b_beg_d (i)) / & - (sum (tw_beg_d (i, :)) + tw_b_beg_d (i)) .gt. cfg%tw_err) then + (sum (tw_beg_d (i, :)) + tw_b_beg_d (i)) .gt. tw_err) then print*, "GFDL-MP-DRY TW: ", & !(sum (tw_beg_d (i, :)) + tw_b_beg_d (i)), & !(sum (tw_end_d (i, :)) + tw_b_end_d (i)), & @@ -1402,7 +1423,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & endif !print*, "GFDL MP TE DRY LOSS (%) : ", te_loss (i) / (sum (te_beg_d (i, :)) + te_b_beg_d (i)) * 100.0 if (abs (sum (te_end_m (i, :)) + te_b_end_m (i) - sum (te_beg_m (i, :)) - te_b_beg_m (i)) / & - (sum (te_beg_m (i, :)) + te_b_beg_m (i)) .gt. cfg%te_err) then + (sum (te_beg_m (i, :)) + te_b_beg_m (i)) .gt. te_err) then print*, "GFDL-MP-WET TE: ", & !(sum (te_beg_m (i, :)) + te_b_beg_m (i)), & !(sum (te_end_m (i, :)) + te_b_end_m (i)), & @@ -1410,7 +1431,7 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & (sum (te_beg_m (i, :)) + te_b_beg_m (i)) endif if (abs (sum (tw_end_m (i, :)) + tw_b_end_m (i) - sum (tw_beg_m (i, :)) - tw_b_beg_m (i)) / & - (sum (tw_beg_m (i, :)) + tw_b_beg_m (i)) .gt. cfg%tw_err) then + (sum (tw_beg_m (i, :)) + tw_b_beg_m (i)) .gt. tw_err) then print*, "GFDL-MP-WET TW: ", & !(sum (tw_beg_m (i, :)) + tw_b_beg_m (i)), & !(sum (tw_end_m (i, :)) + tw_b_end_m (i)), & @@ -1629,7 +1650,7 @@ subroutine mp_full (ks, ke, ntimes, tz, qv, ql, qr, qi, qs, qg, dp, dz, u, v, w, call ice_cloud (ks, ke, tz, qv, ql, qr, qi, qs, qg, den, & denfac, vtw, vtr, vti, vts, vtg, dts, h_var) - if (cfg%do_subgrid_proc) then + if (do_subgrid_proc) then ! ----------------------------------------------------------------------- ! temperature sentive high vertical resolution processes @@ -1708,7 +1729,7 @@ subroutine mp_fast (ks, ke, tz, qv, ql, qr, qi, qs, qg, dtm, dp, den, & call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & lcpk, icpk, tcpk, tcp3) - if (.not. cfg%do_warm_rain_mp .and. cfg%fast_fr_mlt) then + if (.not. do_warm_rain_mp .and. fast_fr_mlt) then ! ----------------------------------------------------------------------- ! cloud ice melting to form cloud water and rain @@ -1730,14 +1751,14 @@ subroutine mp_fast (ks, ke, tz, qv, ql, qr, qi, qs, qg, dtm, dp, den, & ! cloud water condensation and evaporation ! ----------------------------------------------------------------------- - if (cfg%delay_cond_evap) then + if (delay_cond_evap) then cond_evap = last_step else cond_evap = .true. endif if (cond_evap) then - do n = 1, cfg%nconds + do n = 1, nconds call pcond_pevap (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & lcpk, icpk, tcpk, tcp3, cond, reevap) enddo @@ -1746,7 +1767,7 @@ subroutine mp_fast (ks, ke, tz, qv, ql, qr, qi, qs, qg, dtm, dp, den, & condensation = condensation + cond * convt evaporation = evaporation + reevap * convt - if (.not. cfg%do_warm_rain_mp .and. cfg%fast_fr_mlt) then + if (.not. do_warm_rain_mp .and. fast_fr_mlt) then ! ----------------------------------------------------------------------- ! cloud water freezing to form cloud ice and snow @@ -1791,7 +1812,7 @@ subroutine mp_fast (ks, ke, tz, qv, ql, qr, qi, qs, qg, dtm, dp, den, & call praut_simp (ks, ke, dtm, tz, qv, ql, qr, qi, qs, qg) - if (.not. cfg%do_warm_rain_mp .and. cfg%fast_dep_sub) then + if (.not. do_warm_rain_mp .and. fast_dep_sub) then ! ----------------------------------------------------------------------- ! cloud ice deposition and sublimation @@ -1896,15 +1917,15 @@ subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! terminal fall and melting of falling cloud ice into rain ! ----------------------------------------------------------------------- - if (cfg%do_psd_ice_fall) then - call term_rsg (ks, ke, qi, den, denfac, cfg%vi_fac, cfg%blini, cfg%mui, tvai, tvbi, cfg%vi_max, cfg%const_vi, vti) + if (do_psd_ice_fall) then + call term_rsg (ks, ke, qi, den, denfac, vi_fac, blini, mui, tvai, tvbi, vi_max, const_vi, vti) else - call term_ice (ks, ke, tz, qi, den, cfg%vi_fac, cfg%vi_max, cfg%const_vi, vti) + call term_ice (ks, ke, tz, qi, den, vi_fac, vi_max, const_vi, vti) endif - if (cfg%do_sedi_melt) then + if (do_sedi_melt) then call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & - vti, r1, cfg%tau_imlt, icpk, "qi") + vti, r1, tau_imlt, icpk, "qi") endif call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & @@ -1919,11 +1940,11 @@ subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! terminal fall and melting of falling snow into rain ! ----------------------------------------------------------------------- - call term_rsg (ks, ke, qs, den, denfac, cfg%vs_fac, cfg%blins, cfg%mus, tvas, tvbs, cfg%vs_max, cfg%const_vs, vts) + call term_rsg (ks, ke, qs, den, denfac, vs_fac, blins, mus, tvas, tvbs, vs_max, const_vs, vts) - if (cfg%do_sedi_melt) then + if (do_sedi_melt) then call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & - vts, r1, cfg%tau_smlt, icpk, "qs") + vts, r1, tau_smlt, icpk, "qs") endif call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & @@ -1938,15 +1959,15 @@ subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! terminal fall and melting of falling graupel into rain ! ----------------------------------------------------------------------- - if (cfg%do_hail) then - call term_rsg (ks, ke, qg, den, denfac, cfg%vg_fac, cfg%blinh, cfg%muh, tvah, tvbh, cfg%vg_max, cfg%const_vg, vtg) + if (do_hail) then + call term_rsg (ks, ke, qg, den, denfac, vg_fac, blinh, muh, tvah, tvbh, vg_max, const_vg, vtg) else - call term_rsg (ks, ke, qg, den, denfac, cfg%vg_fac, cfg%bling, cfg%mug, tvag, tvbg, cfg%vg_max, cfg%const_vg, vtg) + call term_rsg (ks, ke, qg, den, denfac, vg_fac, bling, mug, tvag, tvbg, vg_max, const_vg, vtg) endif - if (cfg%do_sedi_melt) then + if (do_sedi_melt) then call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & - vtg, r1, cfg%tau_gmlt, icpk, "qg") + vtg, r1, tau_gmlt, icpk, "qg") endif call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & @@ -1961,9 +1982,9 @@ subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! terminal fall of cloud water ! ----------------------------------------------------------------------- - if (cfg%do_psd_water_fall) then + if (do_psd_water_fall) then - call term_rsg (ks, ke, ql, den, denfac, cfg%vw_fac, cfg%blinw, cfg%muw, tvaw, tvbw, cfg%vw_max, cfg%const_vw, vtw) + call term_rsg (ks, ke, ql, den, denfac, vw_fac, blinw, muw, tvaw, tvbw, vw_max, const_vw, vtw) call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & vtw, w1, pfw, u, v, w, dte, "ql") @@ -1979,7 +2000,7 @@ subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! terminal fall of rain ! ----------------------------------------------------------------------- - call term_rsg (ks, ke, qr, den, denfac, cfg%vr_fac, cfg%blinr, cfg%mur, tvar, tvbr, cfg%vr_max, cfg%const_vr, vtr) + call term_rsg (ks, ke, qr, den, denfac, vr_fac, blinr, mur, tvar, tvbr, vr_max, const_vr, vtr) call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & vtr, r1, pfr, u, v, w, dte, "qr") @@ -2040,12 +2061,12 @@ subroutine term_ice (ks, ke, tz, q, den, v_fac, v_max, const_v, vt) vt (k) = 0.0 else tc (k) = tz (k) - tice - if (cfg%ifflag .eq. 1) then + if (ifflag .eq. 1) then vt (k) = (3. + log10 (qden)) * (tc (k) * (aa * tc (k) + bb) + cc) + & dd * tc (k) + ee vt (k) = 0.01 * v_fac * exp (vt (k) * log (10.)) endif - if (cfg%ifflag .eq. 2) & + if (ifflag .eq. 2) & vt (k) = v_fac * 3.29 * exp (0.16 * log (qden)) vt (k) = min (v_max, max (0.0, vt (k))) endif @@ -2272,7 +2293,7 @@ subroutine terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! momentum transportation during sedimentation ! ----------------------------------------------------------------------- - if (cfg%do_sedi_w) then + if (do_sedi_w) then do k = ks, ke dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) enddo @@ -2305,15 +2326,15 @@ subroutine terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & print *, "gfdl_mp: qflag error!" end select - if (cfg%sedflag .eq. 1) & + if (sedflag .eq. 1) & call implicit_fall (dts, ks, ke, ze, vt, dp, q, x1, m1) - if (cfg%sedflag .eq. 2) & + if (sedflag .eq. 2) & call explicit_fall (dts, ks, ke, ze, vt, dp, q, x1, m1) - if (cfg%sedflag .eq. 3) & + if (sedflag .eq. 3) & call lagrangian_fall (ks, ke, zs, ze, zt, dp, q, x1, m1) - if (cfg%sedflag .eq. 4) & + if (sedflag .eq. 4) & call implicit_lagrangian_fall (dts, ks, ke, zs, ze, zt, vt, dp, q, & - x1, m1, cfg%sed_fac) + x1, m1, sed_fac) select case (qflag) case ("ql") @@ -2343,11 +2364,11 @@ subroutine terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! momentum transportation during sedimentation ! ----------------------------------------------------------------------- - if (cfg%do_sedi_uv) then + if (do_sedi_uv) then call sedi_uv (ks, ke, m1, dp, u, v) endif - if (cfg%do_sedi_w) then + if (do_sedi_w) then call sedi_w (ks, ke, m1, w, vt, dm) endif @@ -2363,7 +2384,7 @@ subroutine terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & ! heat exchanges during sedimentation ! ----------------------------------------------------------------------- - if (cfg%do_sedi_heat) then + if (do_sedi_heat) then call sedi_heat (ks, ke, dp, m1, dz, tz, qv, ql, qr, qi, qs, qg, c_ice) endif @@ -2559,8 +2580,8 @@ subroutine prevp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, ! ----------------------------------------------------------------------- fac_revp = 1. - if (cfg%tau_revp .gt. 1.e-6) then - fac_revp = 1. - exp (- dts / cfg%tau_revp) + if (tau_revp .gt. 1.e-6) then + fac_revp = 1. - exp (- dts / tau_revp) endif ! ----------------------------------------------------------------------- @@ -2602,9 +2623,9 @@ subroutine prevp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, endif qden = qr (k) * den (k) t2 = tin * tin - sink = psub (t2, dq, qden, qsat, crevp, den (k), denfac (k), cfg%blinr, cfg%mur, lcpk (k), cvm (k)) + sink = psub (t2, dq, qden, qsat, crevp, den (k), denfac (k), blinr, mur, lcpk (k), cvm (k)) sink = min (qr (k), dts * fac_revp * sink, dqv / (1. + lcpk (k) * dqdt)) - if (cfg%use_rhc_revap .and. rh_tem .ge. cfg%rhc_revap) then + if (use_rhc_revap .and. rh_tem .ge. rhc_revap) then sink = 0.0 endif @@ -2661,11 +2682,11 @@ subroutine pracw (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, vtw, vtr if (tz (k) .gt. t_wfr .and. qr (k) .gt. qcmin .and. ql (k) .gt. qcmin) then qden = qr (k) * den (k) - if (cfg%do_new_acc_water) then + if (do_new_acc_water) then sink = dts * acr3d (vtr (k), vtw (k), ql (k), qr (k), cracw, acco (:, 5), & acc (9), acc (10), den (k)) else - sink = dts * acr2d (qden, cracw, denfac (k), cfg%blinr, cfg%mur) + sink = dts * acr2d (qden, cracw, denfac (k), blinr, mur) sink = sink / (1. + sink) * ql (k) endif @@ -2713,16 +2734,16 @@ subroutine praut (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, ccn, h_var) real, dimension (ks:ke) :: dl, c_praut - if (cfg%irain_f .eq. 0) then + if (irain_f .eq. 0) then - call linear_prof (ke - ks + 1, ql (ks), dl (ks), cfg%z_slope_liq, h_var) + call linear_prof (ke - ks + 1, ql (ks), dl (ks), z_slope_liq, h_var) do k = ks, ke if (tz (k) .gt. t_wfr .and. ql (k) .gt. qcmin) then - if (cfg%do_psd_water_num) then - call cal_pc_ed_oe_rr_tv (ql (k), den (k), cfg%blinw, cfg%muw, & + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & pca = pcaw, pcb = pcbw, pc = ccn (k)) ccn (k) = ccn (k) / den (k) endif @@ -2749,14 +2770,14 @@ subroutine praut (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, ccn, h_var) endif - if (cfg%irain_f .eq. 1) then + if (irain_f .eq. 1) then do k = ks, ke if (tz (k) .gt. t_wfr .and. ql (k) .gt. qcmin) then - if (cfg%do_psd_water_num) then - call cal_pc_ed_oe_rr_tv (ql (k), den (k), cfg%blinw, cfg%muw, & + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & pca = pcaw, pcb = pcbw, pc = ccn (k)) ccn (k) = ccn (k) / den (k) endif @@ -2821,7 +2842,7 @@ subroutine ice_cloud (ks, ke, tz, qv, ql, qr, qi, qs, qg, den, & call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & lcpk, icpk, tcpk, tcp3) - if (.not. cfg%do_warm_rain_mp) then + if (.not. do_warm_rain_mp) then ! ----------------------------------------------------------------------- ! cloud ice melting to form cloud water and rain @@ -2839,7 +2860,7 @@ subroutine ice_cloud (ks, ke, tz, qv, ql, qr, qi, qs, qg, den, & ! vertical subgrid variability ! ----------------------------------------------------------------------- - call linear_prof (ke - ks + 1, qi, di, cfg%z_slope_ice, h_var) + call linear_prof (ke - ks + 1, qi, di, z_slope_ice, h_var) ! ----------------------------------------------------------------------- ! snow melting (includes snow accretion with cloud water and rain) to form cloud water and rain @@ -2934,17 +2955,17 @@ subroutine pimlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, lcpk, icpk, real :: tc, tmp, sink, fac_imlt - fac_imlt = 1. - exp (- dts / cfg%tau_imlt) + fac_imlt = 1. - exp (- dts / tau_imlt) do k = ks, ke - tc = tz (k) - cfg%tice_mlt + tc = tz (k) - tice_mlt if (tc .gt. 0 .and. qi (k) .gt. qcmin) then sink = fac_imlt * tc / icpk (k) sink = min (qi (k), sink) - tmp = min (sink, dim (cfg%ql_mlt, ql (k))) + tmp = min (sink, dim (ql_mlt, ql (k))) call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., tmp, sink - tmp, - sink, 0., 0., te8 (k), cvm (k), tz (k), & @@ -2995,7 +3016,7 @@ subroutine pifr (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, icpk, sink = ql (k) * tc / dt_fr sink = min (ql (k), sink, tc / icpk (k)) - qim = cfg%qi0_crt / den (k) + qim = qi0_crt / den (k) tmp = min (sink, dim (qim, qi (k))) call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & @@ -3053,11 +3074,11 @@ subroutine psmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac psacw = 0. qden = qs (k) * den (k) if (ql (k) .gt. qcmin) then - if (cfg%do_new_acc_water) then + if (do_new_acc_water) then psacw = acr3d (vts (k), vtw (k), ql (k), qs (k), csacw, acco (:, 7), & acc (13), acc (14), den (k)) else - factor = acr2d (qden, csacw, denfac (k), cfg%blins, cfg%mus) + factor = acr2d (qden, csacw, denfac (k), blins, mus) psacw = factor / (1. + dts * factor) * ql (k) endif endif @@ -3074,11 +3095,11 @@ subroutine psmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac tin = tz (k) qsi = iqs (tin, den (k), dqdt) dq = qsi - qv (k) - sink = max (0., pmlt (tc, dq, qden, psacw, psacr, csmlt, den (k), denfac (k), cfg%blins, cfg%mus, & + sink = max (0., pmlt (tc, dq, qden, psacw, psacr, csmlt, den (k), denfac (k), blins, mus, & lcpk (k), icpk (k), cvm (k))) sink = min (qs (k), (sink + pracs) * dts, tc / icpk (k)) - tmp = min (sink, dim (cfg%qs_mlt, ql (k))) + tmp = min (sink, dim (qs_mlt, ql (k))) call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., tmp, sink - tmp, 0., - sink, 0., te8 (k), cvm (k), tz (k), & @@ -3135,14 +3156,14 @@ subroutine pgmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac pgacw = 0. qden = qg (k) * den (k) if (ql (k) .gt. qcmin) then - if (cfg%do_new_acc_water) then + if (do_new_acc_water) then pgacw = acr3d (vtg (k), vtw (k), ql (k), qg (k), cgacw, acco (:, 9), & acc (17), acc (18), den (k)) else - if (cfg%do_hail) then - factor = acr2d (qden, cgacw, denfac (k), cfg%blinh, cfg%muh) + if (do_hail) then + factor = acr2d (qden, cgacw, denfac (k), blinh, muh) else - factor = acr2d (qden, cgacw, denfac (k), cfg%bling, cfg%mug) + factor = acr2d (qden, cgacw, denfac (k), bling, mug) endif pgacw = factor / (1. + dts * factor) * ql (k) endif @@ -3157,12 +3178,12 @@ subroutine pgmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac tin = tz (k) qsi = iqs (tin, den (k), dqdt) dq = qsi - qv (k) - if (cfg%do_hail) then + if (do_hail) then sink = max (0., pmlt (tc, dq, qden, pgacw, pgacr, cgmlt, den (k), denfac (k), & - cfg%blinh, cfg%muh, lcpk (k), icpk (k), cvm (k))) + blinh, muh, lcpk (k), icpk (k), cvm (k))) else sink = max (0., pmlt (tc, dq, qden, pgacw, pgacr, cgmlt, den (k), denfac (k), & - cfg%bling, cfg%mug, lcpk (k), icpk (k), cvm (k))) + bling, mug, lcpk (k), icpk (k), cvm (k))) endif sink = min (qg (k), sink * dts, tc / icpk (k)) @@ -3216,16 +3237,16 @@ subroutine psaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vts sink = 0. qden = qs (k) * den (k) if (qs (k) .gt. qcmin) then - if (cfg%do_new_acc_ice) then + if (do_new_acc_ice) then sink = dts * acr3d (vts (k), vti (k), qi (k), qs (k), csaci, acco (:, 8), & acc (15), acc (16), den (k)) else - factor = dts * acr2d (qden, csaci, denfac (k), cfg%blins, cfg%mus) + factor = dts * acr2d (qden, csaci, denfac (k), blins, mus) sink = factor / (1. + factor) * qi (k) endif endif - sink = min (cfg%fi2s_fac * qi (k), sink) + sink = min (fi2s_fac * qi (k), sink) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., 0., 0., - sink, sink, 0.) @@ -3266,7 +3287,7 @@ subroutine psaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, di) real :: tc, sink, fac_i2s, q_plus, qim, dq, tmp - fac_i2s = 1. - exp (- dts / cfg%tau_i2s) + fac_i2s = 1. - exp (- dts / tau_i2s) do k = ks, ke @@ -3278,7 +3299,7 @@ subroutine psaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, di) tmp = fac_i2s * exp (0.025 * tc) di (k) = max (di (k), qcmin) q_plus = qi (k) + di (k) - qim = cfg%qi0_crt / den (k) + qim = qi0_crt / den (k) if (q_plus .gt. (qim + qcmin)) then if (qim .gt. (qi (k) - di (k))) then dq = (0.25 * (q_plus - qim) ** 2) / di (k) @@ -3288,7 +3309,7 @@ subroutine psaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, di) sink = tmp * dq endif - sink = min (cfg%fi2s_fac * qi (k), sink) + sink = min (fi2s_fac * qi (k), sink) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., 0., 0., - sink, sink, 0.) @@ -3338,20 +3359,20 @@ subroutine pgaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vtg sink = 0. qden = qg (k) * den (k) if (qg (k) .gt. qcmin) then - if (cfg%do_new_acc_ice) then + if (do_new_acc_ice) then sink = dts * acr3d (vtg (k), vti (k), qi (k), qg (k), cgaci, acco (:, 10), & acc (19), acc (20), den (k)) else - if (cfg%do_hail) then - factor = dts * acr2d (qden, cgaci, denfac (k), cfg%blinh, cfg%muh) + if (do_hail) then + factor = dts * acr2d (qden, cgaci, denfac (k), blinh, muh) else - factor = dts * acr2d (qden, cgaci, denfac (k), cfg%bling, cfg%mug) + factor = dts * acr2d (qden, cgaci, denfac (k), bling, mug) endif sink = factor / (1. + factor) * qi (k) endif endif - sink = min (cfg%fi2g_fac * qi (k), sink) + sink = min (fi2g_fac * qi (k), sink) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., 0., 0., - sink, 0., sink) @@ -3410,7 +3431,7 @@ subroutine psacr_pgfr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, d endif pgfr = dts * cgfr (1) / den (k) * (exp (- cgfr (2) * tc) - 1.) * & - exp ((6 + cfg%mur) / (cfg%mur + 3) * log (6 * qr (k) * den (k))) + exp ((6 + mur) / (mur + 3) * log (6 * qr (k) * den (k))) sink = psacr + pgfr factor = min (sink, qr (k), - tc / icpk (k)) / max (sink, qcmin) @@ -3465,7 +3486,7 @@ subroutine pgacs (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, vts, vtg) sink = dts * acr3d (vtg (k), vts (k), qs (k), qg (k), cgacs, acco (:, 4), & acc (7), acc (8), den (k)) - sink = min (cfg%fs2g_fac * qs (k), sink) + sink = min (fs2g_fac * qs (k), sink) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., 0., 0., 0., - sink, sink) @@ -3513,13 +3534,13 @@ subroutine pgaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den) if (tc .lt. 0. .and. qs (k) .gt. qcmin) then sink = 0 - qsm = cfg%qs0_crt / den (k) + qsm = qs0_crt / den (k) if (qs (k) .gt. qsm) then factor = dts * 1.e-3 * exp (0.09 * (tz (k) - tice)) sink = factor / (1. + factor) * (qs (k) - qsm) endif - sink = min (cfg%fs2g_fac * qs (k), sink) + sink = min (fs2g_fac * qs (k), sink) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., 0., 0., 0., - sink, sink) @@ -3574,10 +3595,10 @@ subroutine pgacw_pgacr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, pgacw = 0. if (ql (k) .gt. qcmin) then qden = qg (k) * den (k) - if (cfg%do_hail) then - factor = dts * acr2d (qden, cgacw, denfac (k), cfg%blinh, cfg%muh) + if (do_hail) then + factor = dts * acr2d (qden, cgacw, denfac (k), blinh, muh) else - factor = dts * acr2d (qden, cgacw, denfac (k), cfg%bling, cfg%mug) + factor = dts * acr2d (qden, cgacw, denfac (k), bling, mug) endif pgacw = factor / (1. + factor) * ql (k) endif @@ -3664,7 +3685,7 @@ subroutine subgrid_z_proc (ks, ke, den, denfac, dts, rh_adj, tz, qv, ql, qr, & ! instant processes (include deposition, evaporation, and sublimation) ! ----------------------------------------------------------------------- - if (.not. cfg%do_warm_rain_mp) then + if (.not. do_warm_rain_mp) then call pinst (ks, ke, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & lcpk, icpk, tcpk, tcp3, rh_adj, dep, sub, reevap) @@ -3675,20 +3696,20 @@ subroutine subgrid_z_proc (ks, ke, den, denfac, dts, rh_adj, tz, qv, ql, qr, & ! cloud water condensation and evaporation ! ----------------------------------------------------------------------- - if (cfg%delay_cond_evap) then + if (delay_cond_evap) then cond_evap = last_step else cond_evap = .true. endif if (cond_evap) then - do n = 1, cfg%nconds + do n = 1, nconds call pcond_pevap (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & lcpk, icpk, tcpk, tcp3, cond, reevap) enddo endif - if (.not. cfg%do_warm_rain_mp) then + if (.not. do_warm_rain_mp) then ! ----------------------------------------------------------------------- ! enforce complete freezing below t_wfr @@ -3775,7 +3796,7 @@ subroutine pinst (ks, ke, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & ! instant deposit all water vapor to cloud ice when temperature is super low ! ----------------------------------------------------------------------- - if (tz (k) .lt. cfg%t_min) then + if (tz (k) .lt. t_min) then sink = dim (qv (k), qcmin) dep = dep + sink * dp (k) @@ -3794,7 +3815,7 @@ subroutine pinst (ks, ke, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & tin = (te8 (k) - lv00 * qpz + li00 * (qs (k) + qg (k))) / & mhc (qpz, qr (k), qs (k) + qg (k)) - if (tin .gt. cfg%t_sub + 6.) then + if (tin .gt. t_sub + 6.) then qsi = iqs (tin, den (k), dqdt) rh = qpz / qsi @@ -3854,8 +3875,8 @@ subroutine pcond_pevap (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d real :: sink, tin, qpz, dqdt, qsw, rh_tem, dq, factor, fac_l2v, fac_v2l - fac_l2v = 1. - exp (- dts / cfg%tau_l2v) - fac_v2l = 1. - exp (- dts / cfg%tau_v2l) + fac_l2v = 1. - exp (- dts / tau_l2v) + fac_v2l = 1. - exp (- dts / tau_v2l) do k = ks, ke @@ -3865,19 +3886,19 @@ subroutine pcond_pevap (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d rh_tem = qpz / qsw dq = qsw - qv (k) if (dq .gt. 0.) then - if (cfg%do_evap_timescale) then - factor = min (1., fac_l2v * (cfg%rh_fac_evap * dq / qsw)) + if (do_evap_timescale) then + factor = min (1., fac_l2v * (rh_fac_evap * dq / qsw)) else factor = 1. endif sink = min (ql (k), factor * dq / (1. + tcp3 (k) * dqdt)) - if (cfg%use_rhc_cevap .and. rh_tem .ge. cfg%rhc_cevap) then + if (use_rhc_cevap .and. rh_tem .ge. rhc_cevap) then sink = 0. endif reevap = reevap + sink * dp (k) else - if (cfg%do_cond_timescale) then - factor = min (1., fac_v2l * (cfg%rh_fac_cond * (- dq) / qsw)) + if (do_cond_timescale) then + factor = min (1., fac_v2l * (rh_fac_cond * (- dq) / qsw)) else factor = 1. endif @@ -3974,9 +3995,9 @@ subroutine pwbf (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, i real :: tc, tin, sink, dqdt, qsw, qsi, qim, tmp, fac_wbf - if (.not. cfg%do_wbf) return + if (.not. do_wbf) return - fac_wbf = 1. - exp (- dts / cfg%tau_wbf) + fac_wbf = 1. - exp (- dts / tau_wbf) do k = ks, ke @@ -3990,7 +4011,7 @@ subroutine pwbf (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, i qv (k) .gt. qsi .and. qv (k) .lt. qsw) then sink = min (fac_wbf * ql (k), tc / icpk (k)) - qim = cfg%qi0_crt / den (k) + qim = qi0_crt / den (k) tmp = min (sink, dim (qim, qi (k))) call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & @@ -4042,8 +4063,8 @@ subroutine pbigg (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, ccn, l if (tc .gt. 0 .and. ql (k) .gt. qcmin) then - if (cfg%do_psd_water_num) then - call cal_pc_ed_oe_rr_tv (ql (k), den (k), cfg%blinw, cfg%muw, & + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & pca = pcaw, pcb = pcbw, pc = ccn (k)) ccn (k) = ccn (k) / den (k) endif @@ -4108,20 +4129,20 @@ subroutine pidep_pisub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d tmp = dq / (1. + tcpk (k) * dqdt) if (qi (k) .gt. qcmin) then - if (.not. cfg%prog_ccn) then - if (cfg%inflag .eq. 1) & + if (.not. prog_ccn) then + if (inflag .eq. 1) & cin (k) = 5.38e7 * exp (0.75 * log (qi (k) * den (k))) - if (cfg%inflag .eq. 2) & + if (inflag .eq. 2) & cin (k) = exp (- 2.80 + 0.262 * (tice - tz (k))) * 1000.0 - if (cfg%inflag .eq. 3) & + if (inflag .eq. 3) & cin (k) = exp (- 0.639 + 12.96 * (qv (k) / qsi - 1.0)) * 1000.0 - if (cfg%inflag .eq. 4) & + if (inflag .eq. 4) & cin (k) = 5.e-3 * exp (0.304 * (tice - tz (k))) * 1000.0 - if (cfg%inflag .eq. 5) & + if (inflag .eq. 5) & cin (k) = 1.e-5 * exp (0.5 * (tice - tz (k))) * 1000.0 endif - if (cfg%do_psd_ice_num) then - call cal_pc_ed_oe_rr_tv (qi (k), den (k), cfg%blini, cfg%mui, & + if (do_psd_ice_num) then + call cal_pc_ed_oe_rr_tv (qi (k), den (k), blini, mui, & pca = pcai, pcb = pcbi, pc = cin (k)) cin (k) = cin (k) / den (k) endif @@ -4133,18 +4154,18 @@ subroutine pidep_pisub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d if (dq .gt. 0.) then tc = tice - tz (k) !qi_gen = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tc))) - if (cfg%igflag .eq. 1) & - qi_crt = cfg%qi_gen / den (k) - if (cfg%igflag .eq. 2) & - qi_crt = cfg%qi_gen * min (cfg%qi_lim, 0.1 * tc) / den (k) - if (cfg%igflag .eq. 3) & - qi_crt = 1.82e-6 * min (cfg%qi_lim, 0.1 * tc) / den (k) - if (cfg%igflag .eq. 4) & - qi_crt = max (cfg%qi_gen, 1.82e-6) * min (cfg%qi_lim, 0.1 * tc) / den (k) + if (igflag .eq. 1) & + qi_crt = qi_gen / den (k) + if (igflag .eq. 2) & + qi_crt = qi_gen * min (qi_lim, 0.1 * tc) / den (k) + if (igflag .eq. 3) & + qi_crt = 1.82e-6 * min (qi_lim, 0.1 * tc) / den (k) + if (igflag .eq. 4) & + qi_crt = max (qi_gen, 1.82e-6) * min (qi_lim, 0.1 * tc) / den (k) sink = min (tmp, max (qi_crt - qi (k), pidep), tc / tcpk (k)) dep = dep + sink * dp (k) else - pidep = pidep * min (1., dim (tz (k), cfg%t_sub) * cfg%is_fac) + pidep = pidep * min (1., dim (tz (k), t_sub) * is_fac) sink = max (pidep, tmp, - qi (k)) sub = sub - sink * dp (k) endif @@ -4204,11 +4225,11 @@ subroutine psdep_pssub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d qden = qs (k) * den (k) t2 = tz (k) * tz (k) dq = qsi - qv (k) - pssub = psub (t2, dq, qden, qsi, cssub, den (k), denfac (k), cfg%blins, cfg%mus, tcpk (k), cvm (k)) + pssub = psub (t2, dq, qden, qsi, cssub, den (k), denfac (k), blins, mus, tcpk (k), cvm (k)) pssub = dts * pssub dq = dq / (1. + tcpk (k) * dqdt) if (pssub .gt. 0.) then - sink = min (pssub * min (1., dim (tz (k), cfg%t_sub) * cfg%ss_fac), qs (k)) + sink = min (pssub * min (1., dim (tz (k), t_sub) * ss_fac), qs (k)) sub = sub + sink * dp (k) else sink = 0. @@ -4273,17 +4294,17 @@ subroutine pgdep_pgsub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, d qden = qg (k) * den (k) t2 = tz (k) * tz (k) dq = qsi - qv (k) - if (cfg%do_hail) then + if (do_hail) then pgsub = psub (t2, dq, qden, qsi, cgsub, den (k), denfac (k), & - cfg%blinh, cfg%muh, tcpk (k), cvm (k)) + blinh, muh, tcpk (k), cvm (k)) else pgsub = psub (t2, dq, qden, qsi, cgsub, den (k), denfac (k), & - cfg%bling, cfg%mug, tcpk (k), cvm (k)) + bling, mug, tcpk (k), cvm (k)) endif pgsub = dts * pgsub dq = dq / (1. + tcpk (k) * dqdt) if (pgsub .gt. 0.) then - sink = min (pgsub * min (1., dim (tz (k), cfg%t_sub) * cfg%gs_fac), qg (k)) + sink = min (pgsub * min (1., dim (tz (k), t_sub) * gs_fac), qg (k)) sub = sub + sink * dp (k) else sink = 0. @@ -4353,16 +4374,16 @@ subroutine cloud_fraction (ks, ke, pz, den, qv, ql, qr, qi, qs, qg, qa, tz, h_va ice = q_sol (k) q_sol (k) = qi (k) - if (cfg%rad_snow) then + if (rad_snow) then q_sol (k) = qi (k) + qs (k) - if (cfg%rad_graupel) then + if (rad_graupel) then q_sol (k) = qi (k) + qs (k) + qg (k) endif endif liq = q_liq (k) q_liq (k) = ql (k) - if (cfg%rad_rain) then + if (rad_rain) then q_liq (k) = ql (k) + qr (k) endif @@ -4397,34 +4418,34 @@ subroutine cloud_fraction (ks, ke, pz, den, qv, ql, qr, qi, qs, qg, qa, tz, h_va rh = qpz / qstar if (cfflag .eq. 1) then - if (rh .gt. cfg%rh_thres .and. qpz .gt. qcmin) then + if (rh .gt. rh_thres .and. qpz .gt. qcmin) then dq = h_var * qpz - if (cfg%do_cld_adj) then - q_plus = qpz + dq * cfg%f_dq_p * min (1.0, max (0.0, (pz (k) - 200.e2) / & + if (do_cld_adj) then + q_plus = qpz + dq * f_dq_p * min (1.0, max (0.0, (pz (k) - 200.e2) / & (1000.e2 - 200.e2))) else - q_plus = qpz + dq * cfg%f_dq_p + q_plus = qpz + dq * f_dq_p endif - q_minus = qpz - dq * cfg%f_dq_m + q_minus = qpz - dq * f_dq_m - if (cfg%icloud_f .eq. 2) then + if (icloud_f .eq. 2) then if (qstar .lt. qpz) then qa (k) = 1. else qa (k) = 0. endif - elseif (cfg%icloud_f .eq. 3) then + elseif (icloud_f .eq. 3) then if (qstar .lt. qpz) then qa (k) = 1. else if (qstar .lt. q_plus) then - qa (k) = (q_plus - qstar) / (dq * cfg%f_dq_p) + qa (k) = (q_plus - qstar) / (dq * f_dq_p) else qa (k) = 0. endif if (q_cond (k) .gt. qcmin) then - qa (k) = max (cfg%cld_min, qa (k)) + qa (k) = max (cld_min, qa (k)) endif qa (k) = min (1., qa (k)) endif @@ -4433,17 +4454,17 @@ subroutine cloud_fraction (ks, ke, pz, den, qv, ql, qr, qi, qs, qg, qa, tz, h_va qa (k) = 1. else if (qstar .lt. q_plus) then - if (cfg%icloud_f .eq. 0) then - qa (k) = (q_plus - qstar) / (dq * cfg%f_dq_p + dq * cfg%f_dq_m) + if (icloud_f .eq. 0) then + qa (k) = (q_plus - qstar) / (dq * f_dq_p + dq * f_dq_m) else - qa (k) = (q_plus - qstar) / ((dq * cfg%f_dq_p + dq * cfg%f_dq_m) * & + qa (k) = (q_plus - qstar) / ((dq * f_dq_p + dq * f_dq_m) * & (1. - q_cond (k))) endif else qa (k) = 0. endif if (q_cond (k) .gt. qcmin) then - qa (k) = max (cfg%cld_min, qa (k)) + qa (k) = max (cld_min, qa (k)) endif qa (k) = min (1., qa (k)) endif @@ -4456,9 +4477,9 @@ subroutine cloud_fraction (ks, ke, pz, den, qv, ql, qr, qi, qs, qg, qa, tz, h_va if (cfflag .eq. 2) then if (rh .ge. 1.0) then qa (k) = 1.0 - elseif (rh .gt. cfg%rh_thres .and. q_cond (k) .gt. qcmin) then - qa (k) = exp (cfg%xr_a * log (rh)) * (1.0 - exp (- cfg%xr_b * max (0.0, q_cond (k)) / & - max (1.e-5, exp (cfg%xr_c * log (max (1.e-10, 1.0 - rh) * qstar))))) + elseif (rh .gt. rh_thres .and. q_cond (k) .gt. qcmin) then + qa (k) = exp (xr_a * log (rh)) * (1.0 - exp (- xr_b * max (0.0, q_cond (k)) / & + max (1.e-5, exp (xr_c * log (max (1.e-10, 1.0 - rh) * qstar))))) qa (k) = max (0.0, min (1., qa (k))) else qa (k) = 0.0 @@ -5141,9 +5162,9 @@ function acr3d (v1, v2, q1, q2, c, acco, acc1, acc2, den) t1 = exp (1. / (acc1 + 3) * log (6 * q1 * den)) t2 = exp (1. / (acc2 + 3) * log (6 * q2 * den)) - if (cfg%vdiffflag .eq. 1) vdiff = abs (v1 - v2) - if (cfg%vdiffflag .eq. 2) vdiff = sqrt ((1.20 * v1 - 0.95 * v2) ** 2. + 0.08 * v1 * v2) - if (cfg%vdiffflag .eq. 3) vdiff = sqrt ((1.00 * v1 - 1.00 * v2) ** 2. + 0.04 * v1 * v2) + if (vdiffflag .eq. 1) vdiff = abs (v1 - v2) + if (vdiffflag .eq. 2) vdiff = sqrt ((1.20 * v1 - 0.95 * v2) ** 2. + 0.08 * v1 * v2) + if (vdiffflag .eq. 3) vdiff = sqrt ((1.00 * v1 - 1.00 * v2) ** 2. + 0.04 * v1 * v2) acr3d = c * vdiff / den @@ -5434,7 +5455,7 @@ subroutine pgfr_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & real :: tc, sink, fac_r2g - fac_r2g = 1. - exp (- dts / cfg%tau_r2g) + fac_r2g = 1. - exp (- dts / tau_r2g) do k = ks, ke @@ -5487,7 +5508,7 @@ subroutine psmlt_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & real :: tc, tmp, sink, fac_smlt - fac_smlt = 1. - exp (- dts / cfg%tau_smlt) + fac_smlt = 1. - exp (- dts / tau_smlt) do k = ks, ke @@ -5497,7 +5518,7 @@ subroutine psmlt_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & sink = (tc * 0.1) ** 2 * qs (k) sink = min (qs (k), sink, fac_smlt * tc / icpk (k)) - tmp = min (sink, dim (cfg%qs_mlt, ql (k))) + tmp = min (sink, dim (qs_mlt, ql (k))) call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., tmp, sink - tmp, 0., - sink, 0., te8 (k), cvm (k), tz (k), & @@ -5537,15 +5558,15 @@ subroutine praut_simp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg) real :: tc, sink, fac_l2r - fac_l2r = 1. - exp (- dts / cfg%tau_l2r) + fac_l2r = 1. - exp (- dts / tau_l2r) do k = ks, ke tc = tz (k) - t_wfr - if (tc .gt. 0 .and. ql (k) .gt. cfg%ql0_max) then + if (tc .gt. 0 .and. ql (k) .gt. ql0_max) then - sink = fac_l2r * (ql (k) - cfg%ql0_max) + sink = fac_l2r * (ql (k) - ql0_max) call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & 0., - sink, sink, 0., 0., 0.) @@ -5586,13 +5607,13 @@ subroutine psaut_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den) real :: tc, sink, fac_i2s, qim - fac_i2s = 1. - exp (- dts / cfg%tau_i2s) + fac_i2s = 1. - exp (- dts / tau_i2s) do k = ks, ke tc = tz (k) - tice - qim = cfg%qi0_max / den (k) + qim = qi0_max / den (k) if (tc .lt. 0. .and. qi (k) .gt. qim) then @@ -5689,7 +5710,7 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, ! combine liquid and solid phases ! ----------------------------------------------------------------------- - if (cfg%liq_ice_combine) then + if (liq_ice_combine) then do i = is, ie do k = ks, ke qmw (i, k) = qmw (i, k) + qmr (i, k) @@ -5705,7 +5726,7 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, ! combine snow and graupel ! ----------------------------------------------------------------------- - if (cfg%snow_grauple_combine) then + if (snow_grauple_combine) then do i = is, ie do k = ks, ke qms (i, k) = qms (i, k) + qmg (i, k) @@ -5732,63 +5753,63 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, tc = t (i, k) - tice - if (cfg%rewflag .eq. 1) then + if (rewflag .eq. 1) then ! ----------------------------------------------------------------------- ! cloud water (Martin et al. 1994) ! ----------------------------------------------------------------------- - if (cfg%prog_ccn) then + if (prog_ccn) then ! boucher and lohmann (1995) ccnw = (1.0 - abs (mask - 1.0)) * & (10. ** 2.24 * (qa (i, k) * rho * 1.e9) ** 0.257) + & abs (mask - 1.0) * & (10. ** 2.06 * (qa (i, k) * rho * 1.e9) ** 0.48) else - ccnw = cfg%ccn_o * abs (mask - 1.0) + cfg%ccn_l * (1.0 - abs (mask - 1.0)) + ccnw = ccn_o * abs (mask - 1.0) + ccn_l * (1.0 - abs (mask - 1.0)) endif if (qmw (i, k) .gt. qcmin) then qcw (i, k) = dpg * qmw (i, k) * 1.0e3 rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * qmw (i, k) * rho) / & (4.0 * pi * rhow * ccnw))) * 1.0e4 - rew (i, k) = max (cfg%rewmin, min (cfg%rewmax, rew (i, k))) + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else qcw (i, k) = 0.0 - rew (i, k) = cfg%rewmin + rew (i, k) = rewmin endif endif - if (cfg%rewflag .eq. 2) then + if (rewflag .eq. 2) then ! ----------------------------------------------------------------------- ! cloud water (Martin et al. 1994, gfdl revision) ! ----------------------------------------------------------------------- - if (cfg%prog_ccn) then + if (prog_ccn) then ! boucher and lohmann (1995) ccnw = (1.0 - abs (mask - 1.0)) * & (10. ** 2.24 * (qa (i, k) * rho * 1.e9) ** 0.257) + & abs (mask - 1.0) * & (10. ** 2.06 * (qa (i, k) * rho * 1.e9) ** 0.48) else - ccnw = 1.077 * cfg%ccn_o * abs (mask - 1.0) + 1.143 * cfg%ccn_l * (1.0 - abs (mask - 1.0)) + ccnw = 1.077 * ccn_o * abs (mask - 1.0) + 1.143 * ccn_l * (1.0 - abs (mask - 1.0)) endif if (qmw (i, k) .gt. qcmin) then qcw (i, k) = dpg * qmw (i, k) * 1.0e3 rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * qmw (i, k) * rho) / & (4.0 * pi * rhow * ccnw))) * 1.0e4 - rew (i, k) = max (cfg%rewmin, min (cfg%rewmax, rew (i, k))) + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else qcw (i, k) = 0.0 - rew (i, k) = cfg%rewmin + rew (i, k) = rewmin endif endif - if (cfg%rewflag .eq. 3) then + if (rewflag .eq. 3) then ! ----------------------------------------------------------------------- ! cloud water (Kiehl et al. 1994) @@ -5801,15 +5822,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, (1.0 - abs (mask - 1.0)) rew (i, k) = rew (i, k) + (14.0 - rew (i, k)) * & min (1.0, max (0.0, snowd (i) / 1000.0)) ! snowd is in mm - rew (i, k) = max (cfg%rewmin, min (cfg%rewmax, rew (i, k))) + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else qcw (i, k) = 0.0 - rew (i, k) = cfg%rewmin + rew (i, k) = rewmin endif endif - if (cfg%rewflag .eq. 4) then + if (rewflag .eq. 4) then ! ----------------------------------------------------------------------- ! cloud water derived from PSD @@ -5817,18 +5838,18 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qmw (i, k) .gt. qcmin) then qcw (i, k) = dpg * qmw (i, k) * 1.0e3 - call cal_pc_ed_oe_rr_tv (qmw (i, k), rho, cfg%blinw, cfg%muw, & + call cal_pc_ed_oe_rr_tv (qmw (i, k), rho, blinw, muw, & eda = edaw, edb = edbw, ed = rew (i, k)) - rew (i, k) = cfg%rewfac * 0.5 * rew (i, k) * 1.0e6 - rew (i, k) = max (cfg%rewmin, min (cfg%rewmax, rew (i, k))) + rew (i, k) = rewfac * 0.5 * rew (i, k) * 1.0e6 + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else qcw (i, k) = 0.0 - rew (i, k) = cfg%rewmin + rew (i, k) = rewmin endif endif - if (cfg%reiflag .eq. 1) then + if (reiflag .eq. 1) then ! ----------------------------------------------------------------------- ! cloud ice (Heymsfield and Mcfarquhar 1996) @@ -5838,23 +5859,23 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei_fac = log (1.0e3 * qmi (i, k) * rho) if (tc .lt. - 50) then - rei (i, k) = cfg%beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 + rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 elseif (tc .lt. - 40) then - rei (i, k) = cfg%beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 + rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 elseif (tc .lt. - 30) then - rei (i, k) = cfg%beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 + rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 else - rei (i, k) = cfg%beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 + rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 endif - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 2) then + if (reiflag .eq. 2) then ! ----------------------------------------------------------------------- ! cloud ice (Donner et al. 1997) @@ -5879,15 +5900,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, else rei (i, k) = 92.46298 endif - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 3) then + if (reiflag .eq. 3) then ! ----------------------------------------------------------------------- ! cloud ice (Fu 2007) @@ -5896,15 +5917,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qmi (i, k) .gt. qcmin) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei (i, k) = 47.05 + tc * (0.6624 + 0.001741 * tc) - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 4) then + if (reiflag .eq. 4) then ! ----------------------------------------------------------------------- ! cloud ice (Kristjansson et al. 2000) @@ -5915,15 +5936,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, ind = min (max (int (t (i, k) - 136.0), 44), 138 - 1) cor = t (i, k) - int (t (i, k)) rei (i, k) = retab (ind) * (1. - cor) + retab (ind + 1) * cor - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 5) then + if (reiflag .eq. 5) then ! ----------------------------------------------------------------------- ! cloud ice (Wyser 1998) @@ -5934,15 +5955,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, bw = - 2. + 1.e-3 * log10 (rho * qmi (i, k) / 50.e-3) * & exp (1.5 * log (max (1.e-10, - tc))) rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 6) then + if (reiflag .eq. 6) then ! ----------------------------------------------------------------------- ! cloud ice (Sun and Rikus 1999, Sun 2001) @@ -5954,15 +5975,15 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, rei (i, k) = 45.8966 * exp (0.2214 * rei_fac) + & 0.7957 * exp (0.2535 * rei_fac) * (tc + 190.0) rei (i, k) = (1.2351 + 0.0105 * tc) * rei (i, k) - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%reiflag .eq. 7) then + if (reiflag .eq. 7) then ! ----------------------------------------------------------------------- ! cloud ice derived from PSD @@ -5970,18 +5991,18 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qmi (i, k) .gt. qcmin) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 - call cal_pc_ed_oe_rr_tv (qmi (i, k), rho, cfg%blini, cfg%mui, & + call cal_pc_ed_oe_rr_tv (qmi (i, k), rho, blini, mui, & eda = edai, edb = edbi, ed = rei (i, k)) - rei (i, k) = cfg%reifac * 0.5 * rei (i, k) * 1.0e6 - rei (i, k) = max (cfg%reimin, min (cfg%reimax, rei (i, k))) + rei (i, k) = reifac * 0.5 * rei (i, k) * 1.0e6 + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else qci (i, k) = 0.0 - rei (i, k) = cfg%reimin + rei (i, k) = reimin endif endif - if (cfg%rerflag .eq. 1) then + if (rerflag .eq. 1) then ! ----------------------------------------------------------------------- ! rain derived from PSD @@ -5989,18 +6010,18 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qmr (i, k) .gt. qcmin) then qcr (i, k) = dpg * qmr (i, k) * 1.0e3 - call cal_pc_ed_oe_rr_tv (qmr (i, k), rho, cfg%blinr, cfg%mur, & + call cal_pc_ed_oe_rr_tv (qmr (i, k), rho, blinr, mur, & eda = edar, edb = edbr, ed = rer (i, k)) rer (i, k) = 0.5 * rer (i, k) * 1.0e6 - rer (i, k) = max (cfg%rermin, min (cfg%rermax, rer (i, k))) + rer (i, k) = max (rermin, min (rermax, rer (i, k))) else qcr (i, k) = 0.0 - rer (i, k) = cfg%rermin + rer (i, k) = rermin endif endif - if (cfg%resflag .eq. 1) then + if (resflag .eq. 1) then ! ----------------------------------------------------------------------- ! snow derived from PSD @@ -6008,18 +6029,18 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qms (i, k) .gt. qcmin) then qcs (i, k) = dpg * qms (i, k) * 1.0e3 - call cal_pc_ed_oe_rr_tv (qms (i, k), rho, cfg%blins, cfg%mus, & + call cal_pc_ed_oe_rr_tv (qms (i, k), rho, blins, mus, & eda = edas, edb = edbs, ed = res (i, k)) res (i, k) = 0.5 * res (i, k) * 1.0e6 - res (i, k) = max (cfg%resmin, min (cfg%resmax, res (i, k))) + res (i, k) = max (resmin, min (resmax, res (i, k))) else qcs (i, k) = 0.0 - res (i, k) = cfg%resmin + res (i, k) = resmin endif endif - if (cfg%regflag .eq. 1) then + if (regflag .eq. 1) then ! ----------------------------------------------------------------------- ! graupel derived from PSD @@ -6027,18 +6048,18 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, if (qmg (i, k) .gt. qcmin) then qcg (i, k) = dpg * qmg (i, k) * 1.0e3 - if (cfg%do_hail) then - call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, cfg%blinh, cfg%muh, & + if (do_hail) then + call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, blinh, muh, & eda = edah, edb = edbh, ed = reg (i, k)) else - call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, cfg%bling, cfg%mug, & + call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, bling, mug, & eda = edag, edb = edbg, ed = reg (i, k)) endif reg (i, k) = 0.5 * reg (i, k) * 1.0e6 - reg (i, k) = max (cfg%regmin, min (cfg%regmax, reg (i, k))) + reg (i, k) = max (regmin, min (regmax, reg (i, k))) else qcg (i, k) = 0.0 - reg (i, k) = cfg%regmin + reg (i, k) = regmin endif endif @@ -6146,26 +6167,26 @@ subroutine rad_ref (is, ie, js, je, qv, qr, qs, qg, pt, delp, & ! fall speed ! ----------------------------------------------------------------------- - if (cfg%radr_flag .eq. 3) then - call term_rsg (1, npz, qmr, den, denfac, cfg%vr_fac, cfg%blinr, & - cfg%mur, tvar, tvbr, cfg%vr_max, cfg%const_vr, vtr) + if (radr_flag .eq. 3) then + call term_rsg (1, npz, qmr, den, denfac, vr_fac, blinr, & + mur, tvar, tvbr, vr_max, const_vr, vtr) vtr = vtr / rhor endif - if (cfg%rads_flag .eq. 3) then - call term_rsg (1, npz, qms, den, denfac, cfg%vs_fac, cfg%blins, & - cfg%mus, tvas, tvbs, cfg%vs_max, cfg%const_vs, vts) + if (rads_flag .eq. 3) then + call term_rsg (1, npz, qms, den, denfac, vs_fac, blins, & + mus, tvas, tvbs, vs_max, const_vs, vts) vts = vts / rhos endif - if (cfg%radg_flag .eq. 3) then - if (cfg%do_hail .and. .not. do_inline_mp) then - call term_rsg (1, npz, qmg, den, denfac, cfg%vg_fac, cfg%blinh, & - cfg%muh, tvah, tvbh, cfg%vg_max, cfg%const_vg, vtg) + if (radg_flag .eq. 3) then + if (do_hail .and. .not. do_inline_mp) then + call term_rsg (1, npz, qmg, den, denfac, vg_fac, blinh, & + muh, tvah, tvbh, vg_max, const_vg, vtg) vtg = vtg / rhoh else - call term_rsg (1, npz, qmg, den, denfac, cfg%vg_fac, cfg%bling, & - cfg%mug, tvag, tvbg, cfg%vg_max, cfg%const_vg, vtg) + call term_rsg (1, npz, qmg, den, denfac, vg_fac, bling, & + mug, tvag, tvbg, vg_max, const_vg, vtg) vtg = vtg / rhog endif endif @@ -6180,15 +6201,15 @@ subroutine rad_ref (is, ie, js, je, qv, qr, qs, qg, pt, delp, & !if (rainwat .gt. 0) then qden = den (k) * qmr (k) if (qmr (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qmr (k), den (k), cfg%blinr, cfg%mur, & + call cal_pc_ed_oe_rr_tv (qmr (k), den (k), blinr, mur, & rra = rrar, rrb = rrbr, rr = fac_r) else fac_r = 0.0 endif - if (cfg%radr_flag .eq. 1 .or. cfg%radr_flag .eq. 2) then + if (radr_flag .eq. 1 .or. radr_flag .eq. 2) then z_e = z_e + fac_r * 1.e18 endif - if (cfg%radr_flag .eq. 3) then + if (radr_flag .eq. 3) then z_e = z_e + mp_const * exp (1.6 * log (qden * vtr (k))) endif !endif @@ -6196,68 +6217,68 @@ subroutine rad_ref (is, ie, js, je, qv, qr, qs, qg, pt, delp, & !if (snowwat .gt. 0) then qden = den (k) * qms (k) if (qms (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qms (k), den (k), cfg%blins, cfg%mus, & + call cal_pc_ed_oe_rr_tv (qms (k), den (k), blins, mus, & rra = rras, rrb = rrbs, rr = fac_s) else fac_s = 0.0 endif - if (cfg%rads_flag .eq. 1) then + if (rads_flag .eq. 1) then if (pt (i, j, k) .lt. tice) then z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhor) ** 2 else z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhor) ** 2 / alpha endif endif - if (cfg%rads_flag .eq. 2) then + if (rads_flag .eq. 2) then if (pt (i, j, k) .lt. tice) then z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhoi) ** 2 else z_e = z_e + fac_s * 1.e18 endif endif - if (cfg%rads_flag .eq. 3) then + if (rads_flag .eq. 3) then z_e = z_e + mp_const * exp (1.6 * log (qden * vts (k))) endif !endif !if (graupel .gt. 0) then qden = den (k) * qmg (k) - if (cfg%do_hail .and. .not. do_inline_mp) then + if (do_hail .and. .not. do_inline_mp) then if (qmg (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qmg (k), den (k), cfg%blinh, cfg%muh, & + call cal_pc_ed_oe_rr_tv (qmg (k), den (k), blinh, muh, & rra = rrah, rrb = rrbh, rr = fac_g) else fac_g = 0.0 endif - if (cfg%radg_flag .eq. 1) then + if (radg_flag .eq. 1) then if (pt (i, j, k) .lt. tice) then z_e = z_e + fac_g * 1.e18 * alpha * (rhoh / rhor) ** 2 else z_e = z_e + fac_g * 1.e18 * alpha * (rhoh / rhor) ** 2 / alpha endif endif - if (cfg%radg_flag .eq. 2) then + if (radg_flag .eq. 2) then z_e = z_e + fac_g * 1.e18 endif else if (qmg (k) .gt. qcmin) then - call cal_pc_ed_oe_rr_tv (qmg (k), den (k), cfg%bling, cfg%mug, & + call cal_pc_ed_oe_rr_tv (qmg (k), den (k), bling, mug, & rra = rrag, rrb = rrbg, rr = fac_g) else fac_g = 0.0 endif - if (cfg%radg_flag .eq. 1) then + if (radg_flag .eq. 1) then if (pt (i, j, k) .lt. tice) then z_e = z_e + fac_g * 1.e18 * alpha * (rhog / rhor) ** 2 else z_e = z_e + fac_g * 1.e18 * alpha * (rhog / rhor) ** 2 / alpha endif endif - if (cfg%radg_flag .eq. 2) then + if (radg_flag .eq. 2) then z_e = z_e + fac_g * 1.e18 endif endif - if (cfg%radg_flag .eq. 3) then + if (radg_flag .eq. 3) then z_e = z_e + mp_const * exp (1.6 * log (qden * vtg (k))) endif !endif