LCOV - code coverage report
Current view: | top level - utils - wrap_mpi.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 4 | 196 | 2.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 1 | 30 | 3.3 %

              Line data    Source code
           1             : !-----------------------------------------------------------------------
           2             : !
           3             : ! Purpose:
           4             : !
           5             : !       Wrapper routines for the MPI (Message Passing) library for the
           6             : !       distributed memory (SPMD) version of the code. Also data with
           7             : !       "shorthand" names for the MPI data types.
           8             : !
           9             : ! Entry points:
          10             : !      mpibarrier             Calls mpi_barrier
          11             : !      mpifinalize            Calls mpi_finalize
          12             : !      mpipack_size           Calls mpi_pack
          13             : !      mpipack                Calls mpi_pack
          14             : !      mpiunpack              Calls mpi_unpack
          15             : !      mpisendrecv            Calls mpi_sendrecv
          16             : !      mpiisend               Calls mpi_isend
          17             : !      mpiirsend              Calls mpi_irsend
          18             : !      mpiissend              Calls mpi_issend
          19             : !      mpiirecv               Calls mpi_irecv
          20             : !      mpiwait                Calls mpi_wait
          21             : !      mpiwaitall             Calls mpi_waitall
          22             : !      mpisend                Calls mpi_send
          23             : !      mpirsend               Calls mpi_rsend
          24             : !      mpissend               Calls mpi_ssend
          25             : !      mpirecv                Calls mpi_recv
          26             : !      mpigather              Calls mpi_gather
          27             : !      mpigatherv             Calls mpi_gatherv
          28             : !      mpigathervr4           Calls mpi_gatherv for real*4 data
          29             : !      mpigathervint          Calls mpi_gatherv for integer data
          30             : !      mpisum                 Calls mpi_sum
          31             : !      mpiscatter             Calls mpi_scatter
          32             : !      mpiscatterv            Calls mpi_scatterv
          33             : !      mpibcast               Calls mpi_bcast
          34             : !      mpiallmaxint           Calls mpi_allreduce on integer vector with mpi_max operator
          35             : !      mpialltoallv           Calls mpi_alltoallv
          36             : !      mpialltoallint         Calls mpi_alltoall for integer data
          37             : !      mpiallgatherv          Calls mpi_allgatherv
          38             : !      mpiallgatherint        Calls mpi_allgatherv for integer data
          39             : !      mpiwincreate           Calls mpi_win_create and mpi_win_fence
          40             : !
          41             : ! Author: Many
          42             : !
          43             : !-----------------------------------------------------------------------
          44             : !
          45             :
          46             : !
          47             : ! Performance bug work around for Gemini interconnect
          48             : !
          49             : #ifdef _NO_MPI_RSEND
          50             : #define mpi_rsend mpi_send
          51             : #define mpi_irsend mpi_isend
          52             : #endif
          53             :
          54             : !
          55             : ! Compile these routines only when SPMD is defined
          56             : !
          57             : #if (defined SPMD)
          58             :
          59             : !****************************************************************
          60             :
          61           0 :    subroutine mpibarrier (comm)
          62             : !
          63             : ! MPI barrier, have threads wait until all threads have reached this point
          64             : !
          65             :    use shr_kind_mod,     only: r8 => shr_kind_r8
          66             :    use mpishorthand
          67             :    use cam_abortutils,   only: endrun
          68             :    use cam_logfile,      only: iulog
          69             :
          70             :    implicit none
          71             :
          72             :    integer, intent(in):: comm
          73             :
          74             :    integer ier   !MP error code
          75             :
          76           0 :    call mpi_barrier (comm, ier)
          77           0 :    if (ier.ne.mpi_success) then
          78           0 :       write(iulog,*)'mpi_barrier failed ier=',ier
          79           0 :       call endrun
          80             :    end if
          81             :
          82           0 :    return
          83             :    end subroutine mpibarrier
          84             :
          85             : !****************************************************************
          86             :
          87           0 :    subroutine mpifinalize
          88             : !
          89             : ! End of all MPI communication
          90             : !
          91             :    use shr_kind_mod,     only: r8 => shr_kind_r8
          92             :    use mpishorthand
          93             :    use cam_abortutils,   only: endrun
          94             :    use cam_logfile,      only: iulog
          95             :
          96             :    implicit none
          97             :
          98             :    integer ier   !MP error code
          99             :
         100           0 :    call mpi_finalize (ier)
         101           0 :    if (ier.ne.mpi_success) then
         102           0 :       write(iulog,*)'mpi_finalize failed ier=',ier
         103           0 :       call endrun
         104             :    end if
         105             :
         106           0 :    return
         107             :    end subroutine mpifinalize
         108             :
         109             : !****************************************************************
         110             :
         111           0 :    subroutine mpipack_size (incount, datatype, comm, size)
         112             : !
         113             : ! Returns the size of the packed data
         114             : !
         115             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         116             :    use mpishorthand
         117             :    use cam_abortutils,   only: endrun
         118             :    use cam_logfile,      only: iulog
         119             :
         120             :    implicit none
         121             :
         122             :    integer, intent(in):: incount
         123             :    integer, intent(in):: datatype
         124             :    integer, intent(in):: comm
         125             :    integer, intent(out):: size
         126             :
         127             :    integer ier   !MP error code
         128             :
         129           0 :    call mpi_pack_size (incount, datatype, comm, size, ier)
         130           0 :    if (ier.ne.mpi_success) then
         131           0 :       write(iulog,*)'mpi_pack_size failed ier=',ier
         132           0 :       call endrun
         133             :    end if
         134             :
         135           0 :    return
         136             :    end subroutine mpipack_size
         137             :
         138             : !****************************************************************
         139             :
         140           0 :    subroutine mpipack (inbuf, incount, datatype, outbuf, outsize,    &
         141             :                        position, comm)
         142             : !
         143             : ! Pack the data and send it.
         144             : !
         145             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         146             :    use mpishorthand
         147             :    use cam_abortutils,   only: endrun
         148             :    use cam_logfile,      only: iulog
         149             :
         150             :    implicit none
         151             :
         152             :    real(r8), intent(in):: inbuf(*)
         153             :    real(r8), intent(out):: outbuf(*)
         154             :    integer, intent(in):: incount
         155             :    integer, intent(in):: datatype
         156             :    integer, intent(out):: outsize
         157             :    integer, intent(inout):: position
         158             :    integer, intent(in):: comm
         159             :
         160             :    integer ier   !MP error code
         161             :
         162             :    call mpi_pack (inbuf, incount, datatype, outbuf, outsize,         &
         163           0 :                   position, comm, ier)
         164           0 :    if (ier.ne.mpi_success) then
         165           0 :       write(iulog,*)'mpi_pack failed ier=',ier
         166           0 :       call endrun
         167             :    end if
         168             :
         169           0 :    return
         170             :    end subroutine mpipack
         171             :
         172             : !****************************************************************
         173             :
         174           0 :    subroutine mpiunpack (inbuf, insize, position, outbuf, outcount,  &
         175             :                          datatype, comm)
         176             : !
         177             : ! Un-packs the data from the packed receive buffer
         178             : !
         179             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         180             :    use mpishorthand
         181             :    use cam_abortutils,   only: endrun
         182             :    use cam_logfile,      only: iulog
         183             :
         184             :    implicit none
         185             :
         186             :    real(r8), intent(in):: inbuf(*)
         187             :    real(r8), intent(out):: outbuf(*)
         188             :    integer, intent(in):: insize
         189             :    integer, intent(inout):: position
         190             :    integer, intent(in):: outcount
         191             :    integer, intent(in):: datatype
         192             :    integer, intent(in):: comm
         193             :
         194             :    integer ier   !MP error code
         195             :
         196             :    call mpi_unpack (inbuf, insize, position, outbuf, outcount,       &
         197           0 :                     datatype, comm, ier)
         198           0 :    if (ier.ne.mpi_success) then
         199           0 :       write(iulog,*)'mpi_unpack failed ier=',ier
         200           0 :       call endrun
         201             :    end if
         202             :
         203           0 :    return
         204             :    end subroutine mpiunpack
         205             :
         206             : !****************************************************************
         207             :
         208           0 :    subroutine mpisendrecv (sendbuf, sendcount, sendtype, dest, sendtag,  &
         209             :                            recvbuf, recvcount, recvtype, source,recvtag, &
         210             :                            comm)
         211             : !
         212             : ! Blocking send and receive.
         213             : !
         214             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         215             :    use mpishorthand
         216             :    use cam_abortutils,   only: endrun
         217             :    use cam_logfile,      only: iulog
         218             : #if defined( WRAP_MPI_TIMING )
         219             :    use perf_mod
         220             : #endif
         221             :
         222             :    implicit none
         223             :
         224             :    real(r8), intent(in):: sendbuf(*)
         225             :    real(r8), intent(out):: recvbuf(*)
         226             :    integer, intent(in):: sendcount
         227             :    integer, intent(in):: sendtype
         228             :    integer, intent(in):: dest
         229             :    integer, intent(in):: sendtag
         230             :    integer, intent(in):: recvcount
         231             :    integer, intent(in):: recvtype
         232             :    integer, intent(in):: source
         233             :    integer, intent(in):: recvtag
         234             :    integer, intent(in):: comm
         235             :
         236             :    integer :: status(MPI_STATUS_SIZE)
         237             :    integer ier   !MP error code
         238             :
         239             : #if defined( WRAP_MPI_TIMING )
         240             :    call t_startf ('mpi_sendrecv')
         241             : #endif
         242             :    call mpi_sendrecv (sendbuf, sendcount, sendtype, dest, sendtag,   &
         243             :                       recvbuf, recvcount, recvtype, source, recvtag, &
         244           0 :                       comm, status, ier)
         245           0 :    if (ier.ne.mpi_success) then
         246           0 :       write(iulog,*)'mpi_sendrecv failed ier=',ier
         247           0 :       call endrun
         248             :    end if
         249             : !
         250             : ! ASSUME nrecv = nsend for stats gathering purposes.  This is not actually
         251             : ! correct, but its the best we can do since recvcount is a Max number
         252             : !
         253           0 :    nsend = nsend + 1
         254           0 :    nrecv = nrecv + 1
         255           0 :    nwsend = nwsend + sendcount
         256           0 :    nwrecv = nwrecv + sendcount
         257             :
         258             : #if defined( WRAP_MPI_TIMING )
         259             :    call t_stopf ('mpi_sendrecv')
         260             : #endif
         261             :
         262           0 :    return
         263             :    end subroutine mpisendrecv
         264             :
         265             : !****************************************************************
         266             :
         267           0 :    subroutine mpiisend (buf, count, datatype, dest, tag, comm, request)
         268             : !
         269             : ! Does a non-blocking send.
         270             : !
         271             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         272             :    use mpishorthand
         273             :    use cam_abortutils,   only: endrun
         274             :    use cam_logfile,      only: iulog
         275             : #if defined( WRAP_MPI_TIMING )
         276             :    use perf_mod
         277             : #endif
         278             :
         279             :    implicit none
         280             :
         281             :    real (r8), intent(in):: buf(*)
         282             :    integer, intent(in):: count
         283             :    integer, intent(in):: datatype
         284             :    integer, intent(in):: dest
         285             :    integer, intent(in):: tag
         286             :    integer, intent(in):: comm
         287             :    integer, intent(out):: request
         288             :
         289             :    integer ier   !MP error code
         290             :
         291             : #if defined( WRAP_MPI_TIMING )
         292             :    call t_startf ('mpi_isend')
         293             : #endif
         294           0 :    call mpi_isend (buf, count, datatype, dest, tag, comm, request, ier)
         295           0 :    if (ier/=mpi_success) then
         296           0 :       write(iulog,*)'mpi_isend failed ier=',ier
         297           0 :       call endrun
         298             :    end if
         299           0 :    nsend = nsend + 1
         300           0 :    nwsend = nwsend + count
         301             : #if defined( WRAP_MPI_TIMING )
         302             :    call t_stopf ('mpi_isend')
         303             : #endif
         304             :
         305           0 :    return
         306             :    end subroutine mpiisend
         307             :
         308             : !****************************************************************
         309             :
         310           0 :    subroutine mpiirsend (buf, count, datatype, dest, tag, comm, request)
         311             : !
         312             : ! Does a non-blocking ready send.
         313             : !
         314             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         315             :    use mpishorthand
         316             :    use cam_abortutils,   only: endrun
         317             :    use cam_logfile,      only: iulog
         318             : #if defined( WRAP_MPI_TIMING )
         319             :    use perf_mod
         320             : #endif
         321             :
         322             :    implicit none
         323             :
         324             :    real (r8), intent(in):: buf(*)
         325             :    integer, intent(in):: count
         326             :    integer, intent(in):: datatype
         327             :    integer, intent(in):: dest
         328             :    integer, intent(in):: tag
         329             :    integer, intent(in):: comm
         330             :    integer, intent(out):: request
         331             :
         332             :    integer ier   !MP error code
         333             :
         334             : #if defined( WRAP_MPI_TIMING )
         335             :    call t_startf ('mpi_irsend')
         336             : #endif
         337           0 :    call mpi_irsend (buf, count, datatype, dest, tag, comm, request, ier)
         338           0 :    if (ier/=mpi_success) then
         339           0 :       write(iulog,*)'mpi_irsend failed ier=',ier
         340           0 :       call endrun
         341             :    end if
         342           0 :    nsend = nsend + 1
         343           0 :    nwsend = nwsend + count
         344             : #if defined( WRAP_MPI_TIMING )
         345             :    call t_stopf ('mpi_irsend')
         346             : #endif
         347             :
         348           0 :    return
         349             :    end subroutine mpiirsend
         350             :
         351             : !****************************************************************
         352             :
         353           0 :    subroutine mpiissend (buf, count, datatype, dest, tag, comm, request)
         354             : !
         355             : ! Does a non-blocking synchronous send.
         356             : !
         357             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         358             :    use mpishorthand
         359             :    use cam_abortutils,   only: endrun
         360             :    use cam_logfile,      only: iulog
         361             : #if defined( WRAP_MPI_TIMING )
         362             :    use perf_mod
         363             : #endif
         364             :
         365             :    implicit none
         366             :
         367             :    real (r8), intent(in):: buf(*)
         368             :    integer, intent(in):: count
         369             :    integer, intent(in):: datatype
         370             :    integer, intent(in):: dest
         371             :    integer, intent(in):: tag
         372             :    integer, intent(in):: comm
         373             :    integer, intent(out):: request
         374             :
         375             :    integer ier   !MP error code
         376             :
         377             : #if defined( WRAP_MPI_TIMING )
         378             :    call t_startf ('mpi_issend')
         379             : #endif
         380           0 :    call mpi_issend (buf, count, datatype, dest, tag, comm, request, ier)
         381           0 :    if (ier/=mpi_success) then
         382           0 :       write(iulog,*)'mpi_issend failed ier=',ier
         383           0 :       call endrun
         384             :    end if
         385           0 :    nsend = nsend + 1
         386           0 :    nwsend = nwsend + count
         387             : #if defined( WRAP_MPI_TIMING )
         388             :    call t_stopf ('mpi_issend')
         389             : #endif
         390             :
         391           0 :    return
         392             :    end subroutine mpiissend
         393             :
         394             : !****************************************************************
         395             :
         396           0 :    subroutine mpiirecv (buf, count, datatype, source, tag, comm, request)
         397             : !
         398             : ! Does a non-blocking receive.
         399             : !
         400             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         401             :    use mpishorthand
         402             :    use cam_abortutils,   only: endrun
         403             :    use cam_logfile,      only: iulog
         404             : #if defined( WRAP_MPI_TIMING )
         405             :    use perf_mod
         406             : #endif
         407             :
         408             :    implicit none
         409             :
         410             :    real (r8), intent(out):: buf(*)
         411             :    integer, intent(in):: count
         412             :    integer, intent(in):: datatype
         413             :    integer, intent(in):: source
         414             :    integer, intent(in):: tag
         415             :    integer, intent(in):: comm
         416             :    integer, intent(out):: request
         417             :
         418             :    integer ier   !MP error code
         419             :
         420             : #if defined( WRAP_MPI_TIMING )
         421             :    call t_startf ('mpi_irecv')
         422             : #endif
         423           0 :    call mpi_irecv (buf, count, datatype, source, tag, comm, request, ier )
         424           0 :    if (ier/=mpi_success) then
         425           0 :       write(iulog,*)'mpi_irecv failed ier=',ier
         426           0 :       call endrun
         427             :    end if
         428           0 :    nrecv = nrecv + 1
         429           0 :    nwrecv = nwrecv + count
         430             : #if defined( WRAP_MPI_TIMING )
         431             :    call t_stopf ('mpi_irecv')
         432             : #endif
         433             :
         434           0 :    return
         435             :    end subroutine mpiirecv
         436             :
         437             : !****************************************************************
         438             :
         439           0 :    subroutine mpiwait (request, status)
         440             : !
         441             : ! Waits for a nonblocking operation to complete.
         442             : !
         443             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         444             :    use mpishorthand
         445             :    use cam_abortutils,   only: endrun
         446             :    use cam_logfile,      only: iulog
         447             : #if defined( WRAP_MPI_TIMING )
         448             :    use perf_mod
         449             : #endif
         450             :
         451             :    implicit none
         452             :
         453             :    integer, intent(inout):: request
         454             :    integer, intent(out):: status
         455             :
         456             :    integer ier   !MP error code
         457             :
         458             : #if defined( WRAP_MPI_TIMING )
         459             :    call t_startf ('mpi_wait')
         460             : #endif
         461           0 :    call mpi_wait (request, status, ier)
         462           0 :    if (ier/=mpi_success) then
         463           0 :       write(iulog,*)'mpi_wait failed ier=',ier
         464           0 :       call endrun
         465             :    end if
         466             : #if defined( WRAP_MPI_TIMING )
         467             :    call t_stopf ('mpi_wait')
         468             : #endif
         469             :
         470           0 :    return
         471             :    end subroutine mpiwait
         472             :
         473             : !****************************************************************
         474             :
         475           0 :    subroutine mpiwaitall (count, array_of_requests, array_of_statuses)
         476             : !
         477             : ! Waits for a collection of nonblocking operations to complete.
         478             : !
         479             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         480             :    use mpishorthand
         481             :    use cam_abortutils,   only: endrun
         482             :    use cam_logfile,      only: iulog
         483             : #if defined( WRAP_MPI_TIMING )
         484             :    use perf_mod
         485             : #endif
         486             :
         487             :    implicit none
         488             :
         489             :    integer, intent(in):: count
         490             :    integer, intent(inout):: array_of_requests(*)
         491             :    integer, intent(out):: array_of_statuses(*)
         492             :
         493             :    integer ier   !MP error code
         494             :
         495             : #if defined( WRAP_MPI_TIMING )
         496             :    call t_startf ('mpi_waitall')
         497             : #endif
         498           0 :    call mpi_waitall (count, array_of_requests, array_of_statuses, ier)
         499           0 :    if (ier/=mpi_success) then
         500           0 :       write(iulog,*)'mpi_waitall failed ier=',ier
         501           0 :       call endrun
         502             :    end if
         503             : #if defined( WRAP_MPI_TIMING )
         504             :    call t_stopf ('mpi_waitall')
         505             : #endif
         506             :
         507           0 :    return
         508             :    end subroutine mpiwaitall
         509             :
         510             : !****************************************************************
         511             :
         512           0 :    subroutine mpisend (buf, count, datatype, dest, tag, comm)
         513             : !
         514             : ! Does a blocking send
         515             : !
         516             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         517             :    use mpishorthand
         518             :    use cam_abortutils,   only: endrun
         519             :    use cam_logfile,      only: iulog
         520             : #if defined( WRAP_MPI_TIMING )
         521             :    use perf_mod
         522             : #endif
         523             :
         524             :    implicit none
         525             :
         526             :    real (r8), intent(in):: buf(*)
         527             :    integer, intent(in):: count
         528             :    integer, intent(in):: datatype
         529             :    integer, intent(in):: dest
         530             :    integer, intent(in):: tag
         531             :    integer, intent(in):: comm
         532             :
         533             :    integer ier   !MP error code
         534             :
         535             : #if defined( WRAP_MPI_TIMING )
         536             :    call t_startf ('mpi_send')
         537             : #endif
         538           0 :    call mpi_send (buf, count, datatype, dest, tag, comm, ier)
         539           0 :    if (ier/=mpi_success) then
         540           0 :       write(iulog,*)'mpi_send failed ier=',ier
         541           0 :       call endrun
         542             :    end if
         543           0 :    nsend = nsend + 1
         544           0 :    nwsend = nwsend + count
         545             : #if defined( WRAP_MPI_TIMING )
         546             :    call t_stopf ('mpi_send')
         547             : #endif
         548             :
         549           0 :    return
         550             :    end subroutine mpisend
         551             :
         552             : !****************************************************************
         553             :
         554           0 :    subroutine mpirsend (buf, count, datatype, dest, tag, comm)
         555             : !
         556             : ! Does a blocking ready send
         557             : !
         558             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         559             :    use mpishorthand
         560             :    use cam_abortutils,   only: endrun
         561             :    use cam_logfile,      only: iulog
         562             : #if defined( WRAP_MPI_TIMING )
         563             :    use perf_mod
         564             : #endif
         565             :
         566             :    implicit none
         567             :
         568             :    real (r8), intent(in):: buf(*)
         569             :    integer, intent(in):: count
         570             :    integer, intent(in):: datatype
         571             :    integer, intent(in):: dest
         572             :    integer, intent(in):: tag
         573             :    integer, intent(in):: comm
         574             :
         575             :    integer ier   !MP error code
         576             :
         577             : #if defined( WRAP_MPI_TIMING )
         578             :    call t_startf ('mpi_rsend')
         579             : #endif
         580           0 :    call mpi_rsend (buf, count, datatype, dest, tag, comm, ier)
         581           0 :    if (ier/=mpi_success) then
         582           0 :       write(iulog,*)'mpi_rsend failed ier=',ier
         583           0 :       call endrun
         584             :    end if
         585           0 :    nsend = nsend + 1
         586           0 :    nwsend = nwsend + count
         587             : #if defined( WRAP_MPI_TIMING )
         588             :    call t_stopf ('mpi_rsend')
         589             : #endif
         590             :
         591           0 :    return
         592             :    end subroutine mpirsend
         593             :
         594             : !****************************************************************
         595             :
         596           0 :    subroutine mpissend (buf, count, datatype, dest, tag, comm)
         597             : !
         598             : ! Does a blocking synchronous send
         599             : !
         600             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         601             :    use mpishorthand
         602             :    use cam_abortutils,   only: endrun
         603             :    use cam_logfile,      only: iulog
         604             : #if defined( WRAP_MPI_TIMING )
         605             :    use perf_mod
         606             : #endif
         607             :
         608             :    implicit none
         609             :
         610             :    real (r8), intent(in):: buf(*)
         611             :    integer, intent(in):: count
         612             :    integer, intent(in):: datatype
         613             :    integer, intent(in):: dest
         614             :    integer, intent(in):: tag
         615             :    integer, intent(in):: comm
         616             :
         617             :    integer ier   !MP error code
         618             :
         619             : #if defined( WRAP_MPI_TIMING )
         620             :    call t_startf ('mpi_ssend')
         621             : #endif
         622           0 :    call mpi_ssend (buf, count, datatype, dest, tag, comm, ier)
         623           0 :    if (ier/=mpi_success) then
         624           0 :       write(iulog,*)'mpi_ssend failed ier=',ier
         625           0 :       call endrun
         626             :    end if
         627           0 :    nsend = nsend + 1
         628           0 :    nwsend = nwsend + count
         629             : #if defined( WRAP_MPI_TIMING )
         630             :    call t_stopf ('mpi_ssend')
         631             : #endif
         632             :
         633           0 :    return
         634             :    end subroutine mpissend
         635             :
         636             : !****************************************************************
         637             :
         638           0 :    subroutine mpirecv (buf, count, datatype, source, tag, comm)
         639             : !
         640             : ! Does a blocking receive
         641             : !
         642             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         643             :    use mpishorthand
         644             :    use cam_abortutils,   only: endrun
         645             :    use cam_logfile,      only: iulog
         646             : #if defined( WRAP_MPI_TIMING )
         647             :    use perf_mod
         648             : #endif
         649             :
         650             :    implicit none
         651             :
         652             :    real (r8), intent(out):: buf(*)
         653             :    integer, intent(in):: count
         654             :    integer, intent(in):: datatype
         655             :    integer, intent(in):: source
         656             :    integer, intent(in):: tag
         657             :    integer, intent(in):: comm
         658             :
         659             :    integer status (MPI_STATUS_SIZE) ! Status of message
         660             :    integer ier   !MP error code
         661             :
         662             : #if defined( WRAP_MPI_TIMING )
         663             :    call t_startf ('mpi_recv')
         664             : #endif
         665           0 :    call mpi_recv (buf, count, datatype, source, tag, comm, status, ier)
         666           0 :    if (ier/=mpi_success) then
         667           0 :       write(iulog,*)'mpi_recv failed ier=',ier
         668           0 :       call endrun
         669             :    end if
         670           0 :    nrecv = nrecv + 1
         671           0 :    nwrecv = nwrecv + count
         672             : #if defined( WRAP_MPI_TIMING )
         673             :    call t_stopf ('mpi_recv')
         674             : #endif
         675             :
         676           0 :    return
         677             :    end subroutine mpirecv
         678             :
         679             : !****************************************************************
         680             :
         681           0 :    subroutine mpigather (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, &
         682             :                          recvtype, root, comm)
         683             : !
         684             : ! Collects different messages from each thread on masterproc
         685             : !
         686             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         687             :    use mpishorthand
         688             :    use cam_abortutils,   only: endrun
         689             :    use cam_logfile,      only: iulog
         690             : #if defined( WRAP_MPI_TIMING )
         691             :    use perf_mod
         692             : #endif
         693             :
         694             :    implicit none
         695             :
         696             :    real (r8), intent(in):: sendbuf(*)
         697             :    real (r8), intent(out):: recvbuf(*)
         698             :    integer, intent(in):: sendcnt
         699             :    integer, intent(in):: sendtype
         700             :    integer, intent(in):: recvcnt
         701             :    integer, intent(in):: recvtype
         702             :    integer, intent(in):: root
         703             :    integer, intent(in):: comm
         704             :
         705             :    integer ier   !MP error code
         706             :
         707             : #if defined( WRAP_MPI_TIMING )
         708             :    call t_startf ('mpi_gather')
         709             : #endif
         710             :    call mpi_gather (sendbuf, sendcnt, sendtype,                      &
         711           0 :                     recvbuf, recvcnt, recvtype, root, comm, ier)
         712           0 :    if (ier/=mpi_success) then
         713           0 :       write(iulog,*)'mpi_gather failed ier=',ier
         714           0 :       call endrun
         715             :    end if
         716             : #if defined( WRAP_MPI_TIMING )
         717             :    call t_stopf ('mpi_gather')
         718             : #endif
         719             :
         720           0 :    return
         721             :    end subroutine mpigather
         722             :
         723             : !****************************************************************
         724             :
         725           0 :    subroutine mpigatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, &
         726             :                           displs, recvtype, root, comm)
         727             : !
         728             : ! Collects different messages from each thread on masterproc
         729             : !
         730             :    use shr_kind_mod,   only: r8 => shr_kind_r8
         731             :    use mpishorthand
         732             :    use cam_abortutils, only: endrun
         733             :    use cam_logfile,    only: iulog
         734             : #if defined( WRAP_MPI_TIMING )
         735             :    use perf_mod
         736             : #endif
         737             :
         738             :    implicit none
         739             :
         740             :    real (r8), intent(in)  :: sendbuf(*)
         741             :    real (r8), intent(out) :: recvbuf(*)
         742             :    integer, intent(in) :: displs(*)
         743             :    integer, intent(in) :: sendcnt
         744             :    integer, intent(in) :: sendtype
         745             :    integer, intent(in) :: recvcnts(*)
         746             :    integer, intent(in) :: recvtype
         747             :    integer, intent(in) :: root
         748             :    integer, intent(in) :: comm
         749             :
         750             :    integer ier   ! MPI error code
         751             :
         752             : #if defined( WRAP_MPI_TIMING )
         753             :    call t_startf ('mpi_gatherv')
         754             : #endif
         755             :    call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, &
         756           0 :                      root, comm, ier)
         757           0 :    if (ier /= mpi_success) then
         758           0 :       write(iulog,*)'mpi_gatherv failed ier=',ier
         759           0 :       call endrun
         760             :    end if
         761             : #if defined( WRAP_MPI_TIMING )
         762             :    call t_stopf ('mpi_gatherv')
         763             : #endif
         764             :
         765           0 :    return
         766             :    end subroutine mpigatherv
         767             :
         768             : !****************************************************************
         769             :
         770           0 :    subroutine mpigathervr4 (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, &
         771             :                           displs, recvtype, root, comm)
         772             : !
         773             : ! Collects different messages from each thread on masterproc
         774             : !
         775             :    use shr_kind_mod,   only: r4 => shr_kind_r4, r8 => shr_kind_r8
         776             :    use mpishorthand
         777             :    use cam_abortutils, only: endrun
         778             :    use cam_logfile,    only: iulog
         779             : #if defined( WRAP_MPI_TIMING )
         780             :    use perf_mod
         781             : #endif
         782             :
         783             :    implicit none
         784             :
         785             :    real (r4), intent(in)  :: sendbuf(*)
         786             :    real (r4), intent(out) :: recvbuf(*)
         787             :    integer, intent(in) :: displs(*)
         788             :    integer, intent(in) :: sendcnt
         789             :    integer, intent(in) :: sendtype
         790             :    integer, intent(in) :: recvcnts(*)
         791             :    integer, intent(in) :: recvtype
         792             :    integer, intent(in) :: root
         793             :    integer, intent(in) :: comm
         794             :
         795             :    integer ier   ! MPI error code
         796             :
         797             : #if defined( WRAP_MPI_TIMING )
         798             :    call t_startf ('mpi_gatherv')
         799             : #endif
         800             :    call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, &
         801           0 :                      root, comm, ier)
         802           0 :    if (ier /= mpi_success) then
         803           0 :       write(iulog,*)'mpi_gatherv failed ier=',ier
         804           0 :       call endrun
         805             :    end if
         806             : #if defined( WRAP_MPI_TIMING )
         807             :    call t_stopf ('mpi_gatherv')
         808             : #endif
         809             :
         810           0 :    return
         811             :    end subroutine mpigathervr4
         812             :
         813             : !****************************************************************
         814             :
         815           0 :    subroutine mpigathervint (sendbuf, sendcnt, sendtype, recvbuf, &
         816             :                              recvcnts, displs, recvtype, root, comm)
         817             : !
         818             : ! Collects different messages from each thread on masterproc
         819             : !
         820             :    use shr_kind_mod,   only: r8 => shr_kind_r8
         821             :    use mpishorthand
         822             :    use cam_abortutils, only: endrun
         823             :    use cam_logfile,    only: iulog
         824             : #if defined( WRAP_MPI_TIMING )
         825             :    use perf_mod
         826             : #endif
         827             :
         828             :    implicit none
         829             :
         830             :    integer, intent(in)  :: sendbuf(*)
         831             :    integer, intent(out) :: recvbuf(*)
         832             :    integer, intent(in) :: displs(*)
         833             :    integer, intent(in) :: sendcnt
         834             :    integer, intent(in) :: sendtype
         835             :    integer, intent(in) :: recvcnts(*)
         836             :    integer, intent(in) :: recvtype
         837             :    integer, intent(in) :: root
         838             :    integer, intent(in) :: comm
         839             :
         840             :    integer ier   ! MPI error code
         841             :
         842             : #if defined( WRAP_MPI_TIMING )
         843             :    call t_startf ('mpi_gatherv')
         844             : #endif
         845             :    call mpi_gatherv (sendbuf, sendcnt, sendtype, recvbuf, recvcnts, displs, recvtype, &
         846           0 :                      root, comm, ier)
         847           0 :    if (ier /= mpi_success) then
         848           0 :       write(iulog,*)'mpi_gatherv failed ier=',ier
         849           0 :       call endrun
         850             :    end if
         851             : #if defined( WRAP_MPI_TIMING )
         852             :    call t_stopf ('mpi_gatherv')
         853             : #endif
         854             :
         855           0 :    return
         856             :    end subroutine mpigathervint
         857             :
         858             : !****************************************************************
         859             :
         860           0 :    subroutine mpisum (sendbuf, recvbuf, cnt, datatype, root, comm)
         861             : !
         862             : ! Sums sendbuf across all processors on communicator, returning
         863             : ! result to root.
         864             : !
         865             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         866             :    use mpishorthand
         867             :    use cam_abortutils,   only: endrun
         868             :    use cam_logfile,      only: iulog
         869             : #if defined( WRAP_MPI_TIMING )
         870             :    use perf_mod
         871             : #endif
         872             :
         873             :    implicit none
         874             :
         875             :    real (r8), intent(in):: sendbuf(*)
         876             :    real (r8), intent(out):: recvbuf(*)
         877             :    integer, intent(in):: cnt
         878             :    integer, intent(in):: datatype
         879             :    integer, intent(in):: root
         880             :    integer, intent(in):: comm
         881             :
         882             :    integer ier   !MP error code
         883             :
         884             : #if defined( WRAP_MPI_TIMING )
         885             :    call t_startf ('mpi_reduce')
         886             : #endif
         887             :    call mpi_reduce (sendbuf, recvbuf, cnt, datatype, mpi_sum, &
         888           0 :                     root, comm, ier)
         889           0 :    if (ier/=mpi_success) then
         890           0 :       write(iulog,*)'mpi_reduce failed ier=',ier
         891           0 :       call endrun
         892             :    end if
         893             : #if defined( WRAP_MPI_TIMING )
         894             :    call t_stopf ('mpi_reduce')
         895             : #endif
         896             :
         897           0 :    return
         898             :    end subroutine mpisum
         899             :
         900             : !****************************************************************
         901             :
         902           0 :    subroutine mpiscatter (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, &
         903             :                           recvtype, root, comm)
         904             : !
         905             : ! Sends different messages from masterproc to each thread
         906             : !
         907             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         908             :    use mpishorthand
         909             :    use cam_abortutils,   only: endrun
         910             :    use cam_logfile,      only: iulog
         911             : #if defined( WRAP_MPI_TIMING )
         912             :    use perf_mod
         913             : #endif
         914             :
         915             :    implicit none
         916             :
         917             :    real (r8),intent(in):: sendbuf(*)
         918             :    real (r8), intent(out):: recvbuf(*)
         919             :    integer,intent(in):: sendcnt
         920             :    integer,intent(in):: sendtype
         921             :    integer,intent(in):: recvcnt
         922             :    integer,intent(in):: recvtype
         923             :    integer,intent(in):: root
         924             :    integer,intent(in):: comm
         925             :
         926             :    integer ier   !MP error code
         927             :
         928             : #if defined( WRAP_MPI_TIMING )
         929             :    call t_startf ('mpi_scatter')
         930             : #endif
         931             :    call mpi_scatter (sendbuf, sendcnt, sendtype, recvbuf, recvcnt, &
         932           0 :                      recvtype, root, comm, ier)
         933           0 :    if (ier/=mpi_success) then
         934           0 :       write(iulog,*)'mpi_scatter failed ier=',ier
         935           0 :       call endrun
         936             :    end if
         937             : #if defined( WRAP_MPI_TIMING )
         938             :    call t_stopf ('mpi_scatter')
         939             : #endif
         940             :
         941           0 :    return
         942             :    end subroutine mpiscatter
         943             :
         944             : !****************************************************************
         945             :
         946           0 :    subroutine mpiscatterv (sendbuf, sendcnts, displs, sendtype, recvbuf, &
         947             :                            recvcnt, recvtype, root, comm)
         948             : !
         949             : ! Sends different messages from masterproc to each thread
         950             : !
         951             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         952             :    use mpishorthand
         953             :    use cam_abortutils,   only: endrun
         954             :    use cam_logfile,      only: iulog
         955             : #if defined( WRAP_MPI_TIMING )
         956             :    use perf_mod
         957             : #endif
         958             :
         959             :    implicit none
         960             :
         961             :    real (r8), intent(in)  :: sendbuf(*)
         962             :    real (r8), intent(out) :: recvbuf(*)
         963             :    integer, intent(in) :: displs(*)
         964             :    integer, intent(in) :: sendcnts(*)
         965             :    integer, intent(in) :: sendtype
         966             :    integer, intent(in) :: recvcnt
         967             :    integer, intent(in) :: recvtype
         968             :    integer, intent(in) :: root
         969             :    integer, intent(in) :: comm
         970             :
         971             :    integer ier   !MP error code
         972             :
         973             : #if defined( WRAP_MPI_TIMING )
         974             :    call t_startf ('mpi_scatter')
         975             : #endif
         976             :    call mpi_scatterv (sendbuf, sendcnts, displs, sendtype, recvbuf, recvcnt, &
         977           0 :                       recvtype, root, comm, ier)
         978           0 :    if (ier/=mpi_success) then
         979           0 :       write(iulog,*)'mpi_scatter failed ier=',ier
         980           0 :       call endrun
         981             :    end if
         982             : #if defined( WRAP_MPI_TIMING )
         983             :    call t_stopf ('mpi_scatter')
         984             : #endif
         985             :
         986           0 :    return
         987             :    end subroutine mpiscatterv
         988             :
         989             : !****************************************************************
         990             :
         991      282624 :    subroutine mpibcast (buffer, count, datatype, root, comm )
         992             : !
         993             : ! Broadcasts a message from masterproc to all threads
         994             : !
         995             :    use shr_kind_mod,     only: r8 => shr_kind_r8
         996             :    use mpishorthand
         997             :    use cam_abortutils,   only: endrun
         998             :    use cam_logfile,      only: iulog
         999             : #if defined( WRAP_MPI_TIMING )
        1000             :    use perf_mod
        1001             : #endif
        1002             :
        1003             :    implicit none
        1004             :
        1005             :    real (r8), intent(inout):: buffer(*)
        1006             :    integer, intent(in):: count
        1007             :    integer, intent(in):: datatype
        1008             :    integer, intent(in):: root
        1009             :    integer, intent(in):: comm
        1010             :
        1011             :    integer ier   !MP error code
        1012             :
        1013             : #if defined( WRAP_MPI_TIMING )
        1014             :    call t_startf ('mpi_bcast')
        1015             : #endif
        1016      282624 :    call mpi_bcast (buffer, count, datatype, root, comm, ier)
        1017      282624 :    if (ier/=mpi_success) then
        1018           0 :       write(iulog,*)'mpi_bcast failed ier=',ier
        1019           0 :       call endrun
        1020             :    end if
        1021             : #if defined( WRAP_MPI_TIMING )
        1022             :    call t_stopf ('mpi_bcast')
        1023             : #endif
        1024             :
        1025      282624 :    return
        1026             :    end subroutine mpibcast
        1027             : !****************************************************************
        1028             :
        1029           0 :    subroutine mpiallmaxint (sendbuf, recvbuf, count, comm)
        1030             : !
        1031             : ! Allreduce integer vector maximum
        1032             : !
        1033             :    use mpishorthand
        1034             :    use cam_abortutils,   only: endrun
        1035             :    use cam_logfile,      only: iulog
        1036             : #if defined( WRAP_MPI_TIMING )
        1037             :    use perf_mod
        1038             : #endif
        1039             :
        1040             :    implicit none
        1041             :
        1042             :    integer, intent(in)  :: sendbuf(*)
        1043             :    integer, intent(out) :: recvbuf(*)
        1044             :    integer, intent(in)  :: count
        1045             :    integer, intent(in)  :: comm
        1046             :
        1047             :    integer :: ier              ! MPI error code
        1048             :
        1049             : #if defined( WRAP_MPI_TIMING )
        1050             :    call t_startf ('mpi_allreduce')
        1051             : #endif
        1052             :    call mpi_allreduce (sendbuf, recvbuf, count, mpiint, &
        1053           0 :                        mpimax, comm, ier)
        1054           0 :    if (ier/=mpi_success) then
        1055           0 :       write(iulog,*)'mpi_allreduce failed ier=',ier
        1056           0 :       call endrun
        1057             :    end if
        1058             : #if defined( WRAP_MPI_TIMING )
        1059             :    call t_stopf ('mpi_allreduce')
        1060             : #endif
        1061             :
        1062           0 :    return
        1063             :    end subroutine mpiallmaxint
        1064             :
        1065             : !****************************************************************
        1066             :
        1067           0 :    subroutine mpialltoallv (sendbuf, sendcnts, sdispls, sendtype, &
        1068             :                             recvbuf, recvcnts, rdispls, recvtype, &
        1069             :                             comm)
        1070             : !
        1071             : ! All-to-all scatter/gather
        1072             : !
        1073             :    use shr_kind_mod,     only: r8 => shr_kind_r8
        1074             :    use mpishorthand
        1075             :    use cam_abortutils,   only: endrun
        1076             :    use cam_logfile,      only: iulog
        1077             : #if defined( WRAP_MPI_TIMING )
        1078             :    use perf_mod
        1079             : #endif
        1080             :
        1081             :    implicit none
        1082             :
        1083             :    real (r8), intent(in)  :: sendbuf(*)
        1084             :    real (r8), intent(out) :: recvbuf(*)
        1085             :    integer, intent(in) :: sdispls(*)
        1086             :    integer, intent(in) :: sendcnts(*)
        1087             :    integer, intent(in) :: sendtype
        1088             :    integer, intent(in) :: recvcnts(*)
        1089             :    integer, intent(in) :: rdispls(*)
        1090             :    integer, intent(in) :: recvtype
        1091             :    integer, intent(in) :: comm
        1092             :
        1093             :    integer :: ier              ! MPI error code
        1094             :
        1095             : #if defined( WRAP_MPI_TIMING )
        1096             :    call t_startf ('mpi_alltoallv')
        1097             : #endif
        1098             :    call mpi_alltoallv (sendbuf, sendcnts, sdispls, sendtype, &
        1099             :                        recvbuf, recvcnts, rdispls, recvtype, &
        1100           0 :                        comm, ier)
        1101           0 :    if (ier/=mpi_success) then
        1102           0 :       write(iulog,*)'mpi_alltoallv failed ier=',ier
        1103           0 :       call endrun
        1104             :    end if
        1105             : #if defined( WRAP_MPI_TIMING )
        1106             :    call t_stopf ('mpi_alltoallv')
        1107             : #endif
        1108             :
        1109           0 :    return
        1110             :    end subroutine mpialltoallv
        1111             : !****************************************************************
        1112             :
        1113           0 :    subroutine mpialltoallint (sendbuf, sendcnt, recvbuf, recvcnt, &
        1114             :                               comm)
        1115             : !
        1116             : ! All-to-all scatter/gather
        1117             : !
        1118             :    use shr_kind_mod,     only: r8 => shr_kind_r8
        1119             :    use mpishorthand
        1120             :    use cam_abortutils,   only: endrun
        1121             :    use cam_logfile,      only: iulog
        1122             : #if defined( WRAP_MPI_TIMING )
        1123             :    use perf_mod
        1124             : #endif
        1125             :
        1126             :    implicit none
        1127             :
        1128             :    integer, intent(in)  :: sendbuf(*)
        1129             :    integer, intent(in)  :: sendcnt
        1130             :    integer, intent(out) :: recvbuf(*)
        1131             :    integer, intent(in)  :: recvcnt
        1132             :    integer, intent(in)  :: comm
        1133             :
        1134             :    integer :: ier              ! MPI error code
        1135             :
        1136             : #if defined( WRAP_MPI_TIMING )
        1137             :    call t_startf ('mpi_alltoallint')
        1138             : #endif
        1139             :    call mpi_alltoall (sendbuf, sendcnt, mpiint, &
        1140             :                       recvbuf, recvcnt, mpiint, &
        1141           0 :                       comm, ier)
        1142           0 :    if (ier/=mpi_success) then
        1143           0 :       write(iulog,*)'mpi_alltoallint failed ier=',ier
        1144           0 :       call endrun
        1145             :    end if
        1146             : #if defined( WRAP_MPI_TIMING )
        1147             :    call t_stopf ('mpi_alltoallint')
        1148             : #endif
        1149             :
        1150           0 :    return
        1151             :    end subroutine mpialltoallint
        1152             :
        1153             : !****************************************************************
        1154             :
        1155           0 :    subroutine mpiallgatherv (sendbuf, sendcnt, sendtype, &
        1156             :                              recvbuf, recvcnts, rdispls, recvtype, &
        1157             :                              comm)
        1158             : !
        1159             : ! Collect data from each task and broadcast resulting
        1160             : ! vector to all tasks
        1161             : !
        1162             :    use shr_kind_mod,     only: r8 => shr_kind_r8
        1163             :    use mpishorthand
        1164             :    use cam_abortutils,   only: endrun
        1165             :    use cam_logfile,      only: iulog
        1166             : #if defined( WRAP_MPI_TIMING )
        1167             :    use perf_mod
        1168             : #endif
        1169             :
        1170             :    implicit none
        1171             :
        1172             :    real (r8), intent(in)  :: sendbuf(*)
        1173             :    real (r8), intent(out) :: recvbuf(*)
        1174             :    integer, intent(in) :: sendcnt
        1175             :    integer, intent(in) :: sendtype
        1176             :    integer, intent(in) :: recvcnts(*)
        1177             :    integer, intent(in) :: rdispls(*)
        1178             :    integer, intent(in) :: recvtype
        1179             :    integer, intent(in) :: comm
        1180             :
        1181             :    integer ier   !MP error code
        1182             :
        1183             : #if defined( WRAP_MPI_TIMING )
        1184             :    call t_startf ('mpi_allgatherv')
        1185             : #endif
        1186             :    call mpi_allgatherv (sendbuf, sendcnt, sendtype, &
        1187             :                         recvbuf, recvcnts, rdispls, recvtype, &
        1188           0 :                         comm, ier)
        1189           0 :    if (ier/=mpi_success) then
        1190           0 :       write(iulog,*)'mpi_allgatherv failed ier=',ier
        1191           0 :       call endrun
        1192             :    end if
        1193             : #if defined( WRAP_MPI_TIMING )
        1194             :    call t_stopf ('mpi_allgatherv')
        1195             : #endif
        1196             :
        1197           0 :    return
        1198             :    end subroutine mpiallgatherv
        1199             : !****************************************************************
        1200             :
        1201           0 :    subroutine mpiallgatherint (sendbuf, scount, recvbuf, rcount, comm)
        1202             : !
        1203             : ! Collects integer data from each task and broadcasts resulting
        1204             : ! vector to all tasks
        1205             : !
        1206             :    use shr_kind_mod,     only: r8 => shr_kind_r8
        1207             :    use mpishorthand
        1208             :    use cam_abortutils,   only: endrun
        1209             :    use cam_logfile,      only: iulog
        1210             : #if defined( WRAP_MPI_TIMING )
        1211             :    use perf_mod
        1212             : #endif
        1213             :
        1214             :    implicit none
        1215             :
        1216             :    integer, intent(in)  :: sendbuf(*)
        1217             :    integer, intent(out) :: recvbuf(*)
        1218             :    integer, intent(in)  :: scount
        1219             :    integer, intent(in)  :: rcount
        1220             :    integer, intent(in)  :: comm
        1221             :
        1222             :    integer ier   !MP error code
        1223             :
        1224             : #if defined( WRAP_MPI_TIMING )
        1225             :    call t_startf ('mpi_allgather')
        1226             : #endif
        1227             :    call mpi_allgather (sendbuf, scount, mpiint, recvbuf, rcount, &
        1228           0 :                        mpiint, comm, ier)
        1229           0 :    if (ier/=mpi_success) then
        1230           0 :       write(iulog,*)'mpi_allgather failed ier=',ier
        1231           0 :       call endrun
        1232             :    end if
        1233             : #if defined( WRAP_MPI_TIMING )
        1234             :    call t_stopf ('mpi_allgather')
        1235             : #endif
        1236             :
        1237           0 :    return
        1238             :    end subroutine mpiallgatherint
        1239             :
        1240             : !****************************************************************
        1241             :
        1242           0 :    subroutine mpiwincreate(base,size,comm,win)
        1243             : !
        1244             : ! Creates window for MPI2 one-sided commands
        1245             : !
        1246             :    use shr_kind_mod,     only: r8 => shr_kind_r8
        1247             :    use mpishorthand
        1248             :    use cam_abortutils,   only: endrun
        1249             :    use cam_logfile,      only: iulog
        1250             : #if defined( WRAP_MPI_TIMING )
        1251             :    use perf_mod
        1252             : #endif
        1253             :
        1254             :    implicit none
        1255             :
        1256             :    real(r8), intent(in)  :: base(*)
        1257             :    integer,  intent(in)  :: size
        1258             :    integer,  intent(in)  :: comm
        1259             :    integer,  intent(out) :: win
        1260             : !
        1261             : #ifdef MPI2
        1262             :    integer(kind=MPI_ADDRESS_KIND) :: size8
        1263             :    integer :: ier, info
        1264             : !
        1265             : #if defined( WRAP_MPI_TIMING )
        1266             :    call t_startf ('mpi_win_create')
        1267             : #endif
        1268             :    info = MPI_INFO_NULL
        1269             :    size8 = size
        1270             :    call mpi_win_create(base,size8,8,info,comm,win,ier)
        1271             :    if (ier/=mpi_success) then
        1272             :       write(iulog,*)'mpi_win_create failed ier=',ier
        1273             :       call endrun
        1274             :    end if
        1275             :    call mpi_win_fence(0,win,ier)
        1276             :    if (ier/=mpi_success) then
        1277             :       write(iulog,*)'mpi_win_fence failed ier=',ier
        1278             :       call endrun
        1279             :    end if
        1280             : #if defined( WRAP_MPI_TIMING )
        1281             :    call t_stopf ('mpi_win_create')
        1282             : #endif
        1283             : #endif
        1284             :
        1285           0 :    return
        1286             :    end subroutine mpiwincreate
        1287             : !****************************************************************
        1288             : !
        1289             : ! If SPMD is not turned on
        1290             : !
        1291             : #else
        1292             :    subroutine wrap_mpi
        1293             :    use cam_abortutils, only: endrun
        1294             :    implicit none
        1295             : !
        1296             : ! A unused stub routine to make the compiler happy when SPMD is
        1297             : ! turned off (which means you don't need anything in this file).
        1298             : !
        1299             :    call endrun ('(WRAP_MPI): This should not be called at all')
        1300             :    end subroutine wrap_mpi
        1301             : #endif
        1302             :

Generated by: LCOV version 1.14