Skip to content
This repository was archived by the owner on Oct 23, 2020. It is now read-only.

Commit 85f2541

Browse files
mark-petersenmark-petersen
committed
Add 3 subroutines to support reusable halo exchange group data structures
1 parent 9327929 commit 85f2541

1 file changed

Lines changed: 208 additions & 1 deletion

File tree

‎src/framework/mpas_dmpar.F‎

Lines changed: 208 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818
module mpas_dmpar
1919

2020
#define COMMA ,
21-
#define DMPAR_DEBUG_WRITE(M) ! call mpas_log_write(M)
21+
#define DMPAR_DEBUG_WRITE(M) !call mpas_log_write( M )
2222
#define DMPAR_WARNING_WRITE(M) call mpas_log_write( M , messageType=MPAS_LOG_WARN)
2323
#define DMPAR_ERROR_WRITE(M) call mpas_log_write( M , messageType=MPAS_LOG_CRIT)
2424

@@ -113,6 +113,10 @@ module mpas_dmpar
113113
public :: mpas_dmpar_exch_group_full_halo_exch
114114
public :: mpas_dmpar_field_halo_exch
115115

116+
public :: mpas_dmpar_exch_group_build_reusable_buffers
117+
public :: mpas_dmpar_exch_group_reuse_halo_exch
118+
public :: mpas_dmpar_exch_group_destroy_reusable_buffers
119+
116120

117121
interface mpas_dmpar_alltoall_field
118122
module procedure mpas_dmpar_alltoall_field1d_integer
@@ -7241,6 +7245,209 @@ subroutine mpas_dmpar_field_halo_exch(domain, fieldName, timeLevel, haloLayers,
72417245

72427246
end subroutine mpas_dmpar_field_halo_exch!}}}
72437247

