Shmem.F90 Source File


This file depends on

sourcefile~~shmem.f90~~EfferentGraph sourcefile~shmem.f90 Shmem.F90 sourcefile~constants.f90 Constants.F90 sourcefile~shmem.f90->sourcefile~constants.f90 sourcefile~internalconstants.f90 InternalConstants.F90 sourcefile~constants.f90->sourcefile~internalconstants.f90 sourcefile~mathconstants.f90 MathConstants.F90 sourcefile~constants.f90->sourcefile~mathconstants.f90 sourcefile~physicalconstants.f90 PhysicalConstants.F90 sourcefile~constants.f90->sourcefile~physicalconstants.f90 sourcefile~physicalconstants.f90->sourcefile~mathconstants.f90

Files dependent on this one

sourcefile~~shmem.f90~~AfferentGraph sourcefile~shmem.f90 Shmem.F90 sourcefile~base.f90 Base.F90 sourcefile~base.f90->sourcefile~shmem.f90 sourcefile~binio.f90 BinIO.F90 sourcefile~binio.f90->sourcefile~shmem.f90 sourcefile~extdatagridcompmod.f90 ExtDataGridCompMod.F90 sourcefile~extdatagridcompmod.f90->sourcefile~shmem.f90 sourcefile~extdatagridcompng.f90 ExtDataGridCompNG.F90 sourcefile~extdatagridcompng.f90->sourcefile~shmem.f90 sourcefile~fileioshared.f90 FileIOShared.F90 sourcefile~fileioshared.f90->sourcefile~shmem.f90 sourcefile~genericcplcomp.f90 GenericCplComp.F90 sourcefile~genericcplcomp.f90->sourcefile~shmem.f90 sourcefile~mapl_bundleio_test.f90 mapl_bundleio_test.F90 sourcefile~mapl_bundleio_test.f90->sourcefile~shmem.f90 sourcefile~mapl_capgridcomp.f90 MAPL_CapGridComp.F90 sourcefile~mapl_capgridcomp.f90->sourcefile~shmem.f90 sourcefile~mapl_cfio.f90 MAPL_CFIO.F90 sourcefile~mapl_cfio.f90->sourcefile~shmem.f90 sourcefile~mapl_comms.f90 MAPL_Comms.F90 sourcefile~mapl_comms.f90->sourcefile~shmem.f90 sourcefile~mapl_historygridcomp.f90 MAPL_HistoryGridComp.F90 sourcefile~mapl_historygridcomp.f90->sourcefile~shmem.f90 sourcefile~mapl_locstreammod.f90 MAPL_LocStreamMod.F90 sourcefile~mapl_locstreammod.f90->sourcefile~shmem.f90 sourcefile~mapl_memutils.f90 MAPL_MemUtils.F90 sourcefile~mapl_memutils.f90->sourcefile~shmem.f90 sourcefile~mapl_swathgridfactory.f90 MAPL_SwathGridFactory.F90 sourcefile~mapl_swathgridfactory.f90->sourcefile~shmem.f90 sourcefile~mapl_tilingregridder.f90 MAPL_TilingRegridder.F90 sourcefile~mapl_tilingregridder.f90->sourcefile~shmem.f90 sourcefile~mapl_tripolargridfactory.f90 MAPL_TripolarGridFactory.F90 sourcefile~mapl_tripolargridfactory.f90->sourcefile~shmem.f90 sourcefile~mapl_xygridfactory.f90 MAPL_XYGridFactory.F90 sourcefile~mapl_xygridfactory.f90->sourcefile~shmem.f90 sourcefile~maplshared.f90 MaplShared.F90 sourcefile~maplshared.f90->sourcefile~shmem.f90 sourcefile~ncio.f90 NCIO.F90 sourcefile~ncio.f90->sourcefile~shmem.f90 sourcefile~plain_netcdf_time.f90 Plain_netCDF_Time.F90 sourcefile~plain_netcdf_time.f90->sourcefile~shmem.f90 sourcefile~regrid_util.f90 Regrid_Util.F90 sourcefile~regrid_util.f90->sourcefile~shmem.f90 sourcefile~shmem_implementation.f90 Shmem_implementation.F90 sourcefile~shmem_implementation.f90->sourcefile~shmem.f90

Source Code

#define SHM_SUCCESS  0
#include "unused_dummy.H"
#include "MAPL_ErrLog.h"

