From b9d1248eacee4575b6bfc92cae50661ef18f96f9 Mon Sep 17 00:00:00 2001 From: "Rusty.Benson" Date: Thu, 14 Apr 2022 09:33:55 -0400 Subject: [PATCH 1/3] fixes io performance issues by making everyone a reader when io_layout=1,1 adds capability to use FMS feature to ignore data integrity checksums in restarts --- driver/fvGFS/atmosphere.F90 | 7 +++-- model/fv_arrays.F90 | 2 ++ model/fv_control.F90 | 9 ++++-- tools/external_ic.F90 | 59 ++++++++++++++++--------------------- tools/fv_io.F90 | 28 +++++++++--------- tools/fv_mp_mod.F90 | 18 +++++++++-- tools/fv_restart.F90 | 6 ++-- 7 files changed, 70 insertions(+), 59 deletions(-) diff --git a/driver/fvGFS/atmosphere.F90 b/driver/fvGFS/atmosphere.F90 index 7af45f664..f2f68eb6e 100644 --- a/driver/fvGFS/atmosphere.F90 +++ b/driver/fvGFS/atmosphere.F90 @@ -357,7 +357,7 @@ subroutine atmosphere_init (Time_init, Time, Time_step, Grid_box, area) #ifdef MOVING_NEST call fv_tracker_init(size(Atm)) if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) -#endif +#endif Atm(mygrid)%Time_init = Time_init @@ -953,10 +953,10 @@ end subroutine get_nth_domain_info !! the "domain2d" variable associated with the coupling grid and the !! decomposition for the current cubed-sphere tile. !>@detail Coupling is done using the mass/temperature grid with no halos. - subroutine atmosphere_domain ( fv_domain, layout, regional, nested, & + subroutine atmosphere_domain ( fv_domain, rd_domain, layout, regional, nested, & moving_nest_parent, is_moving_nest, & ngrids_atmos, mygrid_atmos, pelist ) - type(domain2d), intent(out) :: fv_domain + type(domain2d), intent(out) :: fv_domain, rd_domain integer, intent(out) :: layout(2) logical, intent(out) :: regional logical, intent(out) :: nested @@ -969,6 +969,7 @@ subroutine atmosphere_domain ( fv_domain, layout, regional, nested, & integer :: n fv_domain = Atm(mygrid)%domain_for_coupler + rd_domain = Atm(mygrid)%domain_for_read layout(1:2) = Atm(mygrid)%layout(1:2) regional = Atm(mygrid)%flagstruct%regional nested = ngrids > 1 diff --git a/model/fv_arrays.F90 b/model/fv_arrays.F90 index b89dcefa1..6edc03d18 100644 --- a/model/fv_arrays.F90 +++ b/model/fv_arrays.F90 @@ -516,6 +516,7 @@ module fv_arrays_mod !----------------------------------------------------------------------------------------------- logical :: reset_eta = .false. + logical :: enforce_rst_cksum = .true. !< enfore or override data integrity restart checksums real :: p_fac = 0.05 !< Safety factor for minimum nonhydrostatic pressures, which !< will be limited so the full pressure is no less than p_fac !< times the hydrostatic pressure. This is only of concern in mid-top @@ -1303,6 +1304,7 @@ module fv_arrays_mod #if defined(SPMD) type(domain2D) :: domain_for_coupler !< domain used in coupled model with halo = 1. + type(domain2D) :: domain_for_read !< domain used for reads to increase performance when io_layout=(1,1) !global tile and tile_of_mosaic only have a meaning for the CURRENT pe integer :: num_contact, npes_per_tile, global_tile, tile_of_mosaic, npes_this_grid diff --git a/model/fv_control.F90 b/model/fv_control.F90 index 5b24ccf56..35584b0d5 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -198,7 +198,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, real, intent(in) :: dt_atmos integer, intent(OUT) :: this_grid logical, allocatable, intent(OUT) :: grids_on_this_pe(:) - character(len=32), optional, intent(in) :: nml_filename_in ! alternate nml + character(len=32), optional, intent(in) :: nml_filename_in ! alternate nml logical, optional, intent(in) :: skip_nml_read_in ! use previously loaded nml integer, intent(INOUT) :: p_split @@ -291,6 +291,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, real(kind=R_GRID) , pointer :: target_lon logical , pointer :: reset_eta + logical , pointer :: enforce_rst_cksum real , pointer :: p_fac real , pointer :: a_imp integer , pointer :: n_split @@ -676,7 +677,8 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, Atm(this_grid)%flagstruct%grid_type,Atm(this_grid)%neststruct%nested, & Atm(this_grid)%layout,Atm(this_grid)%io_layout,Atm(this_grid)%bd,Atm(this_grid)%tile_of_mosaic, & Atm(this_grid)%gridstruct%square_domain,Atm(this_grid)%npes_per_tile,Atm(this_grid)%domain, & - Atm(this_grid)%domain_for_coupler,Atm(this_grid)%num_contact,Atm(this_grid)%pelist) + Atm(this_grid)%domain_for_coupler,Atm(this_grid)%domain_for_read,Atm(this_grid)%num_contact, & + Atm(this_grid)%pelist) call broadcast_domains(Atm,Atm(this_grid)%pelist,size(Atm(this_grid)%pelist)) do n=1,ngrids tile_id = mpp_get_tile_id(Atm(n)%domain) @@ -857,6 +859,7 @@ subroutine set_namelist_pointers(Atm) regional_bcs_from_gsi => Atm%flagstruct%regional_bcs_from_gsi write_restart_with_bcs => Atm%flagstruct%write_restart_with_bcs reset_eta => Atm%flagstruct%reset_eta + enforce_rst_cksum => Atm%flagstruct%enforce_rst_cksum p_fac => Atm%flagstruct%p_fac a_imp => Atm%flagstruct%a_imp n_split => Atm%flagstruct%n_split @@ -1075,7 +1078,7 @@ subroutine read_namelist_fv_core_nml(Atm) write_coarse_restart_files,& write_coarse_diagnostics,& write_only_coarse_intermediate_restarts, & - write_coarse_agrid_vel_rst, write_coarse_dgrid_vel_rst + write_coarse_agrid_vel_rst, write_coarse_dgrid_vel_rst, enforce_rst_cksum ! Read FVCORE namelist diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index 56cd554f7..cec8bd1f3 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -206,10 +206,9 @@ module external_ic_mod contains - subroutine get_external_ic( Atm, fv_domain, cold_start ) + subroutine get_external_ic( Atm, cold_start ) type(fv_atmos_type), intent(inout), target :: Atm - type(domain2d), intent(inout) :: fv_domain logical, intent(IN) :: cold_start real:: alpha = 0. real rdg @@ -260,14 +259,14 @@ subroutine get_external_ic( Atm, fv_domain, cold_start ) enddo enddo - call mpp_update_domains( f0, fv_domain ) + call mpp_update_domains( f0, Atm%domain ) if ( Atm%gridstruct%cubed_sphere .and. (.not. Atm%gridstruct%bounded_domain))then call fill_corners(f0, Atm%npx, Atm%npy, YDir) endif ! Read in cubed_sphere terrain if ( Atm%flagstruct%mountain ) then - call get_cubed_sphere_terrain(Atm, fv_domain) + call get_cubed_sphere_terrain(Atm) else if (.not. Atm%neststruct%nested) Atm%phis = 0. !TODO: Not sure about this line --- lmh 30 may 18 endif @@ -276,32 +275,32 @@ subroutine get_external_ic( Atm, fv_domain, cold_start ) if ( Atm%flagstruct%ncep_ic ) then nq = 1 call timing_on('NCEP_IC') - call get_ncep_ic( Atm, fv_domain, nq ) + call get_ncep_ic( Atm, nq ) call timing_off('NCEP_IC') #ifdef FV_TRACERS if (.not. cold_start) then - call fv_io_read_tracers( fv_domain, Atm ) + call fv_io_read_tracers( Atm ) if(is_master()) write(*,*) 'All tracers except sphum replaced by FV IC' endif #endif elseif ( Atm%flagstruct%nggps_ic ) then call timing_on('NGGPS_IC') - call get_nggps_ic( Atm, fv_domain ) + call get_nggps_ic( Atm ) call timing_off('NGGPS_IC') elseif ( Atm%flagstruct%hrrrv3_ic ) then call timing_on('HRRR_IC') - call get_hrrr_ic( Atm, fv_domain ) + call get_hrrr_ic( Atm ) call timing_off('HRRR_IC') elseif ( Atm%flagstruct%ecmwf_ic ) then if( is_master() ) write(*,*) 'Calling get_ecmwf_ic' call timing_on('ECMWF_IC') - call get_ecmwf_ic( Atm, fv_domain ) + call get_ecmwf_ic( Atm ) call timing_off('ECMWF_IC') else ! The following is to read in legacy lat-lon FV core restart file ! is Atm%q defined in all cases? nq = size(Atm%q,4) - call get_fv_ic( Atm, fv_domain, nq ) + call get_fv_ic( Atm, nq ) endif call prt_maxmin('PS', Atm%ps, is, ie, js, je, ng, 1, 0.01) @@ -368,9 +367,8 @@ end subroutine get_external_ic !------------------------------------------------------------------ - subroutine get_cubed_sphere_terrain( Atm, fv_domain ) + subroutine get_cubed_sphere_terrain( Atm ) type(fv_atmos_type), intent(inout), target :: Atm - type(domain2d), intent(inout) :: fv_domain type(FmsNetcdfDomainFile_t) :: Fv_core integer :: tile_id(1) character(len=64) :: fname @@ -393,13 +391,13 @@ subroutine get_cubed_sphere_terrain( Atm, fv_domain ) jed = Atm%bd%jed ng = Atm%bd%ng - tile_id = mpp_get_tile_id( fv_domain ) + tile_id = mpp_get_tile_id( Atm%domain ) fname = 'INPUT/fv_core.res.nc' call mpp_error(NOTE, 'external_ic: looking for '//fname) - if( open_file(Fv_core, fname, "read", fv_domain, is_restart=.true.) ) then + if( open_file(Fv_core, fname, "read", Atm%domain_for_read, is_restart=.true.) ) then call read_data(Fv_core, 'phis', Atm%phis(is:ie,js:je)) call close_file(Fv_core) else @@ -428,7 +426,7 @@ end subroutine get_cubed_sphere_terrain !>@brief The subroutine 'get_nggps_ic' reads in data after it has been preprocessed with !! NCEP/EMC orography maker and 'global_chgres', and has been horiztontally !! interpolated to the current cubed-sphere grid - subroutine get_nggps_ic (Atm, fv_domain) + subroutine get_nggps_ic (Atm) !>variables read in from 'gfs_ctrl.nc' !> VCOORD - level information @@ -456,7 +454,6 @@ subroutine get_nggps_ic (Atm, fv_domain) #endif type(fv_atmos_type), intent(inout) :: Atm - type(domain2d), intent(inout) :: fv_domain ! local: real, dimension(:), allocatable:: ak, bk real, dimension(:,:), allocatable:: wk2, ps, oro_g @@ -585,7 +582,7 @@ subroutine get_nggps_ic (Atm, fv_domain) !--- read in surface temperature (k) and land-frac ! surface skin temperature - if( open_file(SFC_restart, fn_sfc_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(SFC_restart, fn_sfc_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then naxis_dims = get_variable_num_dimensions(SFC_restart, 'tsea') allocate (dim_names_alloc(naxis_dims)) call get_variable_dimension_names(SFC_restart, 'tsea', dim_names_alloc) @@ -605,7 +602,7 @@ subroutine get_nggps_ic (Atm, fv_domain) dim_names_2d(2) = "lon" ! terrain surface height -- (needs to be transformed into phis = zs*grav) - if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(ORO_restart, "lat", "y") call register_axis(ORO_restart, "lon", "x") if (filtered_terrain) then @@ -915,7 +912,7 @@ subroutine read_gfs_ic() dim_names_3d4(1) = "levp" ! surface pressure (Pa) - if( open_file(GFS_restart, fn_gfs_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(GFS_restart, fn_gfs_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(GFS_restart, "lat", "y") call register_axis(GFS_restart, "lon", "x") call register_axis(GFS_restart, "lonp", "x", domain_position=east) @@ -945,7 +942,7 @@ subroutine read_gfs_ic() do nt = 1, ntracers q(:,:,:,nt) = -999.99 - + call get_tracer_names(MODEL_ATMOS, nt, tracer_name) call register_restart_field(GFS_restart, trim(tracer_name), q(:,:,:,nt), dim_names_3d3, is_optional=.true.) enddo @@ -964,7 +961,7 @@ subroutine read_gfs_ic() end subroutine get_nggps_ic !------------------------------------------------------------------ !------------------------------------------------------------------ - subroutine get_hrrr_ic (Atm, fv_domain) + subroutine get_hrrr_ic (Atm) ! read in data after it has been preprocessed with ! NCEP/EMC orography maker ! @@ -990,7 +987,6 @@ subroutine get_hrrr_ic (Atm, fv_domain) type(fv_atmos_type), intent(inout) :: Atm - type(domain2d), intent(inout) :: fv_domain ! local: real, dimension(:), allocatable:: ak, bk real, dimension(:,:), allocatable:: wk2, ps, oro_g @@ -1104,7 +1100,7 @@ subroutine get_hrrr_ic (Atm, fv_domain) !--- read in surface temperature (k) and land-frac ! surface skin temperature - if( open_file(SFC_restart, fn_sfc_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(SFC_restart, fn_sfc_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call get_variable_dimension_names(SFC_restart, 'tsea', dim_names_2d) call register_axis(SFC_restart, dim_names_2d(2), "y") call register_axis(SFC_restart, dim_names_2d(1), "x") @@ -1121,7 +1117,7 @@ subroutine get_hrrr_ic (Atm, fv_domain) dim_names_2d(2) = "lon" ! terrain surface height -- (needs to be transformed into phis = zs*grav) - if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(ORO_restart, "lat", "y") call register_axis(ORO_restart, "lon", "x") if (filtered_terrain) then @@ -1164,7 +1160,7 @@ subroutine get_hrrr_ic (Atm, fv_domain) dim_names_3d4(1) = "levp" ! edge pressure (Pa) - if( open_file(HRRR_restart, fn_hrr_ics, "read", Atm%domain,is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(HRRR_restart, fn_hrr_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(HRRR_restart, "lat", "y") call register_axis(HRRR_restart, "lon", "x") call register_axis(HRRR_restart, "lonp", "x", domain_position=east) @@ -1360,9 +1356,8 @@ end subroutine get_hrrr_ic !------------------------------------------------------------------ !------------------------------------------------------------------ !>@brief The subroutine 'get_ncep_ic' reads in the specified NCEP analysis or reanalysis dataset - subroutine get_ncep_ic( Atm, fv_domain, nq ) + subroutine get_ncep_ic( Atm, nq ) type(fv_atmos_type), intent(inout) :: Atm - type(domain2d), intent(inout) :: fv_domain integer, intent(in):: nq ! local: #ifdef HIWPP_ETA @@ -1818,7 +1813,7 @@ end subroutine get_ncep_ic !>@brief The subroutine 'get_ecmwf_ic' reads in initial conditions from ECMWF analyses !! (EXPERIMENTAL: contact Jan-Huey Chen jan-huey.chen@noaa.gov for support) !>@authors Jan-Huey Chen, Xi Chen, Shian-Jiann Lin - subroutine get_ecmwf_ic( Atm, fv_domain ) + subroutine get_ecmwf_ic( Atm ) #ifdef __PGI use GFS_restart, only : GFS_restart_type @@ -1827,7 +1822,6 @@ subroutine get_ecmwf_ic( Atm, fv_domain ) #endif type(fv_atmos_type), intent(inout) :: Atm - type(domain2d), intent(inout) :: fv_domain ! local: real :: ak_ec(138), bk_ec(138) data ak_ec/ 0.000000, 2.000365, 3.102241, 4.666084, 6.827977, 9.746966, & @@ -2062,7 +2056,7 @@ subroutine get_ecmwf_ic( Atm, fv_domain ) dim_names_3d4(1) = "levp" !! Read in model terrain from oro_data.tile?.nc - if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(ORO_restart, fn_oro_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(ORO_restart, "lat", "y") call register_axis(ORO_restart, "lon", "x") if (filtered_terrain) then @@ -2088,7 +2082,7 @@ subroutine get_ecmwf_ic( Atm, fv_domain ) allocate (ps_gfs(is:ie,js:je)) allocate (zh_gfs(is:ie,js:je,levp_gfs+1)) - if( open_file(GFS_restart, fn_gfs_ics, "read", Atm%domain, is_restart=.true., dont_add_res_to_filename=.true.) ) then + if( open_file(GFS_restart, fn_gfs_ics, "read", Atm%domain_for_read, is_restart=.true., dont_add_res_to_filename=.true.) ) then call register_axis(GFS_restart, "lat", "y") call register_axis(GFS_restart, "lon", "x") call register_axis(GFS_restart, "levp", size(zh_gfs,3)) @@ -2622,9 +2616,8 @@ subroutine get_ecmwf_ic( Atm, fv_domain ) end subroutine get_ecmwf_ic !------------------------------------------------------------------ !------------------------------------------------------------------ - subroutine get_fv_ic( Atm, fv_domain, nq ) + subroutine get_fv_ic( Atm, nq ) type(fv_atmos_type), intent(inout) :: Atm - type(domain2d), intent(inout) :: fv_domain integer, intent(in):: nq type(FmsNetcdfFile_t) :: Latlon_dyn, Latlon_tra diff --git a/tools/fv_io.F90 b/tools/fv_io.F90 index e892b6811..b1547824e 100644 --- a/tools/fv_io.F90 +++ b/tools/fv_io.F90 @@ -419,7 +419,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Fv_restart_tile_is_open = open_file(Atm(1)%Fv_restart_tile, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Fv_restart_tile_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Fv_restart_tile) + call read_restart(Atm(1)%Fv_restart_tile, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Fv_restart_tile) Atm(1)%Fv_restart_tile_is_open = .false. endif @@ -429,7 +429,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Tra_restart_is_open = open_file(Atm(1)%Tra_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Tra_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Tra_restart) + call read_restart(Atm(1)%Tra_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Tra_restart) Atm(1)%Tra_restart_is_open = .false. else @@ -442,7 +442,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) if (Atm(1)%Rsf_restart_is_open) then Atm(1)%flagstruct%srf_init = .true. call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Rsf_restart) + call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Rsf_restart) Atm(1)%Rsf_restart_is_open = .false. else @@ -456,7 +456,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Mg_restart_is_open = open_file(Atm(1)%Mg_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Mg_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Mg_restart) + call read_restart(Atm(1)%Mg_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Mg_restart) Atm(1)%Mg_restart_is_open = .false. else @@ -467,7 +467,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Lnd_restart_is_open = open_file(Atm(1)%Lnd_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Lnd_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Lnd_restart) + call read_restart(Atm(1)%Lnd_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Lnd_restart) Atm(1)%Lnd_restart_is_open = .false. else @@ -483,8 +483,7 @@ end subroutine fv_io_read_restart !>@details This subroutine is useful when initializing a cycled or nudged model !! from an analysis that does not have a whole set of microphysical, aerosol, or !! chemical tracers - subroutine fv_io_read_tracers(fv_domain,Atm) - type(domain2d), intent(inout) :: fv_domain + subroutine fv_io_read_tracers(Atm) type(fv_atmos_type), intent(inout) :: Atm(:) integer :: ntracers, ntprog, nt, isc, iec, jsc, jec character(len=6) :: stile_name @@ -499,7 +498,7 @@ subroutine fv_io_read_tracers(fv_domain,Atm) call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers, num_prog=ntprog) ! fix for single tile runs where you need fv_core.res.nc and fv_core.res.tile1.nc - ntiles = mpp_get_ntile_count(fv_domain) + ntiles = mpp_get_ntile_count(Atm(1)%domain_for_read) if(ntiles == 1 .and. .not. Atm(1)%neststruct%nested) then stile_name = '.tile1' else @@ -508,7 +507,7 @@ subroutine fv_io_read_tracers(fv_domain,Atm) fname = 'INPUT/fv_tracer.res'//trim(stile_name)//'.nc' - if (open_file(Tra_restart_r,fname,"read",fv_domain, is_restart=.true.)) then + if (open_file(Tra_restart_r,fname,"read",Atm(1)%domain_for_read, is_restart=.true.)) then do nt = 2, ntprog call get_tracer_names(MODEL_ATMOS, nt, tracer_name) call set_tracer_profile (MODEL_ATMOS, nt, Atm(1)%q(isc:iec,jsc:jec,:,nt) ) @@ -534,10 +533,9 @@ end subroutine fv_io_read_tracers !>@brief The subroutine 'remap_restart' remaps the model state from remap files !! to a new set of Eulerian coordinates. !>@details Use if npz (run time z-dimension) /= npz_rst (restart z-dimension) - subroutine remap_restart(fv_domain,Atm) + subroutine remap_restart(Atm) use fv_mapz_mod, only: rst_remap - type(domain2d), intent(inout) :: fv_domain type(fv_atmos_type), intent(inout) :: Atm(:) character(len=64) :: fname, tracer_name @@ -546,6 +544,7 @@ subroutine remap_restart(fv_domain,Atm) integer :: isd, ied, jsd, jed integer :: ntiles + type(domain2d) :: fv_domain type(FmsNetcdfDomainFile_t) :: FV_tile_restart_r, Tra_restart_r type(FmsNetcdfFile_t) :: Fv_restart_r integer, allocatable, dimension(:) :: pes !< Array of the pes in the current pelist @@ -560,6 +559,7 @@ subroutine remap_restart(fv_domain,Atm) integer npz, npz_rst, ng integer i,j,k + fv_domain = Atm(1)%domain_for_read npz = Atm(1)%npz ! run time z dimension npz_rst = Atm(1)%flagstruct%npz_rst ! restart z dimension isc = Atm(1)%bd%isc; iec = Atm(1)%bd%iec; jsc = Atm(1)%bd%jsc; jec = Atm(1)%bd%jec @@ -640,7 +640,7 @@ subroutine remap_restart(fv_domain,Atm) if (Atm(1)%Rsf_restart_is_open) then Atm%flagstruct%srf_init = .true. call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Rsf_restart) + call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) call close_file(Atm(1)%Rsf_restart) Atm(1)%Rsf_restart_is_open = .false. call mpp_error(NOTE,'==> Warning from remap_restart: Expected file '//trim(fname)//' does not exist') @@ -1279,12 +1279,12 @@ subroutine fv_io_read_BCs(Atm) call fv_io_register_restart_BCs(Atm) if (Atm%neststruct%BCfile_sw_is_open) then - call read_restart_bc(Atm%neststruct%BCfile_sw) + call read_restart_bc(Atm%neststruct%BCfile_sw, ignore_checksum=Atm%flagstruct%enforce_rst_cksum) call close_file(Atm%neststruct%BCfile_sw) endif if (Atm%neststruct%BCfile_ne_is_open) then - call read_restart_bc(Atm%neststruct%BCfile_ne) + call read_restart_bc(Atm%neststruct%BCfile_ne, ignore_checksum=Atm%flagstruct%enforce_rst_cksum) call close_file(Atm%neststruct%BCfile_ne) endif diff --git a/tools/fv_mp_mod.F90 b/tools/fv_mp_mod.F90 index b6f279e31..4f2c0f2c2 100644 --- a/tools/fv_mp_mod.F90 +++ b/tools/fv_mp_mod.F90 @@ -91,7 +91,7 @@ module fv_mp_mod use mpp_domains_mod, only : mpp_group_update_initialized, mpp_do_group_update use mpp_domains_mod, only : mpp_create_group_update,mpp_reset_group_update_field use mpp_domains_mod, only : group_halo_update_type => mpp_group_update_type - use mpp_domains_mod, only: nest_domain_type + use mpp_domains_mod, only : nest_domain_type, mpp_get_io_domain_layout, mpp_get_layout, mpp_copy_domain use mpp_parameter_mod, only : WUPDATE, EUPDATE, SUPDATE, NUPDATE, XUPDATE, YUPDATE use fv_arrays_mod, only: fv_atmos_type, fv_grid_bounds_type use mpp_mod, only : mpp_get_current_pelist, mpp_set_current_pelist @@ -367,7 +367,7 @@ end subroutine mp_stop ! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! !>@brief The subroutine 'domain_decomp' sets up the domain decomposition. subroutine domain_decomp(grid_num,npx,npy,nregions,grid_type,nested,layout,io_layout,bd,tile,square_domain,& - npes_per_tile,domain,domain_for_coupler,num_contact,pelist) + npes_per_tile,domain,domain_for_coupler,domain_for_read,num_contact,pelist) integer, intent(IN) :: grid_num integer, intent(IN) :: npx,npy,grid_type @@ -389,8 +389,9 @@ subroutine domain_decomp(grid_num,npx,npy,nregions,grid_type,nested,layout,io_la integer, intent(INOUT) :: pelist(:) integer, intent(OUT) :: num_contact, npes_per_tile logical, intent(OUT) :: square_domain - type(domain2D), intent(OUT) :: domain, domain_for_coupler + type(domain2D), intent(OUT) :: domain, domain_for_coupler, domain_for_read type(fv_grid_bounds_type), intent(INOUT) :: bd + integer :: l_layout(2) nx = npx-1 ny = npy-1 @@ -652,6 +653,17 @@ subroutine domain_decomp(grid_num,npx,npy,nregions,grid_type,nested,layout,io_la call mpp_define_io_domain(domain, io_layout) call mpp_define_io_domain(domain_for_coupler, io_layout) + !--- create a read domain that can be used to improve read performance + !--- if io_layout=(1,1) then read io_layout=layout (all read) + !--- if io_layout\=(1,1) then read io_layout=io_layout (no change) + l_layout = mpp_get_io_domain_layout(domain) + call mpp_copy_domain(domain, domain_for_read) + if (ALL(l_layout == 1)) then + call mpp_get_layout(domain, l_layout) + call mpp_define_io_domain(domain_for_read, l_layout) + else + call mpp_define_io_domain(domain_for_read, l_layout) + endif endif deallocate(pe_start,pe_end) diff --git a/tools/fv_restart.F90 b/tools/fv_restart.F90 index bcd6ea13b..313ef7355 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -343,7 +343,7 @@ subroutine fv_restart(fv_domain, Atm, seconds, days, cold_start, grid_type, this !3. External_ic if (Atm(n)%flagstruct%external_ic) then if( is_master() ) write(*,*) 'Calling get_external_ic' - call get_external_ic(Atm(n), Atm(n)%domain, .not. do_read_restart) + call get_external_ic(Atm(n), .not. do_read_restart) if( is_master() ) write(*,*) 'IC generated from the specified external source' !4. Restart @@ -358,11 +358,11 @@ subroutine fv_restart(fv_domain, Atm, seconds, days, cold_start, grid_type, this write(*,*) '***** End Note from FV core **************************' write(*,*) ' ' endif - call remap_restart( Atm(n)%domain, Atm(n:n) ) + call remap_restart( Atm(n:n) ) if( is_master() ) write(*,*) 'Done remapping dynamical IC' else if( is_master() ) write(*,*) 'Warm starting, calling fv_io_restart' - call fv_io_read_restart(Atm(n)%domain,Atm(n:n)) + call fv_io_read_restart(Atm(n)%domain_for_read,Atm(n:n)) !====== PJP added DA functionality ====== if (Atm(n)%flagstruct%read_increment) then ! print point in middle of domain for a sanity check From b67bc5d154da2911d20b7a07716ec645eb2a1f0e Mon Sep 17 00:00:00 2001 From: "Rusty.Benson" Date: Thu, 14 Apr 2022 16:33:29 -0400 Subject: [PATCH 2/3] rename enforce_rst_cksum to ignore_rst_cksum and change the default value for compatibility --- model/fv_arrays.F90 | 2 +- model/fv_control.F90 | 6 +++--- tools/fv_io.F90 | 16 ++++++++-------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/model/fv_arrays.F90 b/model/fv_arrays.F90 index 6edc03d18..4a0539509 100644 --- a/model/fv_arrays.F90 +++ b/model/fv_arrays.F90 @@ -516,7 +516,7 @@ module fv_arrays_mod !----------------------------------------------------------------------------------------------- logical :: reset_eta = .false. - logical :: enforce_rst_cksum = .true. !< enfore or override data integrity restart checksums + logical :: ignore_rst_cksum = .false. !< enfore (.false.) or override (.true.) data integrity restart checksums real :: p_fac = 0.05 !< Safety factor for minimum nonhydrostatic pressures, which !< will be limited so the full pressure is no less than p_fac !< times the hydrostatic pressure. This is only of concern in mid-top diff --git a/model/fv_control.F90 b/model/fv_control.F90 index 35584b0d5..6951a15a5 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -291,7 +291,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, real(kind=R_GRID) , pointer :: target_lon logical , pointer :: reset_eta - logical , pointer :: enforce_rst_cksum + logical , pointer :: ignore_rst_cksum real , pointer :: p_fac real , pointer :: a_imp integer , pointer :: n_split @@ -859,7 +859,7 @@ subroutine set_namelist_pointers(Atm) regional_bcs_from_gsi => Atm%flagstruct%regional_bcs_from_gsi write_restart_with_bcs => Atm%flagstruct%write_restart_with_bcs reset_eta => Atm%flagstruct%reset_eta - enforce_rst_cksum => Atm%flagstruct%enforce_rst_cksum + ignore_rst_cksum => Atm%flagstruct%ignore_rst_cksum p_fac => Atm%flagstruct%p_fac a_imp => Atm%flagstruct%a_imp n_split => Atm%flagstruct%n_split @@ -1078,7 +1078,7 @@ subroutine read_namelist_fv_core_nml(Atm) write_coarse_restart_files,& write_coarse_diagnostics,& write_only_coarse_intermediate_restarts, & - write_coarse_agrid_vel_rst, write_coarse_dgrid_vel_rst, enforce_rst_cksum + write_coarse_agrid_vel_rst, write_coarse_dgrid_vel_rst, ignore_rst_cksum ! Read FVCORE namelist diff --git a/tools/fv_io.F90 b/tools/fv_io.F90 index b1547824e..fd5294b32 100644 --- a/tools/fv_io.F90 +++ b/tools/fv_io.F90 @@ -419,7 +419,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Fv_restart_tile_is_open = open_file(Atm(1)%Fv_restart_tile, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Fv_restart_tile_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Fv_restart_tile, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Fv_restart_tile, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Fv_restart_tile) Atm(1)%Fv_restart_tile_is_open = .false. endif @@ -429,7 +429,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Tra_restart_is_open = open_file(Atm(1)%Tra_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Tra_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Tra_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Tra_restart, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Tra_restart) Atm(1)%Tra_restart_is_open = .false. else @@ -442,7 +442,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) if (Atm(1)%Rsf_restart_is_open) then Atm(1)%flagstruct%srf_init = .true. call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Rsf_restart) Atm(1)%Rsf_restart_is_open = .false. else @@ -456,7 +456,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Mg_restart_is_open = open_file(Atm(1)%Mg_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Mg_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Mg_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Mg_restart, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Mg_restart) Atm(1)%Mg_restart_is_open = .false. else @@ -467,7 +467,7 @@ subroutine fv_io_read_restart(fv_domain,Atm) Atm(1)%Lnd_restart_is_open = open_file(Atm(1)%Lnd_restart, fname, "read", fv_domain, is_restart=.true.) if (Atm(1)%Lnd_restart_is_open) then call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Lnd_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Lnd_restart, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Lnd_restart) Atm(1)%Lnd_restart_is_open = .false. else @@ -640,7 +640,7 @@ subroutine remap_restart(Atm) if (Atm(1)%Rsf_restart_is_open) then Atm%flagstruct%srf_init = .true. call fv_io_register_restart(Atm(1)) - call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%enforce_rst_cksum) + call read_restart(Atm(1)%Rsf_restart, ignore_checksum=Atm(1)%flagstruct%ignore_rst_cksum) call close_file(Atm(1)%Rsf_restart) Atm(1)%Rsf_restart_is_open = .false. call mpp_error(NOTE,'==> Warning from remap_restart: Expected file '//trim(fname)//' does not exist') @@ -1279,12 +1279,12 @@ subroutine fv_io_read_BCs(Atm) call fv_io_register_restart_BCs(Atm) if (Atm%neststruct%BCfile_sw_is_open) then - call read_restart_bc(Atm%neststruct%BCfile_sw, ignore_checksum=Atm%flagstruct%enforce_rst_cksum) + call read_restart_bc(Atm%neststruct%BCfile_sw, ignore_checksum=Atm%flagstruct%ignore_rst_cksum) call close_file(Atm%neststruct%BCfile_sw) endif if (Atm%neststruct%BCfile_ne_is_open) then - call read_restart_bc(Atm%neststruct%BCfile_ne, ignore_checksum=Atm%flagstruct%enforce_rst_cksum) + call read_restart_bc(Atm%neststruct%BCfile_ne, ignore_checksum=Atm%flagstruct%ignore_rst_cksum) call close_file(Atm%neststruct%BCfile_ne) endif From 619e5d8e472af1928e84a63541245c97d3e3b00e Mon Sep 17 00:00:00 2001 From: Rusty Benson Date: Tue, 14 Jun 2022 11:26:47 -0400 Subject: [PATCH 3/3] updated UFS/GFS atmosphere.F90 driver as per @BinLiu-NOAA and @junwang-noaa --- driver/fvGFS/atmosphere.F90 | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/driver/fvGFS/atmosphere.F90 b/driver/fvGFS/atmosphere.F90 index f2f68eb6e..2796c823e 100644 --- a/driver/fvGFS/atmosphere.F90 +++ b/driver/fvGFS/atmosphere.F90 @@ -324,10 +324,12 @@ subroutine atmosphere_init (Time_init, Time, Time_step, Grid_box, area) logical :: dycore_only = .false. logical :: debug = .false. logical :: sync = .false. + logical :: ignore_rst_cksum = .false. integer, parameter :: maxhr = 4096 real, dimension(maxhr) :: fdiag = 0. real :: fhmax=384.0, fhmaxhf=120.0, fhout=3.0, fhouthf=1.0,avg_max_length=3600. - namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, ccpp_suite, avg_max_length + namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, ccpp_suite, & + & avg_max_length, ignore_rst_cksum ! *DH 20210326 !For regional @@ -449,6 +451,15 @@ subroutine atmosphere_init (Time_init, Time, Time_step, Grid_box, area) !--- allocate pref allocate(pref(npz+1,2), dum1d(npz+1)) + ! DH* 20210326 + ! First, read atmos_model_nml namelist section - this is a workaround to avoid + ! unnecessary additional changes to the input namelists, in anticipation of the + ! implementation of a generic interface for GFDL and CCPP fast physics soon + read(input_nml_file, nml=atmos_model_nml, iostat=io) + ierr = check_nml_error(io, 'atmos_model_nml') + !write(0,'(a)') "It's me, and my physics suite is '" // trim(ccpp_suite) // "'" + ! *DH 20210326 + call fv_restart(Atm(mygrid)%domain, Atm, seconds, days, cold_start, Atm(mygrid)%gridstruct%grid_type, mygrid) fv_time = Time @@ -490,15 +501,6 @@ subroutine atmosphere_init (Time_init, Time, Time_step, Grid_box, area) ! Do CCPP fast physics initialization before call to adiabatic_init (since this calls fv_dynamics) - ! DH* 20210326 - ! First, read atmos_model_nml namelist section - this is a workaround to avoid - ! unnecessary additional changes to the input namelists, in anticipation of the - ! implementation of a generic interface for GFDL and CCPP fast physics soon - read(input_nml_file, nml=atmos_model_nml, iostat=io) - ierr = check_nml_error(io, 'atmos_model_nml') - !write(0,'(a)') "It's me, and my physics suite is '" // trim(ccpp_suite) // "'" - ! *DH 20210326 - ! For fast physics running over the entire domain, block ! and thread number are not used; set to safe values cdata%blk_no = 1