diff --git a/bld/build-namelist b/bld/build-namelist index 63917171d1..893647cdde 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3073,6 +3073,20 @@ if ($cfg->get('microphys') =~ /^mg/) { add_default($nl, 'forestfileBR'); add_default($nl, 'forestfileBRwarm'); } + add_default($nl, 'rafwbf_on'); + if ($nl->get_value('rafwbf_on') =~ m/$TRUE/io) { + if ($nl->get_value('micro_mg_do_cldice') =~ m/$FALSE/io) { + # Generate an error since both of these variables would have to be + # set manually for this condition + die "$ProgName - Error: Cannot set rafwbf_on = .true. if micro_mg_do_cldice = .false.\n"; + } + if ( ! $nl->get_value('micro_mg_version') == '2') { + # Generate an error since both of these variables would have to be + # set manually for this condition + die "$ProgName - Error: Cannot set rafwbf_on = .true. if micro_mg_versuin /= 2\n"; + } + add_default($nl, 'forestfileWBF'); + } } # Ice nucleation options diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 2f8f0384bc..c6eb171846 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1275,6 +1275,11 @@ atm/cam/RaFSIP/forestBR.txt atm/cam/RaFSIP/forestBRwarm.txt + +.false. +atm/cam/RaFWBF/forestWBF_c260424.txt + + .true. .false. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index cb01ba7a90..1cf6bd8d34 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -2770,6 +2770,19 @@ Default: .true. Default: None + + + If .true., compute factor for Bergeron using random forests method. + Default: .false. + + + + ML parameters for Damman et al., in preparation to submission to ACP. + Default: None + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 514d5bada6..651ef57145 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -50,6 +50,16 @@ + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/cam/rafwbf/shell_commands b/cime_config/testdefs/testmods_dirs/cam/rafwbf/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/rafwbf/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_cam new file mode 100644 index 0000000000..343695eae8 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_cam @@ -0,0 +1,6 @@ +mfilt = 1,1,1,1,1,1 +ndens = 1,1,1,1,1,1 +nhtfrq = 9,9,9,9,9,9 +inithist = 'ENDOFRUN' +history_budget = .true. +rafwbf_on = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_clm new file mode 100644 index 0000000000..58c05c23c2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/rafwbf/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/src/NorESM/micro_mg2_0.F90 b/src/NorESM/micro_mg2_0.F90 index eacf43cab0..225c65b5de 100644 --- a/src/NorESM/micro_mg2_0.F90 +++ b/src/NorESM/micro_mg2_0.F90 @@ -146,6 +146,11 @@ module micro_mg2_0 use module_random_forests, only: max_nodes5, leftchild5, rightchild5, splitfeat5 use module_random_forests, only: thresh5, out51 +!RafWBF +use module_random_forests, only: rafwbf_on, jbtb, tupb, tlob +use module_random_forests, only: max_nodesb, leftchildb, rightchildb, splitfeatb +use module_random_forests, only: threshb, outb + implicit none private save @@ -254,7 +259,7 @@ subroutine micro_mg_init( & allow_sed_supersat_in, do_sb_physics_in, & nccons_in, nicons_in, ncnst_in, ninst_in, errstring) - use module_random_forests, only: sec_ice_init + use module_random_forests, only: sec_ice_init, wbf_init use micro_mg_utils, only: micro_mg_utils_init !----------------------------------------------------------------------- @@ -364,7 +369,10 @@ subroutine micro_mg_init( & ! RaFSIP: INITIALIZE THE RANDOM FOREST PARAMETERS call sec_ice_init() end if - + if (rafwbf_on) then + ! RaFWBF: INITIALIZE THE RANDOM FOREST PARAMETERS + call wbf_init() + end if end subroutine micro_mg_init @@ -373,7 +381,7 @@ end subroutine micro_mg_init subroutine micro_mg_tend ( & mgncol, nlev, deltatin, & - t, q, & + t, q, tsk, pblh, & qcn, qin, & ncn, nin, & qrn, qsn, & @@ -408,7 +416,7 @@ subroutine micro_mg_tend ( & qrsedten, qssedten, & pratot, prctot, & mnuccctot, mnuccttot, msacwitot, & - psacwstot, bergstot, bergtot, & + psacwstot, bergstot, bergtot, bergf, & melttot, homotot, & qcrestot, prcitot, praitot, & qirestot, mnuccrtot, pracstot, & @@ -471,7 +479,7 @@ subroutine micro_mg_tend ( & evaporate_sublimate_precip, & bergeron_process_snow - use module_random_forests, only: MDIM5, MDIM6 + use module_random_forests, only: MDIM5, MDIM6, MDIMB use module_random_forests, only: runforestmulti use module_random_forests, only: runforestriv use module_random_forests, only: runforest @@ -485,6 +493,8 @@ subroutine micro_mg_tend ( & real(r8), intent(in) :: deltatin ! time step (s) real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K) real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) + real(r8), intent(in) :: tsk(mgncol) ! input skin temperature for RaFWBF (K) + real(r8), intent(in) :: pblh(mgncol) ! input planetary boundary layer for RaFWBF (K) ! note: all input cloud variables are grid-averaged real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) @@ -519,6 +529,7 @@ subroutine micro_mg_tend ( & real(r8), intent(in) :: rndst(:,:,:) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) real(r8), intent(in) :: nacon(:,:,:) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) + ! output arguments real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for @@ -581,6 +592,7 @@ subroutine micro_mg_tend ( & real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice + real(r8), intent(out) :: bergf(mgncol,nlev) ! factor for bergeron process in RafWBF real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat @@ -928,6 +940,10 @@ subroutine micro_mg_tend ( & real(r8) :: FEATURES5(MDIM5),FEATURES6(MDIM6) real(r8) :: YPRED1,YPRED2,YPRED3,YPRED4,YPRED5 + ! RaFWBF variables: + real(r8) :: Pb, LWCb, IWCb, Tb, PBLHb, TSKb ! INPUT, dummy + real(r8) :: FEATURESB(MDIMB),YPREDB + real(r8) :: wbf_factor(mgncol,nlev) ! will be applied regardless if RafWBF is ON or OFF !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -1272,7 +1288,18 @@ subroutine micro_mg_tend ( & SIP_RATE=0._r8 QIRSIP=0._r8 QICSIP=0._r8 - + + ! RaFWBF zero vars + Pb = 0._r8 + LWCb = 0._r8 + IWCb = 0._r8 + Tb = 0._r8 + PBLHb = 0._r8 + TSKb = 0._r8 + FEATURESB(:) = 0._r8 + YPREDB = 0._r8 + wbf_factor(:,:) = 1._r8 ! this should default to 1 + bergf=1.0_r8 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -1725,11 +1752,36 @@ subroutine micro_mg_tend ( & qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & pre(:,k), prds(:,k), am_evp_st(:,k), mgncol) + ! RaFWBF parameterisattion: + if (rafwbf_on) then + do i = 1,mgncol + if (t(i,k) >= tlob .and. t(i,k) <= tupb) then + ! make inputs: + Pb = p(i,k) ! Pa + ! input contents are used to be consistent + ! with WRF data used to constract RF + LWCb = qcn(i,k) + qrn(i,k) !kg/kg + IWCb = qin(i,k) + qsn(i,k) !kg/kg + Tb = t(i,k) - 273.15_r8 ! DegC + PBLHb = pblh(i) !m + TSKb = tsk(i) - 273.15 ! DegC + FEATURESB =(/ Pb, LWCb, IWCb, Tb, PBLHb, TSKb /) + call runforest(MDIMB, MAX_NODESB, JBTB, FEATURESB, YPREDB, & + LEFTCHILDB, RIGHTCHILDB, SPLITFEATB, THRESHB, OUTB) + wbf_factor(i,k) = max(0.0_r8, min(1.0_r8,YPREDB)) + else + wbf_factor(i,k) = 1.0_r8 + end if + end do + else + wbf_factor(:,:) = 1.0_r8 + end if + call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & qvl(:,k), qvi(:,k), asn(:,k), qcic(1:mgncol,k), qsic(:,k), lams(:,k), n0s(:,k), & bergs(:,k), mgncol) - bergs(:,k)=bergs(:,k)*micro_mg_berg_eff_factor + bergs(:,k)=bergs(:,k)*micro_mg_berg_eff_factor * wbf_factor(:,k) !+++PMC 12/3/12 - NEW VAPOR DEP/SUBLIMATION GOES HERE!!! if (do_cldice) then @@ -1738,7 +1790,7 @@ subroutine micro_mg_tend ( & icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) - berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor + berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor * wbf_factor(:,k) where (ice_sublim(:,k) < 0._r8 .and. qi(:,k) > qsmall .and. icldm(:,k) > mincld) nsubi(:,k) = sublim_factor*ice_sublim(:,k) / qi(:,k) * ni(:,k) / icldm(:,k) @@ -2430,6 +2482,7 @@ subroutine micro_mg_tend ( & psacwstot(i,k) = psacws(i,k)*lcldm(i,k) bergstot(i,k) = bergs(i,k)*lcldm(i,k) bergtot(i,k) = berg(i,k) + bergf(i,k) = wbf_factor(i,k) prcitot(i,k) = prci(i,k)*icldm(i,k) praitot(i,k) = prai(i,k)*icldm(i,k) mnuccdtot(i,k) = mnuccd(i,k)*icldm(i,k) diff --git a/src/NorESM/micro_mg_cam.F90 b/src/NorESM/micro_mg_cam.F90 index dc82410c6f..812197f0a9 100644 --- a/src/NorESM/micro_mg_cam.F90 +++ b/src/NorESM/micro_mg_cam.F90 @@ -87,6 +87,7 @@ module micro_mg_cam use cam_history, only: addfld, add_default, outfld, horiz_only + use cam_logfile, only: iulog use cam_abortutils, only: endrun use scamMod, only: single_column @@ -258,7 +259,7 @@ subroutine micro_mg_cam_readnl(nlfile) use units, only: getunit, freeunit use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, & mpi_real8, mpi_logical, mpi_character - use module_random_forests, only: sec_ice_readnl + use module_random_forests, only: sec_ice_readnl, wbf_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -389,6 +390,8 @@ subroutine micro_mg_cam_readnl(nlfile) call sec_ice_readnl(nlfile) + call wbf_readnl(nlfile, micro_mg_version) + contains subroutine bad_version_endrun @@ -407,7 +410,6 @@ subroutine micro_mg_cam_register ! Register microphysics constituents and fields in the physics buffer. !----------------------------------------------------------------------- - logical :: prog_modal_aero logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics @@ -643,7 +645,7 @@ subroutine micro_mg_cam_init(pbuf2d) use micro_mg_utils, only: micro_mg_utils_init use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init use micro_mg2_0, only: micro_mg_init2_0 => micro_mg_init - + use module_random_forests, only: rafwbf_on !----------------------------------------------------------------------- ! ! Initialization for MG microphysics @@ -965,6 +967,9 @@ subroutine micro_mg_cam_init(pbuf2d) if (micro_mg_version > 1) then call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed' ) call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed' ) + if (rafwbf_on) then + call addfld ('BERGF', (/ 'lev' /), 'A', 'unitless', 'RaFWBF factor for bergeron' ) + end if end if ! qc limiter (only output in versions 1.5 and later) @@ -1057,6 +1062,9 @@ subroutine micro_mg_cam_init(pbuf2d) call add_default ('CMEIOUT ', budget_histfile, ' ') call add_default ('BERGSO ', budget_histfile, ' ') call add_default ('BERGO ', budget_histfile, ' ') + if (rafwbf_on) then + call add_default ('BERGF ', budget_histfile, ' ') + end if !AL call add_default ('NNUCCCO ', budget_histfile, ' ') call add_default ('NNUCCTO ', budget_histfile, ' ') @@ -1116,6 +1124,7 @@ subroutine micro_mg_cam_init(pbuf2d) call add_default(bpcnst (ixsnow), budget_histfile, ' ') end if + end if ! physics buffer indices @@ -1193,14 +1202,16 @@ end subroutine micro_mg_cam_init !=============================================================================== -subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) +subroutine micro_mg_cam_tend(state, ptend, dtime, tskin, pbuf) use micro_mg1_0, only: micro_mg_get_cols1_0 => micro_mg_get_cols use micro_mg2_0, only: micro_mg_get_cols2_0 => micro_mg_get_cols + use module_random_forests, only: rafwbf_on type(physics_state), intent(in) :: state type(physics_ptend), intent(out) :: ptend real(r8), intent(in) :: dtime + real(r8), intent(in) :: tskin(:) type(physics_buffer_desc), pointer :: pbuf(:) ! Local variables @@ -1221,11 +1232,11 @@ subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) mgncol, mgcols) end select - call micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) + call micro_mg_cam_tend_pack(state, ptend, dtime, tskin, pbuf, mgncol, mgcols, nlev) end subroutine micro_mg_cam_tend -subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) +subroutine micro_mg_cam_tend_pack(state, ptend, dtime,tskin, pbuf, mgncol, mgcols, nlev) use micro_mg_utils, only: size_dist_param_basic, size_dist_param_liq, & mg_liq_props, mg_ice_props, avg_diameter, rhoi, rhosn, rhow, rhows, & @@ -1240,10 +1251,12 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle use subcol, only: subcol_field_avg use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND use wv_saturation, only: qsat + use module_random_forests, only: rafwbf_on type(physics_state), intent(in) :: state type(physics_ptend), intent(out) :: ptend real(r8), intent(in) :: dtime + real(r8), intent(in) :: tskin(pcols) type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nlev @@ -1285,6 +1298,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation real(r8), pointer :: des(:,:) ! Snow effective diameter (m) + real(r8), pointer :: pblh(:) ! Planetary boundary layer height (m) for RaFWBF real(r8) :: rho(state%psetcols,pver) real(r8) :: cldmax(state%psetcols,pver) @@ -1336,6 +1350,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle real(r8), target :: psacwso(state%psetcols,pver) real(r8), target :: bergso(state%psetcols,pver) real(r8), target :: bergo(state%psetcols,pver) + real(r8), target :: bergf(state%psetcols,pver) real(r8), target :: melto(state%psetcols,pver) real(r8), target :: homoo(state%psetcols,pver) real(r8), target :: qcreso(state%psetcols,pver) @@ -1434,6 +1449,8 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle real(r8), allocatable :: packed_rndst(:,:,:) real(r8), allocatable :: packed_nacon(:,:,:) + real(r8) :: packed_tsk(mgncol) + real(r8) :: packed_pblh(mgncol) ! Optional outputs. real(r8) :: packed_tnd_qsnow(mgncol,nlev) @@ -1495,6 +1512,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle real(r8), target :: packed_psacws(mgncol,nlev) real(r8), target :: packed_bergs(mgncol,nlev) real(r8), target :: packed_berg(mgncol,nlev) + real(r8), target :: packed_bergf(mgncol,nlev) real(r8), target :: packed_melt(mgncol,nlev) real(r8), target :: packed_homo(mgncol,nlev) real(r8), target :: packed_qcres(mgncol,nlev) @@ -1751,6 +1769,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle real(r8) :: mnuccco_grid(pcols,pver) real(r8) :: mnuccto_grid(pcols,pver) real(r8) :: bergo_grid(pcols,pver) + real(r8) :: bergf_grid(pcols,pver) real(r8) :: homoo_grid(pcols,pver) real(r8) :: msacwio_grid(pcols,pver) real(r8) :: psacwso_grid(pcols,pver) @@ -1816,6 +1835,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle logical :: use_subcol_microp integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field + integer :: lpblh_idx ! local version of pblh index character(128) :: errstring ! return status (non-blank for error return) @@ -1853,6 +1873,8 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp) call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp) call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp) + lpblh_idx = pbuf_get_index('pblh') + call pbuf_get_field(pbuf, lpblh_idx, pblh, col_type=col_type, copy_if_needed=use_subcol_microp) call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & col_type=col_type, copy_if_needed=use_subcol_microp) @@ -2126,6 +2148,9 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle call post_proc%add_field(p(psacwso), p(packed_psacws)) call post_proc%add_field(p(bergso), p(packed_bergs)) call post_proc%add_field(p(bergo), p(packed_berg)) + if (rafwbf_on) then + call post_proc%add_field(p(bergf), p(packed_bergf)) + endif call post_proc%add_field(p(melto), p(packed_melt)) call post_proc%add_field(p(homoo), p(packed_homo)) call post_proc%add_field(p(qcreso), p(packed_qcres)) @@ -2257,6 +2282,11 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle packed_frzdep = packer%pack(frzdep) end if + if (micro_mg_version > 1) then + packed_tsk = packer%pack(tskin) + packed_pblh = packer%pack(pblh) + end if + do it = 1, num_steps ! Pack input variables that are updated during substeps. @@ -2266,6 +2296,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle packed_nc = packer%pack(state_loc%q(:,:,ixnumliq)) packed_qi = packer%pack(state_loc%q(:,:,ixcldice)) packed_ni = packer%pack(state_loc%q(:,:,ixnumice)) + if (micro_mg_version > 1) then packed_qr = packer%pack(state_loc%q(:,:,ixrain)) packed_nr = packer%pack(state_loc%q(:,:,ixnumrain)) @@ -2321,6 +2352,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle call micro_mg_tend2_0( & mgncol, nlev, dtime/num_steps,& packed_t, packed_q, & + packed_tsk, packed_pblh, & packed_qc, packed_qi, & packed_nc, packed_ni, & packed_qr, packed_qs, & @@ -2356,7 +2388,7 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle packed_pra, packed_prc, & packed_mnuccc, packed_mnucct, packed_msacwi, & packed_psacws, packed_bergs, packed_berg, & - packed_melt, packed_homo, & + packed_bergf, packed_melt, packed_homo, & packed_qcres, packed_prci, packed_prai, & packed_qires, packed_mnuccr, packed_pracs, & packed_meltsdt, packed_frzrdt, packed_mnuccd, & @@ -2616,6 +2648,9 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid) call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid) call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid) + if (rafwbf_on) then + call subcol_field_avg(bergf, ngrdcol, lchnk, bergf_grid) + end if call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid) call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid) call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid) @@ -2682,6 +2717,9 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle mnuccco_grid = mnuccco mnuccto_grid = mnuccto bergo_grid = bergo + if (rafwbf_on) then + bergf_grid = bergf + end if homoo_grid = homoo msacwio_grid = msacwio psacwso_grid = psacwso @@ -3331,6 +3369,9 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle call outfld('PSACWSO', psacwso_grid, pcols, lchnk) call outfld('BERGSO', bergso_grid, pcols, lchnk) call outfld('BERGO', bergo_grid, pcols, lchnk) + if (rafwbf_on) then + call outfld('BERGF', bergf_grid, pcols, lchnk) + end if call outfld('MELTO', melto_grid, pcols, lchnk) call outfld('HOMOO', homoo_grid, pcols, lchnk) call outfld('PRCIO', prcio_grid, pcols, lchnk) diff --git a/src/NorESM/module_random_forests.F90 b/src/NorESM/module_random_forests.F90 index 917d6ad647..03ef3625f2 100644 --- a/src/NorESM/module_random_forests.F90 +++ b/src/NorESM/module_random_forests.F90 @@ -1,14 +1,17 @@ -!PG RaFSIP PARAMETERS +!PG RaFSIP and RafWBF PARAMETERS !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !This MODULE holds the subroutines which are used to initialize all + !built random forest regressors. + +!For both RafSIP and RafWBF parameteriztions + +!Routines with postfix 'wbf' and vars with 'b' are related to RafWBF.+ !This MODULE CONTAINS the following routines: + ! *forestbrhm + ! *forestbr + ! *forestall + ! *forestbrds + ! *forestbrwarm + +! *forestwbf + !Each subroutine opens, reads and stores the parameters of all 4 + !random forest regressors. The initial .txt files are first + !converted into binary files so that the processing is faster. + @@ -19,6 +22,7 @@ ! *runforest + ! *runforestriv + ! *runforestmulti + +!RafWBF uses *runforest routine + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ module module_random_forests @@ -30,7 +34,9 @@ module module_random_forests PRIVATE PUBLIC :: sec_ice_readnl + PUBLIC :: wbf_readnl PUBLIC :: sec_ice_init + PUBLIC :: wbf_init PUBLIC :: runforest PUBLIC :: runforestriv @@ -38,15 +44,20 @@ module module_random_forests !!MDIM DEFINES THE NUMBER OF FEATURES/INPUTS TO THE RaFSIP PARAMETERIZATION INTEGER, PARAMETER, PUBLIC :: MDIM5=5 - INTEGER, PARAMETER, PUBLIC :: MDIM6=6 + INTEGER, PARAMETER, PUBLIC :: MDIM6=6 INTEGER, PARAMETER, PUBLIC :: JBT=10 !!The number of trees in each random forest regressor + !! NUMBER OF FEATURES/INPUTS TO THE RaFWBF PARAMETERIZATION + INTEGER, PARAMETER, PUBLIC :: MDIMB=6 ! for WBF + INTEGER, PARAMETER, PUBLIC :: JBTB=10 !!The number of trees in each random forest regressor + !!The maximum number of nodes across trees INTEGER, PARAMETER, PUBLIC :: MAX_NODES1=7705 !forestBRHM INTEGER, PARAMETER, PUBLIC :: MAX_NODES2=8219 !forestBR INTEGER, PARAMETER, PUBLIC :: MAX_NODES3=7833 !forestALL INTEGER, PARAMETER, PUBLIC :: MAX_NODES4=7093 !forestBRDS INTEGER, PARAMETER, PUBLIC :: MAX_NODES5=8593 !forestBRwarm + INTEGER, PARAMETER, PUBLIC :: MAX_NODESB=124209 !forestWBF !!Thresh = threshold value at each internal node !!Outi = prediction for a given node @@ -55,6 +66,7 @@ module module_random_forests REAL(r8), DIMENSION(JBT,MAX_NODES3), PUBLIC :: THRESH3,OUT31,OUT32,OUT33,OUT34,OUT35 REAL(r8), DIMENSION(JBT,MAX_NODES4), PUBLIC :: THRESH4,OUT41,OUT42,OUT43 REAL(r8), DIMENSION(JBT,MAX_NODES5), PUBLIC :: THRESH5,OUT51 + REAL(r8), DIMENSION(JBTB,MAX_NODESB), PUBLIC :: THRESHB,OUTB !!Splitfeat = feature used for splitting the node !!Leftchild = left child of node @@ -64,21 +76,30 @@ module module_random_forests INTEGER, DIMENSION(JBT,MAX_NODES3), PUBLIC, PROTECTED :: SPLITFEAT3,LEFTCHILD3,RIGHTCHILD3 INTEGER, DIMENSION(JBT,MAX_NODES4), PUBLIC, PROTECTED :: SPLITFEAT4,LEFTCHILD4,RIGHTCHILD4 INTEGER, DIMENSION(JBT,MAX_NODES5), PUBLIC, PROTECTED :: SPLITFEAT5,LEFTCHILD5,RIGHTCHILD5 + INTEGER, DIMENSION(JBTB,MAX_NODESB), PUBLIC, PROTECTED :: SPLITFEATB,LEFTCHILDB,RIGHTCHILDB !!The exact number of nodes across in consecutive trees of the forest - INTEGER, DIMENSION(JBT), PUBLIC, PROTECTED :: NRNODES1,NRNODES2,NRNODES3,NRNODES4,NRNODES5 + INTEGER, DIMENSION(JBT), PUBLIC, PROTECTED :: NRNODES1,NRNODES2,NRNODES3,NRNODES4,NRNODES5 + INTEGER, DIMENSION(JBTB), PUBLIC, PROTECTED :: NRNODESB + + ! RAFWBF specific parameters + REAL(r8), PUBLIC, PARAMETER :: TUPB = 273.15 ! Upper bound for temperature for running RF [K] + REAL(r8), PUBLIC, PARAMETER :: TLOB = 238.15 ! Lower bound for temperature for running RF [K] !! Namelist variables logical, public, protected :: rafsip_on = .false. + logical, public, protected :: rafwbf_on = .false. character(len=256) :: forestfileALL = 'NONE' character(len=256) :: forestfileBRDS = 'NONE' character(len=256) :: forestfileBRHM = 'NONE' character(len=256) :: forestfileBR = 'NONE' character(len=256) :: forestfileBRwarm = 'NONE' + character(len=256) :: forestfileWBF = 'NONE' !! Make sure init is only called once logical :: rafsip_initialized = .false. + logical :: rafwbf_initialized = .false. CONTAINS @@ -155,6 +176,58 @@ end subroutine sec_ice_readnl !------------------------------------------------------------------------+ + subroutine wbf_readnl(nlfile, mg_ver) + ! Read files needed for random forest tables of wbf factor + + use mpi, only: mpi_character, mpi_logical + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom + use namelist_utils, only: find_group_name + use cam_logfile, only: iulog + + character(len=*), intent(in) :: nlfile ! path to file containing namelist input + integer, intent(in) :: mg_ver + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'wbf_readnl' + + namelist /wbf_nl/ rafwbf_on, forestfileWBF + + ! Initialize all namelist variables + rafwbf_on = .false. + forestfileWBF = 'None' + if (mg_ver>1) then + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'wbf_nl', status=ierr) + if (ierr == 0) then + read(unitn, wbf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//':: ERROR reading namelist') + end if + end if + close(unitn) + end if + else + call endrun(subname//':: ERROR rafwbf_on = .true. is incompatible with micro_mg_version=1') + endif + + call MPI_Bcast(rafwbf_on, 1, mpi_logical, mstrid, mpicom, ierr) + + call MPI_Bcast(forestfileWBF, len(forestfileWBF), mpi_character, & + mstrid, mpicom, ierr) + + if (masterproc) then + write(iulog ,*) 'Microphysics WBF factor namelist:' + write(iulog ,*) ' rafwbf_on = ', rafwbf_on + if (rafsip_on) then + write(iulog, *) ' forestfileWBF = ', trim(forestfileWBF) + end if + end if + end subroutine wbf_readnl + + !------------------------------------------------------------------------+ + subroutine sec_ice_init() use mpi, only: mpi_integer, mpi_real8 use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom @@ -320,6 +393,58 @@ end subroutine sec_ice_init !------------------------------------------------------------------------+ + subroutine wbf_init() + use mpi, only: mpi_integer, mpi_real8 + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom + + integer :: j_ind, n_ind + integer :: unitn + integer :: ierr + character(len=*), parameter :: subname = 'wbf_init' + + if (.not. rafwbf_initialized) then + !--------------------------------------------------------------------- + ! RaFWBF: INITIALIZE THE RANDOM FOREST PARAMETERS + ! Initialize on the root processor, then broadcast + !--------------------------------------------------------------------- + + if (masterproc) then + ! Initialize forestBRHM parameters + ! Initialize forestALL parameters + open(newunit=unitn, file=trim(forestfileWBF), status="old", & + action="read") + do j_ind = 1, JBTB + read(unitn, *) nrnodesb(j_ind) + read(unitn, *) (leftchildb(j_ind, n_ind), & + rightchildb(j_ind, n_ind), & + outb(j_ind, n_ind), threshb(j_ind, n_ind), & + splitfeatb(j_ind, n_ind), n_ind=1,nrnodesb(j_ind)) + end do + + close(unitn) + if (any(SPLITFEATB<-1)) then + call endrun(subname//':: ERROR tree has split feature index invalid') + end if + end if ! masterproc + + ! Broadcast + call MPI_Bcast(nrnodesb, JBTB, mpi_integer, & + mstrid, mpicom, ierr) + call MPI_Bcast(leftchildb, JBTB*MAX_NODESB, mpi_integer, & + mstrid, mpicom, ierr) + call MPI_Bcast(rightchildb, JBTB*MAX_NODESB, mpi_integer, & + mstrid, mpicom, ierr) + call MPI_Bcast(outb, JBTB*MAX_NODESB, mpi_real8, & + mstrid, mpicom, ierr) + call MPI_Bcast(splitfeatb, JBTB*MAX_NODESB, mpi_integer, & + mstrid, mpicom, ierr) + + rafwbf_initialized = .true. + end if + + end subroutine wbf_init + !------------------------------------------------------------------------+ + !======================================================================+ ! THREE SUBROUTINES CALLED BY THE RaFSIP PARAMETERIZATION ! !======================================================================+ diff --git a/src/NorESM/physpkg.F90 b/src/NorESM/physpkg.F90 index 053e29d8b1..e6a2871f00 100644 --- a/src/NorESM/physpkg.F90 +++ b/src/NorESM/physpkg.F90 @@ -2206,7 +2206,7 @@ subroutine tphysbc (ztodt, state, & call t_startf('microp_tend') if (use_subcol_microp) then - call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) + call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, cam_in%ts, pbuf) ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend) @@ -2230,7 +2230,7 @@ subroutine tphysbc (ztodt, state, & call physics_tend_dealloc(tend_sc) call physics_ptend_dealloc(ptend_sc) else - call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + call microp_driver_tend(state, ptend, cld_macmic_ztodt, cam_in%ts, pbuf) end if ! combine aero and micro tendencies for the grid call physics_ptend_sum(ptend_aero, ptend, ncol) diff --git a/src/physics/cam/micro_mg_cam.F90 b/src/physics/cam/micro_mg_cam.F90 index d36978ac29..4a0dc6b358 100644 --- a/src/physics/cam/micro_mg_cam.F90 +++ b/src/physics/cam/micro_mg_cam.F90 @@ -1085,7 +1085,7 @@ end subroutine micro_mg_cam_init !=============================================================================== -subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) +subroutine micro_mg_cam_tend(state, ptend, dtime, tskin, pbuf) use micro_mg1_0, only: micro_mg_get_cols1_0 => micro_mg_get_cols use micro_mg2_0, only: micro_mg_get_cols2_0 => micro_mg_get_cols @@ -1093,6 +1093,8 @@ subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) type(physics_state), intent(in) :: state type(physics_ptend), intent(out) :: ptend real(r8), intent(in) :: dtime + real(r8), intent(in) :: tskin(:) ! dummy here, only used in NorESM + type(physics_buffer_desc), pointer :: pbuf(:) ! Local variables diff --git a/src/physics/cam/microp_driver.F90 b/src/physics/cam/microp_driver.F90 index 00e18f8364..aaa57c450f 100644 --- a/src/physics/cam/microp_driver.F90 +++ b/src/physics/cam/microp_driver.F90 @@ -159,14 +159,15 @@ end subroutine microp_driver_init !=============================================================================== -subroutine microp_driver_tend(state, ptend, dtime, pbuf) +subroutine microp_driver_tend(state, ptend, dtime, tskin, pbuf) ! Call the microphysics parameterization run methods. - + use camsrfexch, only: cam_in_t ! Input arguments type(physics_state), intent(in) :: state ! State variables type(physics_ptend), intent(out) :: ptend ! Package tendencies + real(r8), intent(in) :: tskin(:) ! Radiative surface temperature type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: dtime ! Timestep @@ -186,7 +187,7 @@ subroutine microp_driver_tend(state, ptend, dtime, pbuf) select case (microp_scheme) case ('MG') call t_startf('microp_mg_tend') - call micro_mg_cam_tend(state, ptend, dtime, pbuf) + call micro_mg_cam_tend(state, ptend, dtime, tskin, pbuf) call t_stopf('microp_mg_tend') case ('RK') ! microp_driver doesn't handle this one diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 842f57c34b..0308f15865 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -2137,7 +2137,7 @@ subroutine tphysbc (ztodt, state, & call t_startf('microp_tend') if (use_subcol_microp) then - call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) + call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, cam_in%ts, pbuf) ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend) @@ -2161,7 +2161,7 @@ subroutine tphysbc (ztodt, state, & call physics_tend_dealloc(tend_sc) call physics_ptend_dealloc(ptend_sc) else - call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + call microp_driver_tend(state, ptend, cld_macmic_ztodt, cam_in%ts, pbuf) end if ! combine aero and micro tendencies for the grid call physics_ptend_sum(ptend_aero, ptend, ncol)