7248+
!-----------------------------------------------------------------------
7249+
! routine mpas_dmpar_exch_group_reuse_halo_exch
7250+
!
7251+
!> \brief MPAS dmpar halo exchange a group using recycled data structure
7252+
!> \author Bill Arndt
7253+
!> \date 11/07/2017
7254+
!> \details
7255+
!> This routine performs a full halo exchange on an exchange group.
7256+
!> It is blocking, in that the routine doesn't return until the full
7257+
!> exchange is complete. This variant reuses a previously allocated
7258+
!> and build data structure to avoid repeating a large section
7259+
!> of thread serial code.
7260+
!
7261+
!-----------------------------------------------------------------------
7262+
subroutine mpas_dmpar_exch_group_reuse_halo_exch(domain, groupName, timeLevel, haloLayers, iErr)!{{{
7263+
type (domain_type), intent(inout) :: domain
7264+
character (len=*), intent(in) :: groupName
7265+
integer, optional, intent(in) :: timeLevel
7266+
integer, dimension(:), optional, intent(in) :: haloLayers
7267+
integer, optional, intent(out) :: iErr
7268+
integer :: mpi_ierr
7269+
7270+
type (mpas_exchange_group), pointer :: exchGroupPtr
7271+
type (mpas_communication_list), pointer :: commListPtr
7272+
type (mpas_exchange_field_list), pointer :: exchFieldListPtr
7273+
integer :: nLen, timeLevelLocal, iHalo
7274+
7275+
if ( present(iErr) ) then
7276+
iErr = MPAS_DMPAR_NOERR
7277+
end if
7278+
7279+
nLen = len_trim(groupName)
7280+
DMPAR_DEBUG_WRITE(' -- Trying to perform a reused full exchange for group ' // trim(groupName))
7281+
7282+
if ( present(timeLevel) ) then
7283+
timeLevelLocal = timeLevel
7284+
else
7285+
timeLevelLocal = -1
7286+
end if
7287+
7288+
exchGroupPtr => domain % exchangeGroups
7289+
do while (associated(exchGroupPtr))
7290+
if ( nLen == exchGroupPtr % nLen) then
7291+
if ( groupName(1:nLen) == exchGroupPtr % groupName(1:exchGroupPtr % nLen) ) then
7292+
DMPAR_DEBUG_WRITE(' -- Performing a full exchange for reused group ' // trim(groupName))
7293+
7294+
!$omp master
7295+
commListPtr => exchGroupPtr % sendList
7296+
do while ( associated(commListPtr) )
7297+
commListPtr % bufferOffset = 0
7298+
commListPtr => commListPtr % next
7299+
end do
7300+
commListPtr => exchGroupPtr % recvList
7301+
do while ( associated(commListPtr) )
7302+
commListPtr % bufferOffset = 0
7303+
commListPtr => commListPtr % next
7304+
end do
7305+
7306+
if ( associated(exchGroupPtr % fieldList) ) then
7307+
exchFieldListPtr => exchGroupPtr % fieldList
7308+
do while ( associated(exchFieldListPtr) )
7309+
if ( timeLevelLocal == -1 ) then
7310+
exchFieldListPtr % timeLevels(:) = .true.
7311+
else
7312+
exchFieldListPtr % timeLevels(:) = .false.
7313+
exchFieldListPtr % timeLevels(timeLevel) = .true.
7314+
end if
7315+
if ( present (haloLayers) ) then
7316+
exchFieldListPtr % haloLayers(:) = .false.
7317+
do iHalo = 1, size(haloLayers)
7318+
exchFieldListPtr % haloLayers( haloLayers(iHalo) ) = .true.
7319+
end do
7320+
else
7321+
exchFieldListPtr % haloLayers(:) = .true.
7322+
end if
7323+
call mpas_pool_remove_config(exchGroupPtr % fieldPool, exchFieldListPtr % fieldName)
7324+
call mpas_pool_add_config(exchGroupPtr % fieldPool, exchFieldListPtr % fieldName, timeLevelLocal)
7325+
exchFieldListPtr => exchFieldListPtr % next
7326+
end do
7327+
end if
7328+
!$omp end master
7329+
call mpas_threading_barrier()
7330+
7331+
call mpas_dmpar_exch_group_start_recv(domain % dminfo, exchGroupPtr)
7332+
call mpas_dmpar_exch_group_pack_buffers(domain % blocklist % allFields, exchGroupPtr)
7333+
call mpas_dmpar_exch_group_start_send(domain % dminfo, exchGroupPtr)
7334+
7335+
! Perform local copies (should be teh same as local_halo_exch)
7336+
call mpas_dmpar_exch_group_local_exch_fields(domain % blocklist % allFields, exchGroupPtr)
7337+
7338+
! Finish the halo exchange (should be the same as end_halo_exch)
7339+
call mpas_dmpar_exch_group_unpack_buffers(domain % blocklist % allFields, exchGroupPtr)
7340+
7341+
! Print out buffers for debugging
7342+
!call mpas_dmpar_exch_group_print_buffers(exchGroupPtr)
7343+
7344+
!$omp master
7345+
! Wait for isends to finish
7346+
commListPtr => exchGroupPtr % sendList
7347+
do while ( associated(commListPtr) )
7348+
call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
7349+
commListPtr => commListPtr % next
7350+
end do
7351+
!$omp end master
7352+
call mpas_threading_barrier()
7353+
7354+
return
7355+
end if
7356+
end if
7357+
exchGroupPtr => exchGroupPtr % next
7358+
end do
7359+
7360+
call mpas_log_write('No exchange group found named ''' // trim(groupName) // '''.', MPAS_LOG_ERR)
7361+
call mpas_log_write(' Cannot perform reuse halo exchange on group.', MPAS_LOG_ERR)
7362+
if ( present(iErr) ) then
7363+
iErr = MPAS_DMPAR_MISSING_GROUP
7364+
end if
7365+
end subroutine mpas_dmpar_exch_group_reuse_halo_exch!}}}
7366+
7367+
!-----------------------------------------------------------------------
7368+
! routine mpas_dmpar_exch_group_destroy_reusable_buffers
7369+
!
7370+
!> \brief MPAS dmpar exchange group destroy reusable buffers routine
7371+
!> \author Bill Arndt
7372+
!> \date 11/07/2017
7373+
!> \details
7374+
!> This routine destroys buffers. Additionally, it DOES NOT include
7375+
!> MPI_Wait commands to finish receiving messages before destroying buffers.
7376+
!> In this way the catching of iSend can be performed for each halo exchange
7377+
!> while the communication lists are left intact.
7378+
!
7379+
!-----------------------------------------------------------------------
7380+
subroutine mpas_dmpar_exch_group_destroy_reusable_buffers(domain, groupName, iErr)!{{{
7381+
integer, optional, intent(out) :: iErr
7382+
7383+
type (domain_type), intent(inout) :: domain
7384+
character (len=*), intent(in) :: groupName
7385+
type (mpas_exchange_group), pointer :: exchGroupPtr
7386+
integer :: nLen
7387+
7388+
integer :: mpi_ierr
7389+
7390+
if ( present(iErr) ) then
7391+
iErr = MPAS_DMPAR_NOERR
7392+
end if
7393+
7394+
call mpas_threading_barrier()
7395+
!$omp master
7396+
! Destroy communication lists
7397+
nLen = len_trim(groupName)
7398+
exchGroupPtr => domain % exchangeGroups
7399+
do while (associated(exchGroupPtr))
7400+
if ( nLen == exchGroupPtr % nLen) then
7401+
if ( groupName(1:nLen) == exchGroupPtr % groupName(1:exchGroupPtr % nLen) ) then
7402+
call mpas_dmpar_destroy_communication_list(exchGroupPtr % sendList)
7403+
call mpas_dmpar_destroy_communication_list(exchGroupPtr % recvList)
7404+
exit
7405+
end if
7406+
end if
7407+
exchGroupPtr => exchGroupPtr % next
7408+
end do
7409+
call mpas_dmpar_exch_group_destroy(domain, groupName)
7410+
!$omp end master
7411+
call mpas_threading_barrier()
7412+
7413+
end subroutine mpas_dmpar_exch_group_destroy_reusable_buffers!}}}
7414+
7415+
!-----------------------------------------------------------------------
7416+
! routine mpas_dmpar_exch_group_build_reusable_buffers
7417+
!
7418+
!> \brief MPAS dmpar exchange group reusable buffer construction routine
7419+
!> \author Bill Arndt
7420+
!> \date 11/10/2017
7421+
!> \details
7422+
!> This routine creates the buffers and communication lists for a
7423+
!> reusable exchange group.
7424+
!
7425+
!-----------------------------------------------------------------------
7426+
7427+
subroutine mpas_dmpar_exch_group_build_reusable_buffers(domain, groupName, iErr)
7428+
type (domain_type), intent(inout) :: domain
7429+
character (len=*), intent(in) :: groupName
7430+
integer, optional, intent(out) :: iErr
7431+
7432+
integer :: nLen
7433+
type (mpas_exchange_group), pointer :: exchGroupPtr
7434+
7435+
if ( present(iErr) ) then
7436+
iErr = MPAS_DMPAR_NOERR
7437+
end if
7438+
7439+
nLen = len_trim(groupName)
7440+
exchGroupPtr => domain % exchangeGroups
7441+
do while (associated(exchGroupPtr))
7442+
if ( nLen == exchGroupPtr % nLen) then
7443+
if ( groupName(1:nLen) == exchGroupPtr % groupName(1:exchGroupPtr % nLen) ) then
7444+
call mpas_dmpar_exch_group_build_buffers(domain % blocklist % allFields, exchGroupPtr)
7445+
exit
7446+
end if
7447+
end if
7448+
exchGroupPtr => exchGroupPtr % next
7449+
end do
7450+
end subroutine mpas_dmpar_exch_group_build_reusable_buffers
72447451
72457452
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
72467453
!

0 commit comments

Comments
 (0)