!******************************************************************************
! One-sided Communication example:
!
! In this example all processes expose a memory region large enough to
! contain one integer for each rank in MPI_COMM_WORLD. The MPI-2 standard
! defines three synchronization mechanisms:
!
! - Lock/Unlock: One rank requests either a shared or an exclusive
! lock on the window exposed by some target rank.
!
! - Fence: The first call to MPI_WIN_FENCE will open an epoch
! where all ranks can access all other ranks. The
! epoch is closed with another call to MPI_WIN_FENCE.
!
! - Active Target: In this synchronization mode, the targets of remote
! memory accesses explicitly grant permission to the
! origins through the call MPI_WIN_POST. An epoch is
! closed thought a call to MPI_WIN_WAIT. Likewise, the
! origins explicitly request permission through a call
! to MPI_WIN_START and close the epoch through
! MPI_WIN_COMPLETE. Note that every rank granted
! access *must* call MPI_WIN_START and eventually
! MPI_WIN_COMPLETE before an epoch is closed.
!
! Recall that "origin" refers to the process that performs the remote memory
! access call, while the "target" refers to the process in which memory is
! accessed.
!
! In this example we show to use each of the synchronization mechanisms.
!
! More specifically:
! --------------------------------
! - Every process exposes a window large enough to store one integer per
! process in MPI_COMM_WORLD.
! - Lock/Unlock: Every rank x accesses rank x+1's memory, and fills the
! exposed region with integers of value x.
! - Fence: Every process writes one integer (value = rank) to all
! other processes.
! - ActiveTarget: Every rank x accesses rank x-1's memory, and fills the
! exposed region with integers of value x.
! - Get: Every process read the exposed memory region of every
! process and displays the result.
! - The window is freed and MPI_Finalize is called.
! --------------------------------
!
! Copyright 2003 (c) Critical Software SA
! . http://www.criticalsoftware.com
! . http://www.criticalsoftware.com/hpc
! . csWMPI II@criticalsoftware.com
!
!*****************************************************************************/
include 'mpif.f90'
!******************************************************************************
! Displays a list of integers
!******************************************************************************
subroutine DisplayInts(pn_ints,n_count)
implicit none
integer pn_ints(*), n_count
integer nCounter
do nCounter = 1,n_count
print *, '(',pn_ints(nCounter),')'
end do
print *,''
end !subroutine DisplayInts
!******************************************************************************
! In this function we use the MPI_Win_lock and MPI_Win_unlock to open and
! close epochs.
!******************************************************************************
subroutine LockUnlock(n_my_rank, n_comm_size,g_mwWin)
use MPI
implicit none
integer n_my_rank, n_comm_size, g_mwWin, ierr
integer nCounter, nTargetRank, nTargetDisp
integer sizeofInt
! Compute the target rank. If my rank is x then my target will be x+1
! (modulo the communicator size).
nTargetRank = mod((1 + n_my_rank),n_comm_size)
! Lock the window on the target. Use an exclusive lock, since we are
! going to do Puts
call MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, nTargetRank,0,g_mwWin,ierr)
! Fill the memory of the target with integers with a value equal to my
! rank. We put only one integer at the time (a much more efficient
! approach would have been to put n_comm_size integers using a single
! Put operation, however the purpose here is just to show how
! one-sided communication works, and not how to write efficient
! applications).
do nCounter = 0,n_comm_size-1
! Compute the target displacement. Since the Win was created using
! a displacement of 1 [see main()] we have to compute the
! displacements in bytes. Alternatively, we could have created the
! window using a displacement unit of sizeofInt, and simply used
! nCounter as the displacement.
call MPI_TYPE_SIZE(MPI_INTEGER,sizeofInt,ierr)
nTargetDisp = nCounter * sizeofInt
! Perform the Put. Write one integer:
call MPI_PUT (n_my_rank,1,MPI_INTEGER,nTargetRank,&
nTargetDisp,1,MPI_INTEGER,g_mwWin, ierr)
end do
! Unlock the window, since we are done accessing it for now:
call MPI_WIN_UNLOCK(nTargetRank, g_mwWin, ierr)
! Since we are going to use other types of synchronization methods */
! later we synchronize all processes: */
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
end !subroutine LockUnlock
!******************************************************************************
! In this function we use MPI_FENCE to open and close epochs. In this function
! we write one integer to all other processes.
!******************************************************************************
subroutine Fence(n_my_rank,n_comm_size,g_mwWin)
use MPI
implicit none
integer n_my_rank,n_comm_size, g_mwWin, ierr
integer nCounter, nTargetDisp, sizeofInt
call MPI_TYPE_SIZE(MPI_INTEGER,sizeofInt,ierr)
nTargetDisp = n_my_rank * sizeofInt
! Open an epoch:
call MPI_WIN_FENCE (0, g_mwWin, ierr)
do nCounter = 0,n_comm_size-1
! Put an integer in the memory exposed by rank nCounter
call MPI_PUT (n_my_rank,1,MPI_INTEGER,nCounter,&
nTargetDisp,1,MPI_INTEGER,g_mwWin, ierr)
end do
! Close the epoch:
call MPI_WIN_FENCE(0, g_mwWin, ierr)
! Since we are going to use other types of synchronization methods
! later we synchronize all processes:
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
end !subroutine Fence
!******************************************************************************
! In this function we use MPI_WIN_POST, MPI_WIN_WAIT, MPI_WIN_START, and
! MPI_WIN_COMPLETE to open and close epochs.
!
! If we have rank x, then we would like to access rank x-1 and to let rank
! x+1 access our exposed memory.
!******************************************************************************
subroutine ActiveTarget(n_my_rank,n_comm_size,g_mwWin)
use MPI
implicit none
integer n_my_rank,n_comm_size, g_mwWin, ierr
integer nCounter, nPostRank(1), nStartRank(1),nTargetDisp
integer sizeofInt
integer mgCommWorld, mgPostGroup, mgStartGroup
! Compute the rank of the process, which will access our memory, and
! the rank exposing the memory that we are going to access:
nPostRank = mod((n_my_rank + 1),n_comm_size)
nStartRank = mod((n_comm_size + (n_my_rank - 1)),n_comm_size)
! Get the group of MPI_COMM_WORLD and create groups for the Post and
! Start ranks:
call MPI_COMM_GROUP(MPI_COMM_WORLD, mgCommWorld, ierr)
call MPI_GROUP_INCL(mgCommWorld, 1, nPostRank, mgPostGroup, ierr)
call MPI_Group_INCL(mgCommWorld, 1, nStartRank, mgStartGroup, &
ierr)
call MPI_TYPE_SIZE(MPI_INTEGER, sizeofInt, ierr)
! Open the epochs:
call MPI_WIN_POST(mgPostGroup, 0, g_mwWin, ierr)
call MPI_WIN_START(mgStartGroup, 0, g_mwWin, ierr)
do nCounter = 0,n_comm_size-1
nTargetDisp = nCounter * sizeofInt
call MPI_PUT (n_my_rank,1,MPI_INTEGER,nStartRank(1),&
nTargetDisp,1,MPI_INTEGER, g_mwWin, ierr)
end do
! Close the epochs:
call MPI_WIN_COMPLETE(g_mwWin, ierr)
call MPI_WIN_WAIT(g_mwWin,ierr)
! Free the groups:
call MPI_GROUP_FREE(mgCommWorld, ierr)
call MPI_GROUP_FREE(mgPostGroup, ierr)
call MPI_GROUP_FREE(mgStartGroup, ierr)
! Since we are going to use other types of synchronization methods
! later we synchronize all processes:
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
end !subroutine ActiveTarget
!******************************************************************************
! This function reads (using Get) the content of all exposed memory regions
! and displays it:
!******************************************************************************
subroutine Get(n_comm_size,g_mwWin)
use MPI
implicit none
integer n_comm_size, g_mwWin, ierr
integer, allocatable ::pnTempBuffer(:)
integer nCounter
! Allocate a buffer large enough to hold the content of one process'
! exposed region
allocate(pnTempBuffer(n_comm_size))
! Read the content of exposed regions one by one. We use shared locks
! since we only do reads.
do nCounter = 0,n_comm_size-1
! Open an epoch:
call MPI_WIN_LOCK(MPI_LOCK_SHARED, nCounter,0,g_mwWin, ierr)
call MPI_GET(pnTempBuffer,n_comm_size,MPI_INTEGER,&
nCounter,0,n_comm_size,MPI_INTEGER,g_mwWin, ierr)
! Close the epoch. We have to do before accessing pnTempBuffer to
! make sure that the Get operation has completed.
call MPI_WIN_UNLOCK(nCounter, g_mwWin, ierr)
! Display the result:
print *,'Got the following from rank ',nCounter, ' : '
call DisplayInts(pnTempBuffer, n_comm_size)
end do
deallocate(pnTempBuffer)
end subroutine Get
program main
use MPI
implicit none
integer nCommRank, nCommSize, nWindowSize, ierr
integer g_mwWin, sizeofInt
integer, allocatable ::pchSharedMemory(:)
! Initialize csWMPI II II:
call MPI_INIT(ierr)
! Determine what the world looks like and our own position in it:
call MPI_COMM_SIZE(MPI_COMM_WORLD, nCommSize, ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD, nCommRank, ierr)
print *,'I am rank ',nCommRank,' of ',nCommSize, &
' in MPI_COMM_WORLD'
! Compute the size of the memory region to expose and allocate memory:
call MPI_TYPE_SIZE(MPI_INTEGER,sizeofInt,ierr)
nWindowSize = nCommSize * sizeofInt
allocate(pchSharedMemory(nWindowSize))
! Create the window (same size for all processes. Note that we use a
! displacement of 1. This means that displacements in Puts and Gets
! have to be calculated as byte offsets.
call MPI_WIN_CREATE(pchSharedMemory,nWindowSize,1,MPI_INFO_NULL,&
MPI_COMM_WORLD,g_mwWin, ierr)
! Use the lock/unlock synchronization:
call LockUnlock(nCommRank, nCommSize,g_mwWin)
print *,'After LockUnlock - My memory region contains: '
call DisplayInts(pchSharedMemory, nCommSize)
! Use the fence synchronization:
call Fence(nCommRank, nCommSize,g_mwWin)
print *,'After Fence - My memory region contains: '
call DisplayInts(pchSharedMemory, nCommSize)
! Use the active target (post,wait,start,complete) synchronization:
call ActiveTarget(nCommRank, nCommSize,g_mwWin)
print *,'After PostWaitStartComplete - My memory region contains:'
call DisplayInts(pchSharedMemory, nCommSize)
! Use get to read the content of the exposed memory regions on all
! processes:
print *,'Getting content of all ranks exposed memory regions: '
call Get(nCommSize,g_mwWin)
! Free the window and the allocated memory:
call MPI_WIN_FREE(g_mwWin, ierr)
deallocate(pchSharedMemory)
! Pause rank 0 so that the output can be verified:
if (nCommRank == 0) then
pause 'Press ENTER to exit...'
end if
call MPI_FINALIZE(ierr)
stop
end
|