From 29085aa5c9e93caca392fabe7cbb2efca785ea05 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Mon, 27 Mar 2023 10:47:21 -0400 Subject: [PATCH] Smoke, dust, and MYNN updates (#635) * MYNN update * "merge RRFS-SD from the GSL repo to the Community repo" * "include MYNN-EDMF updates from PR #630" Co-authored-by: joeolson42 Co-authored-by: Haiqin.Li --- ccpp/config/ccpp_prebuild_config.py | 5 +- ccpp/data/GFS_typedefs.F90 | 203 ++++++----- ccpp/data/GFS_typedefs.meta | 255 +++++++------ ccpp/driver/GFS_diagnostics.F90 | 53 +-- ccpp/driver/GFS_restart.F90 | 73 ++++ ccpp/framework | 2 +- ccpp/physics | 2 +- ...moke.xml => suite_FV3_GFS_v17_p8_mynn.xml} | 43 ++- ccpp/suites/suite_FV3_HRRR.xml | 2 + io/FV3GFS_io.F90 | 343 +++++++++++++++--- 10 files changed, 713 insertions(+), 268 deletions(-) rename ccpp/suites/{suite_FV3_HRRR_smoke.xml => suite_FV3_GFS_v17_p8_mynn.xml} (69%) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index e178f473e..65273ed69 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -188,9 +188,8 @@ # HAFS FER_HIRES 'physics/physics/mp_fer_hires.F90', # SMOKE - 'physics/smoke/rrfs_smoke_wrapper.F90', - 'physics/smoke/rrfs_smoke_postpbl.F90', - 'physics/smoke/rrfs_smoke_lsdep_wrapper.F90', + 'physics/physics/smoke_dust/rrfs_smoke_wrapper.F90', + 'physics/physics/smoke_dust/rrfs_smoke_postpbl.F90', # RRTMGP 'physics/physics/rrtmgp_aerosol_optics.F90', 'physics/physics/rrtmgp_lw_main.F90', diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 149c35f52..f5059271b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -233,7 +233,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics real (kind=kind_phys), pointer :: dust12m_in (:,:,:) => null() !< fengsha dust input real (kind=kind_phys), pointer :: emi_in (:,:) => null() !< anthropogenic background input - real (kind=kind_phys), pointer :: smoke_GBBEPx(:,:,:) => null() !< GBBEPx fire input + real (kind=kind_phys), pointer :: smoke_RRFS(:,:,:) => null() !< RRFS fire input real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m real (kind=kind_phys), pointer :: semisbase(:) => null() !< background surface emissivity real (kind=kind_phys), pointer :: sfalb_lnd (:) => null() !< surface albedo over land for LSM @@ -403,6 +403,23 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dsnowprv (:) => null() !< snow precipitation rate from previous timestep real (kind=kind_phys), pointer :: dgraupelprv(:) => null() !< graupel precipitation rate from previous timestep + !--- aerosol surface emissions for Thompson microphysics & smoke dust + real (kind=kind_phys), pointer :: emdust (:) => null() !< instantaneous dust emission + real (kind=kind_phys), pointer :: emseas (:) => null() !< instantaneous sea salt emission + real (kind=kind_phys), pointer :: emanoc (:) => null() !< instantaneous anthro. oc emission + + !--- Smoke. These 3 arrays are hourly, so their dimension is imx24 (output is hourly) + real (kind=kind_phys), pointer :: ebb_smoke_hr(:) => null() !< hourly smoke emission + real (kind=kind_phys), pointer :: frp_hr (:) => null() !< hourly FRP + real (kind=kind_phys), pointer :: frp_std_hr (:) => null() !< hourly std. FRP + + !--- For fire diurnal cycle + real (kind=kind_phys), pointer :: fhist (:) => null() !< instantaneous fire coef_bb + real (kind=kind_phys), pointer :: coef_bb_dc (:) => null() !< instantaneous fire coef_bb + + !--- For smoke and dust auxiliary inputs + real (kind=kind_phys), pointer :: fire_in (:,:) => null() !< fire auxiliary inputs + contains procedure :: create => sfcprop_create !< allocate array data end type GFS_sfcprop_type @@ -544,26 +561,16 @@ module GFS_typedefs real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source real (kind=kind_phys), pointer :: nifa2d (:) => null() !< instantaneous ice-friendly sfc aerosol source - !--- aerosol surface emissions for Thompson microphysics & smoke - real (kind=kind_phys), pointer :: emdust (:) => null() !< instantaneous dust emission - real (kind=kind_phys), pointer :: emseas (:) => null() !< instantaneous sea salt emission - real (kind=kind_phys), pointer :: emanoc (:) => null() !< instantaneous anthro. oc emission - - !--- These 3 arrays are hourly, so their dimension is imx24 (output is hourly) - real (kind=kind_phys), pointer :: ebb_smoke_hr(:) => null() !< hourly smoke emission - real (kind=kind_phys), pointer :: frp_hr (:) => null() !< hourly FRP - real (kind=kind_phys), pointer :: frp_std_hr (:) => null() !< hourly std. FRP - !--- For fire diurnal cycle - real (kind=kind_phys), pointer :: fhist (:) => null() !< instantaneous fire coef_bb - real (kind=kind_phys), pointer :: coef_bb_dc (:) => null() !< instantaneous fire coef_bb real (kind=kind_phys), pointer :: ebu_smoke (:,:) => null() !< 3D ebu array !--- For smoke and dust optical extinction real (kind=kind_phys), pointer :: smoke_ext (:,:) => null() !< 3D aod array real (kind=kind_phys), pointer :: dust_ext (:,:) => null() !< 3D aod array + !--- For MYNN PBL transport of smoke and dust real (kind=kind_phys), pointer :: chem3d (:,:,:) => null() !< 3D aod array + real (kind=kind_phys), pointer :: ddvel (:,: ) => null() !< 2D dry deposition velocity !--- Fire plume rise diagnostics real (kind=kind_phys), pointer :: min_fplume (:) => null() !< minimum plume rise level @@ -581,9 +588,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tmf (:,:) => null() !< tmf to be passed from turublence scheme to convection real (kind=kind_phys), pointer :: dqdt_qmicro(:,:) => null() !< instantanious microphysics tendency to be passed from MP to convection - !--- instantaneous total moisture tendency for smoke coupling: - real (kind=kind_phys), pointer :: dqdti (:,:) => null() !< rrfs_smoke=true only; instantaneous total moisture tendency (kg/kg/s) - contains procedure :: create => coupling_create !< allocate array data end type GFS_coupling_type @@ -668,6 +672,8 @@ module GFS_typedefs integer, pointer :: blksz(:) !< for explicit data blocking: block sizes of all blocks integer :: ncols !< total number of columns for all blocks + integer :: fire_aux_data_levels !< vertical levels of fire auxiliary data + !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplice !< default no cplice collection (used together with cplflx) @@ -677,8 +683,7 @@ module GFS_typedefs logical :: cplaqm !< default no cplaqm collection logical :: cplchm !< default no cplchm collection logical :: cpllnd !< default no cpllnd collection - logical :: rrfs_smoke !< default no rrfs_smoke collection - integer :: dust_smoke_rrtmg_band_number !< band number to affect in rrtmg_pre from smoke and dust + logical :: rrfs_sd !< default no rrfs_sd collection logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model logical :: cpl_imp_mrg !< default no merge import with internal forcings logical :: cpl_imp_dbg !< default no write import data to file post merge @@ -1113,7 +1118,7 @@ module GFS_typedefs logical :: do_mynnedmf logical :: do_mynnsfclay ! DH* TODO - move this to MYNN namelist section - logical :: bl_mynn_tkebudget !< flag for activating TKE budget + integer :: tke_budget !< flag for activating TKE budget logical :: bl_mynn_tkeadvect !< activate computation of TKE advection (not yet in use for FV3) integer :: bl_mynn_cloudpdf !< flag to determine which cloud PDF to use integer :: bl_mynn_mixlength !< flag for different version of mixing length formulation @@ -1340,8 +1345,9 @@ module GFS_typedefs integer :: ntia !< tracer index for ice friendly aerosol integer :: ntsmoke !< tracer index for smoke integer :: ntdust !< tracer index for dust - integer :: nchem !< number of prognostic chemical species (vertically mixied) - integer :: ndvel !< number of prognostic chemical species (which are deposited, usually =nchem) + integer :: ntcoarsepm !< tracer index for coarse PM + integer :: nchem = 3 !< number of prognostic chemical species (vertically mixied) + integer :: ndvel = 3 !< number of prognostic chemical species (which are deposited, usually =nchem) integer :: ntchm !< number of prognostic chemical tracers (advected) integer :: ntchs !< tracer index for first prognostic chemical tracer integer :: ntche !< tracer index for last prognostic chemical tracer @@ -1395,21 +1401,25 @@ module GFS_typedefs integer :: npsdelt !< the index of surface air pressure at the previous timestep for Z-C MP in phy_f2d integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d -!-- chem nml variables for RRFS-Smoke +!-- nml variables for RRFS-SD + real(kind=kind_phys) :: dust_alpha !< alpha parameter for fengsha dust scheme + real(kind=kind_phys) :: dust_gamma !< gamma parameter for fengsha dust scheme + real(kind=kind_phys) :: wetdep_ls_alpha !< alpha parameter for wet deposition integer :: seas_opt integer :: dust_opt - integer :: biomass_burn_opt integer :: drydep_opt + integer :: coarsepm_settling integer :: wetdep_ls_opt logical :: do_plumerise integer :: addsmoke_flag integer :: plumerisefire_frq - logical :: smoke_forecast - logical :: aero_ind_fdb ! WFA/IFA indirect - logical :: aero_dir_fdb ! smoke/dust direct + integer :: smoke_forecast + logical :: aero_ind_fdb ! WFA/IFA indirect + logical :: aero_dir_fdb ! smoke/dust direct logical :: rrfs_smoke_debug logical :: mix_chem - logical :: fire_turb + logical :: enh_mix + real(kind=kind_phys) :: smoke_dir_fdb_coef(7) !< smoke & dust direct feedbck coefficents !--- debug flags logical :: debug @@ -1678,6 +1688,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: coszen(:) => null() !< mean cos of zenith angle over rad call period real (kind=kind_phys), pointer :: tsflw (:) => null() !< surface air temp during lw calculation in k real (kind=kind_phys), pointer :: semis (:) => null() !< surface lw emissivity in fraction + real (kind=kind_phys), pointer :: ext550 (:,:) => null() !< aerosol optical extinction from radiation !--- In/Out (???) (radiaition only) real (kind=kind_phys), pointer :: coszdg(:) => null() !< daytime mean cosz over rad call period @@ -2151,7 +2162,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%weasdi (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) allocate (Sfcprop%dust12m_in (IM,12,5)) - allocate (Sfcprop%smoke_GBBEPx(IM,24,3)) + allocate (Sfcprop%smoke_RRFS(IM,24,3)) allocate (Sfcprop%emi_in (IM,1)) allocate(Sfcprop%albdirvis_lnd (IM)) allocate(Sfcprop%albdirnir_lnd (IM)) @@ -2185,7 +2196,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%hprime = clear_val Sfcprop%dust12m_in= clear_val Sfcprop%emi_in = clear_val - Sfcprop%smoke_GBBEPx = clear_val + Sfcprop%smoke_RRFS= clear_val Sfcprop%albdirvis_lnd = clear_val Sfcprop%albdirnir_lnd = clear_val Sfcprop%albdifvis_lnd = clear_val @@ -2533,6 +2544,30 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%conv_act_m = zero end if + if(Model%rrfs_sd) then + !--- needed for smoke aerosol option + allocate (Sfcprop%emdust (IM)) + allocate (Sfcprop%emseas (IM)) + allocate (Sfcprop%emanoc (IM)) + allocate (Sfcprop%ebb_smoke_hr (IM)) + allocate (Sfcprop%frp_hr (IM)) + allocate (Sfcprop%frp_std_hr(IM)) + allocate (Sfcprop%fhist (IM)) + allocate (Sfcprop%coef_bb_dc(IM)) + allocate (Sfcprop%fire_in (IM,Model%fire_aux_data_levels)) + + ! IMPORTANT: This initialization must match rrfs_sd_fill_data + Sfcprop%emdust = clear_val + Sfcprop%emseas = clear_val + Sfcprop%emanoc = clear_val + Sfcprop%ebb_smoke_hr = clear_val + Sfcprop%frp_hr = clear_val + Sfcprop%frp_std_hr = clear_val + Sfcprop%fhist = 1. + Sfcprop%coef_bb_dc = clear_val + Sfcprop%fire_in = clear_val + endif + end subroutine sfcprop_create @@ -2776,7 +2811,7 @@ subroutine coupling_create (Coupling, IM, Model) endif ! -- Aerosols coupling options - if (Model%cplchm .or. Model%rrfs_smoke) then + if (Model%cplchm) then !--- outgoing instantaneous quantities allocate (Coupling%ushfsfci (IM)) ! -- instantaneous 3d fluxes of nonconvective ice and liquid precipitations @@ -2787,7 +2822,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%pfl_lsan = clear_val endif - if (Model%cplchm .or. Model%rrfs_smoke .or. Model%cplflx .or. Model%cpllnd) then + if (Model%cplchm .or. Model%cplflx .or. Model%cpllnd) then !--- accumulated convective rainfall allocate (Coupling%rainc_cpl (IM)) Coupling%rainc_cpl = clear_val @@ -2867,40 +2902,24 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%nifa2d = clear_val endif - if(Model%rrfs_smoke) then + if(Model%rrfs_sd) then !--- needed for smoke aerosol option - allocate (Coupling%emdust (IM)) - allocate (Coupling%emseas (IM)) - allocate (Coupling%emanoc (IM)) - allocate (Coupling%ebb_smoke_hr (IM)) - allocate (Coupling%frp_hr (IM)) - allocate (Coupling%frp_std_hr(IM)) - allocate (Coupling%fhist (IM)) - allocate (Coupling%coef_bb_dc(IM)) allocate (Coupling%ebu_smoke (IM,Model%levs)) allocate (Coupling%smoke_ext (IM,Model%levs)) allocate (Coupling%dust_ext (IM,Model%levs)) - allocate (Coupling%chem3d (IM,Model%levs,2)) + allocate (Coupling%chem3d (IM,Model%levs,Model%nchem)) + allocate (Coupling%ddvel (IM,Model%ndvel)) allocate (Coupling%min_fplume(IM)) allocate (Coupling%max_fplume(IM)) allocate (Coupling%rrfs_hwp (IM)) - allocate (Coupling%dqdti (IM,Model%levs)) - Coupling%emdust = clear_val - Coupling%emseas = clear_val - Coupling%emanoc = clear_val - Coupling%ebb_smoke_hr = clear_val - Coupling%frp_hr = clear_val - Coupling%frp_std_hr = clear_val - Coupling%fhist = 1. - Coupling%coef_bb_dc = clear_val Coupling%ebu_smoke = clear_val Coupling%smoke_ext = clear_val Coupling%dust_ext = clear_val Coupling%chem3d = clear_val + Coupling%ddvel = clear_val Coupling%min_fplume = clear_val Coupling%max_fplume = clear_val Coupling%rrfs_hwp = clear_val - Coupling%dqdti = clear_val endif if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then @@ -3002,8 +3021,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: cplaqm = .false. !< default no cplaqm collection logical :: cplchm = .false. !< default no cplchm collection logical :: cpllnd = .false. !< default no cpllnd collection - logical :: rrfs_smoke = .false. !< default no rrfs_smoke collection - integer :: dust_smoke_rrtmg_band_number = 10!< band number to affect in rrtmg_pre from smoke and dust + logical :: rrfs_sd = .false. !< default no rrfs_sd collection logical :: use_cice_alb = .false. !< default no cice albedo logical :: cpl_imp_mrg = .false. !< default no merge import with internal forcings logical :: cpl_imp_dbg = .false. !< default no write import data to file post merge @@ -3336,7 +3354,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: do_mynnedmf = .false. !< flag for MYNN-EDMF logical :: do_mynnsfclay = .false. !< flag for MYNN Surface Layer Scheme ! DH* TODO - move to MYNN namelist section - logical :: bl_mynn_tkebudget = .false. + integer :: tke_budget = 0 logical :: bl_mynn_tkeadvect = .false. integer :: bl_mynn_cloudpdf = 2 integer :: bl_mynn_mixlength = 1 @@ -3539,21 +3557,25 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: spp_gwd = 0 logical :: do_spp = .false. -!-- chem nml variables for RRFS-Smoke +!-- chem nml variables for RRFS-SD + real(kind=kind_phys) :: dust_alpha = 0. + real(kind=kind_phys) :: dust_gamma = 0. + real(kind=kind_phys) :: wetdep_ls_alpha = 0. integer :: seas_opt = 2 integer :: dust_opt = 5 - integer :: biomass_burn_opt = 1 integer :: drydep_opt = 1 + integer :: coarsepm_settling = 1 integer :: wetdep_ls_opt = 1 logical :: do_plumerise = .false. integer :: addsmoke_flag = 1 integer :: plumerisefire_frq = 60 - logical :: smoke_forecast = .false. ! RRFS-smoke diurnal - logical :: aero_ind_fdb = .false. ! RRFS-smoke wfa/ifa emission - logical :: aero_dir_fdb = .false. ! RRFS-smoke smoke/dust radiation feedback - logical :: rrfs_smoke_debug = .false. ! RRFS-smoke plumerise debug + integer :: smoke_forecast = 0 ! RRFS-sd read in ebb_smoke + logical :: aero_ind_fdb = .false. ! RRFS-sd wfa/ifa emission + logical :: aero_dir_fdb = .false. ! RRFS-sd smoke/dust radiation feedback + logical :: rrfs_smoke_debug = .false. ! RRFS-sd plumerise debug logical :: mix_chem = .false. ! tracer mixing option by MYNN PBL - logical :: fire_turb = .false. ! enh vertmix option by MYNN PBL + logical :: enh_mix = .false. ! enhance vertmix option by MYNN PBL + real(kind=kind_phys) :: smoke_dir_fdb_coef(7) =(/ 0.33, 0.67, 0.02, 0.13, 0.85, 0.05, 0.95 /) !< smoke & dust direct feedbck coefficents !-- Lightning threat index logical :: lightning_threat = .false. @@ -3575,8 +3597,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & thermodyn_id, sfcpress_id, & !--- coupling parameters cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & - cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, & - use_cice_alb, dust_smoke_rrtmg_band_number, & + cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_sd, & + use_cice_alb, & #ifdef IDEA_PHYS lsidea, weimer_model, f107_kp_size, f107_kp_interval, & f107_kp_skip_size, f107_kp_data_size, f107_kp_read_in_start, & @@ -3637,7 +3659,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & bl_mynn_cloudpdf, bl_mynn_edmf, bl_mynn_edmf_mom, & bl_mynn_edmf_tke, bl_mynn_mixlength, bl_mynn_cloudmix, & bl_mynn_mixqt, bl_mynn_output, icloud_bl, bl_mynn_tkeadvect, & - bl_mynn_closure, bl_mynn_tkebudget, & + bl_mynn_closure, tke_budget, & isftcflx, iz0tlnd, sfclay_compute_flux, sfclay_compute_diag, & ! *DH gwd_opt, do_ugwp_v0, do_ugwp_v0_orog_only, & @@ -3695,11 +3717,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & phys_version, & !--- aerosol scavenging factors ('name:value' string array) fscav_aero, & - !--- RRFS smoke namelist - seas_opt, dust_opt, biomass_burn_opt, drydep_opt, & + !--- RRFS-SD namelist + dust_alpha, dust_gamma, wetdep_ls_alpha, & + seas_opt, dust_opt, drydep_opt, coarsepm_settling, & wetdep_ls_opt, smoke_forecast, aero_ind_fdb, aero_dir_fdb, & rrfs_smoke_debug, do_plumerise, plumerisefire_frq, & - addsmoke_flag, fire_turb, mix_chem, & + addsmoke_flag, enh_mix, mix_chem, smoke_dir_fdb_coef, & !--- (DFI) time ranges with radar-prescribed microphysics tendencies ! and (maybe) convection suppression fh_dfi_radar, radar_tten_limits, do_cap_suppress, & @@ -3910,13 +3933,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cpl_imp_dbg = cpl_imp_dbg Model%use_med_flux = use_med_flux -!--- RRFS Smoke - Model%rrfs_smoke = rrfs_smoke - Model%dust_smoke_rrtmg_band_number = dust_smoke_rrtmg_band_number +!--- RRFS-SD + Model%rrfs_sd = rrfs_sd + Model%dust_alpha = dust_alpha + Model%dust_gamma = dust_gamma + Model%wetdep_ls_alpha = wetdep_ls_alpha Model%seas_opt = seas_opt Model%dust_opt = dust_opt - Model%biomass_burn_opt = biomass_burn_opt Model%drydep_opt = drydep_opt + Model%coarsepm_settling = coarsepm_settling Model%wetdep_ls_opt = wetdep_ls_opt Model%do_plumerise = do_plumerise Model%plumerisefire_frq = plumerisefire_frq @@ -3926,7 +3951,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%aero_dir_fdb = aero_dir_fdb Model%rrfs_smoke_debug = rrfs_smoke_debug Model%mix_chem = mix_chem - Model%fire_turb = fire_turb + Model%enh_mix = enh_mix + Model%smoke_dir_fdb_coef = smoke_dir_fdb_coef + + Model%fire_aux_data_levels = 10 !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea @@ -4455,7 +4483,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%bl_mynn_output = bl_mynn_output Model%bl_mynn_tkeadvect = bl_mynn_tkeadvect Model%bl_mynn_closure = bl_mynn_closure - Model%bl_mynn_tkebudget = bl_mynn_tkebudget + Model%tke_budget = tke_budget Model%icloud_bl = icloud_bl Model%isftcflx = isftcflx Model%iz0tlnd = iz0tlnd @@ -4672,8 +4700,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug) Model%ntwa = get_tracer_index(Model%tracer_names, 'liq_aero', Model%me, Model%master, Model%debug) Model%ntia = get_tracer_index(Model%tracer_names, 'ice_aero', Model%me, Model%master, Model%debug) + if (Model%rrfs_sd) then Model%ntsmoke = get_tracer_index(Model%tracer_names, 'smoke', Model%me, Model%master, Model%debug) Model%ntdust = get_tracer_index(Model%tracer_names, 'dust', Model%me, Model%master, Model%debug) + Model%ntcoarsepm = get_tracer_index(Model%tracer_names, 'coarsepm', Model%me, Model%master, Model%debug) + endif !--- initialize parameters for atmospheric chemistry tracers call Model%init_chemistry(tracer_types) @@ -5779,9 +5810,9 @@ subroutine control_chemistry_initialize(Model, tracer_types) Model%ndchs = NO_TRACER Model%ndche = NO_TRACER - if (Model%rrfs_smoke) then - Model%nchem = 2 - Model%ndvel = 2 + if (Model%rrfs_sd) then + Model%nchem = 3 + Model%ndvel = 3 endif do n = 1, size(tracer_types) @@ -5917,19 +5948,21 @@ subroutine control_print(Model) print *, ' cplaqm : ', Model%cplaqm print *, ' cplchm : ', Model%cplchm print *, ' cpllnd : ', Model%cpllnd - print *, ' rrfs_smoke : ', Model%rrfs_smoke + print *, ' rrfs_sd : ', Model%rrfs_sd print *, ' use_cice_alb : ', Model%use_cice_alb print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg print *, ' use_med_flux : ', Model%use_med_flux - if(model%rrfs_smoke) then + if(model%rrfs_sd) then print *, ' ' print *, 'smoke parameters' - print *, 'dust_smoke_rrtmg_band_number : ',Model%dust_smoke_rrtmg_band_number + print *, 'dust_alpha : ',Model%dust_alpha + print *, 'dust_gamma : ',Model%dust_gamma + print *, 'wetdep_ls_alpha : ',Model%wetdep_ls_alpha print *, 'seas_opt : ',Model%seas_opt print *, 'dust_opt : ',Model%dust_opt - print *, 'biomass_burn_opt : ',Model%biomass_burn_opt print *, 'drydep_opt : ',Model%drydep_opt + print *, 'coarsepm_settling: ',Model%coarsepm_settling print *, 'wetdep_ls_opt : ',Model%wetdep_ls_opt print *, 'do_plumerise : ',Model%do_plumerise print *, 'plumerisefire_frq: ',Model%plumerisefire_frq @@ -5939,7 +5972,8 @@ subroutine control_print(Model) print *, 'aero_dir_fdb : ',Model%aero_dir_fdb print *, 'rrfs_smoke_debug : ',Model%rrfs_smoke_debug print *, 'mix_chem : ',Model%mix_chem - print *, 'fire_turb : ',Model%fire_turb + print *, 'enh_mix : ',Model%enh_mix + print *, 'smoke_dir_fdb_coef : ',Model%smoke_dir_fdb_coef endif print *, ' ' print *, ' lsidea : ', Model%lsidea @@ -6349,6 +6383,7 @@ subroutine control_print(Model) print *, ' ntia : ', Model%ntia print *, ' ntsmoke : ', Model%ntsmoke print *, ' ntdust : ', Model%ntdust + print *, ' ntcoarsepm : ', Model%ntcoarsepm print *, ' nchem : ', Model%nchem print *, ' ndvel : ', Model%ndvel print *, ' ntchm : ', Model%ntchm @@ -6730,6 +6765,7 @@ subroutine radtend_create (Radtend, IM, Model) allocate (Radtend%coszen (IM)) allocate (Radtend%tsflw (IM)) allocate (Radtend%semis (IM)) + allocate (Radtend%ext550 (IM,Model%levs)) Radtend%htrsw = clear_val Radtend%htrlw = clear_val @@ -6737,6 +6773,7 @@ subroutine radtend_create (Radtend, IM, Model) Radtend%coszen = clear_val Radtend%tsflw = clear_val Radtend%semis = clear_val + Radtend%ext550 = clear_val !--- In/Out (???) (radiation only) allocate (Radtend%coszdg (IM)) @@ -7231,7 +7268,7 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%det_thl (IM,Model%levs)) allocate (Diag%det_sqv (IM,Model%levs)) endif - if (Model%bl_mynn_tkebudget) then + if (Model%tke_budget .gt. 0) then allocate (Diag%dqke (IM,Model%levs)) allocate (Diag%qwt (IM,Model%levs)) allocate (Diag%qshear (IM,Model%levs)) @@ -7255,7 +7292,7 @@ subroutine diag_create (Diag, IM, Model) Diag%det_thl = clear_val Diag%det_sqv = clear_val endif - if (Model%bl_mynn_tkebudget) then + if (Model%tke_budget .gt. 0) then Diag%dqke = clear_val Diag%qwt = clear_val Diag%qshear = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index b71c86f09..9dfbf378f 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -769,9 +769,9 @@ type = real kind = kind_phys active = (do_smoke_coupling) -[smoke_GBBEPx] - standard_name = emission_smoke_GBBEPx - long_name = emission fire GBBEPx +[smoke_RRFS] + standard_name = emission_smoke_RRFS + long_name = emission fire RRFS units = various dimensions = (horizontal_dimension,24,3) type = real @@ -1868,6 +1868,78 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[emdust] + standard_name = emission_of_dust_for_smoke + long_name = emission of dust for smoke + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[emseas] + standard_name = emission_of_sea_salt_for_mp_indir_fdb + long_name = emission of sea salt for mp indirect feedabck + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[emanoc] + standard_name = emission_of_anothropogenic_for_mp_indir_fdb + long_name = emission of anothropogenic for mp indirect feedabck + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[ebb_smoke_hr] + standard_name = surface_smoke_emission + long_name = emission of surface smoke + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[frp_hr] + standard_name = frp_hourly + long_name = hourly fire radiative power + units = MW + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[frp_std_hr] + standard_name = frp_std_hourly + long_name = hourly stdandard deviation of fire radiative power + units = MW + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[fhist] + standard_name = fire_hist + long_name = coefficient to scale the fire activity depending on the fire duration + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[coef_bb_dc] + standard_name = coef_bb_dc + long_name = coef to estimate the fire emission + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[fire_in] + standard_name = smoke_fire_auxiliary_input + long_name = smoke fire auxiliary input variables + units = various + dimensions = (horizontal_loop_extent,fire_auxiliary_data_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) ######################################################################## [ccpp-table-properties] @@ -2504,14 +2576,6 @@ type = real kind = kind_phys active = (control_for_stochastic_land_surface_perturbation /= 0) -[dqdti] - standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection - long_name = instantaneous moisture tendency due to convection - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (do_smoke_coupling) [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous water-friendly sfc aerosol source @@ -2528,70 +2592,6 @@ type = real kind = kind_phys active = (control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) -[emdust] - standard_name = emission_of_dust_for_smoke - long_name = emission of dust for smoke - units = ug m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[emseas] - standard_name = emission_of_seas_for_smoke - long_name = emission of seas for smoke - units = ug m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[emanoc] - standard_name = emission_of_anoc_for_thompson_mp - long_name = emission of anoc for thompson mp - units = ug m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[ebb_smoke_hr] - standard_name = surface_smoke_emission - long_name = emission of surface smoke - units = ug m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[frp_hr] - standard_name = frp_hourly - long_name = hourly fire radiative power - units = MW - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[frp_std_hr] - standard_name = frp_std_hourly - long_name = hourly stdandard deviation of fire radiative power - units = MW - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[fhist] - standard_name = fire_hist - long_name = coefficient to scale the fire activity depending on the fire duration - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) -[coef_bb_dc] - standard_name = coef_bb_dc - long_name = coef to estimate the fire emission - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) [ebu_smoke] standard_name = ebu_smoke long_name = buffer of vertical fire emission @@ -2620,7 +2620,15 @@ standard_name = chem3d_mynn_pbl_transport long_name = mynn pbl transport of smoke and dust units = various - dimensions = (horizontal_loop_extent,vertical_layer_dimension,2) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[ddvel] + standard_name = dry_deposition_velocity_mynn_pbl_transport + long_name = dry deposition velocity by mynn pbl transport + units = m s-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_deposited) type = real kind = kind_phys active = (do_smoke_coupling) @@ -3010,18 +3018,12 @@ units = flag dimensions = () type = logical -[rrfs_smoke] +[rrfs_sd] standard_name = do_smoke_coupling - long_name = flag controlling rrfs_smoke collection (default off) + long_name = flag controlling rrfs_sd collection (default off) units = flag dimensions = () type = logical -[dust_smoke_rrtmg_band_number] - standard_name = index_of_shortwave_band_affected_by_smoke - long_name = rrtmg band number that smoke and dust should affect - units = count - dimensions = () - type = integer [cpl_imp_mrg] standard_name = flag_for_merging_imported_data long_name = flag controlling cpl_imp_mrg for imported data (default off) @@ -5680,6 +5682,12 @@ units = index dimensions = () type = integer +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer [nchem] standard_name = number_of_chemical_species_vertically_mixed long_name = number of chemical vertically mixed @@ -5886,13 +5894,45 @@ dimensions = () type = logical active = (do_smoke_coupling) -[fire_turb] +[enh_mix] standard_name = do_planetary_boundary_layer_fire_enhancement long_name = flag for rrfs smoke mynn enh vermix units = flag dimensions = () type = logical active = (do_smoke_coupling) +[smoke_dir_fdb_coef] + standard_name = smoke_dust_direct_fdb_coef + long_name = smoke dust direct feedback coefficents + units = none + dimensions = (7) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_alpha] + standard_name = alpha_fengsha_dust_scheme + long_name = alpha paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_gamma] + standard_name = gamma_fengsha_dust_scheme + long_name = gamma paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[wetdep_ls_alpha] + standard_name = alpha_for_ls_wet_depoistion + long_name = alpha paramter for ls wet deposition + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) [seas_opt] standard_name = control_for_smoke_sea_salt long_name = rrfs smoke sea salt emission option @@ -5907,16 +5947,16 @@ dimensions = () type = integer active = (do_smoke_coupling) -[biomass_burn_opt] - standard_name = control_for_smoke_biomass_burn - long_name = rrfs smoke biomass burning option +[drydep_opt] + standard_name = control_for_smoke_dry_deposition + long_name = rrfs smoke dry deposition option units = index dimensions = () type = integer active = (do_smoke_coupling) -[drydep_opt] - standard_name = control_for_smoke_dry_deposition - long_name = rrfs smoke dry deposition option +[coarsepm_settling] + standard_name = control_for_smoke_coarsepm_settling + long_name = rrfs smoke coarsepm settling option units = index dimensions = () type = integer @@ -5951,10 +5991,10 @@ active = (do_smoke_coupling) [smoke_forecast] standard_name = do_smoke_forecast - long_name = flag for rrfs smoke forecast - units = flag + long_name = index for rrfs smoke forecast + units = index dimensions = () - type = logical + type = integer active = (do_smoke_coupling) [aero_ind_fdb] standard_name = do_smoke_aerosol_indirect_feedback @@ -6330,12 +6370,12 @@ units = flag dimensions = () type = logical -[bl_mynn_tkebudget] +[tke_budget] standard_name = control_for_tke_budget_output long_name = flag for activating TKE budget units = flag dimensions = () - type = logical + type = integer [bl_mynn_tkeadvect] standard_name = flag_for_tke_advection long_name = flag for activating TKE advection @@ -6555,6 +6595,12 @@ units = flag dimensions = () type = logical +[fire_aux_data_levels] + standard_name = fire_auxiliary_data_extent + long_name = number of levels of fire auxiliary data + units = count + dimensions = () + type = integer ######################################################################## [ccpp-table-properties] @@ -7435,6 +7481,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[ext550] + standard_name = aerosol_optical_depth_at_550nm + long_name = 3d optical extinction for total aerosol species + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys [swhc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep long_name = clear sky sw heating rates @@ -8386,7 +8439,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) [qwt] standard_name = tke_tendency_due_to_vertical_transport long_name = tke tendency due to vertical transport and diffusion @@ -8394,7 +8447,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) [qshear] standard_name = tke_tendency_due_to_shear long_name = tke tendency due to shear @@ -8402,7 +8455,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) [qbuoy] standard_name = tke_tendency_due_to_buoyancy long_name = tke tendency due to buoyancy production or consumption @@ -8410,7 +8463,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) [qdiss] standard_name = tke_tendency_due_to_dissipation long_name = tke tendency due to the dissipation of tke @@ -8418,7 +8471,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) [nupdraft] standard_name = number_of_plumes long_name = number of plumes per grid column diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index fdefbd657..5d693296e 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -1863,20 +1863,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af totgrp,idx=',idx -!--- RRFS Smoke --- - if (Model%rrfs_smoke) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'dqdti' - ExtDiag(idx)%desc = 'dqdti' - ExtDiag(idx)%unit = 'kg kg-1 s-1' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dqdti(:,:) - enddo - endif - !--- physics instantaneous diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4082,16 +4068,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo end if thompson_extended_diagnostics - if (Model%rrfs_smoke .and. Model%ntsmoke>0) then + if (Model%rrfs_sd .and. Model%ntsmoke>0) then idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'emdust' - ExtDiag(idx)%desc = 'emission of dust for smoke' + ExtDiag(idx)%desc = 'emission of fine dust for smoke' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emdust + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%emdust enddo idx = idx + 1 @@ -4102,7 +4088,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emseas + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%emseas enddo idx = idx + 1 @@ -4113,7 +4099,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emanoc + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%emanoc enddo idx = idx + 1 @@ -4124,7 +4110,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%coef_bb_dc + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%coef_bb_dc enddo idx = idx + 1 @@ -4168,7 +4154,18 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ebb_smoke_hr + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%ebb_smoke_hr + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'fhist' + ExtDiag(idx)%desc = 'coefficient to scale the fire activity depending on the fire duration' + ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%ebb_smoke_hr enddo idx = idx + 1 @@ -4179,7 +4176,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%frp_hr + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frp_hr enddo idx = idx + 1 @@ -4190,7 +4187,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%frp_std_hr + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frp_std_hr enddo idx = idx + 1 @@ -4226,6 +4223,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dust_ext(:,:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'ext550' + ExtDiag(idx)%desc = '3d total extinction at 550nm' + ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Radtend(nb)%ext550(:,:) + enddo endif do i=1,Model%num_dfi_radar diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index c3930d752..8863eba49 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -133,6 +133,9 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & if (Model%do_cap_suppress .and. Model%num_dfi_radar>0) then Restart%num2d = Restart%num2d + Model%num_dfi_radar endif + if (Model%rrfs_sd) then + Restart%num2d = Restart%num2d + 5 + endif Restart%num3d = Model%ntot3d if (Model%num_dfi_radar>0) then @@ -153,6 +156,9 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & if (Model%do_mynnedmf) then Restart%num3d = Restart%num3d + 9 endif + if (Model%rrfs_sd) then + Restart%num3d = Restart%num3d + 7 + endif !Prognostic area fraction if (Model%progsigma) then Restart%num3d = Restart%num3d + 2 @@ -428,6 +434,35 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif + ! RRFS-SD + if (Model%rrfs_sd) then + num = num + 1 + Restart%name2d(num) = 'ddvel_1' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Coupling(nb)%ddvel(:,1) + enddo + num = num + 1 + Restart%name2d(num) = 'ddvel_2' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Coupling(nb)%ddvel(:,2) + enddo + num = num + 1 + Restart%name2d(num) = 'min_fplume' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Coupling(nb)%min_fplume(:) + enddo + num = num + 1 + Restart%name2d(num) = 'max_fplume' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Coupling(nb)%max_fplume(:) + enddo + num = num + 1 + Restart%name2d(num) = 'rrfs_hwp' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Coupling(nb)%rrfs_hwp(:) + enddo + endif + !--- phy_f3d variables do num = 1,Model%ntot3d !--- set the variable name @@ -560,6 +595,44 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif + if(Model%rrfs_sd) then + num = num + 1 + Restart%name3d(num) = 'ebu_smoke' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%ebu_smoke(:,:) + enddo + num = num + 1 + Restart%name3d(num) = 'smoke_ext' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%smoke_ext(:,:) + enddo + num = num + 1 + Restart%name3d(num) = 'dust_ext' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%dust_ext(:,:) + enddo + num = num + 1 + Restart%name3d(num) = 'chem3d_1' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%chem3d(:,:,1) + enddo + num = num + 1 + Restart%name3d(num) = 'chem3d_2' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%chem3d(:,:,2) + enddo + num = num + 1 + Restart%name3d(num) = 'chem3d_3' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%chem3d(:,:,3) + enddo + num = num + 1 + Restart%name3d(num) = 'ext550' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Radtend(nb)%ext550(:,:) + enddo + endif + end subroutine GFS_restart_populate end module GFS_restart diff --git a/ccpp/framework b/ccpp/framework index 60295ad35..1b6352fb2 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 60295ad3578ca01b5ca4214b91dd13bb790fbdfe +Subproject commit 1b6352fb24f053b738bde72eed0ddf0b60ec7c0f diff --git a/ccpp/physics b/ccpp/physics index 03acf7335..6f06ad9e6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 03acf7335ee2966c6d7c83ffa35ec9a5fa7f6d20 +Subproject commit 6f06ad9e60db3c590b3de390e2904051e6ed6da7 diff --git a/ccpp/suites/suite_FV3_HRRR_smoke.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml similarity index 69% rename from ccpp/suites/suite_FV3_HRRR_smoke.xml rename to ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml index e3f51c14d..f77c71cc5 100644 --- a/ccpp/suites/suite_FV3_HRRR_smoke.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml @@ -1,6 +1,6 @@ - + @@ -40,10 +40,13 @@ - mynnsfc_wrapper + sfc_diff GFS_surface_loop_control_part1 - lsm_ruc - flake_driver + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice GFS_surface_loop_control_part2 @@ -52,31 +55,43 @@ sfc_diag sfc_diag_post GFS_surface_generic_post - rrfs_smoke_wrapper + + + mynnedmf_wrapper - rrfs_smoke_postpbl GFS_GWD_generic_pre - drag_suite + unified_ugwp + unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + + + GFS_suite_interstitial_4 + cnvc90 GFS_MP_generic_pre mp_thompson_pre - mp_thompson - mp_thompson_post - GFS_MP_generic_post - maximum_hourly_diagnostics - rrfs_smoke_lsdep_wrapper - phys_tend - + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index a4c5b7dbc..01c493d5a 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -52,7 +52,9 @@ sfc_diag sfc_diag_post GFS_surface_generic_post + rrfs_smoke_wrapper mynnedmf_wrapper + rrfs_smoke_postpbl GFS_GWD_generic_pre drag_suite GFS_GWD_generic_post diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 6ee558fcb..eb4de13e0 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -62,10 +62,10 @@ module FV3GFS_io_mod character(len=32) :: fn_phy = 'phy_data.nc' character(len=32) :: fn_dust12m= 'dust12m_data.nc' character(len=32) :: fn_emi = 'emi_data.nc' - character(len=32) :: fn_gbbepx = 'SMOKE_GBBEPx_data.nc' + character(len=32) :: fn_rrfssd = 'SMOKE_RRFS_data.nc' !--- GFDL FMS netcdf restart data types defined in fms2_io - type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart, dust12m_restart, emi_restart, gbbepx_restart + type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart, dust12m_restart, emi_restart, rrfssd_restart type(FmsNetcdfDomainFile_t) :: Oro_ls_restart, Oro_ss_restart !--- GFDL FMS restart containers @@ -74,10 +74,10 @@ module FV3GFS_io_mod character(len=32), allocatable, dimension(:) :: oro_ls_ss_name real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_ls_var, oro_ss_var real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, phy_var3 - character(len=32), allocatable, dimension(:) :: dust12m_name, emi_name, gbbepx_name - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: gbbepx_var + character(len=32), allocatable, dimension(:) :: dust12m_name, emi_name, rrfssd_name + real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: rrfssd_var real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: dust12m_var - real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: emi_var + real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: emi_var !--- Noah MP restart containers real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3sn,sfc_var3eq,sfc_var3zn @@ -111,6 +111,28 @@ module FV3GFS_io_mod logical :: use_wrtgridcomp_output = .FALSE. logical :: module_is_initialized = .FALSE. + type rrfs_sd_data_type + ! The smoke_data_type stores temporary arrays used to read or + ! write RRFS-SD restart and axis variables. + + real(kind_phys), pointer, private, dimension(:,:) :: & ! i,j variables + emdust=>null(), emseas=>null(), emanoc=>null(), fhist=>null(), coef_bb_dc=>null() + + real(kind_phys), pointer, private, dimension(:,:,:) :: & + fire_in=>null() ! i, j, fire_aux_data_levels + + contains + procedure, public :: register_axis => rrfs_sd_register_axis ! register fire_aux_data_levels axis + procedure, public :: write_axis => rrfs_sd_write_axis ! write fire_aux_data_levels variable + procedure, public :: allocate_data => rrfs_sd_allocate_data ! allocate all pointers + procedure, public :: fill_data => rrfs_sd_fill_data ! fill data with default values + procedure, public :: register_fields => rrfs_sd_register_fields ! register rrfs_sd fields + procedure, public :: deallocate_data => rrfs_sd_deallocate_data ! deallocate pointers + procedure, public :: copy_to_temporaries => rrfs_sd_copy_to_temporaries ! Copy Sfcprop to arrays + procedure, public :: copy_from_temporaries => rrfs_sd_copy_from_temporaries ! Copy arrays to Sfcprop + final :: rrfs_sd_final ! Destructor; calls deallocate_data + end type rrfs_sd_data_type + interface copy_from_GFS_Data module procedure copy_from_GFS_Data_2d_phys2phys, & copy_from_GFS_Data_3d_phys2phys, & @@ -846,7 +868,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow - integer :: nvar_emi, nvar_dust12m, nvar_gbbepx + integer :: nvar_emi, nvar_dust12m, nvar_rrfssd integer, allocatable :: ii1(:), jj1(:) real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() @@ -864,16 +886,18 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta logical :: amiopen logical :: is_lsoil + type(rrfs_sd_data_type) :: rrfs_sd_data + nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 - if(Model%rrfs_smoke) then + if(Model%rrfs_sd) then nvar_dust12m = 5 - nvar_gbbepx = 3 + nvar_rrfssd = 3 nvar_emi = 1 else nvar_dust12m = 0 - nvar_gbbepx = 0 + nvar_rrfssd = 0 nvar_emi = 0 endif @@ -1017,7 +1041,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) - if_smoke: if(Model%rrfs_smoke) then ! for RRFS-Smoke + if_smoke: if(Model%rrfs_sd) then ! for RRFS-SD !--- Dust input FILE !--- open file @@ -1071,78 +1095,85 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta deallocate(dust12m_name,dust12m_var) + read_emi: if(nvar_emi>0) then !--- open anthropogenic emission file infile=trim(indir)//'/'//trim(fn_emi) amiopen=open_file(emi_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) - if (.not. allocated(emi_name)) then + !if (.not. allocated(emi_name)) then !--- allocate the various containers needed for anthropogenic emission data + if(allocated(emi_name)) deallocate(emi_name) + if(allocated(emi_var)) deallocate(emi_var) allocate(emi_name(nvar_emi)) - allocate(emi_var(nx,ny,nvar_emi)) + allocate(emi_var(nx,ny,1,nvar_emi)) emi_name(1) = 'e_oc' !--- register axis + call register_axis( emi_restart, 'time', 1) ! only read first time level, even if multiple are present call register_axis( emi_restart, "grid_xt", 'X' ) call register_axis( emi_restart, "grid_yt", 'Y' ) !--- register the 2D fields do num = 1,nvar_emi - var2_p => emi_var(:,:,num) - call register_restart_field(emi_restart, emi_name(num), var2_p, dimensions=(/'grid_yt','grid_xt'/)) + var3_p2 => emi_var(:,:,:,num) + call register_restart_field(emi_restart, emi_name(num), var3_p2, dimensions=(/'time ','grid_yt','grid_xt'/)) enddo - nullify(var2_p) - endif + nullify(var3_p2) + !endif - !--- read new GSL created emi restart/data + !--- read anthropogenic emi restart/data call mpp_error(NOTE,'reading emi information from INPUT/emi_data.tile*.nc') call read_restart(emi_restart) call close_file(emi_restart) + do num=1,nvar_emi do nb = 1, Atm_block%nblks !--- 2D variables do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - Sfcprop(nb)%emi_in(ix,1) = emi_var(i,j,1) + Sfcprop(nb)%emi_in(ix,num) = emi_var(i,j,1,num) enddo enddo + enddo !--- deallocate containers and free restart container deallocate(emi_name, emi_var) + endif read_emi !--- Dust input FILE !--- open file - infile=trim(indir)//'/'//trim(fn_gbbepx) - amiopen=open_file(gbbepx_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + infile=trim(indir)//'/'//trim(fn_rrfssd) + amiopen=open_file(rrfssd_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) - if (.not. allocated(gbbepx_name)) then - !--- allocate the various containers needed for gbbepx fire data - allocate(gbbepx_name(nvar_gbbepx)) - allocate(gbbepx_var(nx,ny,24,nvar_gbbepx)) + if (.not. allocated(rrfssd_name)) then + !--- allocate the various containers needed for rrfssd fire data + allocate(rrfssd_name(nvar_rrfssd)) + allocate(rrfssd_var(nx,ny,24,nvar_rrfssd)) - gbbepx_name(1) = 'ebb_smoke_hr' - gbbepx_name(2) = 'frp_avg_hr' - gbbepx_name(3) = 'frp_std_hr' + rrfssd_name(1) = 'ebb_smoke_hr' + rrfssd_name(2) = 'frp_avg_hr' + rrfssd_name(3) = 'frp_std_hr' !--- register axis - call register_axis(gbbepx_restart, 'lon', 'X') - call register_axis(gbbepx_restart, 'lat', 'Y') - call register_axis(gbbepx_restart, 't', 24) + call register_axis(rrfssd_restart, 'lon', 'X') + call register_axis(rrfssd_restart, 'lat', 'Y') + call register_axis(rrfssd_restart, 't', 24) !--- register the 3D fields mand = .false. - do num = 1,nvar_gbbepx - var3_p2 => gbbepx_var(:,:,:,num) - call register_restart_field(gbbepx_restart, gbbepx_name(num), var3_p2, dimensions=(/'t ', 'lat', 'lon'/),& + do num = 1,nvar_rrfssd + var3_p2 => rrfssd_var(:,:,:,num) + call register_restart_field(rrfssd_restart, rrfssd_name(num), var3_p2, dimensions=(/'t ', 'lat', 'lon'/),& &is_optional=.not.mand) enddo nullify(var3_p2) endif - !--- read new GSL created gbbepx restart/data - call mpp_error(NOTE,'reading gbbepx information from INPUT/SMOKE_GBBEPx_data.nc') - call read_restart(gbbepx_restart) - call close_file(gbbepx_restart) + !--- read new GSL created rrfssd restart/data + call mpp_error(NOTE,'reading rrfssd information from INPUT/SMOKE_RRFS_data.nc') + call read_restart(rrfssd_restart) + call close_file(rrfssd_restart) do nb = 1, Atm_block%nblks !--- 3D variables @@ -1151,15 +1182,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta j = Atm_block%index(nb)%jj(ix) - jsc + 1 !--- assign hprime(1:10) and hprime(15:24) with new oro stat data do k = 1, 24 - Sfcprop(nb)%smoke_GBBEPx(ix,k,1) = gbbepx_var(i,j,k,1) - Sfcprop(nb)%smoke_GBBEPx(ix,k,2) = gbbepx_var(i,j,k,2) - Sfcprop(nb)%smoke_GBBEPx(ix,k,3) = gbbepx_var(i,j,k,3) + Sfcprop(nb)%smoke_RRFS(ix,k,1) = rrfssd_var(i,j,k,1) + Sfcprop(nb)%smoke_RRFS(ix,k,2) = rrfssd_var(i,j,k,2) + Sfcprop(nb)%smoke_RRFS(ix,k,3) = rrfssd_var(i,j,k,3) enddo enddo enddo - deallocate(gbbepx_name, gbbepx_var) - endif if_smoke ! RRFS_Smoke + deallocate(rrfssd_name, rrfssd_var) + endif if_smoke ! RRFS_SD !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & @@ -1326,6 +1357,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call register_axis(Sfc_restart, 'Time', unlimited) end if + if(Model%rrfs_sd) then + call rrfs_sd_data%allocate_data(Model) + call rrfs_sd_data%fill_data(Model, Sfcprop, Atm_block) + call rrfs_sd_data%register_axis(Model) + call rrfs_sd_data%register_fields + endif + !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) @@ -1475,6 +1513,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call read_restart(Sfc_restart, ignore_checksum=ignore_rst_cksum) call close_file(Sfc_restart) + if(Model%rrfs_sd) then + call rrfs_sd_data%copy_from_temporaries(Model,Sfcprop,Atm_block) + end if + ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,35)),maxval(sfc_var2(:,:,35)),' sfc_name2=',sfc_name2(35) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,18)),maxval(sfc_var2(:,:,18)) ! write(0,*)' sfc_var2=',sfc_var2(:,:,12) @@ -2038,6 +2080,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif + ! A standard-compliant Fortran 2003 compiler will call rrfs_sd_final here + end subroutine sfc_prop_restart_read @@ -2081,6 +2125,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- variables used for fms2_io register axis integer :: is, ie integer, allocatable, dimension(:) :: buffer + !--- temporary variables for storing rrfs_sd fields + type(rrfs_sd_data_type) :: rrfs_sd_data nvar2m = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -2202,6 +2248,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) end if if_amiopen + if(Model%rrfs_sd) then + call rrfs_sd_data%allocate_data(Model) + call rrfs_sd_data%register_axis(Model) + call rrfs_sd_data%write_axis(Model) + end if if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts @@ -2227,6 +2278,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar2m,.true.) end if + if(Model%rrfs_sd) then + call rrfs_sd_data%register_fields + endif + !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) @@ -2334,6 +2389,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nullify(var3_p3) endif ! lsm = lsm_noahmp + if(Model%rrfs_sd) then + call rrfs_sd_data%copy_to_temporaries(Model,Sfcprop,Atm_block) + endif + !$omp parallel do default(shared) private(i, j, nb, ix, nt, ii1, jj1, lsoil, k, ice) block_loop: do nb = 1, Atm_block%nblks allocate(ii1(Atm_block%blksz(nb))) @@ -2547,8 +2606,208 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call write_restart(Sfc_restart) call close_file(Sfc_restart) + ! A standard-compliant Fortran 2003 compiler will call rrfs_sd_final here + end subroutine sfc_prop_restart_write + subroutine rrfs_sd_register_axis(data,Model) + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_control_type), intent(in) :: Model + call register_axis(Sfc_restart, 'fire_aux_data_levels', & + dimension_length=Model%fire_aux_data_levels) + end subroutine rrfs_sd_register_axis + + subroutine rrfs_sd_write_axis(data,Model) + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_control_type), intent(in) :: Model + real(kind_phys) :: fire_aux_data_levels(Model%fire_aux_data_levels) + integer :: i + + call register_field(Sfc_restart, 'fire_aux_data_levels', 'double', (/'fire_aux_data_levels'/)) + call register_variable_attribute(Sfc_restart, 'fire_aux_data_levels', 'cartesian_axis' ,'Z', str_len=1) + + do i=1,Model%fire_aux_data_levels + fire_aux_data_levels(i) = i + enddo + + call write_data(Sfc_restart, 'fire_aux_data_levels', fire_aux_data_levels) + end subroutine rrfs_sd_write_axis + + subroutine rrfs_sd_allocate_data(data,Model) + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_control_type), intent(in) :: Model + integer :: nx, ny + + call data%deallocate_data + + nx=Model%nx + ny=Model%ny + + allocate(data%emdust(nx,ny)) + allocate(data%emseas(nx,ny)) + allocate(data%emanoc(nx,ny)) + allocate(data%fhist(nx,ny)) + allocate(data%coef_bb_dc(nx,ny)) + + allocate(data%fire_in(nx,ny,Model%fire_aux_data_levels)) + + end subroutine rrfs_sd_allocate_data + + subroutine rrfs_sd_fill_data(data, Model, Sfcprop, Atm_block) + ! Fills all temporary variables with default values. + ! Terrible things will happen if you don't call data%allocate_data first. + ! IMPORTANT: This must match the corresponding code in sfcprop_create in + ! GFS_typedefs.F90 + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + + isc = Model%isc + jsc = Model%jsc + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%emdust(i,j) = 0 + data%emseas(i,j) = 0 + data%emanoc(i,j) = 0 + data%fhist(i,j) = 1. + data%coef_bb_dc(i,j) = 0 + + data%fire_in(i,j,:) = 0 + end do + end do + end subroutine rrfs_sd_fill_data + + subroutine rrfs_sd_register_fields(data) + ! Registers all restart fields needed by the RRFS-SD + ! Terrible things will happen if you don't call data%allocate_data + ! and data%register_axes first. + implicit none + class(rrfs_sd_data_type) :: data + + ! Register 2D fields + call register_restart_field(Sfc_restart, 'emdust', data%emdust, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'emseas', data%emseas, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'emanoc', data%emanoc, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'fhist', data%fhist, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'coef_bb_dc', data%coef_bb_dc, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + + ! Register 3D field + call register_restart_field(Sfc_restart, 'fire_in', data%fire_in, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'fire_aux_data_levels', 'Time '/), & + is_optional=.true.) + end subroutine rrfs_sd_register_fields + + subroutine rrfs_sd_final(data) + ! Final routine for rrfs_sd_data_type, called automatically when + ! an object of that type goes out of scope. This is a wrapper + ! around data%deallocate_data() with necessary syntactic + ! differences. + implicit none + type(rrfs_sd_data_type) :: data + call rrfs_sd_deallocate_data(data) + end subroutine rrfs_sd_final + + subroutine rrfs_sd_deallocate_data(data) + ! Deallocates all data used, and nullifies the pointers. The data + ! object can safely be used again after this call. This is also + ! the implementation of the rrfs_sd_deallocate_data final routine. + implicit none + class(rrfs_sd_data_type) :: data + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(data%var)) then ; \ + deallocate(data%var) ; \ + nullify(data%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(emdust) + IF_ASSOC_DEALLOC_NULL(emseas) + IF_ASSOC_DEALLOC_NULL(emanoc) + IF_ASSOC_DEALLOC_NULL(fhist) + IF_ASSOC_DEALLOC_NULL(coef_bb_dc) + + IF_ASSOC_DEALLOC_NULL(fire_in) + + ! Undefine this to avoid cluttering the cpp scope: +#undef IF_ASSOC_DEALLOC_NULL + end subroutine rrfs_sd_deallocate_data + + subroutine rrfs_sd_copy_from_temporaries(data, Model, Sfcprop, Atm_block) + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + + isc = Model%isc + jsc = Model%jsc + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + Sfcprop(nb)%emdust(ix) = data%emdust(i,j) + Sfcprop(nb)%emseas(ix) = data%emseas(i,j) + Sfcprop(nb)%emanoc(ix) = data%emanoc(i,j) + Sfcprop(nb)%fhist(ix) = data%fhist(i,j) + Sfcprop(nb)%coef_bb_dc(ix) = data%coef_bb_dc(i,j) + + Sfcprop(nb)%fire_in(ix,:) = data%fire_in(i,j,:) + enddo + enddo + end subroutine rrfs_sd_copy_from_temporaries + + subroutine rrfs_sd_copy_to_temporaries(data, Model, Sfcprop, Atm_block) + implicit none + class(rrfs_sd_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + + isc = Model%isc + jsc = Model%jsc + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%emdust(i,j) = Sfcprop(nb)%emdust(ix) + data%emseas(i,j) = Sfcprop(nb)%emseas(ix) + data%emanoc(i,j) = Sfcprop(nb)%emanoc(ix) + data%fhist(i,j) = Sfcprop(nb)%fhist(ix) + data%coef_bb_dc(i,j) = Sfcprop(nb)%coef_bb_dc(ix) + + data%fire_in(i,j,:) = Sfcprop(nb)%fire_in(ix,:) + enddo + enddo + end subroutine rrfs_sd_copy_to_temporaries !---------------------------------------------------------------------- ! phys_restart_read