Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

MPP Update #1655

Open
wants to merge 10 commits into
base: main
Choose a base branch
from
Open

MPP Update #1655

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
48f031f
update mpp_pelist_scatter routines to use native collectives
abrooks1085 Feb 27, 2025
0a97a4f
update mpp_gather_1D_ and mpp_gather_1DV_ routines to use native coll…
abrooks1085 Feb 27, 2025
8d91ace
Added mpp_commID to return communicator
abrooks1085 Feb 27, 2025
32cc448
Added MPI_TYPE_ macro for scatter/gather routines that use native col…
abrooks1085 Feb 27, 2025
a93702f
Updated test to work with new gat/scat routines. Offsets are not used…
abrooks1085 Feb 27, 2025
260f54d
Removed trailing white spaces
abrooks1085 Feb 27, 2025
8928d44
Revert some changes causing CI checks to fail
abrooks1085 Feb 27, 2025
2f8259e
Merge branch 'NOAA-GFDL:main' into mpp_update
abrooks1085 Mar 3, 2025
be6bdf5
Create new scatter and gather routines in mpp_transmit_mpi.fh and mpp…
abrooks1085 Mar 4, 2025
0889251
Fixed issues related to rebase
abrooks1085 Mar 4, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 18 additions & 0 deletions mpp/include/mpp_comm.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -384,6 +384,8 @@
#undef MPP_GATHER_PELIST_3D_
#define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_logical_2d
#define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_logical_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_LOGICAL
#include <mpp_gather.fh>

#undef MPP_GATHER_1D_
Expand All @@ -396,6 +398,8 @@
#undef MPP_GATHER_PELIST_3D_
#define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_int4_2d
#define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_int4_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_INTEGER4
#include <mpp_gather.fh>


Expand All @@ -409,6 +413,8 @@
#undef MPP_GATHER_PELIST_3D_
#define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_int8_2d
#define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_int8_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_INTEGER8
#include <mpp_gather.fh>


Expand All @@ -422,6 +428,8 @@
#undef MPP_GATHER_PELIST_3D_
#define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_real4_2d
#define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_real4_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL4
#include <mpp_gather.fh>

#undef MPP_GATHER_1D_
Expand All @@ -434,6 +442,8 @@
#undef MPP_GATHER_PELIST_3D_
#define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_real8_2d
#define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_real8_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL8
#include <mpp_gather.fh>

!#################################################
Expand All @@ -443,6 +453,8 @@
#define MPP_TYPE_ integer(i4_kind)
#define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_int4_2d
#define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_int4_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_INTEGER4
#include <mpp_scatter.fh>

#undef MPP_SCATTER_PELIST_2D_
Expand All @@ -451,6 +463,8 @@
#define MPP_TYPE_ integer(i8_kind)
#define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_int8_2d
#define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_int8_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_INTEGER8
#include <mpp_scatter.fh>

#undef MPP_SCATTER_PELIST_2D_
Expand All @@ -459,6 +473,8 @@
#define MPP_TYPE_ real(r4_kind)
#define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_real4_2d
#define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_real4_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL4
#include <mpp_scatter.fh>

#undef MPP_SCATTER_PELIST_2D_
Expand All @@ -467,5 +483,7 @@
#define MPP_TYPE_ real(r8_kind)
#define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_real8_2d
#define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_real8_3d
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL8
#include <mpp_scatter.fh>
!> @}
51 changes: 51 additions & 0 deletions mpp/include/mpp_comm_mpi.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -411,12 +411,21 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_real8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_real8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_real8
#undef MPP_TYPE_
#define MPP_TYPE_ real(r8_kind)
#undef MPP_TYPE_BYTELEN_
#define MPP_TYPE_BYTELEN_ 8
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL8



#include <mpp_transmit_mpi.fh>

#ifdef OVERLOAD_C8
Expand Down Expand Up @@ -468,6 +477,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_complx8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_complx8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_complx8
#undef MPP_TYPE_
#define MPP_TYPE_ complex(c8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -525,6 +540,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_real4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_real4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_real4
#undef MPP_TYPE_
#define MPP_TYPE_ real(r4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -582,6 +603,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_cmplx4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_cmplx4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_cmplx4
#undef MPP_TYPE_
#define MPP_TYPE_ complex(c4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -641,6 +668,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_int8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_int8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_int8
#undef MPP_TYPE_
#define MPP_TYPE_ integer(i8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -697,6 +730,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_int4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_int4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_int4
#undef MPP_TYPE_
#define MPP_TYPE_ integer(i4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -755,6 +794,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_logical8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_logical8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_logical8
#undef MPP_TYPE_
#define MPP_TYPE_ logical(l8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -811,6 +856,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_logical4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_logical4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_logical4
#undef MPP_TYPE_
#define MPP_TYPE_ logical(l4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down
48 changes: 48 additions & 0 deletions mpp/include/mpp_comm_nocomm.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -311,6 +311,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_real8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_real8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_real8
#undef MPP_TYPE_
#define MPP_TYPE_ real(r8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -368,6 +374,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_cmplx8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_cmplx8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_cmplx8
#undef MPP_TYPE_
#define MPP_TYPE_ complex(c8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -425,6 +437,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_real4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_real4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_real4
#undef MPP_TYPE_
#define MPP_TYPE_ real(r4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -482,6 +500,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_cmplx4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_cmplx4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_cmplx4
#undef MPP_TYPE_
#define MPP_TYPE_ complex(c4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -541,6 +565,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_int8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_int8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_int8
#undef MPP_TYPE_
#define MPP_TYPE_ integer(i8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -597,6 +627,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_int4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_int4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_int4
#undef MPP_TYPE_
#define MPP_TYPE_ integer(i4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -655,6 +691,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_logical8
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_logical8
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_logical8
#undef MPP_TYPE_
#define MPP_TYPE_ logical(l8_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down Expand Up @@ -711,6 +753,12 @@ end subroutine mpp_exit
#define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
#undef MPP_BROADCAST_5D_
#define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
#undef MPP_SCATTERV_
#define MPP_SCATTERV_ mpp_scatterv_logical4
#undef MPP_GATHER_
#define MPP_GATHER_ mpp_gather_logical4
#undef MPP_GATHERV_
#define MPP_GATHERV_ mpp_gatherv_logical4
#undef MPP_TYPE_
#define MPP_TYPE_ logical(l4_kind)
#undef MPP_TYPE_BYTELEN_
Expand Down
53 changes: 20 additions & 33 deletions mpp/include/mpp_gather.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,20 +20,21 @@

