diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 49f15ecbb..caba092f6 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 49f15ecbbc16405025fae8d672dced19c2073d9e +Subproject commit caba092f682c9713a485e782b8f9ba6480adaca2 diff --git a/atmos_model.F90 b/atmos_model.F90 index 6725b1809..25cc61a88 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -748,7 +748,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call fv3atm_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain_for_read, & Atm(mygrid)%flagstruct%warm_start, ignore_rst_cksum) if(GFS_control%do_ca .and. Atm(mygrid)%flagstruct%warm_start)then - call read_ca_restart (Atmos%domain,GFS_control%ncells,GFS_control%nca,GFS_control%ncells_g,GFS_control%nca_g) + call read_ca_restart (Atmos%domain,3,GFS_control%ncells,GFS_control%nca,GFS_control%ncells_g,GFS_control%nca_g) endif ! Populate the GFS_data%Statein container with the prognostic state ! in Atm_block, which contains the initial conditions/restart data. @@ -2015,7 +2015,7 @@ subroutine assign_importdata(jdat, rc) ! get upward LW flux: for sea ice covered area !---------------------------------------------- - fldname = 'mean_up_lw_flx_ice' + fldname = 'lwup_flx_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2042,7 +2042,7 @@ subroutine assign_importdata(jdat, rc) ! get latent heat flux: for sea ice covered area !------------------------------------------------ - fldname = 'mean_laten_heat_flx_atm_into_ice' + fldname = 'laten_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2062,7 +2062,7 @@ subroutine assign_importdata(jdat, rc) ! get sensible heat flux: for sea ice covered area !-------------------------------------------------- - fldname = 'mean_sensi_heat_flx_atm_into_ice' + fldname = 'sensi_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2122,7 +2122,7 @@ subroutine assign_importdata(jdat, rc) ! get sea ice volume: for sea ice covered area !---------------------------------------------- - fldname = 'mean_ice_volume' + fldname = 'sea_ice_volume' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2143,7 +2143,7 @@ subroutine assign_importdata(jdat, rc) ! get snow volume: for sea ice covered area !------------------------------------------- - fldname = 'mean_snow_volume' + fldname = 'snow_volume_on_sea_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2251,7 +2251,7 @@ subroutine assign_importdata(jdat, rc) ! get upward LW flux: for open ocean !---------------------------------------------- - fldname = 'mean_up_lw_flx_ocn' + fldname = 'lwup_flx_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2271,7 +2271,7 @@ subroutine assign_importdata(jdat, rc) ! get latent heat flux: for open ocean !------------------------------------------------ - fldname = 'mean_laten_heat_flx_atm_into_ocn' + fldname = 'laten_heat_flx_atm_into_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2291,7 +2291,7 @@ subroutine assign_importdata(jdat, rc) ! get sensible heat flux: for open ocean !-------------------------------------------------- - fldname = 'mean_sensi_heat_flx_atm_into_ocn' + fldname = 'sensi_heat_flx_atm_into_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2923,19 +2923,28 @@ subroutine setup_exportdata(rc) call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc) ! Instantaneous Zonal compt of momentum flux (N/m**2) case ('inst_zonal_moment_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Merid compt of momentum flux (N/m**2) case ('inst_merid_moment_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Sensible heat flux (W/m**2) case ('inst_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Latent heat flux (W/m**2) case ('inst_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Evap flux (kg/m**2/s) case ('inst_evap_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, revap, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, -revap, spval, rc=localrc) + ! Instantaneous precipitation rate (kg/m2/s) + case ('inst_prec_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) + ! Instantaneous convective precipitation rate (kg/m2/s) + case ('inst_prec_rate_conv') + call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) + ! Instaneous snow precipitation rate (kg/m2/s) + case ('inst_fprec_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! Instantaneous Downward long wave radiation flux (W/m**2) case ('inst_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc) @@ -2993,19 +3002,19 @@ subroutine setup_exportdata(rc) !--- Mean quantities ! MEAN Zonal compt of momentum flux (N/m**2) case ('mean_zonal_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Merid compt of momentum flux (N/m**2) case ('mean_merid_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Sensible heat flux (W/m**2) case ('mean_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Latent heat flux (W/m**2) case ('mean_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Evap rate (kg/m**2/s) case ('mean_evap_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime*revap, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, -rtime*revap, spval, rc=localrc) ! MEAN Downward LW heat flux (W/m**2) case ('mean_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) @@ -3042,15 +3051,6 @@ subroutine setup_exportdata(rc) ! MEAN NET sfc uv+vis diffused flux (W/m**2) case ('mean_net_sw_vis_dif_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) - ! MEAN precipitation rate (kg/m2/s) - case ('mean_prec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) - ! MEAN convective precipitation rate (kg/m2/s) - case ('mean_prec_rate_conv') - call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) - ! MEAN snow precipitation rate (kg/m2/s) - case ('mean_fprec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! oceanfrac used by atm to calculate fluxes case ('openwater_frac_in_atm') call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d0b19327c..bfb6af571 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -135,7 +135,7 @@ module GFS_typedefs integer, pointer :: tracer_types(:) !< tracers types: 0=generic, 1=chem,prog, 2=chem,diag character(len=64) :: fn_nml !< namelist filename character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist - !< for use with internal file reads + !< for use with internal file reads end type GFS_init_type @@ -217,19 +217,19 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] real (kind=kind_phys), pointer :: clm_lakedepth(:) => null() !< clm internal lake depth [ m ] integer, pointer :: use_lake_model(:) => null()!1=run lake, 2=run lake&nsst, 0=no lake - real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model + real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model - real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] - real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K - real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] - real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] - real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] - real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] + real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] + real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K + real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] + real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] + real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] + real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] real (kind=kind_phys), pointer :: t_bot2(:) => null() !Temperature for bottom layer of water [K] - real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile - real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] - real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] + real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile + real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] + real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] real (kind=kind_phys), pointer :: tsfc (:) => null() !< surface air temperature in K real (kind=kind_phys), pointer :: vegtype_frac (:,:) => null() !< fractions [0:1] of veg. categories @@ -431,13 +431,7 @@ module GFS_typedefs ! CLM Lake model internal variables: real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! - real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_watsat3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tkmg3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tkdry3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tksatu3d(:,:) => null() ! + real (kind=kind_phys), pointer :: input_lakedepth(:) => null() ! real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! real (kind=kind_phys), pointer :: lake_sndpth2d(:) => null() ! real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! @@ -454,8 +448,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_icefrac3d(:,:)=> null() real (kind=kind_phys), pointer :: lake_rho0(:)=> null() real (kind=kind_phys), pointer :: lake_ht(:)=> null() - real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() - real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() integer, pointer :: lake_is_salty(:) => null() integer, pointer :: lake_cannot_freeze(:) => null() real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called @@ -533,7 +525,7 @@ module GFS_typedefs ! real (kind=kind_phys), pointer :: sfc_alb_vis_dif_cpl(:) => null() !< sfc vis albedo for diffuse rad !--- only variable needed for cplwav2atm=.TRUE. ! real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model - !--- also needed for ice/ocn coupling + !--- also needed for ice/ocn coupling real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) !--- variables needed for use_med_flux =.TRUE. real (kind=kind_phys), pointer :: dusfcin_med(:) => null() !< sfc u momentum flux over ocean @@ -612,6 +604,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: spp_wts_mp (:,:) => null() ! spp-mp-perts real (kind=kind_phys), pointer :: spp_wts_gwd (:,:) => null() ! spp-gwd-perts real (kind=kind_phys), pointer :: spp_wts_rad (:,:) => null() ! spp-rad-perts + real (kind=kind_phys), pointer :: spp_wts_cu_deep (:,:) => null() ! spp-cu-deep-perts !--- aerosol surface emissions for Thompson microphysics real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source @@ -844,7 +837,7 @@ module GFS_typedefs !< 1: K day-1 - 2: K s-1 logical :: inc_minor_gas !< Include minor trace gases in RRTMG radiation calculation? integer :: ipsd0 !< initial permutaion seed for mcica radiation - integer :: ipsdlim !< limit initial permutaion seed for mcica radiation + integer :: ipsdlim !< limit initial permutaion seed for mcica radiation logical :: lrseeds !< flag to use host-provided random seeds integer :: nrstreams !< number of random number streams in host-provided random seed array logical :: lextop !< flag for using an extra top layer for radiation @@ -876,10 +869,10 @@ module GFS_typedefs real(kind_phys) :: lfnc_p0 !< Logistic function transition level (Pa) logical :: doGP_lwscat !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics logical :: doGP_sgs_cnv !< If true, include SubGridScale convective cloud in RRTMGP - logical :: doGP_sgs_mynn !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP + logical :: doGP_sgs_mynn !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP integer :: rrtmgp_lw_phys_blksz !< Number of columns to pass to RRTMGP LW per block. integer :: rrtmgp_sw_phys_blksz !< Number of columns to pass to RRTMGP SW per block. - logical :: doGP_smearclds !< If true, include implicit SubGridScale clouds in RRTMGP + logical :: doGP_smearclds !< If true, include implicit SubGridScale clouds in RRTMGP real(kind_phys) :: minGPpres !< Minimum pressure allowed in RRTMGP. real(kind_phys) :: maxGPpres !< Maximum pressure allowed in RRTMGP. real(kind_phys) :: minGPtemp !< Minimum temperature allowed in RRTMGP. @@ -972,9 +965,9 @@ module GFS_typedefs real(kind=kind_phys) :: nssl_cccn !< CCN concentration (m-3) real(kind=kind_phys) :: nssl_alphah !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl !< hail shape parameter - real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0 ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0 ! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) + real(kind=kind_phys) :: nssl_ehw0 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on !< NSSL flag to activate the hail category logical :: nssl_ccn_on !< NSSL flag to activate the CCN category logical :: nssl_invertccn !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -1047,7 +1040,7 @@ module GFS_typedefs integer :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc !snow/soil temperature time scheme (only layer 1) integer :: iopt_trs !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb inversed) - integer :: iopt_diag !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title 3->NoahMP + integer :: iopt_diag !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title 3->NoahMP !2-title + internal GFS sfc_diag ) ! -- RUC LSM options @@ -1082,6 +1075,7 @@ module GFS_typedefs real(kind_phys) :: clm_lake_depth_default !< minimum lake elevation in clm lake model logical :: clm_lake_use_lakedepth !< initialize lake from lakedepth logical :: clm_lake_debug !< verbose debugging in clm_lake + logical :: clm_debug_print !< enables prints in clm_lakedebugging in clm_laki !--- tuning parameters for physical parameterizations logical :: ras !< flag for ras convection scheme @@ -1152,7 +1146,7 @@ module GFS_typedefs integer :: imfshalcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) integer :: imfshalcnv_c3 = 5 !< flag for the Community Convective Cloud (C3) scheme logical :: hwrf_samfdeep !< flag for HWRF SAMF deepcnv scheme (HWRF) - logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) + logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) integer :: imfdeepcnv !< flag for mass-flux deep convection scheme !< 1: July 2010 version of SAS conv scheme !< current operational version as of 2016 @@ -1218,7 +1212,7 @@ module GFS_typedefs real(kind=kind_phys) :: bl_mynn_closure !< flag to determine closure level of MYNN logical :: sfclay_compute_flux!< flag for thermal roughness lengths over water in mynnsfclay logical :: sfclay_compute_diag!< flag for computing surface diagnostics in mynnsfclay - integer :: isftcflx !< flag for thermal roughness lengths over water in mynnsfclay + integer :: isftcflx !< flag for thermal roughness lengths over water in mynnsfclay integer :: iz0tlnd !< flag for thermal roughness lengths over land in mynnsfclay real(kind=kind_phys) :: var_ric real(kind=kind_phys) :: coef_ric_l @@ -1327,6 +1321,7 @@ module GFS_typedefs integer :: nseed !< cellular automata seed frequency integer :: nseed_g !< cellular automata seed frequency logical :: do_ca !< cellular automata main switch + logical :: ca_advect !< Advection of cellular automata logical :: ca_sgs !< switch for sgs ca logical :: ca_global !< switch for global ca logical :: ca_smooth !< switch for gaussian spatial filter @@ -1368,8 +1363,9 @@ module GFS_typedefs integer :: spp_mp integer :: spp_rad integer :: spp_gwd + integer :: spp_cu_deep integer :: n_var_spp - character(len=3) , pointer :: spp_var_list(:) + character(len=10) , pointer :: spp_var_list(:) real(kind=kind_phys), pointer :: spp_prt_list(:) real(kind=kind_phys), pointer :: spp_stddev_cutoff(:) @@ -1433,7 +1429,7 @@ module GFS_typedefs integer :: ntgv !< tracer index for graupel particle volume integer :: nthv !< tracer index for hail particle volume integer :: ntke !< tracer index for kinetic energy - integer :: ntsigma !< tracer index for updraft area fraction + integer :: ntsigma !< tracer index for updraft area fraction integer :: nto !< tracer index for oxygen ion integer :: nto2 !< tracer index for oxygen integer :: ntwa !< tracer index for water friendly aerosol @@ -1497,6 +1493,9 @@ module GFS_typedefs integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d !-- nml variables for RRFS-SD + real(kind=kind_phys) :: dust_drylimit_factor !< factor for drylimit parameterization in fengsha + real(kind=kind_phys) :: dust_moist_correction !< factor to tune volumetric soil moisture + integer :: dust_moist_opt !< dust moisture option 1:fecan 2:shao 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 @@ -1943,7 +1942,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: zmtnblck(:) => null() ! null() !< tracer changes due to physics @@ -2711,13 +2710,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_t2m(IM)) allocate(Sfcprop%lake_q2m(IM)) allocate(Sfcprop%lake_albedo(IM)) - allocate(Sfcprop%lake_z3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_dz3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_watsat3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_csol3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tkmg3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tkdry3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tksatu3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%input_lakedepth(IM)) allocate(Sfcprop%lake_h2osno2d(IM)) allocate(Sfcprop%lake_sndpth2d(IM)) allocate(Sfcprop%lake_snl2d(IM)) @@ -2734,8 +2727,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_icefrac3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_rho0(IM)) allocate(Sfcprop%lake_ht(IM)) - allocate(Sfcprop%lake_clay3d(IM,Model%nlevsoil_clm_lake)) - allocate(Sfcprop%lake_sand3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_is_salty(IM)) allocate(Sfcprop%lake_cannot_freeze(IM)) allocate(Sfcprop%clm_lake_initialized(IM)) @@ -2743,13 +2734,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_t2m = clear_val Sfcprop%lake_q2m = clear_val Sfcprop%lake_albedo = clear_val - Sfcprop%lake_z3d = clear_val - Sfcprop%lake_dz3d = clear_val - Sfcprop%lake_soil_watsat3d = clear_val - Sfcprop%lake_csol3d = clear_val - Sfcprop%lake_soil_tkmg3d = clear_val - Sfcprop%lake_soil_tkdry3d = clear_val - Sfcprop%lake_soil_tksatu3d = clear_val + Sfcprop%input_lakedepth = clear_val Sfcprop%lake_h2osno2d = clear_val Sfcprop%lake_sndpth2d = clear_val Sfcprop%lake_snl2d = clear_val @@ -2766,8 +2751,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_icefrac3d = clear_val Sfcprop%lake_rho0 = -111 Sfcprop%lake_ht = -111 - Sfcprop%lake_clay3d = clear_val - Sfcprop%lake_sand3d = clear_val Sfcprop%lake_is_salty = zero Sfcprop%lake_cannot_freeze = zero Sfcprop%clm_lake_initialized = zero @@ -2884,6 +2867,8 @@ subroutine coupling_create (Coupling, IM, Model) ! endif if (Model%cplflx .or. Model%cpllnd) then + allocate (Coupling%dlwsfci_cpl (IM)) + allocate (Coupling%dswsfci_cpl (IM)) allocate (Coupling%dlwsfc_cpl (IM)) allocate (Coupling%dswsfc_cpl (IM)) allocate (Coupling%psurfi_cpl (IM)) @@ -2898,6 +2883,8 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%nvisbm_cpl (IM)) allocate (Coupling%nvisdf_cpl (IM)) + Coupling%dlwsfci_cpl = clear_val + Coupling%dswsfci_cpl = clear_val Coupling%dlwsfc_cpl = clear_val Coupling%dswsfc_cpl = clear_val Coupling%psurfi_cpl = clear_val @@ -2988,8 +2975,6 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dvsfci_cpl (IM)) allocate (Coupling%dtsfci_cpl (IM)) allocate (Coupling%dqsfci_cpl (IM)) - allocate (Coupling%dlwsfci_cpl (IM)) - allocate (Coupling%dswsfci_cpl (IM)) allocate (Coupling%dnirbmi_cpl (IM)) allocate (Coupling%dnirdfi_cpl (IM)) allocate (Coupling%dvisbmi_cpl (IM)) @@ -3004,8 +2989,6 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%dvsfci_cpl = clear_val Coupling%dtsfci_cpl = clear_val Coupling%dqsfci_cpl = clear_val - Coupling%dlwsfci_cpl = clear_val - Coupling%dswsfci_cpl = clear_val Coupling%dnirbmi_cpl = clear_val Coupling%dnirdfi_cpl = clear_val Coupling%dvisbmi_cpl = clear_val @@ -3100,13 +3083,13 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%skebu_wts = clear_val Coupling%skebv_wts = clear_val endif - + !--- stochastic land perturbation option if (Model%lndp_type /= 0) then allocate (Coupling%sfc_wts (IM,Model%n_var_lndp)) Coupling%sfc_wts = clear_val endif - + !--- stochastic spp perturbation option if (Model%do_spp) then allocate (Coupling%spp_wts_pbl (IM,Model%levs)) @@ -3119,6 +3102,8 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%spp_wts_gwd = clear_val allocate (Coupling%spp_wts_rad (IM,Model%levs)) Coupling%spp_wts_rad = clear_val + allocate (Coupling%spp_wts_cu_deep (IM,Model%levs)) + Coupling%spp_wts_cu_deep = clear_val endif !--- needed for Thompson's aerosol option @@ -3339,7 +3324,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: swhtr = .true. !< flag to output sw heating rate (Radtend%swhc) integer :: rad_hr_units = 2 !< heating rate units are K s-1 logical :: inc_minor_gas = .true. !< Include minor trace gases in RRTMG radiation calculation - integer :: ipsd0 = 0 !< initial permutaion seed for mcica radiation + integer :: ipsd0 = 0 !< initial permutaion seed for mcica radiation integer :: ipsdlim = 1e8 !< limit initial permutaion seed for mcica radiation logical :: lrseeds = .false. !< flag to use host-provided random seeds integer :: nrstreams = 2 !< number of random number streams in host-provided random seed array @@ -3354,7 +3339,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & character(len=128) :: sw_file_gas = '' !< RRTMGP K-distribution file, coefficients to compute optics for gaseous atmosphere character(len=128) :: sw_file_clouds = '' !< RRTMGP file containing coefficients used to compute clouds optical properties integer :: rrtmgp_nBandsSW = -999 !< Number of RRTMGP SW bands. # *NOTE* - integer :: rrtmgp_nGptsSW = -999 !< Number of RRTMGP SW spectral points. # The RRTMGP spectral dimensions in the files + integer :: rrtmgp_nGptsSW = -999 !< Number of RRTMGP SW spectral points. # The RRTMGP spectral dimensions in the files integer :: rrtmgp_nBandsLW = -999 !< Number of RRTMGP LW bands. # need to be provided via namelsit. integer :: rrtmgp_nGptsLW = -999 !< Number of RRTMGP LW spectral points. # logical :: doG_cldoptics = .false. !< Use legacy RRTMG cloud-optics? @@ -3373,7 +3358,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: doGP_sgs_mynn = .false. !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP integer :: rrtmgp_lw_phys_blksz= 1 !< Number of columns for RRTMGP LW scheme to process at each instance. integer :: rrtmgp_sw_phys_blksz= 1 !< Number of columns for RRTMGP SW scheme to process at each instance. - logical :: doGP_smearclds = .true. !< If true, include implicit SubGridScale clouds in RRTMGP + logical :: doGP_smearclds = .true. !< If true, include implicit SubGridScale clouds in RRTMGP !--- Z-C microphysical parameters integer :: imp_physics = 99 !< choice of cloud scheme real(kind=kind_phys) :: psautco(2) = (/6.0d-4,3.0d-4/) !< [in] auto conversion coeff from ice to snow @@ -3426,9 +3411,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: nssl_cccn = 0.6e9 !< CCN concentration (m-3) real(kind=kind_phys) :: nssl_alphah = 0.0 !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl = 1.0 !< hail shape parameter - real(kind=kind_phys) :: nssl_alphar = 0.0 ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_alphar = 0.0 ! shape parameter for rain (imurain=1 only) + real(kind=kind_phys) :: nssl_ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on = .false. !< NSSL flag to activate the hail category logical :: nssl_ccn_on = .true. !< NSSL flag to activate the CCN category logical :: nssl_invertccn = .true. !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -3440,7 +3425,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: nsfullradar_diag = -999.0 !< seconds between resetting radar reflectivity calculation, set to <0 for every time step real(kind=kind_phys) :: ttendlim = -999.0 !< temperature tendency limiter, set to <0 to deactivate logical :: ext_diag_thompson = .false. !< flag for extended diagnostic output from Thompson - real(kind=kind_phys) :: dt_inner = -999.0 !< time step for the inner loop + real(kind=kind_phys) :: dt_inner = -999.0 !< time step for the inner loop logical :: sedi_semi = .false. !< flag for semi Lagrangian sedi of rain integer :: decfl = 8 !< deformed CFL factor @@ -3461,6 +3446,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind_phys) :: clm_lake_depth_default = 50 !< default lake depth in clm lake model logical :: clm_lake_use_lakedepth = .true. !< initialize depth from lakedepth logical :: clm_lake_debug = .false. !< verbose debugging in clm_lake + logical :: clm_debug_print = .false. !< enables prints in clm_lake !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm @@ -3706,7 +3692,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid = .false. !< flag for fractional grid - logical :: frac_ice = .false. !< flag for fractional ice when fractional grid is not in use + logical :: frac_ice = .true. !< flag for lake fractional ice when fractional grid is not in use logical :: ignore_lake = .true. !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value @@ -3724,7 +3710,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: thsfc_loc = .true. !< flag for local vs. standard potential temperature !--- flux method in 2-m diagnostics logical :: diag_flux = .false. !< flag for flux method in 2-m diagnostics -!--- flux method in 2-m diagnostics (for stable conditions) +!--- flux method in 2-m diagnostics (for stable conditions) logical :: diag_log = .false. !< flag for log method in 2-m diagnostics (for stable conditions) !<.true. means use local (gridpoint) surface pressure to define potential temperature !< this is the current GFS physics approach @@ -3753,7 +3739,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: nca = 1 integer :: ncells = 5 integer :: nlives = 12 - + integer :: nca_g = 1 integer :: ncells_g = 1 integer :: nlives_g = 100 @@ -3763,6 +3749,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iseed_ca = 1 integer :: nspinup = 1 logical :: do_ca = .false. + logical :: ca_advect = .false. logical :: ca_sgs = .false. logical :: ca_global = .false. logical :: ca_smooth = .false. @@ -3813,6 +3800,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: spp_mp = 0 integer :: spp_rad = 0 integer :: spp_gwd = 0 + integer :: spp_cu_deep = 0 logical :: do_spp = .false. integer :: ichoice = 0 !< flag for closure of C3/GF deep convection @@ -3820,9 +3808,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: ichoice_s = 3 !< flag for closure of C3/GF shallow convection !-- chem nml variables for RRFS-SD + real(kind=kind_phys) :: dust_drylimit_factor = 1.0 + real(kind=kind_phys) :: dust_moist_correction = 1.0 real(kind=kind_phys) :: dust_alpha = 0. real(kind=kind_phys) :: dust_gamma = 0. real(kind=kind_phys) :: wetdep_ls_alpha = 0. + integer :: dust_moist_opt = 1 ! fecan :1 else shao integer :: seas_opt = 2 integer :: dust_opt = 5 integer :: drydep_opt = 1 @@ -3849,7 +3840,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) integer :: itime integer :: w3kindreal,w3kindint - + !--- END NAMELIST VARIABLES NAMELIST /gfs_physics_nml/ & @@ -3915,7 +3906,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- lake model control lkm, iopt_lake, lakedepth_threshold, lakefrac_threshold, & clm_lake_depth_default, clm_lake_use_lakedepth, & - clm_lake_debug, use_lake2m, & + clm_lake_debug, clm_debug_print, use_lake2m, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & @@ -3972,7 +3963,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & h0facu, h0facs, & !--- cellular automata nca, ncells, nlives, nca_g, ncells_g, nlives_g, nfracseed, & - nseed, nseed_g, nthresh, do_ca, & + nseed, nseed_g, nthresh, do_ca, ca_advect, & ca_sgs, ca_global,iseed_ca,ca_smooth, & nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, & !--- IAU @@ -3986,6 +3977,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- aerosol scavenging factors ('name:value' string array) fscav_aero, & !--- RRFS-SD namelist + dust_drylimit_factor, dust_moist_correction, dust_moist_opt, & 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, & @@ -4205,6 +4197,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- RRFS-SD Model%rrfs_sd = rrfs_sd + Model%dust_drylimit_factor = dust_drylimit_factor + Model%dust_moist_correction = dust_moist_correction + Model%dust_moist_opt = dust_moist_opt Model%dust_alpha = dust_alpha Model%dust_gamma = dust_gamma Model%wetdep_ls_alpha = wetdep_ls_alpha @@ -4508,7 +4503,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & stop end if Model%lradar = lradar - Model%nsfullradar_diag = nsfullradar_diag + Model%nsfullradar_diag = nsfullradar_diag Model%ttendlim = ttendlim Model%ext_diag_thompson= ext_diag_thompson if (dt_inner>0) then @@ -4623,7 +4618,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & (Model%imp_physics /= Model%imp_physics_gfdl .and. Model%imp_physics /= Model%imp_physics_thompson .and. & Model%imp_physics /= Model%imp_physics_nssl )) then !see GFS_MP_generic_post.F90; exticeden is only compatible with GFDL, - !Thompson, or NSSL MP + !Thompson, or NSSL MP print *,' Using exticeden = T is only valid when using GFDL, Thompson, or NSSL microphysics.' stop end if @@ -4649,6 +4644,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%clm_lake_depth_default = clm_lake_depth_default Model%clm_lake_use_lakedepth = clm_lake_use_lakedepth Model%clm_lake_debug = clm_lake_debug + Model%clm_debug_print = clm_debug_print ! Noah MP options from namelist ! @@ -4913,7 +4909,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lndp_var_list(:) = '' Model%lndp_prt_list(:) = clear_val end if - + if (Model%do_spp) then allocate(Model%spp_var_list(Model%n_var_spp)) allocate(Model%spp_prt_list(Model%n_var_spp)) @@ -4928,7 +4924,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & allocate(Model%vfact_ca(levs)) if ( .not. ca_global ) nca_g=0 if ( .not. ca_sgs ) nca=0 - + Model%nca = nca Model%ncells = ncells Model%nlives = nlives @@ -4940,6 +4936,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nseed_g = nseed_g Model%ca_global = ca_global Model%do_ca = do_ca + Model%ca_advect = ca_advect Model%ca_sgs = ca_sgs Model%iseed_ca = iseed_ca Model%ca_smooth = ca_smooth @@ -4979,7 +4976,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #else Model%ntoz = get_tracer_index(Model%tracer_names, 'o3mr', Model%me, Model%master, Model%debug) if( Model%ntoz <= 0 ) & - Model%ntoz = get_tracer_index(Model%tracer_names, 'spo3', Model%me, Model%master, Model%debug) + Model%ntoz = get_tracer_index(Model%tracer_names, 'spo3', Model%me, Model%master, Model%debug) #endif Model%ntcw = get_tracer_index(Model%tracer_names, 'liq_wat', Model%me, Model%master, Model%debug) Model%ntiw = get_tracer_index(Model%tracer_names, 'ice_wat', Model%me, Model%master, Model%debug) @@ -5276,7 +5273,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_photochem,have_oz_phys) call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_physics,.true.) call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_non_physics,.true.) - + if(.not.Model%do_mynnedmf .and. .not. Model%satmedmf) then call fill_dtidx(Model,dtend_select,100+Model%ntqv,Model%index_of_process_pbl,have_pbl) call fill_dtidx(Model,dtend_select,100+Model%ntcw,Model%index_of_process_pbl,have_pbl) @@ -5334,9 +5331,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & write(*,*) 'NSSL micro: CCNA is ON' ENDIF ENDIF - + if (Model%me == Model%master) then - write(*,*) 'Model%nthl = ',Model%nthl + write(*,*) 'Model%nthl = ',Model%nthl ENDIF IF ( ( Model%nthl < 1 ) ) THEN ! check if hail is in the field_table. If not, set flag so the microphysics knows. if (Model%me == Model%master) then @@ -5346,9 +5343,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & nssl_hail_on = .false. Model%nssl_hail_on = .false. ! pretend that hail exists so that bad arrays are not passed to microphysics -! Model%nthl = Max( 1, Model%ntgl ) -! Model%nthv = Max( 1, Model%ntgv ) -! Model%nthnc = Max( 1, Model%ntgnc ) +! Model%nthl = Max( 1, Model%ntgl ) +! Model%nthv = Max( 1, Model%ntgv ) +! Model%nthnc = Max( 1, Model%ntgnc ) ELSE nssl_hail_on = .true. Model%nssl_hail_on = .true. @@ -5381,16 +5378,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ENDIF ENDIF - IF ( Model%ntgl < 1 .or. Model%ntgv < 1 .or. Model%ntgnc < 1 .or. & - Model%ntsw < 1 .or. Model%ntsnc < 1 .or. & - Model%ntrw < 1 .or. Model%ntrnc < 1 .or. & - Model%ntiw < 1 .or. Model%ntinc < 1 .or. & - Model%ntcw < 1 .or. Model%ntlnc < 1 & + IF ( Model%ntgl < 1 .or. Model%ntgv < 1 .or. Model%ntgnc < 1 .or. & + Model%ntsw < 1 .or. Model%ntsnc < 1 .or. & + Model%ntrw < 1 .or. Model%ntrnc < 1 .or. & + Model%ntiw < 1 .or. Model%ntinc < 1 .or. & + Model%ntcw < 1 .or. Model%ntlnc < 1 & ) THEN if (Model%me == Model%master) write(0,*) 'missing needed tracers for NSSL!' stop ENDIF - + ENDIF !} @@ -5640,6 +5637,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' clm_lake_use_lakedepth = ',Model%clm_lake_use_lakedepth print *,' clm_lake_depth_default = ',Model%clm_lake_depth_default print *,' clm_lake_debug = ',Model%clm_lake_debug + print *,' clm_debug_print = ',Model%clm_debug_print print *,' nlevlake_clm_lake = ',Model%nlevlake_clm_lake print *,' nlevsoil_clm_lake = ',Model%nlevsoil_clm_lake print *,' nlevsnow_clm_lake = ',Model%nlevsnow_clm_lake @@ -5860,7 +5858,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 - Model%nreffr = 4 + Model%nreffr = 4 Model%lradar = .true. if (.not. Model%effr_in) then print *,' NSSL MP requires effr_in to be set to .true., changing value from false to true' @@ -5898,7 +5896,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' ttendlim =',Model%ttendlim, & ' ext_diag_thompson =',Model%ext_diag_thompson, & ' dt_inner =',Model%dt_inner, & - ' sedi_semi=',Model%sedi_semi, & + ' sedi_semi=',Model%sedi_semi, & ' decfl=',decfl, & ' effr_in =',Model%effr_in, & ' lradar =',Model%lradar, & @@ -6065,7 +6063,7 @@ subroutine control_initialize_radar_tten(Model, radar_tten_limits) ! Helper subroutine for initializing variables for radar-derived ! temperature tendency or convection suppression. - + class(GFS_control_type) :: Model real(kind_phys) :: radar_tten_limits(2) integer :: i @@ -6239,7 +6237,7 @@ subroutine control_print(Model) !--- local variables integer :: i - + if (Model%me == Model%master) then print *, ' ' print *, 'basic control parameters' @@ -6302,6 +6300,9 @@ subroutine control_print(Model) if(model%rrfs_sd) then print *, ' ' print *, 'smoke parameters' + print *, 'dust_drylimit_factor: ',Model%dust_drylimit_factor + print *, 'dust_moist_correction: ',Model%dust_moist_correction + print *, 'dust_moist_opt : ',Model%dust_moist_opt print *, 'dust_alpha : ',Model%dust_alpha print *, 'dust_gamma : ',Model%dust_gamma print *, 'wetdep_ls_alpha : ',Model%wetdep_ls_alpha @@ -6441,8 +6442,8 @@ subroutine control_print(Model) print *, ' nssl_alphah - graupel shape parameter : ', Model%nssl_alphah print *, ' nssl_alphahl - hail shape parameter : ', Model%nssl_alphahl print *, ' nssl_alphar - rain shape parameter : ', Model%nssl_alphar - print *, ' nssl_ehw0 - graupel-droplet collection effiency : ', Model%nssl_ehw0 - print *, ' nssl_ehlw0 - hail-droplet collection effiency : ', Model%nssl_ehlw0 + print *, ' nssl_ehw0 - graupel-droplet collection effiency : ', Model%nssl_ehw0 + print *, ' nssl_ehlw0 - hail-droplet collection effiency : ', Model%nssl_ehlw0 print *, ' nssl_hail_on - hail activation flag : ', Model%nssl_hail_on print *, ' lradar - radar refl. flag : ', Model%lradar print *, ' lrefres : ', Model%lrefres @@ -6701,6 +6702,7 @@ subroutine control_print(Model) print *, ' ca_global : ', Model%ca_global print *, ' ca_sgs : ', Model%ca_sgs print *, ' do_ca : ', Model%do_ca + print *, ' ca_advect : ', Model%ca_advect print *, ' iseed_ca : ', Model%iseed_ca print *, ' ca_smooth : ', Model%ca_smooth print *, ' nspinup : ', Model%nspinup @@ -7339,14 +7341,14 @@ subroutine allocate_dtend_labels_and_causes(Model) implicit none type(GFS_control_type), intent(inout) :: Model integer :: i - + allocate(Model%dtend_var_labels(Model%ntracp100)) allocate(Model%dtend_process_labels(Model%nprocess)) - + Model%dtend_var_labels(1)%name = 'unallocated' Model%dtend_var_labels(1)%desc = 'unallocated tracer' Model%dtend_var_labels(1)%unit = 'kg kg-1 s-1' - + do i=2,Model%ntracp100 Model%dtend_var_labels(i)%name = 'unknown' Model%dtend_var_labels(i)%desc = 'unspecified tracer' @@ -7359,24 +7361,24 @@ subroutine allocate_dtend_labels_and_causes(Model) Model%dtend_process_labels(i)%mod_name = 'gfs_phys' enddo end subroutine allocate_dtend_labels_and_causes - + subroutine label_dtend_tracer(Model,itrac,name,desc,unit) implicit none type(GFS_control_type), intent(inout) :: Model integer, intent(in) :: itrac character(len=*), intent(in) :: name, desc character(len=*), intent(in) :: unit - + if(itrac<2) then ! Special index 1 is for unallocated tracers return endif - + Model%dtend_var_labels(itrac)%name = name Model%dtend_var_labels(itrac)%desc = desc Model%dtend_var_labels(itrac)%unit = unit end subroutine label_dtend_tracer - + subroutine label_dtend_cause(Model,icause,name,desc,mod_name,time_avg) implicit none type(GFS_control_type), intent(inout) :: Model @@ -7384,7 +7386,7 @@ subroutine label_dtend_cause(Model,icause,name,desc,mod_name,time_avg) character(len=*), intent(in) :: name, desc character(len=*), optional, intent(in) :: mod_name logical, optional, intent(in) :: time_avg - + Model%dtend_process_labels(icause)%name=name Model%dtend_process_labels(icause)%desc=desc if(present(mod_name)) then @@ -7768,7 +7770,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%evcw = zero Diag%trans = zero Diag%snowmt_land= zero - Diag%snowmt_ice = zero + Diag%snowmt_ice = zero Diag%soilm = zero Diag%tmpmin = Model%huge Diag%tmpmax = zero diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 64e7ae5b7..4f3a757b8 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2034,59 +2034,11 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_z3d] - standard_name = depth_of_lake_interface_layers - long_name = depth of lake interface layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_dz3d] - standard_name = thickness_of_lake_layers - long_name = thickness of lake layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_watsat3d] - standard_name = saturated_volumetric_soil_water_in_lake_model - long_name = saturated volumetric soil water in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_csol3d] - standard_name = soil_heat_capacity_in_lake_model - long_name = soil heat capacity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tkmg3d] - standard_name = soil_mineral_thermal_conductivity_in_lake_model - long_name = soil mineral thermal conductivity in lake model +[input_lakedepth] + standard_name = lake_depth_before_correction + long_name = lake depth_before_correction units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tkdry3d] - standard_name = dry_soil_thermal_conductivity_in_lake_model - long_name = dry soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tksatu3d] - standard_name = saturated_soil_thermal_conductivity_in_lake_model - long_name = saturated soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) @@ -2218,20 +2170,6 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_clay3d] - standard_name = clm_lake_percent_clay - long_name = percent clay in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_sand3d] - standard_name = clm_lake_percent_sand - long_name = percent sand in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_is_salty] standard_name = clm_lake_is_salty long_name = lake at this point is salty (1) or not (0) @@ -2603,7 +2541,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dswsfci_cpl] standard_name = surface_downwelling_shortwave_flux_for_coupling long_name = instantaneous sfc downward sw flux @@ -2611,7 +2549,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dnirbmi_cpl] standard_name = surface_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir beam downward sw flux @@ -2907,7 +2845,7 @@ kind = kind_phys active = (do_stochastically_perturbed_parameterizations) [spp_wts_sfc] - standard_name = spp_weights_for_surface_layer_scheme + standard_name = spp_weights_for_surface_layer_scheme long_name = spp weights for surface layer scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -2916,7 +2854,7 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_mp] standard_name = spp_weights_for_microphysics_scheme - long_name = spp weights for microphysics scheme + long_name = spp weights for microphysics scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -2924,7 +2862,7 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_gwd] standard_name = spp_weights_for_gravity_wave_drag_scheme - long_name = spp weights for gravity wave drag scheme + long_name = spp weights for gravity wave drag scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -2932,7 +2870,15 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_rad] standard_name = spp_weights_for_radiation_scheme - long_name = spp weights for radiation scheme + long_name = spp weights for radiation scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_wts_cu_deep] + standard_name = spp_weights_for_cu_deep_scheme + long_name = spp weights for cu deep scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -3726,7 +3672,7 @@ type = integer [inc_minor_gas] standard_name = flag_to_include_minor_gases_in_rrtmg - long_name = flag to include minor trace gases in rrtmg + long_name = flag to include minor trace gases in rrtmg units = flag dimensions = () type = logical @@ -5698,6 +5644,12 @@ units = flag dimensions = () type = logical +[ca_advect] + standard_name = flag_for_cellular_automata_advection + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical [ca_sgs] standard_name = flag_for_sgs_cellular_automata long_name = switch for sgs ca @@ -5853,7 +5805,7 @@ units = none dimensions = (number_of_perturbed_spp_schemes) type = character - kind = len=3 + kind = len=10 active = (do_stochastically_perturbed_parameterizations) [spp_pbl] standard_name = control_for_pbl_spp_perturbations @@ -5885,6 +5837,12 @@ units = count dimensions = () type = integer +[spp_cu_deep] + standard_name = control_for_deep_convection_spp_perturbations + long_name = control for deep convection spp perturbations + units = count + dimensions = () + type = integer [ntrac] standard_name = number_of_tracers long_name = number of tracers @@ -6325,7 +6283,7 @@ type = integer [ntbcl] standard_name = index_for_bcphilic - long_name = index for bcphilic + long_name = index for bcphilic units = index dimensions = () type = integer @@ -6337,7 +6295,7 @@ type = integer [ntocl] standard_name = index_for_ocphilic - long_name = index for ocphilic + long_name = index for ocphilic units = index dimensions = () type = integer @@ -6442,6 +6400,29 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[dust_moist_correction] + standard_name = dust_moist_correction_fengsha_dust_scheme + long_name = moisture correction term for fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_drylimit_factor] + standard_name = dust_drylimit_factor_fengsha_dust_scheme + long_name = moisture correction term for drylimit in fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_moist_opt] + standard_name = control_for_dust_soil_moisture_option + long_name = smoke dust moisture parameterization 1 - fecan 2 - shao + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) [dust_alpha] standard_name = alpha_fengsha_dust_scheme long_name = alpha paramter for fengsha dust scheme @@ -7147,6 +7128,12 @@ units = flag dimensions = () type = logical +[clm_debug_print] + standard_name = flag_for_printing_in_clm_lake_model + long_name = flag for printing in clm lake model + units = flag + dimensions = () + type = logical [fire_aux_data_levels] standard_name = fire_auxiliary_data_extent long_name = number of levels of fire auxiliary data diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index f14773d34..e3512528c 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2510,6 +2510,19 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo endif + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_cu_deep' + ExtDiag(idx)%desc = 'spp cu deep perturbation wts' + ExtDiag(idx)%unit = 'm/s' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_cu_deep(:,:) + enddo + endif + if (Model%lndp_type /= 0) then idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2696,8 +2709,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'lake_q2m' - ExtDiag(idx)%desc = 'Humidity at 2 m from Lake Model' - ExtDiag(idx)%unit = '%' + ExtDiag(idx)%desc = '2m specific humidity from Lake Model' + ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) @@ -4048,6 +4061,50 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%wetness(:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nirbmdi' + ExtDiag(idx)%desc = 'sfc nir beam sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nirbmdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nirdfdi' + ExtDiag(idx)%desc = 'sfc nir diff sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nirdfdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'visbmdi' + ExtDiag(idx)%desc = 'sfc uv+vis beam sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%visbmdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'visdfdi' + ExtDiag(idx)%desc = ' sfc uv+vis diff sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%visdfdi(:) + enddo + if (Model%rdlai) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5073,42 +5130,6 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, integer :: nk, idx0, iblk - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_z3d, 'lake_z3d', 'lake_depth_on_interface_levels', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_clay3d, 'lake_clay3d', 'percent clay on soil levels in clm lake model', '%') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_sand3d, 'lake_sand3d', 'percent sand on soil levels in clm lake model', '%') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_dz3d, 'lake_dz3d', 'lake level thickness', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_watsat3d, 'lake_soil_watsat3d', 'saturated volumetric soil water', 'm3 m-3') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_csol3d, 'lake_csol3d', 'soil heat capacity', 'J m-3 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') - enddo - do iblk=1,nblks call link_all_levels(Sfcprop(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm') enddo diff --git a/ccpp/physics b/ccpp/physics index 61b419f13..f3368e4ef 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 61b419f132ea24cbe191e34f1bbfcedf2c66e0dd +Subproject commit f3368e4efe8fae4f4ba62dd361109f14941fb28d diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml new file mode 100644 index 000000000..e9cdb1c40 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml @@ -0,0 +1,96 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_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_SCNV_generic_pre + samfshalcnv + GFS_SCNV_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 + + + + + GFS_stochastics + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml index a79f37f7f..d93060d5a 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml @@ -13,6 +13,7 @@ GFS_suite_interstitial_rad_reset + sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface rad_sw_pre @@ -20,6 +21,7 @@ rrtmg_sw_post rrtmg_lw_pre rrtmg_lw + sgscloud_radpost rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml new file mode 100644 index 000000000..fef14b176 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml @@ -0,0 +1,95 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_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_SCNV_generic_pre + samfshalcnv + GFS_SCNV_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 + + + + + GFS_stochastics + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml index ec55ee1ec..fe4feedc7 100644 --- a/ccpp/suites/suite_FV3_HRRR_c3.xml +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml b/ccpp/suites/suite_FV3_HRRR_gf.xml similarity index 98% rename from ccpp/suites_not_used/suite_FV3_HRRR_gf.xml rename to ccpp/suites/suite_FV3_HRRR_gf.xml index f8aade231..7e594e621 100644 --- a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 884a3bdeb..83d62ee30 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -64,7 +64,7 @@ module module_cplfields FieldInfo("mean_evap_rate ", "s"), & FieldInfo("mean_down_lw_flx ", "s"), & FieldInfo("mean_down_sw_flx ", "s"), & - FieldInfo("mean_prec_rate ", "s"), & + FieldInfo("inst_prec_rate ", "s"), & FieldInfo("inst_zonal_moment_flx ", "s"), & FieldInfo("inst_merid_moment_flx ", "s"), & FieldInfo("inst_sensi_heat_flx ", "s"), & @@ -106,7 +106,7 @@ module module_cplfields FieldInfo("inst_merid_wind_height_lowest ", "s"), & FieldInfo("inst_pres_height_lowest ", "s"), & FieldInfo("inst_height_lowest ", "s"), & - FieldInfo("mean_fprec_rate ", "s"), & + FieldInfo("inst_fprec_rate ", "s"), & FieldInfo("openwater_frac_in_atm ", "s"), & FieldInfo("ice_fraction_in_atm ", "s"), & FieldInfo("lake_fraction ", "s"), & @@ -122,7 +122,7 @@ module module_cplfields FieldInfo("inst_merid_wind_height_lowest_from_phys ", "s"), & FieldInfo("inst_pres_height_lowest_from_phys ", "s"), & FieldInfo("inst_spec_humid_height_lowest_from_phys ", "s"), & - FieldInfo("mean_prec_rate_conv ", "s"), & + FieldInfo("inst_prec_rate_conv ", "s"), & FieldInfo("inst_temp_height_lowest_from_phys ", "s"), & FieldInfo("inst_exner_function_height_lowest ", "s"), & FieldInfo("surface_friction_velocity ", "s"), & @@ -168,13 +168,13 @@ module module_cplfields FieldInfo("sea_ice_surface_temperature ", "s"), & FieldInfo("sea_surface_temperature ", "s"), & FieldInfo("ice_fraction ", "s"), & - FieldInfo("mean_up_lw_flx_ice ", "s"), & - FieldInfo("mean_laten_heat_flx_atm_into_ice ", "s"), & - FieldInfo("mean_sensi_heat_flx_atm_into_ice ", "s"), & + FieldInfo("lwup_flx_ice ", "s"), & + FieldInfo("laten_heat_flx_atm_into_ice ", "s"), & + FieldInfo("sensi_heat_flx_atm_into_ice ", "s"), & FieldInfo("stress_on_air_ice_zonal ", "s"), & FieldInfo("stress_on_air_ice_merid ", "s"), & - FieldInfo("mean_ice_volume ", "s"), & - FieldInfo("mean_snow_volume ", "s"), & + FieldInfo("sea_ice_volume ", "s"), & + FieldInfo("snow_volume_on_sea_ice ", "s"), & FieldInfo("inst_ice_ir_dif_albedo ", "s"), & FieldInfo("inst_ice_ir_dir_albedo ", "s"), & FieldInfo("inst_ice_vis_dif_albedo ", "s"), & @@ -185,9 +185,9 @@ module module_cplfields ! For receiving fluxes from mediator FieldInfo("stress_on_air_ocn_zonal ", "s"), & FieldInfo("stress_on_air_ocn_merid ", "s"), & - FieldInfo("mean_laten_heat_flx_atm_into_ocn ", "s"), & - FieldInfo("mean_sensi_heat_flx_atm_into_ocn ", "s"), & - FieldInfo("mean_up_lw_flx_ocn ", "s"), & + FieldInfo("laten_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("sensi_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("lwup_flx_ocn ", "s"), & ! For JEDI ! dynamics diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 50ad49104..efd84211f 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -70,11 +70,14 @@ module fv3atm_cap_mod logical, allocatable :: is_moving_FB(:) logical :: profile_memory = .true. + logical :: write_runtimelog = .false. + logical :: lprint = .false. integer :: mype = -1 integer :: dbug = 0 integer :: frestart(999) = -1 + real(kind=8) :: timere, timep2re !----------------------------------------------------------------------- contains @@ -209,7 +212,7 @@ subroutine InitializeAdvertise(gcomp, rc) integer :: wrttasks_per_group_from_parent, wrtLocalPet, num_threads character(len=64) :: rh_filename logical :: use_saved_routehandles, rh_file_exist - logical :: fieldbundle_is_restart = .false. + logical :: fieldbundle_uses_redist = .false. integer :: sloc type(ESMF_StaggerLoc) :: staggerloc @@ -246,6 +249,11 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") + call ESMF_AttributeGet(gcomp, name="RunTimeLog", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write_runtimelog = (trim(value)=="true") + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -290,7 +298,7 @@ subroutine InitializeAdvertise(gcomp, rc) noutput_fh = ESMF_ConfigGetLen(config=CF, label ='output_fh:',rc=rc) - if(mype == 0) print *,'af nems config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & + if(mype == 0) print *,'af ufs config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & ' noutput_fh=',noutput_fh ! nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 @@ -312,7 +320,7 @@ subroutine InitializeAdvertise(gcomp, rc) label ='isrcTermProcessing:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,quilting=',quilting,' write_groups=', & + if(mype == 0) print *,'af ufs config,quilting=',quilting,' write_groups=', & write_groups,wrttasks_per_group_from_parent,' isrcTermProcessing=', isrcTermProcessing ! call ESMF_ConfigGetAttribute(config=CF,value=num_files, & @@ -333,7 +341,7 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_ConfigGetAttribute(config=CF, value=nsout, label ='nsout:', default=-1,rc=rc) nsout_io = nsout ! - if(mype==0) print *,'af nems config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh + if(mype==0) print *,'af ufs config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh call ESMF_ConfigGetAttribute(config=CF, value=time_unlimited, label ='time_unlimited:', default=.false., rc=rc) @@ -341,12 +349,13 @@ subroutine InitializeAdvertise(gcomp, rc) ! call ESMF_ConfigGetAttribute(config=CF, value=dt_atmos, label ='dt_atmos:', rc=rc) call ESMF_ConfigGetAttribute(config=CF, value=nfhmax, label ='nhours_fcst:',rc=rc) - if(mype == 0) print *,'af nems config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax + if(mype == 0) print *,'af ufs config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax call ESMF_TimeIntervalSet(timeStep, s=dt_atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return first_kdt = 1 + if( mype == 0) lprint = .true. ! !####################################################################### ! set up fcst grid component @@ -486,6 +495,7 @@ subroutine InitializeAdvertise(gcomp, rc) enddo k = k + wrttasks_per_group_from_parent last_wrttask(i) = k - 1 + if( mype == lead_wrttask(i) ) lprint = .true. ! if(mype==0)print *,'af wrtComp(i)=',i,'k=',k ! prepare name of the wrtComp(i) @@ -698,11 +708,12 @@ subroutine InitializeAdvertise(gcomp, rc) if(mype == 0) print *,'af get wrtfb=',"output_"//trim(fcstItemNameList(j)),' rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - fieldbundle_is_restart = .false. + fieldbundle_uses_redist = .false. + ! if (fcstItemNameList(j)(1:8) == "restart_" .or. fcstItemNameList(j)(1:18) == "cubed_sphere_grid_") then if (fcstItemNameList(j)(1:8) == "restart_") then ! restart output forecast bundles, no need to set regridmethod ! Redist will be used instead of Regrid - fieldbundle_is_restart = .true. + fieldbundle_uses_redist = .true. else ! history output forecast bundles ! determine regridmethod @@ -739,7 +750,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else ! this is a Store() for the first wrtComp -> must do the Store() - if (fieldbundle_is_restart) then + if (fieldbundle_uses_redist) then call ESMF_TraceRegionEnter("ESMF_FieldBundleRedistStore()", rc=rc) call ESMF_FieldBundleRedistStore(fcstFB(j), wrtFB(j,1), & routehandle=routehandle(j,1), & @@ -970,8 +981,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' - if(mype==0) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis + if(write_runtimelog .and. lprint) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis,mype !----------------------------------------------------------------------- ! end subroutine InitializeAdvertise @@ -988,7 +998,10 @@ subroutine InitializeRealize(gcomp, rc) type(ESMF_State) :: importState, exportState integer :: urc + real(8) :: MPI_Wtime, timeirs + rc = ESMF_SUCCESS + timeirs = MPI_Wtime() ! query for importState and exportState call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -1003,6 +1016,11 @@ subroutine InitializeRealize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + timere = 0. + timep2re = 0. + + if(write_runtimelog .and. lprint) print *,'in fv3_cap, initirealz time=',MPI_Wtime()-timeirs,mype + end subroutine InitializeRealize !----------------------------------------------------------------------------- @@ -1011,10 +1029,13 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + real(kind=8) :: MPI_Wtime, timers !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timers = MPI_Wtime() + if(write_runtimelog .and. timere>0. .and. lprint) print *,'in fv3_cap, time between fv3 run step=', timers-timere,mype if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance: ") @@ -1026,6 +1047,9 @@ subroutine ModelAdvance(gcomp, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance: ") + timere = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap, time in fv3 run step=', timere-timers, mype + end subroutine ModelAdvance !----------------------------------------------------------------------------- @@ -1040,10 +1064,13 @@ subroutine ModelAdvance_phase1(gcomp, rc) logical :: fcstpe character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' character(240) :: msgString + real(kind=8) :: MPI_Wtime, timep1rs, timep1re !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep1rs = MPI_Wtime() + if(write_runtimelog .and. timep2re>0. .and. lprint) print *,'in fv3_cap, time between fv3 run phase2 and phase1 ', timep1rs-timep2re,mype if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase1: ") @@ -1073,6 +1100,8 @@ subroutine ModelAdvance_phase1(gcomp, rc) call diagnose_cplFields(gcomp, clock, fcstpe, cplprint_flag, dbug, 'import') endif + timep1re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase1 time ', timep1re-timep1rs,mype if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase1: ") end subroutine ModelAdvance_phase1 @@ -1097,10 +1126,14 @@ subroutine ModelAdvance_phase2(gcomp, rc) character(240) :: msgString type(ESMF_Clock) :: clock, clock_out + integer :: fieldCount + + real(kind=8) :: MPI_Wtime, timep2rs !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep2rs = MPI_Wtime() if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase2: ") @@ -1147,12 +1180,17 @@ subroutine ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()) - call ESMF_FieldBundleSMM(fcstFB(j), wrtFB(j,n_group), & - routehandle=routehandle(j, n_group), & - termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()), only if there are fields in the bundle + call ESMF_FieldBundleGet(fcstFB(j), fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + call ESMF_FieldBundleSMM(fcstFB(j), wrtFB(j,n_group), & + routehandle=routehandle(j, n_group), & + termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + enddo call ESMF_VMEpochExit(rc=rc) @@ -1199,6 +1237,8 @@ subroutine ModelAdvance_phase2(gcomp, rc) call diagnose_cplFields(gcomp, clock_out, fcstpe, cplprint_flag, dbug, 'export') end if + timep2re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase2 time ', timep2re-timep2rs, mype if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase2: ") end subroutine ModelAdvance_phase2 @@ -1373,8 +1413,8 @@ subroutine ModelFinalize(gcomp, rc) !----------------------------------------------------------------------------- !*** finialize forecast - timeffs = MPI_Wtime() rc = ESMF_SUCCESS + timeffs = MPI_Wtime() ! call ESMF_GridCompGet(gcomp,vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1407,7 +1447,7 @@ subroutine ModelFinalize(gcomp, rc) call ESMF_GridCompDestroy(fcstComp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - if(mype==0)print *,' wrt grid comp destroy time=',MPI_Wtime()-timeffs + if(write_runtimelog .and. lprint) print *,'in fv3_cap, finalize time=',MPI_Wtime()-timeffs, mype end subroutine ModelFinalize ! diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index 5c61a26be..37c221597 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -12,9 +12,9 @@ module fv3atm_clm_lake_io use block_control_mod, only: block_control_type use fms2_io_mod, only: FmsNetcdfDomainFile_t, register_axis, & register_restart_field, write_data, & - register_variable_attribute, register_field + register_variable_attribute, register_field, get_dimension_size use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle + create_3d_field_and_add_to_bundle, axis_type implicit none @@ -22,7 +22,7 @@ module fv3atm_clm_lake_io public :: clm_lake_data_type, clm_lake_register_axes, clm_lake_allocate_data, & clm_lake_register_fields, clm_lake_deallocate_data, clm_lake_write_axes, & clm_lake_copy_from_grid, clm_lake_copy_to_grid, clm_lake_bundle_fields, & - clm_lake_final + clm_lake_final, clm_lake_fill_data !>\defgroup CLM Lake Model restart public interface !> @{ @@ -39,21 +39,19 @@ module fv3atm_clm_lake_io real(kind_phys), pointer, private, dimension(:,:) :: & T_snow=>null(), T_ice=>null(), & lake_snl2d=>null(), lake_h2osno2d=>null(), lake_tsfc=>null(), clm_lakedepth=>null(), & - lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null() + lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null(), & + input_lakedepth=>null() ! All 3D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:,:) :: & - lake_z3d=>null(), lake_dz3d=>null(), lake_soil_watsat3d=>null(), & - lake_csol3d=>null(), lake_soil_tkmg3d=>null(), lake_soil_tkdry3d=>null(), & - lake_soil_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & lake_snow_zi3d=>null(), lake_h2osoi_vol3d=>null(), lake_h2osoi_liq3d=>null(), & lake_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & - lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() + lake_icefrac3d=>null() ! Axis indices in 1-based array, containing non-1-based indices real(kind_phys), pointer, private, dimension(:) :: & - levlake_clm_lake, levsoil_clm_lake, levsnowsoil_clm_lake, & - levsnowsoil1_clm_lake + levlake_clm_lake, levsnowsoil_clm_lake, levsnowsoil1_clm_lake contains ! register_axes calls registers_axis on Sfc_restart for all required axes @@ -73,6 +71,9 @@ module fv3atm_clm_lake_io ! each axis, containing the appropriate information procedure, public :: write_axes => clm_lake_write_axes + ! fills internal arrays with zero: + procedure, public :: fill_data => clm_lake_fill_data + ! copy_from_grid copies from Sfcprop to internal pointers (declared above) procedure, public :: copy_from_grid => clm_lake_copy_from_grid @@ -114,14 +115,8 @@ subroutine clm_lake_allocate_data(clm_lake,Model) allocate(clm_lake%lake_sndpth2d(nx,ny)) allocate(clm_lake%clm_lakedepth(nx,ny)) allocate(clm_lake%clm_lake_initialized(nx,ny)) + allocate(clm_lake%input_lakedepth(nx,ny)) - allocate(clm_lake%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_watsat3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) allocate(clm_lake%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) @@ -131,20 +126,14 @@ subroutine clm_lake_allocate_data(clm_lake,Model) allocate(clm_lake%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) allocate(clm_lake%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) - allocate(clm_lake%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) allocate(clm_lake%levlake_clm_lake(Model%nlevlake_clm_lake)) - allocate(clm_lake%levsoil_clm_lake(Model%nlevsoil_clm_lake)) allocate(clm_lake%levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake)) allocate(clm_lake%levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake)) do i=1,Model%nlevlake_clm_lake clm_lake%levlake_clm_lake(i) = i enddo - do i=1,Model%nlevsoil_clm_lake - clm_lake%levsoil_clm_lake(i) = i - enddo do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake clm_lake%levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i enddo @@ -162,7 +151,6 @@ subroutine clm_lake_register_axes(clm_lake,Model,Sfc_restart) type(FmsNetcdfDomainFile_t) :: Sfc_restart call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) - call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) end subroutine clm_lake_register_axes @@ -176,24 +164,67 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) type(GFS_control_type), intent(in) :: Model type(FmsNetcdfDomainFile_t) :: Sfc_restart integer :: i - call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) + call register_field(Sfc_restart, 'levlake_clm_lake', axis_type, (/'levlake_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) + call register_field(Sfc_restart, 'levsnowsoil_clm_lake', axis_type, (/'levsnowsoil_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) + call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', axis_type, (/'levsnowsoil1_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) call write_data(Sfc_restart, 'levlake_clm_lake', clm_lake%levlake_clm_lake) - call write_data(Sfc_restart, 'levsoil_clm_lake', clm_lake%levsoil_clm_lake) call write_data(Sfc_restart, 'levsnowsoil_clm_lake', clm_lake%levsnowsoil_clm_lake) call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', clm_lake%levsnowsoil1_clm_lake) end subroutine clm_lake_write_axes + !>@ This is clm_lake%fill_data. It fills internal arrays with zero + !! Terrible things will happen if you don't call + !! clm_lake%allocate_data first. + subroutine clm_lake_fill_data(clm_lake, Model, Atm_block, Sfcprop) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + real(kind_phys), parameter :: zero = 0 + integer :: nb, ix, isc, jsc, i, j + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + + !$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 + + clm_lake%T_snow(i,j) = zero + clm_lake%T_ice(i,j) = zero + clm_lake%lake_snl2d(i,j) = zero + clm_lake%lake_h2osno2d(i,j) = zero + clm_lake%lake_tsfc(i,j) = zero + clm_lake%lake_savedtke12d(i,j) = zero + clm_lake%lake_sndpth2d(i,j) = zero + clm_lake%clm_lakedepth(i,j) = zero + clm_lake%clm_lake_initialized(i,j) = zero + clm_lake%input_lakedepth(i,j) = zero + + clm_lake%lake_snow_z3d(i,j,:) = zero + clm_lake%lake_snow_dz3d(i,j,:) = zero + clm_lake%lake_snow_zi3d(i,j,:) = zero + clm_lake%lake_h2osoi_vol3d(i,j,:) = zero + clm_lake%lake_h2osoi_liq3d(i,j,:) = zero + clm_lake%lake_h2osoi_ice3d(i,j,:) = zero + clm_lake%lake_t_soisno3d(i,j,:) = zero + clm_lake%lake_t_lake3d(i,j,:) = zero + clm_lake%lake_icefrac3d(i,j,:) = zero + enddo + enddo + end subroutine clm_lake_fill_data + !>@ This is clm_lake%copy_from_grid. It copies from Sfcprop !! variables to the corresponding data temporary variables. !! Terrible things will happen if you don't call @@ -226,14 +257,8 @@ subroutine clm_lake_copy_from_grid(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_sndpth2d(i,j) = Sfcprop(nb)%lake_sndpth2d(ix) clm_lake%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) clm_lake%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) + clm_lake%input_lakedepth(i,j) = Sfcprop(nb)%input_lakedepth(ix) - clm_lake%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) - clm_lake%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) - clm_lake%lake_soil_watsat3d(i,j,:) = Sfcprop(nb)%lake_soil_watsat3d(ix,:) - clm_lake%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) - clm_lake%lake_soil_tkmg3d(i,j,:) = Sfcprop(nb)%lake_soil_tkmg3d(ix,:) - clm_lake%lake_soil_tkdry3d(i,j,:) = Sfcprop(nb)%lake_soil_tkdry3d(ix,:) - clm_lake%lake_soil_tksatu3d(i,j,:) = Sfcprop(nb)%lake_soil_tksatu3d(ix,:) clm_lake%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) clm_lake%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) clm_lake%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) @@ -243,8 +268,6 @@ subroutine clm_lake_copy_from_grid(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) clm_lake%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) clm_lake%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) - clm_lake%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) - clm_lake%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) enddo enddo end subroutine clm_lake_copy_from_grid @@ -280,14 +303,8 @@ subroutine clm_lake_copy_to_grid(clm_lake, Model, Atm_block, Sfcprop) Sfcprop(nb)%lake_sndpth2d(ix) = clm_lake%lake_sndpth2d(i,j) Sfcprop(nb)%clm_lakedepth(ix) = clm_lake%clm_lakedepth(i,j) Sfcprop(nb)%clm_lake_initialized(ix) = clm_lake%clm_lake_initialized(i,j) + Sfcprop(nb)%input_lakedepth(ix) = clm_lake%input_lakedepth(i,j) - Sfcprop(nb)%lake_z3d(ix,:) = clm_lake%lake_z3d(i,j,:) - Sfcprop(nb)%lake_dz3d(ix,:) = clm_lake%lake_dz3d(i,j,:) - Sfcprop(nb)%lake_soil_watsat3d(ix,:) = clm_lake%lake_soil_watsat3d(i,j,:) - Sfcprop(nb)%lake_csol3d(ix,:) = clm_lake%lake_csol3d(i,j,:) - Sfcprop(nb)%lake_soil_tkmg3d(ix,:) = clm_lake%lake_soil_tkmg3d(i,j,:) - Sfcprop(nb)%lake_soil_tkdry3d(ix,:) = clm_lake%lake_soil_tkdry3d(i,j,:) - Sfcprop(nb)%lake_soil_tksatu3d(ix,:) = clm_lake%lake_soil_tksatu3d(i,j,:) Sfcprop(nb)%lake_snow_z3d(ix,:) = clm_lake%lake_snow_z3d(i,j,:) Sfcprop(nb)%lake_snow_dz3d(ix,:) = clm_lake%lake_snow_dz3d(i,j,:) Sfcprop(nb)%lake_snow_zi3d(ix,:) = clm_lake%lake_snow_zi3d(i,j,:) @@ -297,8 +314,6 @@ subroutine clm_lake_copy_to_grid(clm_lake, Model, Atm_block, Sfcprop) Sfcprop(nb)%lake_t_soisno3d(ix,:) = clm_lake%lake_t_soisno3d(i,j,:) Sfcprop(nb)%lake_t_lake3d(ix,:) = clm_lake%lake_t_lake3d(i,j,:) Sfcprop(nb)%lake_icefrac3d(ix,:) = clm_lake%lake_icefrac3d(i,j,:) - Sfcprop(nb)%lake_clay3d(ix,:) = clm_lake%lake_clay3d(i,j,:) - Sfcprop(nb)%lake_sand3d(ix,:) = clm_lake%lake_sand3d(i,j,:) enddo enddo end subroutine clm_lake_copy_to_grid @@ -312,81 +327,64 @@ subroutine clm_lake_register_fields(clm_lake, Sfc_restart) class(clm_lake_data_type) :: clm_lake type(FmsNetcdfDomainFile_t) :: Sfc_restart + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3), chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + chunksizes2d = (/xaxis_1_chunk, yaxis_1_chunk, 1/) + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + ! Register 2D fields call register_restart_field(Sfc_restart, 'T_snow', clm_lake%T_snow, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'T_ice', clm_lake%T_ice, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_snl2d', clm_lake%lake_snl2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_h2osno2d', clm_lake%lake_h2osno2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_tsfc', clm_lake%lake_tsfc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_savedtke12d', clm_lake%lake_savedtke12d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_sndpth2d', clm_lake%lake_sndpth2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lakedepth', clm_lake%clm_lakedepth, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lake_initialized', clm_lake%clm_lake_initialized, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) + call register_restart_field(Sfc_restart, 'input_lakedepth', clm_lake%input_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) ! Register 3D fields - call register_restart_field(Sfc_restart, 'lake_z3d', clm_lake%lake_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dz3d', clm_lake%lake_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_watsat3d', clm_lake%lake_soil_watsat3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_csol3d', clm_lake%lake_csol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', clm_lake%lake_soil_tkmg3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', clm_lake%lake_soil_tkdry3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', clm_lake%lake_soil_tksatu3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_z3d', clm_lake%lake_snow_z3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_dz3d', clm_lake%lake_snow_dz3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_zi3d', clm_lake%lake_snow_zi3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) + 'levsnowsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_vol3d', clm_lake%lake_h2osoi_vol3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_liq3d', clm_lake%lake_h2osoi_liq3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_ice3d', clm_lake%lake_h2osoi_ice3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_soisno3d', clm_lake%lake_t_soisno3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_lake3d', clm_lake%lake_t_lake3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_icefrac3d', clm_lake%lake_icefrac3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_clay3d', clm_lake%lake_clay3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_sand3d', clm_lake%lake_sand3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) end subroutine clm_lake_register_fields !>@ This is clm_lake%bundle_fields, and it is only used in the @@ -418,22 +416,9 @@ subroutine clm_lake_bundle_fields(clm_lake, bundle, grid, Model, outputfile) call create_2d_field_and_add_to_bundle(clm_lake%lake_sndpth2d, "lake_sndpth2d", trim(outputfile), grid, bundle) call create_2d_field_and_add_to_bundle(clm_lake%clm_lakedepth, "clm_lakedepth", trim(outputfile), grid, bundle) call create_2d_field_and_add_to_bundle(clm_lake%clm_lake_initialized, "clm_lake_initialized", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%input_lakedepth, "input_lakedepth", trim(outputfile), grid, bundle) ! Register 3D fields - call create_3d_field_and_add_to_bundle(clm_lake%lake_z3d, 'lake_z3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_dz3d, 'lake_dz3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_watsat3d, 'lake_soil_watsat3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_csol3d, 'lake_csol3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_z3d, 'lake_snow_z3d', 'levsnowsoil1_clm_lake', & clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_dz3d, 'lake_snow_dz3d', 'levsnowsoil1_clm_lake', & @@ -452,10 +437,6 @@ subroutine clm_lake_bundle_fields(clm_lake, bundle, grid, Model, outputfile) clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_icefrac3d, 'lake_icefrac3d', 'levlake_clm_lake', & clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_clay3d, 'lake_clay3d', 'levsoil_clm_lake', & - clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_sand3d, 'lake_sand3d', 'levsoil_clm_lake', & - clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) end subroutine Clm_lake_bundle_fields @@ -494,14 +475,8 @@ subroutine clm_lake_deallocate_data(clm_lake) IF_ASSOC_DEALLOC_NULL(lake_sndpth2d) IF_ASSOC_DEALLOC_NULL(clm_lakedepth) IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) + IF_ASSOC_DEALLOC_NULL(input_lakedepth) - IF_ASSOC_DEALLOC_NULL(lake_z3d) - IF_ASSOC_DEALLOC_NULL(lake_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_watsat3d) - IF_ASSOC_DEALLOC_NULL(lake_csol3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkmg3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkdry3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tksatu3d) IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) @@ -511,8 +486,6 @@ subroutine clm_lake_deallocate_data(clm_lake) IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) - IF_ASSOC_DEALLOC_NULL(lake_clay3d) - IF_ASSOC_DEALLOC_NULL(lake_sand3d) #undef IF_ASSOC_DEALLOC_NULL end subroutine clm_lake_deallocate_data diff --git a/io/fv3atm_common_io.F90 b/io/fv3atm_common_io.F90 index 1143f23ac..faee19306 100644 --- a/io/fv3atm_common_io.F90 +++ b/io/fv3atm_common_io.F90 @@ -31,6 +31,12 @@ module fv3atm_common_io public :: get_nx_ny_from_atm +#ifdef CCPP_32BIT + character(len=5), parameter, public :: axis_type = 'float' +#else + character(len=6), parameter, public :: axis_type = 'double' +#endif + !>\defgroup fv3atm_common_io FV3ATM Common I/O Utilities Module !> @{ diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index ccdc6d719..39d2131b9 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -14,10 +14,10 @@ module fv3atm_restart_io_mod register_axis, register_restart_field, & register_variable_attribute, register_field, & read_restart, write_restart, write_data, & - get_global_io_domain_indices + get_global_io_domain_indices, get_dimension_size use mpp_domains_mod, only: domain2d use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle, copy_from_gfs_data + create_3d_field_and_add_to_bundle, copy_from_gfs_data, axis_type use fv3atm_sfc_io use fv3atm_rrfs_sd_io use fv3atm_clm_lake_io @@ -651,6 +651,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Tell CLM Lake to allocate data, and register its axes and fields if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) + call clm_lake%fill_data(Model,Atm_block,Sfcprop) call clm_lake%copy_from_grid(Model,Atm_block,Sfcprop) call clm_lake%register_axes(Model, Sfc_restart) call clm_lake%register_fields(Sfc_restart) @@ -890,6 +891,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta character(7) :: indir='RESTART' character(72) :: infile logical :: amiopen, allocated_something + integer :: xaxis_1_chunk, yaxis_1_chunk type(phy_data_type) :: phy type(FmsNetcdfDomainFile_t) :: Phy_restart @@ -911,21 +913,23 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta amiopen=open_file(Phy_restart, trim(infile), 'overwrite', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) if( amiopen ) then call register_axis(Phy_restart, 'xaxis_1', 'X') - call register_field(Phy_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_field(Phy_restart, 'xaxis_1', axis_type, (/'xaxis_1'/)) call register_variable_attribute(Phy_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) call get_global_io_domain_indices(Phy_restart, 'xaxis_1', is, ie, indices=buffer) call write_data(Phy_restart, "xaxis_1", buffer) deallocate(buffer) + call get_dimension_size(Phy_restart, 'xaxis_1', xaxis_1_chunk) call register_axis(Phy_restart, 'yaxis_1', 'Y') - call register_field(Phy_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_field(Phy_restart, 'yaxis_1', axis_type, (/'yaxis_1'/)) call register_variable_attribute(Phy_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) call get_global_io_domain_indices(Phy_restart, 'yaxis_1', is, ie, indices=buffer) call write_data(Phy_restart, "yaxis_1", buffer) deallocate(buffer) + call get_dimension_size(Phy_restart, 'yaxis_1', yaxis_1_chunk) call register_axis(Phy_restart, 'zaxis_1', phy%npz) - call register_field(Phy_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_field(Phy_restart, 'zaxis_1', axis_type, (/'zaxis_1'/)) call register_variable_attribute(Phy_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) allocate( buffer(phy%npz) ) do i=1, phy%npz @@ -935,7 +939,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta deallocate(buffer) call register_axis(Phy_restart, 'Time', unlimited) - call register_field(Phy_restart, 'Time', 'double', (/'Time'/)) + call register_field(Phy_restart, 'Time', axis_type, (/'Time'/)) call register_variable_attribute(Phy_restart, 'Time', 'cartesian_axis', 'T', str_len=1) call write_data(Phy_restart, "Time", 1) else @@ -945,12 +949,12 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,phy%nvar2d var2_p => phy%var2(:,:,num) call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& - &is_optional=.true.) + & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1/), is_optional=.true.) enddo do num = 1,phy%nvar3d var3_p => phy%var3(:,:,:,num) call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& - &is_optional=.true.) + & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1,1/), is_optional=.true.) enddo nullify(var2_p) nullify(var3_p) @@ -985,10 +989,12 @@ subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) if(Model%iopt_lake == 2 .and. Model%lkm > 0) then call clm_lake_quilt%allocate_data(Model) + call clm_lake_quilt%fill_data(Model, Atm_block, Sfcprop) endif if(Model%rrfs_sd) then call rrfs_sd_quilt%allocate_data(Model) + call rrfs_sd_quilt%fill_data(Model, Atm_block, Sfcprop) endif end subroutine fv3atm_restart_register diff --git a/io/fv3atm_rrfs_sd_io.F90 b/io/fv3atm_rrfs_sd_io.F90 index c6dc44e34..780153208 100644 --- a/io/fv3atm_rrfs_sd_io.F90 +++ b/io/fv3atm_rrfs_sd_io.F90 @@ -6,10 +6,11 @@ module fv3atm_rrfs_sd_io use block_control_mod, only: block_control_type use fms2_io_mod, only: FmsNetcdfDomainFile_t, write_data, & register_axis, register_restart_field, & - register_variable_attribute, register_field + register_variable_attribute, register_field, & + get_dimension_size use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys use fv3atm_common_io, only: get_nx_ny_from_atm, create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle + create_3d_field_and_add_to_bundle, axis_type implicit none @@ -113,7 +114,7 @@ subroutine rrfs_sd_state_write_axis(data,Model,Sfc_restart) type(FmsNetcdfDomainFile_t) :: Sfc_restart type(GFS_control_type), intent(in) :: Model - call register_field(Sfc_restart, 'fire_aux_data_levels', 'double', (/'fire_aux_data_levels'/)) + call register_field(Sfc_restart, 'fire_aux_data_levels', axis_type, (/'fire_aux_data_levels'/)) call register_variable_attribute(Sfc_restart, 'fire_aux_data_levels', 'cartesian_axis' ,'Z', str_len=1) call write_data(Sfc_restart, 'fire_aux_data_levels', data%fire_aux_data_levels) end subroutine rrfs_sd_state_write_axis @@ -193,23 +194,31 @@ subroutine rrfs_sd_state_register_fields(data,Sfc_restart) class(rrfs_sd_state_type) :: data type(FmsNetcdfDomainFile_t) :: Sfc_restart + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3), chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + chunksizes2d = (/xaxis_1_chunk, yaxis_1_chunk, 1/) + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + ! Register 2D fields call register_restart_field(Sfc_restart, 'emdust', data%emdust, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'emseas', data%emseas, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'emanoc', data%emanoc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'fhist', data%fhist, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, 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.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, 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.) + chunksizes=chunksizes3d, is_optional=.true.) end subroutine rrfs_sd_state_register_fields ! -------------------------------------------------------------------- diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 index 6cd007761..c0bfcf6d9 100644 --- a/io/fv3atm_sfc_io.F90 +++ b/io/fv3atm_sfc_io.F90 @@ -9,8 +9,9 @@ module fv3atm_sfc_io use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, write_data,& register_axis, register_restart_field, & register_variable_attribute, register_field, & - get_global_io_domain_indices, variable_exists - use fv3atm_common_io, only: GFS_Data_transfer, & + get_global_io_domain_indices, variable_exists, & + get_dimension_size + use fv3atm_common_io, only: GFS_Data_transfer, axis_type, & create_2d_field_and_add_to_bundle, create_3d_field_and_add_to_bundle use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys use mpp_mod, only: mpp_error, NOTE @@ -308,19 +309,19 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) integer :: i, is, ie logical :: mand - call register_field(Sfc_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_field(Sfc_restart, 'xaxis_1', axis_type, (/'xaxis_1'/)) call register_variable_attribute(Sfc_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) call get_global_io_domain_indices(Sfc_restart, 'xaxis_1', is, ie, indices=buffer) call write_data(Sfc_restart, "xaxis_1", buffer) deallocate(buffer) - call register_field(Sfc_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_field(Sfc_restart, 'yaxis_1', axis_type, (/'yaxis_1'/)) call register_variable_attribute(Sfc_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) call get_global_io_domain_indices(Sfc_restart, 'yaxis_1', is, ie, indices=buffer) call write_data(Sfc_restart, "yaxis_1", buffer) deallocate(buffer) - call register_field(Sfc_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_field(Sfc_restart, 'zaxis_1', axis_type, (/'zaxis_1'/)) call register_variable_attribute(Sfc_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) allocate( buffer(Model%kice) ) do i=1, Model%kice @@ -330,7 +331,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) deallocate(buffer) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - call register_field(Sfc_restart, 'zaxis_2', 'double', (/'zaxis_2'/)) + call register_field(Sfc_restart, 'zaxis_2', axis_type, (/'zaxis_2'/)) call register_variable_attribute(Sfc_restart, 'zaxis_2', 'cartesian_axis', 'Z', str_len=1) allocate( buffer(Model%lsoil) ) do i=1, Model%lsoil @@ -341,7 +342,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) endif if(Model%lsm == Model%lsm_noahmp) then - call register_field(Sfc_restart, 'zaxis_3', 'double', (/'zaxis_3'/)) + call register_field(Sfc_restart, 'zaxis_3', axis_type, (/'zaxis_3'/)) call register_variable_attribute(Sfc_restart, 'zaxis_3', 'cartesian_axis', 'Z', str_len=1) allocate(buffer(3)) do i=1, 3 @@ -350,7 +351,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) call write_data(Sfc_restart, 'zaxis_3', buffer) deallocate(buffer) - call register_field(Sfc_restart, 'zaxis_4', 'double', (/'zaxis_4'/)) + call register_field(Sfc_restart, 'zaxis_4', axis_type, (/'zaxis_4'/)) call register_variable_attribute(Sfc_restart, 'zaxis_4', 'cartesian_axis' ,'Z', str_len=1) allocate(buffer(7)) do i=1, 7 @@ -359,7 +360,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) call write_data(Sfc_restart, 'zaxis_4', buffer) deallocate(buffer) end if - call register_field(Sfc_restart, 'Time', 'double', (/'Time'/)) + call register_field(Sfc_restart, 'Time', axis_type, (/'Time'/)) call register_variable_attribute(Sfc_restart, 'Time', 'cartesian_axis', 'T', str_len=1) call write_data( Sfc_restart, 'Time', 1) end subroutine Sfc_io_write_axes @@ -575,8 +576,15 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) character(len=7) :: time2d(3) + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + if(.not.reading) then time2d=(/'xaxis_1','yaxis_1','Time '/) + chunksizes2d=(/xaxis_1_chunk, yaxis_1_chunk, 1/) else time2d=(/'Time ','yaxis_1','xaxis_1'/) endif @@ -599,13 +607,13 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) else call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d,& - &is_optional=.true.) + & chunksizes=chunksizes2d, is_optional=.true.) end if else if(reading .and. sfc%is_lsoil) then call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=(/'lat','lon'/)) else - call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d) + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d, chunksizes=chunksizes2d) end if endif enddo @@ -618,7 +626,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%is_lsoil) then call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) else - call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) endif enddo endif @@ -629,7 +637,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%is_lsoil) then call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/) ) else - call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d) end if enddo endif ! mp/ruc @@ -643,7 +651,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%is_lsoil) then call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) else - call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) end if enddo endif ! noahmp @@ -656,7 +664,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%is_lsoil) then call register_restart_field(Sfc_restart, sfc%name2(num),var2_p,dimensions=(/'lat','lon'/), is_optional=.not.mand) else - call register_restart_field(Sfc_restart, sfc%name2(num),var2_p,dimensions=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num),var2_p,dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) endif enddo endif @@ -684,9 +692,17 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) character(len=7), parameter :: xyz3_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/) character(len=7), parameter :: xyz4_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/) + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + !--- register the 3D fields var3_p => sfc%var3ice(:,:,:) - call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, is_optional=.true.) + call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d, is_optional=.true.) if(reading) then do num = 1,sfc%nvar3 @@ -706,13 +722,13 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) elseif(Model%lsm == Model%lsm_ruc) then do num = 1,sfc%nvar3 var3_p => sfc%var3(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz1_time) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d) enddo nullify(var3_p) else ! writing something other than ruc do num = 1,sfc%nvar3 var3_p => sfc%var3(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz2_time) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz2_time, chunksizes=chunksizes3d) enddo nullify(var3_p) endif @@ -721,14 +737,14 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) mand = .not.reading do num = sfc%nvar3+1,sfc%nvar3+3 var3_p1 => sfc%var3sn(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p1, dimensions=xyz3_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p1, dimensions=xyz3_time, chunksizes=chunksizes3d, is_optional=.not.mand) enddo var3_p2 => sfc%var3eq(:,:,:,7) - call register_restart_field(Sfc_restart, sfc%name3(7), var3_p2, dimensions=xyz2_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(7), var3_p2, dimensions=xyz2_time, chunksizes=chunksizes3d, is_optional=.not.mand) var3_p3 => sfc%var3zn(:,:,:,8) - call register_restart_field(Sfc_restart, sfc%name3(8), var3_p3, dimensions=xyz4_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(8), var3_p3, dimensions=xyz4_time, chunksizes=chunksizes3d, is_optional=.not.mand) endif !mp end subroutine Sfc_io_register_3d_fields diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 380ea5975..4b0506549 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -11,7 +11,7 @@ module module_write_netcdf use netcdf use module_fv3_io_def,only : ideflate, nbits, & ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, & - output_grid,dx,dy,lon1,lat1,lon2,lat2, & + dx,dy,lon1,lat1,lon2,lat2, & time_unlimited use mpi @@ -95,6 +95,7 @@ subroutine write_netcdf(wrtfb, filename, & integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap logical :: do_io integer :: par_access + character(len=ESMF_MAXSTR) :: output_grid_name ! is_cubed_sphere = .false. tileCount = 0 @@ -106,13 +107,15 @@ subroutine write_netcdf(wrtfb, filename, & do_io = par .or. (mype==0) call ESMF_FieldBundleGet(wrtfb, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_AttributeGet(wrtfb, convention="NetCDF", purpose="FV3", & + name='grid', value=output_grid_name, rc=rc); ESMF_ERR_RETURN(rc) allocate(compress_err(fieldCount)); compress_err=-999. allocate(fldlev(fieldCount)) ; fldlev = 0 allocate(fcstField(fieldCount)) allocate(varids(fieldCount)) - call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtGrid, & + call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtgrid, & ! itemorderflag=ESMF_ITEMORDER_ADDORDER, & rc=rc); ESMF_ERR_RETURN(rc) @@ -162,6 +165,10 @@ subroutine write_netcdf(wrtfb, filename, & start_i = 1 start_j = 1 end if + if (is_cubed_sphere) then + start_i = mod(start_i, im) + start_j = mod(start_j, jm) + end if end if if (fieldDimCount > gridDimCount) then @@ -240,21 +247,18 @@ subroutine write_netcdf(wrtfb, filename, & ncerr = nf90_put_att(ncid, timeiso_varid, "_Encoding", "UTF-8"); NC_ERR_STOP(ncerr) ! coordinate variable attributes based on output_grid type - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. & + trim(output_grid_name) == 'latlon') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr) @@ -466,10 +470,10 @@ subroutine write_netcdf(wrtfb, filename, & ! write lon (lon_varid) if (par) then - call ESMF_GridGetCoord(wrtGrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_put_var(ncid, lon_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) else - call ESMF_GridGetCoord(wrtGrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) if (is_cubed_sphere) then do t=1,tileCount call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) @@ -491,39 +495,35 @@ subroutine write_netcdf(wrtfb, filename, & ! write grid_xt (im_varid) if (do_io) then allocate (x(im)) - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then ncerr = nf90_put_var(ncid, im_varid, values=array_r8(:,jstart), start=[istart], count=[iend-istart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then do i=1,im x(i) = lon1(grid_id) + (lon2(grid_id)-lon1(grid_id))/(im-1) * (i-1) end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then do i=1,im x(i) = dx(grid_id) * (i-1) end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + else if (trim(output_grid_name) == 'cubed_sphere') then do i=1,im x(i) = i end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) else - if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if end if ! write lat (lat_varid) if (par) then - call ESMF_GridGetCoord(wrtGrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_put_var(ncid, lat_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) else - call ESMF_GridGetCoord(wrtGrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) if (is_cubed_sphere) then do t=1,tileCount call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) @@ -542,29 +542,25 @@ subroutine write_netcdf(wrtfb, filename, & ! write grid_yt (jm_varid) if (do_io) then allocate (y(jm)) - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then ncerr = nf90_put_var(ncid, jm_varid, values=array_r8(istart,:), start=[jstart], count=[jend-jstart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then do j=1,jm y(j) = lat1(grid_id) + (lat2(grid_id)-lat1(grid_id))/(jm-1) * (j-1) end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then do j=1,jm y(j) = dy(grid_id) * (j-1) end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + else if (trim(output_grid_name) == 'cubed_sphere') then do j=1,jm y(j) = j end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) else - if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if end if diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index 259079bb2..7904fe4cd 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -74,7 +74,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & integer :: ncerr,ierr integer :: ncid integer :: oldMode - integer :: dimid + integer :: dimid, dimtype integer :: im_dimid, im_p1_dimid, jm_dimid, jm_p1_dimid, time_dimid integer :: im_varid, im_p1_varid, jm_varid, jm_p1_varid, time_varid integer, dimension(:), allocatable :: dimids_2d, dimids_3d @@ -188,6 +188,15 @@ subroutine write_restart_netcdf(wrtfb, filename, & deallocate(maxIndexPTile) deallocate(deToTileMap) deallocate(localDeToDeMap) + + if (typekind == ESMF_TYPEKIND_R4) then + dimtype = NF90_FLOAT + else if (typekind == ESMF_TYPEKIND_R8) then + dimtype = NF90_DOUBLE + else + if (mype==0) write(0,*)'Unsupported typekind ', typekind + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if if (fieldDimCount > gridDimCount) then @@ -236,29 +245,29 @@ subroutine write_restart_netcdf(wrtfb, filename, & if ( .not.is_restart_core ) then ncerr = nf90_def_dim(ncid, "xaxis_1", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_1", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_1", dimtype, im_dimid, im_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_1", jm, jm_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_1", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_1", dimtype, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) else ncerr = nf90_def_dim(ncid, "xaxis_1", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_1", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_1", dimtype, im_dimid, im_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "xaxis_2", im+1, im_p1_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_2", NF90_DOUBLE, im_p1_dimid, im_p1_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_2", dimtype, im_p1_dimid, im_p1_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_p1_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_1", jm+1, jm_p1_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_1", NF90_DOUBLE, jm_p1_dimid, jm_p1_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_1", dimtype, jm_p1_dimid, jm_p1_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_p1_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_2", jm, jm_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_2", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_2", dimtype, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) end if @@ -291,7 +300,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & ncerr = nf90_def_dim(ncid, "Time", NF90_UNLIMITED, time_dimid); NC_ERR_STOP(ncerr) ! ncerr = nf90_def_dim(ncid, "Time", 1, time_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "Time", NF90_DOUBLE, time_dimid, time_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "Time", dimtype, time_dimid, time_varid); NC_ERR_STOP(ncerr) if (par) then ncerr = nf90_var_par_access(ncid, time_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) end if diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 3cd17002f..781d62685 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -163,6 +163,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_DELayout) :: delayout type(ESMF_Grid) :: fcstGrid type(ESMF_Grid), allocatable :: wrtGrid(:) + type(ESMF_Grid) :: wrtGrid_cubed_sphere + logical :: create_wrtGrid_cubed_sphere = .true. type(ESMF_Grid) :: actualWrtGrid type(ESMF_Array) :: array type(ESMF_Field) :: field_work, field @@ -208,6 +210,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG integer :: grid_id + + logical :: history_file_on_native_grid + character(len=esmf_maxstr) :: output_grid_name ! !----------------------------------------------------------------------- !*********************************************************************** @@ -480,10 +485,35 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif + call ESMF_ConfigGetAttribute(config=CF, value=history_file_on_native_grid, default=.false., & + label='history_file_on_native_grid:', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +#if 1 + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + do tl=1,6 + decomptile(1,tl) = 1 + decomptile(2,tl) = jidx + decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) + enddo + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="gridfile", value=gridfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + wrtGrid_cubed_sphere = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + regDecompPTile=decomptile,tileFilePath="INPUT/", & + decompflagPTile=decompflagPTile, & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + name='wrt_grid', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + create_wrtGrid_cubed_sphere = .false. + endif +#endif + if ( trim(output_grid(n)) == 'cubed_sphere_grid' ) then !*** Create cubed sphere grid from file - if (top_parent_is_global .and. n==1) then - gridfile = 'grid_spec.nc' ! global top-level parent + if (top_parent_is_global .and. n == 1) then do tl=1,6 decomptile(1,tl) = 1 decomptile(2,tl) = jidx @@ -493,7 +523,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="gridfile", value=gridfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) wrtGrid(n) = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & regDecompPTile=decomptile,tileFilePath="INPUT/", & decompflagPTile=decompflagPTile, & @@ -528,8 +557,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (lprnt) print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & - 'gridfile=',trim(gridfile) deallocate(petMap) endif else ! non 'cubed_sphere_grid' @@ -869,29 +896,51 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_StateAdd(imp_state_write, (/mirrorFB/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! copy the fcstFB Attributes to the 'mirror_' FieldBundle + ! copy the fcstFB Attributes to the 'mirror_' FieldBundle call ESMF_AttributeCopy(fcstFB, mirrorFB, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif ! deal with all of the Fields inside this fcstFB - call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, grid=fcstGrid, rc=rc) + call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (fieldCount > 0) then + call ESMF_FieldBundleGet(fcstFB, grid=fcstGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fcstField(fieldCount)) call ESMF_FieldBundleGet(fcstFB, fieldList=fcstField, & itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - actualWrtGrid = wrtGrid(grid_id) + if (fcstItemNameList(i)(1:18) == 'cubed_sphere_grid_') then + + if (create_wrtGrid_cubed_sphere) then + ! create a grid from fcstGrid on forecast grid comp, by rebalancing distgrid to the local PETs + ! access the acceptor DistGrid + call ESMF_GridGet(fcstGrid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! rebalance the acceptor DistGrid across the local PETs + newAcceptorDG = ESMF_DistGridCreate(acceptorDG, balanceflag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + wrtGrid_cubed_sphere = ESMF_GridCreate(fcstGrid, newAcceptorDG, copyAttributes=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + create_wrtGrid_cubed_sphere = .false. + end if + + actualWrtGrid = wrtGrid_cubed_sphere + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="output_grid", value="cubed_sphere_grid", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + else if (fcstItemNameList(i)(1:8) == 'restart_') then + ! If this is a 'restart' bundle the actual grid that the output field ('field_work' below) is created on + ! must be the same grid as forecast grid, not the output grid for this grid_id (wrtGrid(grid_id)). + ! For 'cubed_sphere_grid' these are the same, but for all other output grids (like Lambert) they are not. - ! If this is a 'restart' bundle the actual grid that the output field ('field_work' below) is created on - ! must be the same grid as forecast grid, not the output grid for this grid_id (wrtGrid(grid_id)). - ! For 'cubed_sphere_grid' these are the same, but for all other output grids (like Lambert) they are not. - if (fcstItemNameList(i)(1:8) == 'restart_') then ! create a grid from fcstGrid on forecast grid comp, by rebalancing distgrid to the local PETs ! access the acceptor DistGrid call ESMF_GridGet(fcstGrid, distgrid=acceptorDG, rc=rc) @@ -901,7 +950,11 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return actualWrtGrid = ESMF_GridCreate(fcstGrid, newAcceptorDG, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if ! end of setting actualWrtGrid for restart bundle + else + actualWrtGrid = wrtGrid(grid_id) + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="output_grid", value=output_grid(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if do j=1, fieldCount @@ -925,7 +978,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! 'gridToFieldMap=',gridToFieldMap,'ungriddedLBound=',ungriddedLBound, & ! 'ungriddedUBound=',ungriddedUBound,'rc=',rc -! create the output field on output grid + ! create the output field on output grid field_work = ESMF_FieldCreate(actualWrtGrid, typekind, name=fieldName, & ! use actualWrtGrid instead of wrtGrid(grid_id) staggerloc=staggerloc, & gridToFieldMap=gridToFieldMap, & @@ -936,7 +989,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeCopy(fcstField(j), field_work, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! get output file name + ! get output file name call ESMF_AttributeGet(fcstField(j), convention="NetCDF", purpose="FV3", & name="output_file", value=outfile_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -947,13 +1000,13 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif call ESMF_LogWrite("af fcstfield, get output_file",ESMF_LOGMSG_INFO,rc=RC) -! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) + ! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) -! add the output field to the 'output_' FieldBundle + ! add the output field to the 'output_' FieldBundle call ESMF_FieldBundleAdd(fieldbundle, (/field_work/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! deal with grids for which 'is_moving' is .true. + ! deal with grids for which 'is_moving' is .true. if (is_moving(grid_id)) then ! create an empty field that will serve as acceptor for GridTransfer of fcstGrid field_work = ESMF_FieldEmptyCreate(name=fieldName, rc=rc) @@ -981,11 +1034,10 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif -! local garbage collection + ! local garbage collection deallocate(gridToFieldMap, ungriddedLBound, ungriddedUBound) enddo -! - ! call ESMF_AttributeCopy(fcstGrid, wrtGrid(grid_id), & + call ESMF_AttributeCopy(fcstGrid, actualWrtGrid , & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1000,15 +1052,13 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, return endif -!end FBCount - enddo -! -!loop over all items in the imp_state_write and count output FieldBundles + enddo !FBCount + + !loop over all items in the imp_state_write and count output FieldBundles call get_outfile(FBCount, outfilename, FBlist_outfilename, noutfile) wrt_int_state%FBCount = noutfile -! -!create output field bundles + !create output field bundles allocate(wrt_int_state%wrtFB(wrt_int_state%FBCount)) ! if (lprnt) write(0,*)'wrt_initialize_p1: allocated ',wrt_int_state%FBCount, ' wrt_int_state%wrtFB' @@ -1016,7 +1066,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, wrt_int_state%wrtFB(i) = ESMF_FieldBundleCreate(name=trim(FBlist_outfilename(i)), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if (lprnt) write(0,*)'wrt_initialize_p1: created wrtFB ',i, ' with name ', trim(wrt_int_state%wrtFB_names(i)) + ! if (lprnt) write(0,*)'wrt_initialize_p1: created wrtFB ',i, ' with name ', trim(FBlist_outfilename(i)) ! if (lprnt) write(0,*)'wrt_initialize_p1: loop over ', FBCount, ' forecast bundles' do n=1, FBCount @@ -1029,9 +1079,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! if (lprnt) write(0,*)'wrt_initialize_p1: is ', trim(fcstItemNameList(n)), ' == ', trim(FBlist_outfilename(i)) if (trim_regridmethod_suffix(fcstItemNameList(n)) == trim_regridmethod_suffix(FBlist_outfilename(i))) then -! -! copy the fcstfield bundle Attributes to the output field bundle - ! if (lprnt) write(0,*)'wrt_initialize_p1: copy atts/fields from ', "output_"//trim(fcstItemNameList(n)), ' to ', trim(wrt_int_state%wrtFB_names(i)) + + ! copy the fcstfield bundle Attributes to the output field bundle + ! if (lprnt) write(0,*)'wrt_initialize_p1: copy atts/fields from ', "output_"//trim(fcstItemNameList(n)), ' to ', trim(FBlist_outfilename(i)) call ESMF_AttributeCopy(fcstFB, wrt_int_state%wrtFB(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) @@ -1059,10 +1109,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if (lprnt) print *,'in wrt,add field,i=',i,'n=',n,' j=',j, & -! 'fieldname=',trim(fieldnamelist(j)), ' outfile_name=',trim(outfile_name), & -! ' field bundle name, FBlist_outfilename(i)=',trim(FBlist_outfilename(i)) - if( trim(outfile_name) == trim(FBlist_outfilename(i))) then call ESMF_FieldBundleAdd(wrt_int_state%wrtFB(i), (/fcstField(j)/), rc=rc) @@ -1074,21 +1120,26 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif ! index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) - enddo ! end FBCount + enddo ! FBCount -! add output grid related attributes + ! add output grid related attributes, only for history files(bundles), skip restart + if (FBlist_outfilename(i)(1:8) /= 'restart_') then + + call ESMF_AttributeGet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3-nooutput", & + name="output_grid", value=output_grid_name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & attrList=(/"source","grid "/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="source", value="FV3GFS", rc=rc) - if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + if (trim(output_grid_name) == 'cubed_sphere_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="cubed_sphere", rc=rc) - else if (trim(output_grid(grid_id)) == 'gaussian_grid') then + else if (trim(output_grid_name) == 'gaussian_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="gaussian", rc=rc) @@ -1099,9 +1150,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="jm", value=jmo(grid_id), rc=rc) - else if (trim(output_grid(grid_id)) == 'regional_latlon' & - .or. trim(output_grid(grid_id)) == 'regional_latlon_moving' & - .or. trim(output_grid(grid_id)) == 'global_latlon') then + else if (trim(output_grid_name) == 'regional_latlon' & + .or. trim(output_grid_name) == 'regional_latlon_moving' & + .or. trim(output_grid_name) == 'global_latlon') then ! for 'regional_latlon_moving' lon1/2 and lat1/2 will be overwritten in run phase call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1112,7 +1163,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid(grid_id)) /= 'regional_latlon_moving') then + if (trim(output_grid_name) /= 'regional_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1122,8 +1173,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lat2", value=lat2(grid_id), rc=rc) endif - else if (trim(output_grid(grid_id)) == 'rotated_latlon' & - .or. trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon' & + .or. trim(output_grid_name) == 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="rotated_latlon", rc=rc) @@ -1145,7 +1196,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid(grid_id)) /= 'rotated_latlon_moving') then + if (trim(output_grid_name) /= 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1155,7 +1206,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lat2", value=lat2(grid_id), rc=rc) endif - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="lambert_conformal", rc=rc) @@ -1192,6 +1243,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dy", value=dy(grid_id), rc=rc) end if + end if enddo ! end wrt_int_state%FBCount ! @@ -1235,14 +1287,19 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif enddo - do n = 1, ngrids -! add the transfer attributes from importState to grid + ! add the transfer attributes from importState to grid call ESMF_AttributeAdd(wrtGrid(n), convention="NetCDF", purpose="FV3", & attrList=attNameList(1:j-1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! add the transfer attributes from importState to special cubed_sphere grid + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + call ESMF_AttributeAdd(wrtGrid_cubed_sphere, convention="NetCDF", purpose="FV3", & + attrList=attNameList(1:j-1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + ! loop over the added attributes, access the value (only scalar allowed), ! and set them on the grid do i=1, j-1 @@ -1266,9 +1323,14 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + call ESMF_AttributeSet(wrtGrid_cubed_sphere, convention="NetCDF", purpose="FV3", & + name=trim(attNameList(i)), value=valueS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + else if (typekindList(i) == ESMF_TYPEKIND_I4) then call ESMF_AttributeGet(imp_state_write, & convention="NetCDF", purpose="FV3", & @@ -1804,6 +1866,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) fieldbundle=mirror_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if (fcstItemNameList(i)(1:8) == "restart_" .or. fcstItemNameList(i)(1:18) == 'cubed_sphere_grid_') then if (fcstItemNameList(i)(1:8) == "restart_") then ! restart output forecast bundles, use Redist instead of Regrid @@ -1977,8 +2040,12 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif -!recover fields from cartesian vector and sfc pressure - call recover_fields(file_bundle,rc) + if (fcstItemNameList(i)(1:8) /= "restart_") then + !recover fields from cartesian vector and sfc pressure + call recover_fields(file_bundle,rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + enddo ! !----------------------------------------------------------------------- @@ -2004,6 +2071,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call mask_fields(wrt_int_state%wrtFB(nbdl),rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -2024,7 +2092,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (mype == lead_write_task) then !** write out inline post log file open(newunit=nolog,file='log.atm.inlinepost.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif if (lprnt) then @@ -2158,7 +2228,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) endif call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (wrt_int_state%mype == 0) then + if (lprnt) then print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) endif @@ -2327,7 +2397,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (out_phase == 1 .and. mype == lead_write_task) then !** write out log file open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif enddo two_phase_loop @@ -2416,6 +2488,7 @@ subroutine recover_fields(file_bundle,rc) type(ESMF_TypeKind_Flag) typekind character(100) fieldName,uwindname,vwindname type(ESMF_Field), allocatable :: fcstField(:) + real(ESMF_KIND_R4), dimension(:,:), pointer :: lonr4, latr4 real(ESMF_KIND_R8), dimension(:,:), pointer :: lon, lat real(ESMF_KIND_R8), dimension(:,:), pointer :: lonloc, latloc real(ESMF_KIND_R4), dimension(:,:), pointer :: pressfc @@ -2424,12 +2497,18 @@ subroutine recover_fields(file_bundle,rc) real(ESMF_KIND_R4), dimension(:,:,:), pointer :: cart3dPtr2dr4 real(ESMF_KIND_R4), dimension(:,:,:,:), pointer :: cart3dPtr3dr4 real(ESMF_KIND_R8) :: coslon, sinlon, sinlat + + type(ESMF_Array) :: lon_array, lat_array ! ! get filed count - call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, & - grid=fieldGrid, rc=rc) + call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + + if (fieldCount == 0) return + + call ESMF_FieldBundleGet(file_bundle, grid=fieldGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite("call recover field on wrt comp",ESMF_LOGMSG_INFO,rc=RC) call ESMF_GridGet(fieldgrid, dimCount=gridDimCount, rc=rc) @@ -2437,10 +2516,26 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 1",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=1, array=lon_array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lon_array, typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lonr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lon(lbound(lonr4,1):ubound(lonr4,1),lbound(lonr4,2):ubound(lonr4,2))) + lon = lonr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + allocate(lonloc(lbound(lon,1):ubound(lon,1),lbound(lon,2):ubound(lon,2))) istart = lbound(lon,1) iend = ubound(lon,1) @@ -2456,10 +2551,25 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 2",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=2, array=lat_array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lat_array, typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=latr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lat(lbound(latr4,1):ubound(latr4,1),lbound(latr4,2):ubound(latr4,2))) + lat = latr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + allocate(latloc(lbound(lat,1):ubound(lat,1),lbound(lat,2):ubound(lat,2))) istart = lbound(lat,1) iend = ubound(lat,1) @@ -3290,7 +3400,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) trim(tileFileName), ESMF_LOGMSG_INFO, rc=rc) if (status == ESMF_FILESTATUS_OLD) then - ! This writes the vectical coordinates and the time dimension into the + ! This writes the vertical coordinates and the time dimension into the ! file. Doing this before the large data sets are written, assuming that ! the first time coming into ioCompRun() with this tileFileName, only ! the grid info is written. Second time in, with ESMF_FILESTATUS_OLD, @@ -3314,7 +3424,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) ncerr = nf90_open(tileFileName, NF90_WRITE, ncid=ncid) if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - ! loop over all the fields in the bundle and handle their vectical dims + ! loop over all the fields in the bundle and handle their vertical dims thereAreVerticals = .false. do i=1, fieldCount @@ -3447,7 +3557,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) attName = attNameList(i) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), typekind=typekind, rc=rc) -! print *,'in esmf call, att name=',trim(attNameList(i)) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3455,7 +3564,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) -! print *,'in esmf call, att string value=',trim(valueS) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & @@ -3468,7 +3577,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueI4, rc=rc) -! print *,'in esmf call, att I4 value=',valueR8 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & trim(attName(6:len(attName))), values=valueI4) @@ -3479,7 +3588,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR4, rc=rc) -! print *,'in esmf call, att r4 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3492,7 +3600,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR8, rc=rc) -! print *,'in esmf call, att r8 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 7cc6ab45e..2026b67d9 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -93,7 +93,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & its = wrt_int_state%out_grid_info(grid_id)%i_start !<-- Starting I of this write task's subsection ite = wrt_int_state%out_grid_info(grid_id)%i_end !<-- Ending I of this write task's subsection - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg, & + if(mype==0) print *,'in post_run, numx=',numx,'its=',its,'ite=',ite,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! @@ -187,7 +187,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd,ista,iend) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,datapd,ista,iend) do k=1,nrecout+100 do j=1,jend+1-jsta do i=1,iend+1-ista @@ -258,6 +258,7 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle ! set grid spec: ! if(mype==0) print*,'in post_getattr_lam,output_grid=',trim(output_grid(grid_id)),'nfb=',nfb @@ -494,6 +495,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! Apr 2022 W. Meng Unify set_postvars_gfs and ! set_postvars_regional to set_postvars_fv3 ! Apr 2023 W. Meng Sync RRFS and GFS changes from off-line post +! Jun 2023 W. Meng Remove duplicate initialization; +! relocate computation of aerosol fields ! !----------------------------------------------------------------------- !*** set up post fields from nmint_state @@ -505,7 +508,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, qqni, qqnr, qqnwfa, & + pint, exch_h, ref_10cm, qqni, qqnr, qqnw, qqnwfa, & qqnifa, effri, effrl, effrs, aextc55, taod5503d, & duem, dusd, dudp, duwt, dusv, ssem, sssd, ssdp, & sswt, sssv, bcem, bcsd, bcdp, bcwt, bcsv, ocem, & @@ -542,12 +545,13 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) sfcvxi, t10m, t10avg, psfcavg, akhsavg, akmsavg, & albedo, tg, prate_max, pwat, snow_acm, snow_bkt, & acgraup, graup_bucket, acfrain, frzrn_bucket, & - ltg1_max, ltg2_max, ltg3_max, aodtot, ebb, hwp, & + ltg1_max, ltg2_max, ltg3_max, ebb, hwp, & aod550,du_aod550,ss_aod550,su_aod550,oc_aod550, & bc_aod550,maod, & dustpm10, dustcb, bccb, occb, sulfcb, sscb, & dustallcb, ssallcb, dustpm, sspm, pp25cb, pp10cb, & - no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25 + no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25, & + snownc, graupelnc, qrmax use soil, only: sldpth, sh2o, smc, stc, sllevel use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & @@ -603,9 +607,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) real,dimension(:), allocatable :: slat,qstl real,external::FPVSNEW real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & - cw2d, cfr2d, accswe_ice, accswe_land, & - snacc_land, snacc_ice - real,dimension(:,:,:),allocatable :: extsmoke, extdust + cw2d, cfr2d, snacc_land, snacc_ice + real,dimension(:,:,:),allocatable :: ext550 character(len=80) :: fieldname, wrtFBName, flatlon, & VarName type(ESMF_Grid) :: wrtGrid @@ -670,7 +673,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) bk5(i) = wrt_int_state%bk(i) enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat,ista,iend) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,f,gdlat,ista,iend) do j=jsta,jend do i=ista,iend f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) @@ -679,18 +682,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! pt = ak5(1) -! GFS does not have surface specific humidity -! inst sensible heat flux -! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths,ista,iend) - do j=jsta,jend - do i=ista,iend - qs(i,j) = SPVAL - twbs(i,j) = SPVAL - qwbs(i,j) = SPVAL - enddo - enddo - ! GFS set up DT to compute accumulated fields, set it to one dtq2 = wrt_int_state%dtp nphs = 2. @@ -698,57 +689,26 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) !Allocate for regional models only if(modelname=='FV3R') then - allocate(extsmoke(ista:iend,jsta:jend,lm)) - allocate(extdust(ista:iend,jsta:jend,lm)) - allocate(accswe_ice(ista:iend,jsta:jend)) - allocate(accswe_land(ista:iend,jsta:jend)) + allocate(ext550(ista:iend,jsta:jend,lm)) allocate(snacc_ice(ista:iend,jsta:jend)) allocate(snacc_land(ista:iend,jsta:jend)) - endif -! -! GFS does not have convective cloud efficiency -! similated precip -! 10 m theta -! 10 m humidity -! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(cldefi,lspa,th10,q10,albase) - do j=jsta,jend - do i=ista,iend - cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL - albase(i,j) = SPVAL - enddo - enddo + do j=jsta,jend + do i=ista,iend + snacc_ice(i,j)=spval + snacc_land(i,j)=spval + end do + end do -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate,ista,iend) - do j=jsta,jend - do i=ista,iend - cprate(i,j) = 0. - enddo - enddo + do l=1,lm + do j=jsta,jend + do i=ista,iend + ext550(i,j,l)=spval + end do + end do + end do + endif -! GFS probably does not use zenith angle, czen, czmean -! inst surface outgoing longwave, radot -! inst cloud fraction for high, middle, and low cloud, -! cfrach -! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) - do j=jsta,jend - do i=ista,iend - czen(i,j) = SPVAL - czmean(i,j) = SPVAL - cfrach(i,j) = SPVAL - cfracl(i,j) = SPVAL - cfracm(i,j) = SPVAL - grnflx(i,j) = SPVAL - enddo - enddo ! ! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam sldpth(1) = 0.10 @@ -756,27 +716,13 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) sldpth(3) = 0.6 sldpth(4) = 1.0 -! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n -! cfrcv to 1 -! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 -! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave -! inst incoming sfc shortwave, rswin -! inst incoming clear sky sfc shortwave, rswinc -! inst outgoing sfc shortwave, rswout -! snow phase change heat flux, snopcx -! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rswin,rswinc,rswout,snopcx,sfcuvx,& -!$omp& ltg1_max,ltg2_max,ltg3_max) +! set ncfrcv to 1, ncfrst to 1 +!$omp parallel do default(none),private(i,j),shared(jsta,jend,spval,ista,iend), & +!$omp& shared(ncfrcv,ncfrst) do j=jsta,jend do i=ista,iend - acfrcv(i,j) = spval ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval ncfrst(i,j) = 1.0 - bgroff(i,j) = spval - rswinc(i,j) = spval enddo enddo @@ -787,77 +733,11 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! GFS surface flux has been averaged, set ASRFC to 1 asrfc = 1.0 -! GFS does not have temperature tendency due to long wave radiation -! temperature tendency due to short wave radiation -! temperature tendency due to latent heating from convection -! temperature tendency due to latent heating from grid scale - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l,ista_2l,iend_2u), & -!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - rlwtt(i,j,l) = spval - rswtt(i,j,l) = spval - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval - train(i,j,l) = spval - enddo - enddo - enddo - ! set avrain to 1 avrain = 1.0 avcnvc = 1.0 theat = 6.0 ! just in case GFS decides to output T tendency -! GFS does not have temperature tendency due to latent heating from grid scale - train = spval - -! GFS does not have soil moisture availability, smstav -! accumulated surface evaporatio, sfcevp -! averaged accumulated snow, acsnow -! snow melt,acsnom -! humidity at roughness length, qz0 -! u at roughness length, uz0 -! v at roughness length, vz0 -! shelter rh max, maxrhshltr -! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & -!$omp& shared(sfcevp,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - sfcevp(i,j) = spval - acsnom(i,j) = spval - qz0(i,j) = spval - uz0(i,j) = spval - vz0(i,j) = spval - enddo - enddo - -! GFS does not have mixing length,el_pbl -! exchange coefficient, exch_h - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h,ista_2l,iend_2u) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - el_pbl(i,j,l) = spval - exch_h(i,j,l) = spval - enddo - enddo - enddo - -! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & -!$omp& shared(htopd,hbotd,htops,hbots,cuppt) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - htopd(i,j) = SPVAL - hbotd(i,j) = SPVAL - htops(i,j) = SPVAL - hbots(i,j) = SPVAL - cuppt(i,j) = SPVAL - enddo - enddo ! ! get inital date sdat(1) = wrt_int_state%idate(2) !month @@ -896,7 +776,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle - + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & name="grid_id", value=bundle_grid_id, rc=rc) @@ -987,6 +867,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) line=__LINE__, file=__FILE__)) return ! bail out if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & name="grid_id", value=bundle_grid_id, rc=rc) @@ -1114,17 +995,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif - ! total aod - if(trim(fieldname)=='aodtot') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aodtot,arrayr42d,fillValue,spval) - do j=jsta,jend - do i=ista, iend - aodtot(i,j)=arrayr42d(i,j) - if(abs(arrayr42d(i,j)-fillValue) < small) aodtot(i,j)=spval - enddo - enddo - endif - ! biomass burning emissions if(trim(fieldname)=='ebb_smoke_hr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ebb,arrayr42d,fillValue,spval) @@ -1367,6 +1237,28 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + !time step snow (in m) + if(trim(fieldname)=='snow') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snownc,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + snownc(i,j) = arrayr42d(i,j) + if (abs(arrayr42d(i,j)-fillValue) < small) snownc(i,j) = spval + enddo + enddo + endif + + !time step graupel (in m) + if(trim(fieldname)=='graupel') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,graupelnc,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + graupelnc(i,j) = arrayr42d(i,j) + if (abs(arrayr42d(i,j)-fillValue) < small) graupelnc(i,j) = spval + enddo + enddo + endif + ! max hourly surface precipitation rate if(trim(fieldname)=='pratemax') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,prate_max,arrayr42d,sm,fillValue) @@ -1736,6 +1628,69 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + if(nsoil==9) then + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill5') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,5) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,5) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,5) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill6') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,6) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,6) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,6) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill7') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,7) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,7) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,7) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill8') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,8) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,8) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,8) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill9') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,9) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,9) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,9) = spval + enddo + enddo + endif + + endif !nsoil + ! volumetric soil moisture if(trim(fieldname)=='soilw1') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) @@ -2350,25 +2305,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) endif if(modelname=='FV3R')then - !acsnow - if(trim(fieldname)=='accswe_land') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,accswe_land,arrayr42d,fillvalue,spval) - do j=jsta,jend - do i=ista, iend - accswe_land(i,j) = arrayr42d(i,j) - if(abs(arrayr42d(i,j)-fillvalue) null() logical :: top_parent_is_global + logical :: history_file_on_native_grid integer :: num_restart_interval, restart_starttime real,dimension(:),allocatable :: restart_interval @@ -606,14 +606,14 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval + if (mype == 0) print *,'af ufs config,num_restart_interval=',num_restart_interval if (num_restart_interval<=0) num_restart_interval = 1 allocate(restart_interval(num_restart_interval)) restart_interval = 0 call ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', & count=num_restart_interval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype == 0) print *,'af nems config,restart_interval=',restart_interval + if (mype == 0) print *,'af ufs config,restart_interval=',restart_interval ! call fms_init(fcst_mpi_comm) call mpp_init() @@ -985,12 +985,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! Create FieldBundle for Fields that need to be regridded bilinear if( quilting ) then - allocate(fieldbundle(ngrids)) - nbdlphys = 2 - allocate(fieldbundlephys(nbdlphys,ngrids)) + call ESMF_ConfigGetAttribute(config=CF, value=history_file_on_native_grid, default=.false., label='history_file_on_native_grid:', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(fieldbundle_dyn_restart(ngrids,3)) ! fv_core.res fv_srf_wnd.res fv_tracer.res - allocate(fieldbundle_phy_restart(ngrids,2)) ! phy_data sfc_data + nbdlphys = 2 do n=1,ngrids bundle_grid='' @@ -1005,69 +1003,41 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(filename_base(i)) // trim(bundle_grid) ! - if( i==1 ) then -! for dyn + if (i == 1) then ! for dyn name_FB1 = trim(name_FB)//'_bilinear' - fieldbundle(n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle(n), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB1), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(fieldbundle(n), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle(n), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle(n), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle(n)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .AND. top_parent_is_global .AND. history_file_on_native_grid) then + call create_bundle_and_add_it_to_state('cubed_sphere_grid_'//trim(name_FB1), tempState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& - exportState=exportState, phase=1, userrc=urc, rc=rc) + exportState=exportState, phase=1, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - else if( i==2 ) then -! for phys + else if (i == 2) then ! for phys + do j=1, nbdlphys - if( j==1 ) then + if (j == 1) then name_FB1 = trim(name_FB)//'_nearest_stod' else name_FB1 = trim(name_FB)//'_bilinear' endif - fieldbundlephys(j,n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB1), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeAdd(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .AND. top_parent_is_global .AND. history_file_on_native_grid) then + call create_bundle_and_add_it_to_state('cubed_sphere_grid_'//trim(name_FB1), tempState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif - call ESMF_StateAdd(tempState, (/fieldbundlephys(j,n)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& - exportState=exportState, phase=2, userrc=urc, rc=rc) + exportState=exportState, phase=2, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1106,26 +1076,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(name_FB)//nest_suffix endif - fieldbundle_dyn_restart(n,i) = ESMF_FieldBundleCreate(name=trim(name_FB),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle_dyn_restart(n,i)/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState, & @@ -1157,26 +1108,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(name_FB)//nest_suffix endif - fieldbundle_phy_restart(n,i) = ESMF_FieldBundleCreate(name=trim(name_FB),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle_phy_restart(n,i)/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState, & @@ -1192,11 +1124,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) enddo ! ngrids - ! total number of field bundles created is ngrids * (1(atm) + 2(phy) + 3(dyn_rest) +2(phy_rest) - if (mype == 0) write(*,*)'fcst_initialize: total number of field bundles: ', ngrids*(1+2+0+2) - -!end qulting - endif + endif ! quilting call get_atmos_model_ungridded_dim(nlev=numLevels, & nsoillev=numSoilLayers, & @@ -1206,6 +1134,36 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !----------------------------------------------------------------------- ! + contains + + subroutine create_bundle_and_add_it_to_state(name_fb, state, rc) + + character(len=*), intent(in) :: name_fb + type(ESMF_State), intent(inout) :: state + integer, intent(out) :: rc + + type(ESMF_FieldBundle) :: fieldbundle + + fieldbundle = ESMF_FieldBundleCreate(name=trim(name_fb), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeAdd(fieldbundle, convention="NetCDF", purpose="FV3", attrList=(/"grid_id"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3", name="grid_id", value=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeAdd(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", attrList=(/"frestart"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="frestart", valueList=frestart, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(state, (/fieldbundle/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine create_bundle_and_add_it_to_state + end subroutine fcst_initialize ! !----------------------------------------------------------------------- diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 8096ddbb4..b76c52a39 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -37,6 +37,10 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:), allocatable, save :: sst real(kind=kind_phys), dimension(:,:), allocatable, save :: lmsk real(kind=kind_phys), dimension(:,:), allocatable, save :: lake + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: uwind + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: vwind + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: height + real(kind=kind_phys), dimension(:,:), allocatable, save :: dx real(kind=kind_phys), dimension(:,:), allocatable, save :: condition real(kind=kind_phys), dimension(:,:), allocatable, save :: ca_deep_cpl, ca_turb_cpl, ca_shal_cpl real(kind=kind_phys), dimension(:,:), allocatable, save :: ca1_cpl, ca2_cpl, ca3_cpl @@ -137,6 +141,8 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) GFS_Control%spp_rad = 1 case('gwd') GFS_Control%spp_gwd = 1 + case('cu_deep') + GFS_Control%spp_cu_deep = 1 end select end do end if @@ -189,7 +195,11 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(sst (1:nblks, maxblk)) allocate(lmsk (1:nblks, maxblk)) allocate(lake (1:nblks, maxblk)) + allocate(uwind (1:nblks, maxblk, 1:levs)) + allocate(vwind (1:nblks, maxblk, 1:levs)) + allocate(height (1:nblks, maxblk, 1:levs)) allocate(condition (1:nblks, maxblk)) + allocate(dx (1:nblks, maxblk)) allocate(ca_deep_cpl (1:nblks, maxblk)) allocate(ca_turb_cpl (1:nblks, maxblk)) allocate(ca_shal_cpl (1:nblks, maxblk)) @@ -249,6 +259,10 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%spp_wts_rad(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) end do + case('cu_deep') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_cu_deep(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do end select end do end if @@ -374,16 +388,20 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) lake (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%lakefrac(:) + uwind (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%ugrs(:,:) + vwind (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%vgrs(:,:) + height (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%phil(:,:) + dx (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%dx(:) condition (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%condition(:) ca_deep_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_deep(:) ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) enddo call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtp,GFS_control%restart,GFS_Control%first_time_step, & - sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl, Atm(mygrid)%domain_for_coupler,nblks, & + sst,lmsk,lake,uwind,vwind,height,dx,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl, Atm(mygrid)%domain_for_coupler,nblks, & Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & GFS_Control%nthresh,GFS_Control%tile_num,GFS_Control%nca,GFS_Control%ncells,GFS_Control%nlives, & - GFS_Control%nfracseed, GFS_Control%nseed,GFS_Control%iseed_ca, & + GFS_Control%nfracseed, GFS_Control%nseed,GFS_Control%iseed_ca,GFS_Control%ca_advect, & GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back as needed do nb=1,nblks @@ -461,6 +479,10 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) deallocate(sst ) deallocate(lmsk ) deallocate(lake ) + deallocate(uwind ) + deallocate(vwind ) + deallocate(height ) + deallocate(dx ) deallocate(condition ) deallocate(ca_deep_cpl ) deallocate(ca_turb_cpl ) diff --git a/upp b/upp index dccb32176..fae617ba4 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit dccb32176930676ef2a258eb65571ab4e3f7e7a4 +Subproject commit fae617ba485dbbadc8fc10f512a6a0c29c81741a