#include "misc.h"!-----------------------------------------------------------------------!         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS!-----------------------------------------------------------------------      MODULE parutilitiesmodule#if defined( SPMD )!BOP!! !MODULE: parutilitiesmodule!! !USES:      USE precision#include "debug.h"      IMPLICIT NONE#include "mpif.h"#include "pilgrim.h"!! !PUBLIC DATA MEMBERS:#if defined(USE_ARENAS)      COMMON /ARENA/  buf01, buf02, buf03      POINTER(buf01,volume)      INTEGER(i4), DIMENSION(MAX_PE,MAX_PE,MAX_TRF) :: volume      POINTER(buf02,databuf)      REAL(r8), DIMENSION(MAX_BUF,MAX_TRF,MAX_SMP) :: databuf      POINTER(buf03,intbuf)      INTEGER(i4), DIMENSION(MAX_BUF,MAX_TRF,MAX_SMP)  :: intbuf      POINTER(buf04,databuf4)      REAL(r4), DIMENSION(MAX_BUF,MAX_TRF,MAX_SMP) :: databuf4#endif      PUBLIC     CommGlobal, GID, Gsize      PUBLIC     SUMOP, MAXOP, MINOP      INTEGER,SAVE :: CommGlobal   ! Global communicator (before ParSplit)      INTEGER,SAVE :: GSize        ! Size of communicator CommGlobal      INTEGER,SAVE :: GID          ! My rank in communicator CommGlobal#define CPP_SUM_OP 101#define CPP_MAX_OP 102#define CPP_MIN_OP 103#define CPP_BCST_OP 104#if defined( USE_ARENAS )      INTEGER,SAVE :: SUMOP = CPP_SUM_OP      INTEGER,SAVE :: MAXOP = CPP_MAX_OP      INTEGER,SAVE :: MINOP = CPP_MIN_OP      INTEGER,SAVE :: BCSTOP = CPP_BCST_OP#else      INTEGER,SAVE :: SUMOP = MPI_SUM      INTEGER,SAVE :: MAXOP = MPI_MAX      INTEGER,SAVE :: MINOP = MPI_MIN      INTEGER,SAVE :: BCSTOP = CPP_BCST_OP#endif      INTEGER,SAVE :: numcpu, blocksize, packetsize! !PUBLIC MEMBER FUNCTIONS:      PUBLIC ParPatternType       TYPE BlockDescriptor         INTEGER, POINTER     :: Displacements(:)   ! Offsets in local segment         INTEGER, POINTER     :: BlockSizes(:)      ! Block sizes to transfer       END TYPE BlockDescriptor       TYPE ParPatternType        INTEGER ::     Comm                  ! Communicator        INTEGER ::     Iam                   ! My rank in communicator        INTEGER ::     Size                  ! Size of communicator#if defined( USE_ARENAS )        TYPE(BlockDescriptor), POINTER :: SendDesc(:) ! Array of descriptors        TYPE(BlockDescriptor), POINTER :: RecvDesc(:) ! Array of descriptors#else        INTEGER, POINTER :: SendDesc( : )    ! Send descriptors        INTEGER, POINTER :: RecvDesc( : )    ! Receive descriptors#endif      END TYPE ParPatternType       PUBLIC     ParInit, ParSplit, ParFree, ParExit      PUBLIC     ParScatter, ParGather      PUBLIC     ParBeginTransfer, ParEndTransfer      PUBLIC     ParExchangeVector, ParCollective      PUBLIC     ParPatternCreate, ParPatternFree      INTERFACE     ParPatternCreate        MODULE PROCEDURE ParPatternGhost        MODULE PROCEDURE ParPatternDecompToDecomp        MODULE PROCEDURE ParPatternDecompToGhost        MODULE PROCEDURE ParPatternGhostToDecomp        MODULE PROCEDURE ParPatternGhostToGhost      END INTERFACE       INTERFACE     ParScatter        MODULE PROCEDURE ParScatterReal        MODULE PROCEDURE ParScatterReal4        MODULE PROCEDURE ParScatterInt      END INTERFACE       INTERFACE     ParGather        MODULE PROCEDURE ParGatherReal        MODULE PROCEDURE ParGatherReal4        MODULE PROCEDURE ParGatherInt      END INTERFACE      INTERFACE     ParBeginTransfer        MODULE PROCEDURE ParBeginTransferReal        MODULE PROCEDURE ParBeginTransferPattern1D        MODULE PROCEDURE ParBeginTransferPattern2D        MODULE PROCEDURE ParBeginTransferPattern2Domp        MODULE PROCEDURE ParBeginTransferPattern3Domp!        MODULE PROCEDURE ParBeginTransferInt      END INTERFACE      INTERFACE     ParEndTransfer        MODULE PROCEDURE ParEndTransferReal        MODULE PROCEDURE ParEndTransferPattern1D        MODULE PROCEDURE ParEndTransferPattern2D        MODULE PROCEDURE ParEndTransferPattern2Domp        MODULE PROCEDURE ParEndTransferPattern3Domp!        MODULE PROCEDURE ParEndTransferInt      END INTERFACE      INTERFACE     ParExchangeVector        MODULE PROCEDURE ParExchangeVectorReal        MODULE PROCEDURE ParExchangeVectorInt      END INTERFACE      INTERFACE     ParCollective        MODULE PROCEDURE ParCollectiveBarrier        MODULE PROCEDURE ParCollective0D        MODULE PROCEDURE ParCollective1D        MODULE PROCEDURE ParCollective1DReal4        MODULE PROCEDURE ParCollective2D        MODULE PROCEDURE ParCollective3D        MODULE PROCEDURE ParCollective0DInt        MODULE PROCEDURE ParCollective1DInt      END INTERFACE!! !DESCRIPTION:!!      This module provides the basic utilities to support parallelism!      on a distributed or shared memory multiprocessor.!!      \begin{center}!      \begin{tabular}{|l|l|} \hline \hline!        ParInit           & Initialize the parallel system \\ \hline!        ParExit           & Exit from the parallel system \\ \hline!        ParSplit          & Create a Compute grid of PEs   \\ \hline!        ParFree           & Free a split communicator \\ \hline!        ParScatter        & Scatter global slice to local slices \\ \hline!        ParGather         & Gather local slices to one global \\ \hline!        ParBeginTransfer  & Initiate an all-to-all packet transfer \\ \hline!        ParEndTransfer    & Complete an all-to-all packet transfer \\ \hline!        ParExchangeVector & Complete an all-to-all packet transfer \\ \hline!        ParCollective     & Collective operation across communicator \\ \hline!      \end{tabular}!      \end{center}!      \vspace{2mm}!!      Other utilities can be added to this module as needs evolve.!!      Conceptually the intention is to aggregate as many of the!      MPI communication calls as possible into a well-maintained!      module.  This will help avoid the occurrence of MPI spaghetti !      code.  !!      This module is tailored to GEOS DAS and implements the !      design of Lucchesi/Mirin/Sawyer/Larson.!! !REVISION HISTORY:!   97.02.01   Sawyer     Creation!   97.07.22   Sawyer     Removal of DecompType related subroutines!   97.08.13   Sawyer     Added ParScatter/Gather for Integers!   97.09.26   Sawyer     Additions of Sparse communication primitives!   97.12.01   Sawyer     Changed all MPI_SSEND to MPI_ISEND!   97.12.23   Lucchesi   Added member variables IsIONode and InterComm!   98.01.06   Sawyer     Additions from RL for I/O Nodes!   98.02.02   Sawyer     Added the Cartesian data members!   98.02.05   Sawyer     Removed the use of intercommunicators!   98.02.23   Sawyer     Added ghosting utilities!   98.02.25   Sawyer     Modified interface of BeginTransfer!   98.03.03   Sawyer     Added Global ID number to public data members!   98.03.25   Sawyer     Added documentation for walkthrough!   98.04.16   Sawyer     Removed all use of MPI_CART (CommRow redefined)!   98.07.23   Sawyer     Added ParGhost, ParPoleDot; ParBegin/EndGhost out!   98.09.15   Sawyer     Added ParMerge, ParPoleGhost!   98.09.17   Sawyer     Added ParSum, removed ParPoleDot!   99.01.18   Sawyer     Minor cleaning!   99.03.04   Sawyer     Revised SHMEM concept for Transfer!   99.04.22   Sawyer     Removed COMMON for handles -- they are!                         always used in same program unit.!   99.05.21   Sawyer     Reintroduced barriers in Scatter/Gather!   99.06.03   Sawyer     USE_SHMEM revisions!   99.12.10   Sawyer     ParInit now sets GID, Gsize!   99.12.13   Sawyer     Version slimmed down for FVCCM release!   00.06.14   Sawyer     Precision module now used!   00.07.07   Sawyer     Removed 2D scatter/gather; simplified API!   00.07.30   Sawyer     Full implementation with shared memory!   00.08.09   Sawyer     Replaced ParSum with ParCollective!   00.08.28   Sawyer     Moved LLNL 2D data to LLNL2DModule; new MLP impl!   01.02.04   Sawyer     Added PatternType and related routines!   01.02.12   Sawyer     Converted to free format!! !BUGS:!   There are several MPI_Barriers at locations in the code.!   These avoid potential race conditions which probably only occur!   if the number of real processors is less than the number of!   message passing processes.  Remove these barriers at your own risk!!EOP      INTEGER, SAVE :: Inhandle(MAX_PAX, MAX_SMP, MAX_TRF)      INTEGER, SAVE :: OutHandle(MAX_PAX,MAX_SMP, MAX_TRF)      INTEGER, SAVE :: BegTrf = 0  ! Ongoing overlapped begintransfer #       INTEGER, SAVE :: EndTrf = 0  ! Ongoing overlapped endtransfer #      CONTAINS!-----------------------------------------------------------------------!-----------------------------------------------------------------------!BOP! !IROUTINE: ParInit --- Initialize the parallel execution!! !INTERFACE:       SUBROUTINE ParInit (  )!! !USES:      IMPLICIT NONE!! !DESCRIPTION:!     Initializes the system.  In MPI mode, call MPI\_INIT if not done !     already.  In USE\_ARENAS mode, initialize the shared memory buffer.!!     This routine is the very {\em first} thing which is executed!!! !SYSTEM ROUTINES:!     MPI_INITIALIZED, MPI_INIT!! !REVISION HISTORY:!   97.03.20   Sawyer     Creation!   97.04.16   Sawyer     Cleaned up for walk-through!   97.07.03   Sawyer     Reformulated documentation!   00.07.23   Sawyer     Added shared memory arena implementation!!EOP!-----------------------------------------------------------------------!BOC! !LOCAL VARIABLES:      INTEGER Ierror      LOGICAL Flag!#if defined(USE_ARENAS)#include <ulocks.h>      INTEGER(i4) :: ipe, fork, getpid, master, n, nowcpu      INTEGER(i8) :: nvars, extent(100), pnt(100)      character*80 evalue! Get the memory for the global variables       extent(1) = MAX_PE * MAX_PE * MAX_TRF * 4      extent(2) = MAX_BUF * MAX_TRF * MAX_SMP * 8      extent(3) = MAX_BUF * MAX_TRF * MAX_SMP * 4      extent(4) = MAX_BUF * MAX_TRF * MAX_SMP * 4      nvars = 4      call mlp_getmem(nvars,extent,pnt)      buf01=pnt(1)      buf02=pnt(2)      buf03=pnt(3)      buf04=pnt(4)! Get the number of processes      call getenv('N_MPI',evalue)      read(evalue,*) Gsize! Get the max number of threads per process      call getenv('N_SMP',evalue)      read(evalue,*) numcpu! Calculate maximum blocksize and packetsize      blocksize = MAX_BUF / Gsize      packetsize = blocksize / MAX_PAX! Destroy and recreate the environment      master=getpid()#if defined(SGI)      call mp_destroy#endif      gid = 0      do while ( getpid() .eq. master .and. gid < Gsize-1 )        ierror=fork()        gid = gid+1      enddo      if ( getpid() .eq. master ) gid = 0#if defined (SGI)      call mp_set_numthreads(numcpu)  !keep it for a while#else      call omp_set_num_threads(numcpu)#endif#if defined(SGI) && !defined(NO_PIN)!$omp parallel do private(n,nowcpu)      do n=1,numcpu         nowcpu = n + gid*numcpu - 1         call mp_assign_to_cpu(nowcpu)      enddo#endif#else!!     Check if MPI is initialized.  If not, initialize.  No mpi_call!      CALL MPI_INITIALIZED( Flag, Ierror )      CPP_ASSERT_F90( Ierror == 0 )      IF ( .not. Flag ) then        CALL MPI_INIT( ierror )        CPP_ASSERT_F90( Ierror == 0 )      ENDIF      CALL MPI_COMM_SIZE( MPI_COMM_WORLD, Gsize, Ierror )       CALL MPI_COMM_RANK( MPI_COMM_WORLD, GID, Ierror )      CALL MPI_COMM_DUP( MPI_COMM_WORLD, CommGlobal, Ierror )#endif      RETURN!EOC      END SUBROUTINE ParInit!-----------------------------------------------------------------------!-----------------------------------------------------------------------!BOP! !IROUTINE: ParExit --- Finalize the parallel execution!! !INTERFACE:      SUBROUTINE ParExit ( )! !USES:      IMPLICIT NONE! !DESCRIPTION:!     All PEs, compute nodes and IO nodes alike meet here to terminate!     themselves.  If someone does not check in, everything will hang!     here.!!     This routine is the very {\em last} thing which is executed!!! !LOCAL VARIABLES:      INTEGER Ierror!! !SYSTEM ROUTINES:!     MPI_BARRIER, MPI_FINALIZE!! !REVISION HISTORY:!   97.03.20   Sawyer     Creation!   97.04.16   Sawyer     Cleaned up for walk-through!   97.07.03   Sawyer     Reformulated documentation!   00.07.23   Sawyer     Added shared memory arena implementation!!EOP!-----------------------------------------------------------------------!BOC#if !defined( USE_ARENAS )      CALL MPI_BARRIER( MPI_COMM_WORLD, Ierror )      CALL MPI_FINALIZE( Ierror )#endif      RETURN!EOC      END SUBROUTINE ParExit!-----------------------------------------------------------------------!-----------------------------------------------------------------------!BOP! !IROUTINE:   ParSplit --- Split into group for I/O and computation!! !INTERFACE:      SUBROUTINE ParSplit( InComm, Color, InID, Comm, MyID, Nprocs )!! !USES:      IMPLICIT NONE! !INPUT PARAMETERS:      INTEGER, INTENT( IN )     :: InComm    ! Communicator to split      INTEGER, INTENT( IN )     :: Color     ! Group label      INTEGER, INTENT( IN )     :: InID      ! Input ID! !OUTPUT PARAMETERS:      INTEGER, INTENT( OUT )    :: Comm      ! Split communicator      INTEGER, INTENT( OUT )    :: MyID      ! Group label      INTEGER, INTENT( OUT )    :: Nprocs    ! Number of PEs in my group