!> @addtogroup mpp_mod
!> @{
subroutine MPP_GATHER_1D_(sbuf, rbuf,pelist)
subroutine MPP_GATHER_1D_(sbuf, rbuf, pelist)
! JWD: Did not create mpp_gather_2d because have no requirement for it
! JWD: See mpp_gather_2dv below
MPP_TYPE_, dimension(:), intent(in) :: sbuf
MPP_TYPE_, dimension(:), intent(inout) :: rbuf
integer, dimension(:), intent(in), optional :: pelist(:)

integer :: cnt, l, nproc, op_root
integer :: cnt, l, nproc, op_root, ierr
integer, allocatable :: pelist2(:)

if( .NOT.module_is_initialized ) call mpp_error( FATAL, 'MPP_NEW_GATHER: You must first call mpp_init.' )

! If pelist is provided, the first position must be
! the operation root
! If pelist is provided, the first position must be the operation root, w.r.t. new comm, op_root = 0
if(PRESENT(pelist))then
if(.not.ANY(mpp_pe().eq.pelist(:))) return
nproc = size(pelist)
allocate(pelist2(nproc))
pelist2 = pelist
Expand All @@ -46,19 +47,10 @@ subroutine MPP_GATHER_1D_(sbuf, rbuf,pelist)

cnt = size(sbuf(:))
if(size(rbuf(:)) < cnt*nproc) call mpp_error(FATAL, &
"MPP_GATHER_1D_: size(rbuf) must be at least npes*size(sbuf) ")
"MPP_NEW_GATHER_1D_: size(rbuf) must be at least npes*size(sbuf) ")

!--- pre-post receiving
if(pe == op_root) then
rbuf(1:cnt) = sbuf
do l = 2, nproc
call mpp_recv(rbuf((l-1)*cnt+1), glen=cnt, from_pe=pelist2(l), block=.FALSE., tag=COMM_TAG_1 )
enddo
else
call mpp_send(sbuf(1), plen=cnt, to_pe=op_root, tag=COMM_TAG_1)
endif
call mpp_gather( sbuff, size(sbuf,1), rbuf, size(rbuf,1), 0, pelist2, ierr)

call mpp_sync_self(check=EVENT_RECV)
call mpp_sync_self()
deallocate(pelist2)
end subroutine MPP_GATHER_1D_
Expand All @@ -70,8 +62,9 @@ subroutine MPP_GATHER_1DV_(sbuf, ssize, rbuf, rsize, pelist)
integer, dimension(:), intent(in) :: rsize
integer, dimension(:), intent(in), optional :: pelist(:)

integer :: l, nproc, pos, op_root
integer, allocatable :: pelist2(:)
integer :: l, nproc, op_root, ierr
integer, dimension(:), allocatable :: displs
integer, dimension(:), allocatable :: pelist2

! If pelist is provided, the first position must be
! the operation root
Expand All @@ -82,30 +75,24 @@ subroutine MPP_GATHER_1DV_(sbuf, ssize, rbuf, rsize, pelist)
else
nproc = mpp_npes()
allocate(pelist2(nproc))
pelist2 = (/ (l, l=0+root_pe, nproc-1+root_pe) /)
pelist2 = (/ (l, l=root_pe, nproc-1+root_pe) /)
endif
op_root = pelist2(1)

if(pe .eq. op_root) then
allocate(displs(nproc))

!--- pre-post receiving
if (pe .eq. op_root) then
pos = 1
do l = 1,nproc ! include op_root to simplify logic
if (rsize(l) == 0) then
cycle ! avoid ranks with no data
endif
call mpp_recv(rbuf(pos),glen=rsize(l),from_pe=pelist2(l), &
block=.FALSE.,tag=COMM_TAG_2)
pos = pos + rsize(l)
enddo
endif
if (ssize .gt. 0) then
call mpp_send(sbuf(1),plen=ssize,to_pe=op_root,tag=COMM_TAG_2) !avoid ranks with no data
displs(1) = 0
do i = 2, nproc
displs(i) = displs(i-1) + rsize(i-1)
enddo
endif

call mpp_sync_self(check=EVENT_RECV)
call mpp_gather( sbuf, size(sbuf), displs, rbuf, size(rbuf), root_pe, pelist2, ierr)

call mpp_sync_self()
deallocate(pelist2)
if(pe .eq. op_root) deallocate(displs)
end subroutine MPP_GATHER_1DV_


Expand Down
Loading
Loading