LCOV - code coverage report
Current view: | top level - dynamics/se/dycore - parallel_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 51 | 65 | 78.5 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 3 | 4 | 75.0 %

              Line data    Source code
           1             : module parallel_mod
           2             :   ! ---------------------------
           3             :   use shr_kind_mod,   only: r8=>shr_kind_r8
           4             :   ! ---------------------------
           5             :   use dimensions_mod, only : nmpi_per_node, nlev, qsize_d, ntrac_d
           6             :   ! ---------------------------
           7             :   use spmd_utils,     only: MPI_STATUS_SIZE, MPI_MAX_ERROR_STRING, MPI_TAG_UB
           8             :
           9             :   implicit none
          10             :   private
          11             :
          12             :   integer,  public, parameter   :: ORDERED         = 1
          13             :   integer,  public, parameter   :: FAST            = 2
          14             :   integer,  public, parameter   :: BNDRY_TAG_BASE  = 0
          15             :   integer,  public, parameter   :: THREAD_TAG_BITS = 9
          16             :   integer,  public, parameter   :: MAX_ACTIVE_MSG = (MPI_TAG_UB/2**THREAD_TAG_BITS) - 1
          17             :   integer,  public, parameter   :: HME_status_size = MPI_STATUS_SIZE
          18             :
          19             :   integer,  public, parameter   :: HME_BNDRY_P2P   = 1
          20             :   integer,  public, parameter   :: HME_BNDRY_MASHM = 2
          21             :   integer,  public, parameter   :: HME_BNDRY_A2A   = 3
          22             :   integer,  public, parameter   :: HME_BNDRY_A2AO  = 4
          23             :
          24             :   integer,  public, parameter   :: nrepro_vars = MAX(10, nlev*qsize_d, nlev*ntrac_d)
          25             :
          26             :   integer,  public              :: MaxNumberFrames
          27             :   integer,  public              :: numframes
          28             :   integer,  public              :: useframes
          29             :   logical,  public              :: PartitionForNodes
          30             :   logical,  public              :: PartitionForFrames
          31             :
          32             :   ! Namelist-selectable type of boundary comms (AUTO,P2P,A2A,MASHM)
          33             :   integer,  public              :: boundaryCommMethod
          34             :
          35             :   integer,  public, allocatable :: status(:,:)
          36             :   integer,  public, allocatable :: Rrequest(:)
          37             :   integer,  public, allocatable :: Srequest(:)
          38             :
          39             :   real(r8), public, allocatable :: FrameWeight(:)
          40             :   integer,  public, allocatable :: FrameIndex(:)
          41             :   integer,  public, allocatable :: FrameCount(:)
          42             :   integer,  public              :: nComPoints
          43             :   integer,  public              :: nPackPoints
          44             :
          45             :   real(r8), public, allocatable :: global_shared_buf(:,:)
          46             :   real(r8), public              :: global_shared_sum(nrepro_vars)
          47             :
          48             :   ! ==================================================
          49             :   ! Define type parallel_t for distributed memory info
          50             :   ! ==================================================
          51             :   type, public :: parallel_t
          52             :     integer :: rank                       ! local rank
          53             :     integer :: root                       ! local root
          54             :     integer :: nprocs                     ! number of processes in group
          55             :     integer :: comm                       ! communicator
          56             :     integer :: intracomm                  ! Intra-node communicator
          57             :     integer :: commGraphFull              ! distributed graph topo communicator for all neighbors
          58             :     integer :: commGraphInter             ! distributed graph topo communicator for off-node neighbors
          59             :     integer :: commGraphIntra             ! distributed graph topo communicator for on-node neighbors
          60             :     integer :: groupGraphFull
          61             :     logical :: masterproc
          62             :   end type
          63             :
          64             :   type (parallel_t), public :: par ! info for distributed memory programming
          65             :
          66             :   ! ===================================================
          67             :   ! Module Interfaces
          68             :   ! ===================================================
          69             :
          70             :   public :: initmpi
          71             :   public :: syncmp
          72             :   public :: copy_par
          73             :
          74             :   interface assignment ( = )
          75             :     module procedure copy_par
          76             :   end interface
          77             :
          78             : CONTAINS
          79             :
          80             : ! ================================================
          81             : !   copy_par: copy constructor for parallel_t type
          82             : !
          83             : !
          84             : !   Overload assignment operator for parallel_t
          85             : ! ================================================
          86             :
          87      742656 :   subroutine copy_par(par2,par1)
          88             :     type(parallel_t), intent(out) :: par2
          89             :     type(parallel_t), intent(in)  :: par1
          90             :
          91      742656 :     par2%rank       = par1%rank
          92      742656 :     par2%root       = par1%root
          93      742656 :     par2%nprocs     = par1%nprocs
          94      742656 :     par2%comm       = par1%comm
          95      742656 :     par2%intracomm  = par1%intracomm
          96      742656 :     par2%commGraphFull   = par1%commGraphFull
          97      742656 :     par2%commGraphInter  = par1%commGraphInter
          98      742656 :     par2%commGraphIntra  = par1%commGraphIntra
          99      742656 :     par2%groupGraphFull  = par1%groupGraphFull
         100      742656 :     par2%masterproc = par1%masterproc
         101             :
         102      742656 :   end subroutine copy_par
         103             :
         104             : ! ================================================
         105             : !  initmpi:
         106             : !  Initializes the parallel (message passing)
         107             : !  environment, returns a parallel_t structure..
         108             : ! ================================================
         109             :
         110        1536 :   function initmpi(npes_homme) result(par)
         111             :     use cam_logfile,    only: iulog
         112             :     use cam_abortutils, only: endrun
         113             :     use spmd_utils,     only: mpicom, MPI_COMM_NULL, MPI_MAX_PROCESSOR_NAME
         114             :     use spmd_utils,     only: MPI_CHARACTER, MPI_INTEGER, MPI_BAND, iam, npes
         115             :
         116             :     integer, intent(in) :: npes_homme
         117             :
         118             :     type(parallel_t)     :: par
         119             :
         120             :     integer              :: ierr,tmp
         121             :     integer              :: FrameNumber
         122             :     logical :: running   ! state of MPI at beginning of initmpi call
         123             :     character(len=MPI_MAX_PROCESSOR_NAME)               :: my_name
         124        1536 :     character(len=MPI_MAX_PROCESSOR_NAME), allocatable  :: the_names(:)
         125             :
         126             :     integer, allocatable :: tarray(:)
         127             :     integer              :: namelen, i
         128             :     integer              :: color
         129             :
         130             :     !================================================
         131             :     !     Basic MPI initialization
         132             :     ! ================================================
         133             :
         134        1536 :     call MPI_initialized(running, ierr)
         135             :
         136        1536 :     if (.not.running) then
         137           0 :       call endrun('initmpi: MPI not initialized for SE dycore')
         138             :     end if
         139             :
         140        1536 :     par%root          = 0
         141        1536 :     par%masterproc    = .FALSE.
         142        1536 :     nmpi_per_node     = 2
         143        1536 :     PartitionForNodes = .TRUE.
         144             :
         145             :     ! The SE dycore needs to split from CAM communicator for npes > par%nprocs
         146        1536 :     color = iam / npes_homme
         147        1536 :     call mpi_comm_split(mpicom, color, iam, par%comm, ierr)
         148        1536 :     if (iam < npes_homme) then
         149        1536 :       call MPI_comm_size(par%comm, par%nprocs, ierr)
         150        1536 :       call MPI_comm_rank(par%comm, par%rank,  ierr)
         151        1536 :       if ( par%nprocs /= npes_homme) then
         152           0 :         call endrun('INITMPI: SE communicator count mismatch')
         153             :       end if
         154             :
         155        1536 :       if(par%rank == par%root) then
         156           2 :         par%masterproc = .TRUE.
         157             :       end if
         158             :     else
         159           0 :       par%rank   = 0
         160           0 :       par%nprocs = 0
         161           0 :       par%comm   = MPI_COMM_NULL
         162             :     end if
         163             :
         164        1536 :     if (par%masterproc) then
         165           2 :       write(iulog, '(a,i0)')'initmpi: Number of MPI processes: ', par%nprocs
         166             :     end if
         167             :
         168        1536 :     if (iam < npes_homme) then
         169             :       ! ================================================
         170             :       !  Determine where this MPI process is running
         171             :       !   then use this information to determined the
         172             :       !   number of MPI processes per node
         173             :       ! ================================================
         174        1536 :       my_name(:) = ''
         175        1536 :       call MPI_Get_Processor_Name(my_name, namelen, ierr)
         176             :
         177        4608 :       allocate(the_names(par%nprocs))
         178     1181184 :       do i = 1, par%nprocs
         179     1181184 :         the_names(i)(:) =  ''
         180             :       end do
         181             :
         182             :       ! ================================================
         183             :       !   Collect all the machine names
         184             :       ! ================================================
         185             :       call MPI_Allgather(my_name, MPI_MAX_PROCESSOR_NAME, MPI_CHARACTER, &
         186        1536 :            the_names,MPI_MAX_PROCESSOR_NAME,MPI_CHARACTER,par%comm,ierr)
         187             :
         188             :       ! ======================================================================
         189             :       !   Calculate how many other MPI processes are on my node
         190             :       ! ======================================================================
         191        1536 :       nmpi_per_node = 0
         192     1181184 :       do i = 1, par%nprocs
         193     1181184 :         if(TRIM(ADJUSTL(my_name)) .eq. TRIM(ADJUSTL(the_names(i)))) then
         194      196608 :           nmpi_per_node = nmpi_per_node + 1
         195             :         end if
         196             :       end do
         197             :
         198             :       ! =======================================================================
         199             :       !  Verify that everybody agrees on this number otherwise do not do
         200             :       !  the multi-level partitioning
         201             :       ! =======================================================================
         202        1536 :       call MPI_Allreduce(nmpi_per_node,tmp,1,MPI_INTEGER,MPI_BAND,par%comm,ierr)
         203        1536 :       if(tmp /= nmpi_per_node) then
         204           0 :         if (par%masterproc) then
         205           0 :           write(iulog,*)'initmpi:  disagrement accross nodes for nmpi_per_node'
         206             :         end if
         207           0 :         nmpi_per_node = 1
         208           0 :         PartitionForNodes = .FALSE.
         209             :       else
         210        1536 :         PartitionForNodes = .TRUE.
         211             :       end if
         212             :
         213        1536 :       if(PartitionForFrames .and. par%masterproc) then
         214           0 :         write(iulog,*)'initmpi: FrameWeight: ', FrameWeight
         215             :       end if
         216             :
         217        1536 :       deallocate(the_names)
         218             :     end if
         219             :
         220        1536 :   end function initmpi
         221             :
         222             :   ! =====================================
         223             :   ! syncmp:
         224             :   !
         225             :   ! sychronize message passing domains
         226             :   !
         227             :   ! =====================================
         228        3072 :   subroutine syncmp(par)
         229             :     use cam_abortutils, only: endrun
         230             :     use spmd_utils,     only: MPI_MAX_ERROR_STRING, MPI_ERROR
         231             :
         232             :     type (parallel_t), intent(in)       :: par
         233             :
         234             :     integer                             :: errorcode, errorlen, ierr
         235             :     character(len=MPI_MAX_ERROR_STRING) :: errorstring
         236             :
         237        3072 :     call MPI_barrier(par%comm, ierr)
         238             :
         239        3072 :     if(ierr == MPI_ERROR) then
         240           0 :       errorcode = ierr
         241           0 :       call MPI_Error_String(errorcode, errorstring, errorlen, ierr)
         242           0 :       call endrun(errorstring)
         243             :     end if
         244        3072 :   end subroutine syncmp
         245             :
         246           0 : end module parallel_mod

Generated by: LCOV version 1.14