Use mpp_broadcast instead of MPI_Bcast at the request of NOAA-GFDL

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
@@ -2429,12 +2429,12 @@ end subroutine atmosphere_fill_nest_cpl
 !! coupling variables from its parent grid
 !>@details Fill parent2nest_2d on the nested grid with values from its parent.
   subroutine fill_nested_grid_cpl(this_grid, proc_in)
-    use mpi
     integer, intent(in) :: this_grid
     logical, intent(in), optional :: proc_in
 
     real, allocatable :: g_dat(:,:,:)
-    integer :: p, ierr
+    integer, allocatable :: global_pelist(:)
+    integer :: p
     integer :: isd_p, ied_p, jsd_p, jed_p
     integer :: isg, ieg, jsg, jeg
     integer :: isc, iec, jsc, jec
@@ -2459,17 +2459,23 @@ subroutine fill_nested_grid_cpl(this_grid, proc_in)
                             Atm(this_grid)%parent_grid%parent2nest_2d(isd_p:ied_p,jsd_p:jed_p), &
                             g_dat(isg:,jsg:,1), position=CENTER)
     endif
+
+    allocate(global_pelist(mpp_npes()))
+    call mpp_get_current_pelist(global_pelist)
     if(any(mpp_pe() == Atm(this_grid)%Bcast_ranks)) then
-      call MPI_Bcast(g_dat, size(g_dat), MPI_REAL, 0, Atm(this_grid)%Bcast_comm, ierr) ! root==0 because sending rank (Atm(this_grid)%sending) is rank zero in Bcast_comm
+      call mpp_set_current_pelist(Atm(this_grid)%Bcast_ranks)
+      call mpp_broadcast(g_dat, size(g_dat),Atm(this_grid)%sending_proc, Atm(this_grid)%Bcast_ranks)
     endif
+    call mpp_set_current_pelist(global_pelist)
+
     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
-
     deallocate(g_dat)
+    deallocate(global_pelist)
 
   end subroutine fill_nested_grid_cpl
 

model/fv_arrays.F90

@@ -1303,7 +1303,7 @@ 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 MPI_Bcast
+    ! to replace numerous p2p MPI transfers with a single mpp_broadcast()
     integer, allocatable :: Bcast_ranks(:)
     integer :: Bcast_comm, sending_proc
 
@@ -2070,7 +2070,6 @@ subroutine deallocate_fv_atmos_type(Atm)
        endif
 #endif
        if(allocated(Atm%Bcast_ranks)) deallocate(Atm%Bcast_ranks)
-       if(Atm%Bcast_comm /= MPI_COMM_NULL) call MPI_Comm_free(Atm%Bcast_comm,ierr)
     end if
 
     if (Atm%flagstruct%grid_type < 4) then

model/fv_control.F90

@@ -188,10 +188,6 @@ module fv_control_mod
 
    subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split, &
                               nml_filename_in, skip_nml_read_in)
-     use mpi
-     use esmf
-     integer :: fcst_mpi_comm, color, ierr, rc
-     type(ESMF_VM) :: vm
 
      type(fv_atmos_type), allocatable, intent(inout), target :: Atm(:)
      real,                intent(in)    :: dt_atmos
@@ -456,10 +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
 
-     ! Need the fcst_mpi_comm in order to construct the communicators used by MPI_Bcast in fill_nested_grid_cpl()
-     call ESMF_VMGetCurrent(vm=vm,rc=rc)
-     call ESMF_VMGet(vm=vm, mpiCommunicator=fcst_mpi_comm, rc=rc)
-
      allocate(grids_master_procs(ngrids))
      pecounter = 0
      allocate(grids_on_this_pe(ngrids))
@@ -681,22 +673,6 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split,
         tile_id = mpp_get_tile_id(Atm(n)%domain)
         Atm(n)%global_tile = tile_id(1) ! only meaningful locally
         Atm(n)%npes_per_tile = size(Atm(n)%pelist)/Atm(n)%flagstruct%ntiles ! domain decomp doesn't set this globally
-
-        ! Construct the MPI communicators that are used in fill_nested_grid_cpl()
-        if(n>1) then
-          Atm(n)%sending_proc = 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
-          allocate(Atm(n)%Bcast_ranks(0:size(Atm(n)%pelist)))
-
-          Atm(n)%Bcast_ranks(0)=Atm(n)%sending_proc ! parent grid sending rank within the soon to be created Bcast_comm
-          Atm(n)%Bcast_ranks(1:size(Atm(n)%pelist))=Atm(n)%pelist ! Receivers
-
-          color=0
-          if(any(mpp_pe() == Atm(n)%Bcast_ranks)) color=1
-          call MPI_Comm_split(fcst_mpi_comm, color, mpp_pe(), Atm(n)%Bcast_comm, ierr)
-          if(ierr /= MPI_SUCCESS) print*,'fv_control_init: MPI_Comm_split',n,ierr
-        endif
      enddo
 
      ! 6. Set up domain and Atm structure
@@ -757,6 +733,22 @@ 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
 
+     call mpp_set_current_pelist( global_pelist )
+     do n=1,ngrids
+        ! Construct the MPI communicators that are used in fill_nested_grid_cpl()
+        if(n>1) then
+          Atm(n)%sending_proc = 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
+          allocate(Atm(n)%Bcast_ranks(0:size(Atm(n)%pelist)))
+
+          Atm(n)%Bcast_ranks(0)=Atm(n)%sending_proc ! parent grid sending rank within the soon to be created Bcast_comm
+          Atm(n)%Bcast_ranks(1:size(Atm(n)%pelist))=Atm(n)%pelist ! Receivers
+          call mpp_declare_pelist(Atm(n)%Bcast_ranks)
+        endif
+     enddo
+     call mpp_set_current_pelist(Atm(this_grid)%pelist)
+
      if (ngrids > 1) call setup_update_regions
      if (Atm(this_grid)%neststruct%nestbctype > 1) then
         call mpp_error(FATAL, 'nestbctype > 1 not yet implemented')