diff --git a/driver/fvGFS/atmosphere.F90 b/driver/fvGFS/atmosphere.F90 index dcd43fb52..dc4e208fa 100644 --- a/driver/fvGFS/atmosphere.F90 +++ b/driver/fvGFS/atmosphere.F90 @@ -165,7 +165,7 @@ module atmosphere_mod mpp_npes, mpp_pe, mpp_chksum, & mpp_get_current_pelist, & mpp_set_current_pelist, & - mpp_sync, mpp_sync_self, mpp_send, mpp_recv + mpp_sync, mpp_sync_self, mpp_send, mpp_recv, mpp_broadcast use mpp_parameter_mod, only: EUPDATE, WUPDATE, SUPDATE, NUPDATE use mpp_domains_mod, only: CENTER, CORNER, NORTH, EAST, WEST, SOUTH use mpp_domains_mod, only: domain2d, mpp_update_domains, mpp_global_field @@ -2433,7 +2433,6 @@ subroutine fill_nested_grid_cpl(this_grid, proc_in) logical, intent(in), optional :: proc_in real, allocatable :: g_dat(:,:,:) - integer :: p, sending_proc integer :: isd_p, ied_p, jsd_p, jed_p integer :: isg, ieg, jsg, jeg integer :: isc, iec, jsc, jec @@ -2453,31 +2452,22 @@ subroutine fill_nested_grid_cpl(this_grid, proc_in) allocate( g_dat(isg:ieg, jsg:jeg, 1) ) call timing_on('COMM_TOTAL') - sending_proc = Atm(this_grid)%parent_grid%pelist(1) + & - ( Atm(this_grid)%neststruct%parent_tile-tile_fine(Atm(this_grid)%parent_grid%grid_number)+ & - Atm(this_grid)%parent_grid%flagstruct%ntiles-1 )*Atm(this_grid)%parent_grid%npes_per_tile - !if (Atm(this_grid)%neststruct%parent_proc .and. Atm(this_grid)%neststruct%parent_tile == Atm(this_grid)%parent_grid%global_tile) then if (Atm(this_grid)%neststruct%parent_tile == Atm(this_grid)%parent_grid%global_tile) then call mpp_global_field(Atm(this_grid)%parent_grid%domain, & Atm(this_grid)%parent_grid%parent2nest_2d(isd_p:ied_p,jsd_p:jed_p), & g_dat(isg:,jsg:,1), position=CENTER) - if (mpp_pe() == sending_proc) then - do p=1,size(Atm(this_grid)%pelist) - call mpp_send(g_dat, size(g_dat), Atm(this_grid)%pelist(p)) - enddo - endif endif - if (any(Atm(this_grid)%pelist == mpp_pe())) then - call mpp_recv(g_dat, size(g_dat), sending_proc) + + if(Atm(this_grid)%BcastMember) then + call mpp_broadcast(g_dat, size(g_dat),Atm(this_grid)%Bcast_ranks(1), Atm(this_grid)%Bcast_ranks) endif + call timing_off('COMM_TOTAL') if (process) then call fill_nested_grid(Atm(this_grid)%parent2nest_2d, g_dat(isg:,jsg:,1), & Atm(this_grid)%neststruct%ind_h, Atm(this_grid)%neststruct%wt_h, & 0, 0, isg, ieg, jsg, jeg, Atm(this_grid)%bd) endif - - call mpp_sync_self deallocate(g_dat) end subroutine fill_nested_grid_cpl diff --git a/model/fv_arrays.F90 b/model/fv_arrays.F90 index 0f61c8c42..b5dbf9e4f 100644 --- a/model/fv_arrays.F90 +++ b/model/fv_arrays.F90 @@ -1302,6 +1302,11 @@ module fv_arrays_mod integer, allocatable, dimension(:) :: pelist + ! These are set in fv_control_init() and used in fill_nested_grid_cpl() + ! to replace numerous p2p MPI transfers with a single mpp_broadcast() + integer, allocatable :: Bcast_ranks(:) + logical :: BcastMember + type(fv_grid_bounds_type) :: bd type(fv_regional_bc_bounds_type) :: regional_bc_bounds @@ -2063,7 +2068,7 @@ subroutine deallocate_fv_atmos_type(Atm) call deallocate_fv_nest_BC_type(Atm%neststruct%delz_BC) endif #endif - + if(allocated(Atm%Bcast_ranks)) deallocate(Atm%Bcast_ranks) end if if (Atm%flagstruct%grid_type < 4) then diff --git a/model/fv_control.F90 b/model/fv_control.F90 index b030eda96..bf111afd2 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -452,7 +452,6 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, allocate(global_pelist(npes)) call mpp_get_current_pelist(global_pelist, commID=global_commID) ! for commID - allocate(grids_master_procs(ngrids)) pecounter = 0 allocate(grids_on_this_pe(ngrids)) @@ -734,6 +733,27 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, Atm(this_grid)%neststruct%parent_proc = ANY(Atm(this_grid)%neststruct%child_grids) !ANY(tile_coarse == Atm(this_grid)%global_tile) Atm(this_grid)%neststruct%child_proc = ASSOCIATED(Atm(this_grid)%parent_grid) !this means a nested grid + if(n>1) then + call mpp_set_current_pelist( global_pelist ) + do n=2,ngrids + ! Construct the MPI communicators that are used in fill_nested_grid_cpl() + allocate(Atm(n)%Bcast_ranks(1+size(Atm(n)%pelist))) + ! parent grid sending rank within Bcast_ranks array + Atm(n)%Bcast_ranks(1)=Atm(n)%parent_grid%pelist(1) + & + ( Atm(n)%neststruct%parent_tile-tile_fine(Atm(n)%parent_grid%grid_number)+ & + Atm(n)%parent_grid%flagstruct%ntiles-1 )*Atm(n)%parent_grid%npes_per_tile + + Atm(n)%Bcast_ranks(2:(1+size(Atm(n)%pelist)))=Atm(n)%pelist ! Receivers + Atm(n)%BcastMember=.false. + if(any(mpp_pe() == Atm(n)%Bcast_ranks)) then + Atm(n)%BcastMember=.true. + endif + + call mpp_declare_pelist(Atm(n)%Bcast_ranks(:)) + enddo + call mpp_set_current_pelist(Atm(this_grid)%pelist) + endif + if (ngrids > 1) call setup_update_regions if (Atm(this_grid)%neststruct%nestbctype > 1) then call mpp_error(FATAL, 'nestbctype > 1 not yet implemented') diff --git a/model/molecular_diffusion.F90 b/model/molecular_diffusion.F90 index c34432634..bc0d3ac4f 100644 --- a/model/molecular_diffusion.F90 +++ b/model/molecular_diffusion.F90 @@ -41,7 +41,7 @@ module molecular_diffusion_mod use constants_mod, only: rdgas, cp_air use fv_mp_mod, only: is_master use mpp_mod, only: stdlog, input_nml_file - use fms_mod, only: check_nml_error, open_namelist_file, close_file + use fms_mod, only: check_nml_error use fv_grid_utils_mod, only: g_sum use mpp_domains_mod, only: domain2d use fv_arrays_mod, only: fv_grid_type, fv_grid_bounds_type @@ -128,20 +128,10 @@ subroutine read_namelist_molecular_diffusion_nml(nml_filename,ncnst,nwat) unit = stdlog() -#ifdef INTERNAL_FILE_NML - ! Read molecular_diffusion namelist - read (input_nml_file,molecular_diffusion_nml,iostat=ios) - ierr = check_nml_error(ios,'molecular_diffusion_nml') + read (input_nml_file,molecular_diffusion_nml,iostat=ios) + ierr = check_nml_error(ios,'molecular_diffusion_nml') -#else - ! Read molecular_diffusion namelist - f_unit = open_namelist_file(nml_filename) - rewind (f_unit) - read (f_unit,molecular_diffusion_nml,iostat=ios) - ierr = check_nml_error(ios,'molecular_diffusion_nml') - call close_file(f_unit) -#endif write(unit, nml=molecular_diffusion_nml) call molecular_diffusion_init(ncnst,nwat) diff --git a/model/multi_gases.F90 b/model/multi_gases.F90 index 082a9c0f0..2e555915a 100644 --- a/model/multi_gases.F90 +++ b/model/multi_gases.F90 @@ -42,7 +42,7 @@ module multi_gases_mod use constants_mod, only: rdgas, rvgas, cp_air use fv_mp_mod, only: is_master use mpp_mod, only: stdlog, input_nml_file - use fms_mod, only: check_nml_error, open_namelist_file, close_file + use fms_mod, only: check_nml_error implicit none @@ -154,25 +154,15 @@ subroutine read_namelist_multi_gases_nml(nml_filename,ncnst,nwat) ri(1) = rvgas cpi(0) = cp_air cpi(1) = 4*cp_air -#ifdef INTERNAL_FILE_NML - ! Read multi_gases namelist - read (input_nml_file,multi_gases_nml,iostat=ios) - ierr = check_nml_error(ios,'multi_gases_nml') + ! Read multi_gases namelist + read (input_nml_file,multi_gases_nml,iostat=ios) + ierr = check_nml_error(ios,'multi_gases_nml') -#else - ! Read multi_gases namelist - f_unit = open_namelist_file(nml_filename) + write(unit, nml=multi_gases_nml) + call multi_gases_init(ncnst,nwat) - rewind (f_unit) - read (f_unit,multi_gases_nml,iostat=ios) - ierr = check_nml_error(ios,'multi_gases_nml') - call close_file(f_unit) -#endif - write(unit, nml=multi_gases_nml) - call multi_gases_init(ncnst,nwat) - - return + return end subroutine read_namelist_multi_gases_nml diff --git a/tools/fv_grid_tools.F90 b/tools/fv_grid_tools.F90 index 9cc909a02..d74000f64 100644 --- a/tools/fv_grid_tools.F90 +++ b/tools/fv_grid_tools.F90 @@ -148,7 +148,7 @@ module fv_grid_tools_mod use fms2_io_mod, only: file_exists, variable_exists, open_file, read_data, & get_global_attribute, get_variable_attribute, & close_file, get_mosaic_tile_grid, FmsNetcdfFile_t - use mosaic_mod, only: get_mosaic_ntiles + use mosaic2_mod, only: get_mosaic_ntiles implicit none private @@ -227,6 +227,11 @@ subroutine read_grid(Atm, grid_file, ndims, nregions, ng) call get_mosaic_tile_grid(atm_hgrid, atm_mosaic, Atm%domain) + if (open_file(Grid_input, atm_mosaic, "read")) then + ntiles = get_mosaic_ntiles(Grid_input) + call close_file(Grid_input) + endif + grid_form = "none" if (open_file(Grid_input, atm_hgrid, "read")) then call get_global_attribute(Grid_input, "history", attvalue) @@ -234,7 +239,6 @@ subroutine read_grid(Atm, grid_file, ndims, nregions, ng) if(grid_form .NE. "gnomonic_ed") call mpp_error(FATAL, & "fv_grid_tools(read_grid): the grid should be 'gnomonic_ed' when reading from grid file, contact developer") - ntiles = get_mosaic_ntiles(atm_mosaic) if( .not. Atm%gridstruct%bounded_domain) then !<-- The regional setup has only 1 tile so do not shutdown in that case. if(ntiles .NE. 6) call mpp_error(FATAL, & 'fv_grid_tools(read_grid): ntiles should be 6 in mosaic file '//trim(atm_mosaic) ) diff --git a/tools/fv_iau_mod.F90 b/tools/fv_iau_mod.F90 index 703640a4f..e4ca56500 100644 --- a/tools/fv_iau_mod.F90 +++ b/tools/fv_iau_mod.F90 @@ -37,7 +37,7 @@ module fv_iau_mod - use fms_mod, only: file_exist + use fms2_io_mod, only: file_exists use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_pe use mpp_domains_mod, only: domain2d @@ -186,7 +186,7 @@ subroutine IAU_initialize (IPD_Control, IAU_Data,Init_parm) npz = IPD_Control%levs fname = 'INPUT/'//trim(IPD_Control%iau_inc_files(1)) - if( file_exist(fname) ) then + if( file_exists(fname) ) then call open_ncfile( fname, ncid ) ! open the file call get_ncdim1( ncid, 'lon', im) call get_ncdim1( ncid, 'lat', jm) @@ -457,7 +457,7 @@ subroutine read_iau_forcing(IPD_Control,increments,fname) npz = IPD_Control%levs - if( file_exist(fname) ) then + if( file_exists(fname) ) then call open_ncfile( fname, ncid ) ! open the file else call mpp_error(FATAL,'==> Error in read_iau_forcing: Expected file '& diff --git a/tools/fv_restart.F90 b/tools/fv_restart.F90 index 6e8363fdb..a3291ba91 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -168,7 +168,6 @@ module fv_restart_mod use mpp_domains_mod, only: mpp_global_field use fv_treat_da_inc_mod, only: read_da_inc use fms2_io_mod, only: file_exists, set_filename_appendix, FmsNetcdfFile_t, open_file, close_file - use fms_io_mod, only: fmsset_filename_appendix=> set_filename_appendix use coarse_grained_restart_files_mod, only: fv_io_write_restart_coarse use fv_regional_mod, only: write_full_fields #ifdef MULTI_GASES @@ -289,7 +288,6 @@ subroutine fv_restart(fv_domain, Atm, seconds, days, cold_start, grid_type, this if (Atm(n)%neststruct%nested .and. n==this_grid) then write(gnn,'(A4, I2.2)') "nest", Atm(n)%grid_number call set_filename_appendix(gnn) - call fmsset_filename_appendix(gnn) endif !3preN. Topography BCs for nest, including setup for blending diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 7ebbef44d..420958149 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -117,7 +117,7 @@ module test_cases_mod use mpp_mod, only: mpp_error, FATAL, mpp_root_pe, mpp_broadcast, mpp_sum use mpp_mod, only: stdlog, input_nml_file - use fms_mod, only: check_nml_error, close_file, open_namelist_file + use fms_mod, only: check_nml_error use mpp_domains_mod, only: mpp_update_domains, domain2d use mpp_parameter_mod, only: AGRID_PARAM=>AGRID,CGRID_NE_PARAM=>CGRID_NE, & SCALAR_PAIR