module MAPL_Shmem

  use, intrinsic :: ISO_C_BINDING
  use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32
  use MAPL_Constants
  use mpi

  implicit none
  private

  public :: MAPL_GetNodeInfo
  public :: MAPL_CoresPerNodeGet
  public :: MAPL_InitializeShmem
  public :: MAPL_FinalizeShmem

  public :: MAPL_AllocNodeArray
  public :: MAPL_DeAllocNodeArray
  public :: MAPL_ShmemAmOnFirstNode
  public :: MAPL_SyncSharedMemory
  public :: MAPL_BroadcastToNodes

  public :: MAPL_AllocateShared
  public :: GetSharedMemory
  public :: ReleaseSharedMemory

  public :: MAPL_GetNewRank

  character(len=30) :: Iam="MAPL_ShmemMod in line "

  integer(c_int), parameter :: IPC_CREAT = 512
  integer(c_int), parameter :: IPC_RMID  = 0
  integer,        parameter :: C_KEY_T = c_int32_t

  integer,        parameter :: CHUNK=256

  integer, public, save :: MAPL_NodeComm=-1
  integer, public, save :: MAPL_NodeRootsComm=-1
  integer, public, save :: MAPL_MyNodeNum=-1
  logical, public, save :: MAPL_AmNodeRoot=.false.
  logical, public, save :: MAPL_ShmInitialized=.false.

  integer,         save :: MAPL_CoresPerNodeUsed=-1
  integer,         save :: MAPL_CoresPerNodeMin=-1
  integer,         save :: MAPL_CoresPerNodeMax=-1
  integer,         save :: MAPL_NumNodes=-1

  type Segment_T
     integer (c_int) :: shmid=-1
     type    (c_ptr) :: addr
  end type Segment_T

  type(Segment_T), pointer :: Segs(:) => NULL()
  type(Segment_T), pointer :: SegsNew(:) => null()

  type NodeRankList_T
     integer, pointer :: rank(:) => NULL()
     integer          :: rankLastUsed
  end type NodeRankList_T

  type(NodeRankList_T), public, allocatable :: MAPL_NodeRankList(:)

  interface
     module function shmget(key, size, shmflg) bind(c, name="shmget")
       use, intrinsic :: ISO_C_BINDING
       implicit none
       integer (c_int)              :: shmget
       integer (c_key_t),     value :: key
       integer (c_size_t),    value :: size
       integer (c_int),       value :: shmflg
     end function shmget

     module function shmat(shmid, shmaddr, shmflg) bind(c, name="shmat")
       use, intrinsic :: ISO_C_BINDING
       implicit none
       type (c_ptr)           :: shmat
       integer (c_int), value :: shmid
       type (c_ptr),    value :: shmaddr
       integer (c_int), value :: shmflg
     end function shmat

     module function shmdt(shmaddr) bind(c, name="shmdt")
       use, intrinsic :: ISO_C_BINDING
       implicit none
       integer (c_int)     :: shmdt
       type (c_ptr), value :: shmaddr
     end function shmdt

     module function shmctl(shmid, cmd, buf) bind(c, name="shmctl")
       use, intrinsic :: ISO_C_BINDING
       implicit none
       integer (c_int)        :: shmctl
       integer (c_int), value :: shmid
       integer (c_int), value :: cmd
       type (c_ptr),    value :: buf
     end function shmctl

  end interface

  interface MAPL_AllocNodeArray
     module procedure MAPL_AllocNodeArray_1DL4
     module procedure MAPL_AllocNodeArray_1DI4
     module procedure MAPL_AllocNodeArray_2DI4
     module procedure MAPL_AllocNodeArray_3DI4
     module procedure MAPL_AllocNodeArray_4DI4
     module procedure MAPL_AllocNodeArray_1DR4
     module procedure MAPL_AllocNodeArray_2DR4
     module procedure MAPL_AllocNodeArray_3DR4
     module procedure MAPL_AllocNodeArray_4DR4
     module procedure MAPL_AllocNodeArray_1DR8
     module procedure MAPL_AllocNodeArray_2DR8
     module procedure MAPL_AllocNodeArray_3DR8
     module procedure MAPL_AllocNodeArray_4DR8
     module procedure MAPL_AllocNodeArray_5DR8
     module procedure MAPL_AllocNodeArray_6DR8
  end interface MAPL_AllocNodeArray

  interface MAPL_DeAllocNodeArray
     module procedure MAPL_DeAllocNodeArray_1DL4
     module procedure MAPL_DeAllocNodeArray_1DI4
     module procedure MAPL_DeAllocNodeArray_2DI4
     module procedure MAPL_DeAllocNodeArray_3DI4
     module procedure MAPL_DeAllocNodeArray_4DI4
     module procedure MAPL_DeAllocNodeArray_1DR4
     module procedure MAPL_DeAllocNodeArray_2DR4
     module procedure MAPL_DeAllocNodeArray_3DR4
     module procedure MAPL_DeAllocNodeArray_4DR4
     module procedure MAPL_DeAllocNodeArray_1DR8
     module procedure MAPL_DeAllocNodeArray_2DR8
     module procedure MAPL_DeAllocNodeArray_3DR8
     module procedure MAPL_DeAllocNodeArray_4DR8
     module procedure MAPL_DeAllocNodeArray_5DR8
     module procedure MAPL_DeAllocNodeArray_6DR8
  end interface MAPL_DeAllocNodeArray

  interface MAPL_BroadcastToNodes
     module procedure BroadcastToNodes_1DI4
     module procedure BroadcastToNodes_2DI4
     module procedure BroadcastToNodes_3DI4
     module procedure BroadcastToNodes_1DR4
     module procedure BroadcastToNodes_2DR4
     module procedure BroadcastToNodes_3DR4
     module procedure BroadcastToNodes_4DR4
     module procedure BroadcastToNodes_1DR8
     module procedure BroadcastToNodes_2DR8
     module procedure BroadcastToNodes_3DR8
     module procedure BroadcastToNodes_4DR8
  end interface MAPL_BroadcastToNodes

  interface MAPL_AllocateShared
     module procedure MAPL_AllocateShared_1DL4
     module procedure MAPL_AllocateShared_1DI4
     module procedure MAPL_AllocateShared_1DR4
     module procedure MAPL_AllocateShared_1DR8
     module procedure MAPL_AllocateShared_2DI4
     module procedure MAPL_AllocateShared_2DR4
     module procedure MAPL_AllocateShared_2DR8
  end interface MAPL_AllocateShared

  interface

     module subroutine MAPL_GetNodeInfo(comm, rc)
       integer,           intent(IN ) :: comm
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_GetNodeInfo

     module subroutine MAPL_InitializeShmem(rc)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_InitializeShmem

     module subroutine MAPL_FinalizeShmem(rc)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_FinalizeShmem

     module subroutine MAPL_DeAllocNodeArray_1DL4(Ptr,rc)
       logical, pointer :: Ptr(:)
       integer, optional, intent(OUT) :: rc

     end subroutine MAPL_DeAllocNodeArray_1DL4

     module subroutine MAPL_DeAllocNodeArray_1DI4(Ptr,rc)
       integer,  pointer              :: Ptr(:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_1DI4

     module subroutine MAPL_DeAllocNodeArray_2DI4(Ptr,rc)
       integer,  pointer              :: Ptr(:,:)
       integer, optional, intent(OUT) :: rc

     end subroutine MAPL_DeAllocNodeArray_2DI4

     module subroutine MAPL_DeAllocNodeArray_3DI4(Ptr,rc)
       integer,  pointer              :: Ptr(:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_3DI4

     module subroutine MAPL_DeAllocNodeArray_4DI4(Ptr,rc)
       integer,  pointer              :: Ptr(:,:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_4DI4


     module subroutine MAPL_DeAllocNodeArray_1DR4(Ptr,rc)
       real(kind=REAL32),  pointer    :: Ptr(:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_1DR4

     module subroutine MAPL_DeAllocNodeArray_2DR4(Ptr,rc)
       real(kind=REAL32),  pointer    :: Ptr(:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_2DR4

     module subroutine MAPL_DeAllocNodeArray_3DR4(Ptr,rc)
       real(kind=REAL32),  pointer    :: Ptr(:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_3DR4

     module subroutine MAPL_DeAllocNodeArray_4DR4(Ptr,rc)
       real,  pointer                 :: Ptr(:,:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_4DR4


     module subroutine MAPL_DeAllocNodeArray_1DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_1DR8

     module subroutine MAPL_DeAllocNodeArray_2DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_2DR8

     module subroutine MAPL_DeAllocNodeArray_3DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_3DR8

     module subroutine MAPL_DeAllocNodeArray_4DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:,:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_4DR8

     module subroutine MAPL_DeAllocNodeArray_5DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:,:,:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_5DR8

     module subroutine MAPL_DeAllocNodeArray_6DR8(Ptr,rc)
       real(kind=REAL64),  pointer    :: Ptr(:,:,:,:,:,:)
       integer, optional, intent(OUT) :: rc
     end subroutine MAPL_DeAllocNodeArray_6DR8

     module subroutine MAPL_AllocNodeArray_1DL4(Ptr, Shp, lbd, rc)
       logical, pointer,  intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_1DL4

     module subroutine MAPL_AllocNodeArray_1DI4(Ptr, Shp, lbd, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_1DI4


     module subroutine MAPL_AllocNodeArray_2DI4(Ptr, Shp, lbd, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_2DI4

     module subroutine MAPL_AllocNodeArray_3DI4(Ptr, Shp, lbd, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:,:,:)
       integer,           intent(IN   ) :: Shp(3)
       integer, optional, intent(IN   ) :: lbd(3)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_3DI4

     module subroutine MAPL_AllocNodeArray_4DI4(Ptr, Shp, lbd, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:,:,:,:)
       integer,           intent(IN   ) :: Shp(4)
       integer, optional, intent(IN   ) :: lbd(4)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_4DI4

     module subroutine MAPL_AllocNodeArray_1DR4(Ptr, Shp, lbd, rc)
       real(kind=REAL32), pointer,   intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_1DR4


     module subroutine MAPL_AllocNodeArray_2DR4(Ptr, Shp, lbd, rc)
       real(kind=REAL32), pointer,   intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_2DR4

     module subroutine MAPL_AllocNodeArray_3DR4(Ptr, Shp, lbd, rc)
       real(kind=REAL32), pointer,   intent(INOUT) :: Ptr(:,:,:)
       integer,           intent(IN   ) :: Shp(3)
       integer, optional, intent(IN   ) :: lbd(3)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_3DR4

     module subroutine MAPL_AllocNodeArray_4DR4(Ptr, Shp, lbd, rc)
       real, pointer,     intent(INOUT) :: Ptr(:,:,:,:)
       integer,           intent(IN   ) :: Shp(4)
       integer, optional, intent(IN   ) :: lbd(4)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_4DR4


     module subroutine MAPL_AllocNodeArray_1DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_1DR8


     module subroutine MAPL_AllocNodeArray_2DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_2DR8

     module subroutine MAPL_AllocNodeArray_3DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:,:,:)
       integer,           intent(IN   ) :: Shp(3)
       integer, optional, intent(IN   ) :: lbd(3)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_3DR8

     module subroutine MAPL_AllocNodeArray_4DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:,:,:,:)
       integer,           intent(IN   ) :: Shp(4)
       integer, optional, intent(IN   ) :: lbd(4)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_4DR8

     module subroutine MAPL_AllocNodeArray_5DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:,:,:,:,:)
       integer,           intent(IN   ) :: Shp(5)
       integer, optional, intent(IN   ) :: lbd(5)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_5DR8

     module subroutine MAPL_AllocNodeArray_6DR8(Ptr, Shp, lbd, rc)
       real(kind=REAL64), pointer,   intent(INOUT) :: Ptr(:,:,:,:,:,:)
       integer,           intent(IN   ) :: Shp(6)
       integer, optional, intent(IN   ) :: lbd(6)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocNodeArray_6DR8

     module subroutine MAPL_AllocateShared_1DL4(Ptr, Shp, lbd, TransRoot, rc)
       logical, pointer,  intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_1DL4

     module subroutine MAPL_AllocateShared_1DI4(Ptr, Shp, lbd, TransRoot, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_1DI4

     module subroutine MAPL_AllocateShared_1DR4(Ptr, Shp, lbd, TransRoot, rc)
       real, pointer,     intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_1DR4

     module subroutine MAPL_AllocateShared_1DR8(Ptr, Shp, lbd, TransRoot, rc)
       real(KIND=REAL64), pointer,     intent(INOUT) :: Ptr(:)
       integer,           intent(IN   ) :: Shp(1)
       integer, optional, intent(IN   ) :: lbd(1)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_1DR8

     module subroutine MAPL_AllocateShared_2DI4(Ptr, Shp, lbd, TransRoot, rc)
       integer, pointer,  intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_2DI4

     module subroutine MAPL_AllocateShared_2DR4(Ptr, Shp, lbd, TransRoot, rc)
       real,    pointer,  intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_2DR4
     
     module subroutine MAPL_AllocateShared_2DR8(Ptr, Shp, lbd, TransRoot, rc)
       real(KIND=REAL64), pointer, intent(INOUT) :: Ptr(:,:)
       integer,           intent(IN   ) :: Shp(2)
       integer, optional, intent(IN   ) :: lbd(2)
       logical,           intent(IN   ) :: TransRoot
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_AllocateShared_2DR8

     module subroutine ReleaseSharedMemory(Caddr,rc)
       type(c_ptr),       intent(INOUT) :: Caddr
       integer, optional, intent(  OUT) :: rc
     end subroutine ReleaseSharedMemory



     module subroutine GetSharedMemory(Caddr,Len,rc)
       type(c_ptr),       intent(  OUT) :: Caddr
       integer,           intent(IN   ) :: Len
       integer, optional, intent(  OUT) :: rc
     end subroutine GetSharedMemory

     module subroutine BroadcastToNodes_1DR4(DATA,N,ROOT,rc)
       real(kind=REAL32), intent(INOUT) :: DATA(:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_1DR4

     module subroutine BroadcastToNodes_2DR4(DATA,N,ROOT,rc)
       real(kind=REAL32), intent(INOUT) :: DATA(:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_2DR4

     module subroutine BroadcastToNodes_3DR4(DATA,N,ROOT,rc)
       real,              intent(INOUT) :: DATA(:,:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_3DR4

     module subroutine BroadcastToNodes_4DR4(DATA,N,ROOT,rc)
       real,              intent(INOUT) :: DATA(:,:,:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_4DR4

     module subroutine BroadcastToNodes_1DR8(DATA,N,ROOT,rc)
       real(kind=REAL64), intent(INOUT) :: DATA(:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_1DR8

     module subroutine BroadcastToNodes_2DR8(DATA,N,ROOT,rc)
       real(kind=REAL64), intent(INOUT) :: DATA(:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_2DR8

     module subroutine BroadcastToNodes_3DR8(DATA,N,ROOT,rc)
       real(kind=REAL64), intent(INOUT) :: DATA(:,:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_3DR8

     module subroutine BroadcastToNodes_4DR8(DATA,N,ROOT,rc)
       real(kind=REAL64), intent(INOUT) :: DATA(:,:,:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_4DR8

     module subroutine BroadcastToNodes_1DI4(DATA,N,ROOT,rc)
       integer,           intent(INOUT) :: DATA(:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_1DI4

     module subroutine BroadcastToNodes_2DI4(DATA,N,ROOT,rc)
       integer,           intent(INOUT) :: DATA(:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_2DI4

     module subroutine BroadcastToNodes_3DI4(DATA,N,ROOT,rc)
       integer,           intent(INOUT) :: DATA(:,:,:)
       integer,           intent(IN   ) :: N
       integer,           intent(IN   ) :: ROOT
       integer, optional, intent(  OUT) :: rc
     end subroutine BroadcastToNodes_3DI4

     module subroutine MAPL_SyncSharedMemory(rc)
       integer, optional, intent(  OUT) :: rc
     end subroutine MAPL_SyncSharedMemory

     module function MAPL_GetNewRank(node,rc) result(rank)
       integer :: rank
       integer, intent(in) :: node
       integer, optional, intent(out) :: rc
     end function MAPL_GetNewRank

     module function getNodeComm(Comm, rc) result(NodeComm)
       integer,           intent( IN) :: Comm
       integer, optional, intent(OUT) :: rc
       integer                        :: NodeComm
     end function getNodeComm

     module function getNodeRootsComm(Comm, rc) result(NodeRootsComm)
       integer,           intent( IN) :: Comm
       integer, optional, intent(OUT) :: rc
       integer                        :: NodeRootsComm
     end function getNodeRootsComm


     module function MAPL_ShmemAmOnFirstNode(comm, rc) result(a)
       integer,           intent(IN   ) :: comm
       integer, optional, intent(  OUT) :: RC
       logical                          :: a
     end function MAPL_ShmemAmOnFirstNode

     integer module function MAPL_CoresPerNodeGet(comm, rc)
       integer,           intent(IN   ) :: comm
       integer, optional, intent(  OUT) :: RC
     end function MAPL_CoresPerNodeGet
  end interface
end module MAPL_Shmem

! For backwards compatibility
module MAPL_ShmemMod
  use MAPL_Shmem
end module MAPL_ShmemMod