LCOV - code coverage report
Current view: top level - src/mpiwrap - message_passing.f90 (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:9f1e18e) Lines: 590 1027 57.4 %
Date: 2021-09-22 20:58:48 Functions: 105 576 18.2 %

          Line data    Source code
       1             : #:include 'message_passing.fypp'
       2             : #:for nametype1, type1, mpi_type1, mpi_2type1, kind1, bytes1, handle1, zero1, one1 in inst_params
       3             : ! *****************************************************************************
       4             : !> \brief Shift around the data in msg
       5             : !> \param[in,out] msg         Rank-2 data to shift
       6             : !> \param[in] group           message passing environment identifier
       7             : !> \param[in] displ_in        displacements (?)
       8             : !> \par Example
       9             : !>      msg will be moved from rank to rank+displ_in (in a circular way)
      10             : !> \par Limitations
      11             : !>      * displ_in will be 1 by default (others not tested)
      12             : !>      * the message array needs to be the same size on all processes
      13             : ! *****************************************************************************
      14         800 :   SUBROUTINE mp_shift_${nametype1}$m(msg, group, displ_in)
      15             : 
      16             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :)
      17             :      INTEGER, INTENT(IN)                      :: group
      18             :      INTEGER, INTENT(IN), OPTIONAL            :: displ_in
      19             : 
      20             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_shift_${nametype1}$m'
      21             : 
      22             :      INTEGER                                  :: handle, ierror
      23             : #if defined(__parallel)
      24             :      INTEGER                                  :: displ, left, &
      25             :                                                  msglen, myrank, nprocs, &
      26             :                                                  right, tag
      27             : #endif
      28             : 
      29         800 :      ierror = 0
      30         800 :      CALL mp_timeset(routineN, handle)
      31             : 
      32             : #if defined(__parallel)
      33         800 :      CALL mpi_comm_rank(group, myrank, ierror)
      34         800 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_rank @ "//routineN)
      35         800 :      CALL mpi_comm_size(group, nprocs, ierror)
      36         800 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_size @ "//routineN)
      37         800 :      IF (PRESENT(displ_in)) THEN
      38           0 :         displ = displ_in
      39             :      ELSE
      40             :         displ = 1
      41             :      ENDIF
      42         800 :      right = MODULO(myrank + displ, nprocs)
      43         800 :      left = MODULO(myrank - displ, nprocs)
      44         800 :      tag = 17
      45         800 :      msglen = SIZE(msg)
      46             :      CALL mpi_sendrecv_replace(msg, msglen, ${mpi_type1}$, right, tag, left, tag, &
      47         800 :                                group, MPI_STATUS_IGNORE, ierror)
      48         800 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_sendrecv_replace @ "//routineN)
      49         800 :      CALL add_perf(perf_id=7, count=1, msg_size=msglen*${bytes1}$)
      50             : #else
      51             :      MARK_USED(msg)
      52             :      MARK_USED(group)
      53             :      MARK_USED(displ_in)
      54             : #endif
      55         800 :      CALL mp_timestop(handle)
      56             : 
      57         800 :   END SUBROUTINE mp_shift_${nametype1}$m
      58             : 
      59             : ! *****************************************************************************
      60             : !> \brief Shift around the data in msg
      61             : !> \param[in,out] msg         Data to shift
      62             : !> \param[in] group           message passing environment identifier
      63             : !> \param[in] displ_in        displacements (?)
      64             : !> \par Example
      65             : !>      msg will be moved from rank to rank+displ_in (in a circular way)
      66             : !> \par Limitations
      67             : !>      * displ_in will be 1 by default (others not tested)
      68             : !>      * the message array needs to be the same size on all processes
      69             : ! *****************************************************************************
      70        2400 :   SUBROUTINE mp_shift_${nametype1}$ (msg, group, displ_in)
      71             : 
      72             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
      73             :      INTEGER, INTENT(IN)                      :: group
      74             :      INTEGER, INTENT(IN), OPTIONAL            :: displ_in
      75             : 
      76             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_shift_${nametype1}$'
      77             : 
      78             :      INTEGER                                  :: handle, ierror
      79             : #if defined(__parallel)
      80             :      INTEGER                                  :: displ, left, &
      81             :                                                  msglen, myrank, nprocs, &
      82             :                                                  right, tag
      83             : #endif
      84             : 
      85        2400 :      ierror = 0
      86        2400 :      CALL mp_timeset(routineN, handle)
      87             : 
      88             : #if defined(__parallel)
      89        2400 :      CALL mpi_comm_rank(group, myrank, ierror)
      90        2400 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_rank @ "//routineN)
      91        2400 :      CALL mpi_comm_size(group, nprocs, ierror)
      92        2400 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_size @ "//routineN)
      93        2400 :      IF (PRESENT(displ_in)) THEN
      94           0 :         displ = displ_in
      95             :      ELSE
      96             :         displ = 1
      97             :      ENDIF
      98        2400 :      right = MODULO(myrank + displ, nprocs)
      99        2400 :      left = MODULO(myrank - displ, nprocs)
     100        2400 :      tag = 19
     101        2400 :      msglen = SIZE(msg)
     102             :      CALL mpi_sendrecv_replace(msg, msglen, ${mpi_type1}$, right, tag, left, &
     103        2400 :                                tag, group, MPI_STATUS_IGNORE, ierror)
     104        2400 :      IF (ierror /= 0) CALL mp_stop(ierror, "mpi_sendrecv_replace @ "//routineN)
     105        2400 :      CALL add_perf(perf_id=7, count=1, msg_size=msglen*${bytes1}$)
     106             : #else
     107             :      MARK_USED(msg)
     108             :      MARK_USED(group)
     109             :      MARK_USED(displ_in)
     110             : #endif
     111        2400 :      CALL mp_timestop(handle)
     112             : 
     113        2400 :   END SUBROUTINE mp_shift_${nametype1}$
     114             : 
     115             : ! *****************************************************************************
     116             : !> \brief All-to-all data exchange, rank-1 data of different sizes
     117             : !> \param[in] sb              Data to send
     118             : !> \param[in] scount          Data counts for data sent to other processes
     119             : !> \param[in] sdispl          Respective data offsets for data sent to process
     120             : !> \param[in,out] rb          Buffer into which to receive data
     121             : !> \param[in] rcount          Data counts for data received from other
     122             : !>                            processes
     123             : !> \param[in] rdispl          Respective data offsets for data received from
     124             : !>                            other processes
     125             : !> \param[in] group           Message passing environment identifier
     126             : !> \par MPI mapping
     127             : !>      mpi_alltoallv
     128             : !> \par Array sizes
     129             : !>      The scount, rcount, and the sdispl and rdispl arrays have a
     130             : !>      size equal to the number of processes.
     131             : !> \par Offsets
     132             : !>      Values in sdispl and rdispl start with 0.
     133             : ! *****************************************************************************
     134       52314 :   SUBROUTINE mp_alltoall_${nametype1}$11v(sb, scount, sdispl, rb, rcount, rdispl, group)
     135             : 
     136             :      ${type1}$, DIMENSION(:), INTENT(IN)        :: sb
     137             :      INTEGER, DIMENSION(:), INTENT(IN)        :: scount, sdispl
     138             :      ${type1}$, DIMENSION(:), INTENT(INOUT)     :: rb
     139             :      INTEGER, DIMENSION(:), INTENT(IN)        :: rcount, rdispl
     140             :      INTEGER, INTENT(IN)                      :: group
     141             : 
     142             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$11v'
     143             : 
     144             :      INTEGER                                  :: handle, ierr
     145             : #if defined(__parallel)
     146             :      INTEGER                                  :: msglen
     147             : #else
     148             :      INTEGER                                  :: i
     149             : #endif
     150             : 
     151       52314 :      CALL mp_timeset(routineN, handle)
     152             : 
     153       52314 :      ierr = 0
     154             : #if defined(__parallel)
     155             :      CALL mpi_alltoallv(sb, scount, sdispl, ${mpi_type1}$, &
     156       52314 :                         rb, rcount, rdispl, ${mpi_type1}$, group, ierr)
     157       52314 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoallv @ "//routineN)
     158      263664 :      msglen = SUM(scount) + SUM(rcount)
     159       52314 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     160             : #else
     161             :      MARK_USED(group)
     162             :      MARK_USED(scount)
     163             :      MARK_USED(sdispl)
     164             :      !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i) SHARED(rcount,rdispl,sdispl,rb,sb)
     165             :      DO i = 1, rcount(1)
     166             :         rb(rdispl(1) + i) = sb(sdispl(1) + i)
     167             :      ENDDO
     168             : #endif
     169       52314 :      CALL mp_timestop(handle)
     170             : 
     171       52314 :   END SUBROUTINE mp_alltoall_${nametype1}$11v
     172             : 
     173             : ! *****************************************************************************
     174             : !> \brief All-to-all data exchange, rank-2 data of different sizes
     175             : !> \param sb ...
     176             : !> \param scount ...
     177             : !> \param sdispl ...
     178             : !> \param rb ...
     179             : !> \param rcount ...
     180             : !> \param rdispl ...
     181             : !> \param group ...
     182             : !> \par MPI mapping
     183             : !>      mpi_alltoallv
     184             : !> \note see mp_alltoall_${nametype1}$11v
     185             : ! *****************************************************************************
     186     1425062 :   SUBROUTINE mp_alltoall_${nametype1}$22v(sb, scount, sdispl, rb, rcount, rdispl, group)
     187             : 
     188             :      ${type1}$, DIMENSION(:, :), &
     189             :         INTENT(IN)                             :: sb
     190             :      INTEGER, DIMENSION(:), INTENT(IN)        :: scount, sdispl
     191             :      ${type1}$, DIMENSION(:, :), &
     192             :         INTENT(INOUT)                          :: rb
     193             :      INTEGER, DIMENSION(:), INTENT(IN)        :: rcount, rdispl
     194             :      INTEGER, INTENT(IN)                      :: group
     195             : 
     196             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$22v'
     197             : 
     198             :      INTEGER                                  :: handle, ierr
     199             : #if defined(__parallel)
     200             :      INTEGER                                  :: msglen
     201             : #endif
     202             : 
     203     1425062 :      ierr = 0
     204     1425062 :      CALL mp_timeset(routineN, handle)
     205             : 
     206             : #if defined(__parallel)
     207             :      CALL mpi_alltoallv(sb, scount, sdispl, ${mpi_type1}$, &
     208     1425062 :                         rb, rcount, rdispl, ${mpi_type1}$, group, ierr)
     209     1425062 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoallv @ "//routineN)
     210     8550372 :      msglen = SUM(scount) + SUM(rcount)
     211     1425062 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*2*${bytes1}$)
     212             : #else
     213             :      MARK_USED(group)
     214             :      MARK_USED(scount)
     215             :      MARK_USED(sdispl)
     216             :      MARK_USED(rcount)
     217             :      MARK_USED(rdispl)
     218             :      rb = sb
     219             : #endif
     220     1425062 :      CALL mp_timestop(handle)
     221             : 
     222     1425062 :   END SUBROUTINE mp_alltoall_${nametype1}$22v
     223             : 
     224             : ! *****************************************************************************
     225             : !> \brief All-to-all data exchange, rank 1 arrays, equal sizes
     226             : !> \param[in] sb    array with data to send
     227             : !> \param[out] rb   array into which data is received
     228             : !> \param[in] count  number of elements to send/receive (product of the
     229             : !>                   extents of the first two dimensions)
     230             : !> \param[in] group           Message passing environment identifier
     231             : !> \par Index meaning
     232             : !> \par The first two indices specify the data while the last index counts
     233             : !>      the processes
     234             : !> \par Sizes of ranks
     235             : !>      All processes have the same data size.
     236             : !> \par MPI mapping
     237             : !>      mpi_alltoall
     238             : ! *****************************************************************************
     239        2184 :   SUBROUTINE mp_alltoall_${nametype1}$ (sb, rb, count, group)
     240             : 
     241             :      ${type1}$, DIMENSION(:), INTENT(IN)        :: sb
     242             :      ${type1}$, DIMENSION(:), INTENT(OUT)       :: rb
     243             :      INTEGER, INTENT(IN)                      :: count, group
     244             : 
     245             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$'
     246             : 
     247             :      INTEGER                                  :: handle, ierr
     248             : #if defined(__parallel)
     249             :      INTEGER                                  :: msglen, np
     250             : #endif
     251             : 
     252        2184 :      ierr = 0
     253        2184 :      CALL mp_timeset(routineN, handle)
     254             : 
     255             : #if defined(__parallel)
     256             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     257        2184 :                        rb, count, ${mpi_type1}$, group, ierr)
     258        2184 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     259        2184 :      CALL mpi_comm_size(group, np, ierr)
     260        2184 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     261        2184 :      msglen = 2*count*np
     262        2184 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     263             : #else
     264             :      MARK_USED(count)
     265             :      MARK_USED(group)
     266             :      rb = sb
     267             : #endif
     268        2184 :      CALL mp_timestop(handle)
     269             : 
     270        2184 :   END SUBROUTINE mp_alltoall_${nametype1}$
     271             : 
     272             : ! *****************************************************************************
     273             : !> \brief All-to-all data exchange, rank-2 arrays, equal sizes
     274             : !> \param sb ...
     275             : !> \param rb ...
     276             : !> \param count ...
     277             : !> \param group ...
     278             : !> \note see mp_alltoall_${nametype1}$
     279             : ! *****************************************************************************
     280        5476 :   SUBROUTINE mp_alltoall_${nametype1}$22(sb, rb, count, group)
     281             : 
     282             :      ${type1}$, DIMENSION(:, :), INTENT(IN)     :: sb
     283             :      ${type1}$, DIMENSION(:, :), INTENT(OUT)    :: rb
     284             :      INTEGER, INTENT(IN)                      :: count, group
     285             : 
     286             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$22'
     287             : 
     288             :      INTEGER                                  :: handle, ierr
     289             : #if defined(__parallel)
     290             :      INTEGER                                  :: msglen, np
     291             : #endif
     292             : 
     293        5476 :      ierr = 0
     294        5476 :      CALL mp_timeset(routineN, handle)
     295             : 
     296             : #if defined(__parallel)
     297             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     298        5476 :                        rb, count, ${mpi_type1}$, group, ierr)
     299        5476 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     300        5476 :      CALL mpi_comm_size(group, np, ierr)
     301        5476 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     302        5476 :      msglen = 2*SIZE(sb)*np
     303        5476 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     304             : #else
     305             :      MARK_USED(count)
     306             :      MARK_USED(group)
     307             :      rb = sb
     308             : #endif
     309        5476 :      CALL mp_timestop(handle)
     310             : 
     311        5476 :   END SUBROUTINE mp_alltoall_${nametype1}$22
     312             : 
     313             : ! *****************************************************************************
     314             : !> \brief All-to-all data exchange, rank-3 data with equal sizes
     315             : !> \param sb ...
     316             : !> \param rb ...
     317             : !> \param count ...
     318             : !> \param group ...
     319             : !> \note see mp_alltoall_${nametype1}$
     320             : ! *****************************************************************************
     321           0 :   SUBROUTINE mp_alltoall_${nametype1}$33(sb, rb, count, group)
     322             : 
     323             :      ${type1}$, DIMENSION(:, :, :), INTENT(IN)  :: sb
     324             :      ${type1}$, DIMENSION(:, :, :), INTENT(OUT) :: rb
     325             :      INTEGER, INTENT(IN)                      :: count, group
     326             : 
     327             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$33'
     328             : 
     329             :      INTEGER                                  :: handle, ierr
     330             : #if defined(__parallel)
     331             :      INTEGER                                  :: msglen, np
     332             : #endif
     333             : 
     334           0 :      ierr = 0
     335           0 :      CALL mp_timeset(routineN, handle)
     336             : 
     337             : #if defined(__parallel)
     338             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     339           0 :                        rb, count, ${mpi_type1}$, group, ierr)
     340           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     341           0 :      CALL mpi_comm_size(group, np, ierr)
     342           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     343           0 :      msglen = 2*count*np
     344           0 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     345             : #else
     346             :      MARK_USED(count)
     347             :      MARK_USED(group)
     348             :      rb = sb
     349             : #endif
     350           0 :      CALL mp_timestop(handle)
     351             : 
     352           0 :   END SUBROUTINE mp_alltoall_${nametype1}$33
     353             : 
     354             : ! *****************************************************************************
     355             : !> \brief All-to-all data exchange, rank 4 data, equal sizes
     356             : !> \param sb ...
     357             : !> \param rb ...
     358             : !> \param count ...
     359             : !> \param group ...
     360             : !> \note see mp_alltoall_${nametype1}$
     361             : ! *****************************************************************************
     362           0 :   SUBROUTINE mp_alltoall_${nametype1}$44(sb, rb, count, group)
     363             : 
     364             :      ${type1}$, DIMENSION(:, :, :, :), &
     365             :         INTENT(IN)                             :: sb
     366             :      ${type1}$, DIMENSION(:, :, :, :), &
     367             :         INTENT(OUT)                            :: rb
     368             :      INTEGER, INTENT(IN)                      :: count, group
     369             : 
     370             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$44'
     371             : 
     372             :      INTEGER                                  :: handle, ierr
     373             : #if defined(__parallel)
     374             :      INTEGER                                  :: msglen, np
     375             : #endif
     376             : 
     377           0 :      ierr = 0
     378           0 :      CALL mp_timeset(routineN, handle)
     379             : 
     380             : #if defined(__parallel)
     381             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     382           0 :                        rb, count, ${mpi_type1}$, group, ierr)
     383           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     384           0 :      CALL mpi_comm_size(group, np, ierr)
     385           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     386           0 :      msglen = 2*count*np
     387           0 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     388             : #else
     389             :      MARK_USED(count)
     390             :      MARK_USED(group)
     391             :      rb = sb
     392             : #endif
     393           0 :      CALL mp_timestop(handle)
     394             : 
     395           0 :   END SUBROUTINE mp_alltoall_${nametype1}$44
     396             : 
     397             : ! *****************************************************************************
     398             : !> \brief All-to-all data exchange, rank 5 data, equal sizes
     399             : !> \param sb ...
     400             : !> \param rb ...
     401             : !> \param count ...
     402             : !> \param group ...
     403             : !> \note see mp_alltoall_${nametype1}$
     404             : ! *****************************************************************************
     405           0 :   SUBROUTINE mp_alltoall_${nametype1}$55(sb, rb, count, group)
     406             : 
     407             :      ${type1}$, DIMENSION(:, :, :, :, :), &
     408             :         INTENT(IN)                             :: sb
     409             :      ${type1}$, DIMENSION(:, :, :, :, :), &
     410             :         INTENT(OUT)                            :: rb
     411             :      INTEGER, INTENT(IN)                      :: count, group
     412             : 
     413             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$55'
     414             : 
     415             :      INTEGER                                  :: handle, ierr
     416             : #if defined(__parallel)
     417             :      INTEGER                                  :: msglen, np
     418             : #endif
     419             : 
     420           0 :      ierr = 0
     421           0 :      CALL mp_timeset(routineN, handle)
     422             : 
     423             : #if defined(__parallel)
     424             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     425           0 :                        rb, count, ${mpi_type1}$, group, ierr)
     426           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     427           0 :      CALL mpi_comm_size(group, np, ierr)
     428           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     429           0 :      msglen = 2*count*np
     430           0 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     431             : #else
     432             :      MARK_USED(count)
     433             :      MARK_USED(group)
     434             :      rb = sb
     435             : #endif
     436           0 :      CALL mp_timestop(handle)
     437             : 
     438           0 :   END SUBROUTINE mp_alltoall_${nametype1}$55
     439             : 
     440             : ! *****************************************************************************
     441             : !> \brief All-to-all data exchange, rank-4 data to rank-5 data
     442             : !> \param sb ...
     443             : !> \param rb ...
     444             : !> \param count ...
     445             : !> \param group ...
     446             : !> \note see mp_alltoall_${nametype1}$
     447             : !> \note User must ensure size consistency.
     448             : ! *****************************************************************************
     449        7010 :   SUBROUTINE mp_alltoall_${nametype1}$45(sb, rb, count, group)
     450             : 
     451             :      ${type1}$, DIMENSION(:, :, :, :), &
     452             :         INTENT(IN)                             :: sb
     453             :      ${type1}$, &
     454             :         DIMENSION(:, :, :, :, :), INTENT(OUT)  :: rb
     455             :      INTEGER, INTENT(IN)                      :: count, group
     456             : 
     457             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$45'
     458             : 
     459             :      INTEGER                                  :: handle, ierr
     460             : #if defined(__parallel)
     461             :      INTEGER                                  :: msglen, np
     462             : #endif
     463             : 
     464        7010 :      ierr = 0
     465        7010 :      CALL mp_timeset(routineN, handle)
     466             : 
     467             : #if defined(__parallel)
     468             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     469        7010 :                        rb, count, ${mpi_type1}$, group, ierr)
     470        7010 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     471        7010 :      CALL mpi_comm_size(group, np, ierr)
     472        7010 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     473        7010 :      msglen = 2*count*np
     474        7010 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     475             : #else
     476             :      MARK_USED(count)
     477             :      MARK_USED(group)
     478             :      rb = RESHAPE(sb, SHAPE(rb))
     479             : #endif
     480        7010 :      CALL mp_timestop(handle)
     481             : 
     482        7010 :   END SUBROUTINE mp_alltoall_${nametype1}$45
     483             : 
     484             : ! *****************************************************************************
     485             : !> \brief All-to-all data exchange, rank-3 data to rank-4 data
     486             : !> \param sb ...
     487             : !> \param rb ...
     488             : !> \param count ...
     489             : !> \param group ...
     490             : !> \note see mp_alltoall_${nametype1}$
     491             : !> \note User must ensure size consistency.
     492             : ! *****************************************************************************
     493           2 :   SUBROUTINE mp_alltoall_${nametype1}$34(sb, rb, count, group)
     494             : 
     495             :      ${type1}$, DIMENSION(:, :, :), &
     496             :         INTENT(IN)                             :: sb
     497             :      ${type1}$, DIMENSION(:, :, :, :), &
     498             :         INTENT(OUT)                            :: rb
     499             :      INTEGER, INTENT(IN)                      :: count, group
     500             : 
     501             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$34'
     502             : 
     503             :      INTEGER                                  :: handle, ierr
     504             : #if defined(__parallel)
     505             :      INTEGER                                  :: msglen, np
     506             : #endif
     507             : 
     508           2 :      ierr = 0
     509           2 :      CALL mp_timeset(routineN, handle)
     510             : 
     511             : #if defined(__parallel)
     512             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     513           2 :                        rb, count, ${mpi_type1}$, group, ierr)
     514           2 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     515           2 :      CALL mpi_comm_size(group, np, ierr)
     516           2 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     517           2 :      msglen = 2*count*np
     518           2 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     519             : #else
     520             :      MARK_USED(count)
     521             :      MARK_USED(group)
     522             :      rb = RESHAPE(sb, SHAPE(rb))
     523             : #endif
     524           2 :      CALL mp_timestop(handle)
     525             : 
     526           2 :   END SUBROUTINE mp_alltoall_${nametype1}$34
     527             : 
     528             : ! *****************************************************************************
     529             : !> \brief All-to-all data exchange, rank-5 data to rank-4 data
     530             : !> \param sb ...
     531             : !> \param rb ...
     532             : !> \param count ...
     533             : !> \param group ...
     534             : !> \note see mp_alltoall_${nametype1}$
     535             : !> \note User must ensure size consistency.
     536             : ! *****************************************************************************
     537        6748 :   SUBROUTINE mp_alltoall_${nametype1}$54(sb, rb, count, group)
     538             : 
     539             :      ${type1}$, &
     540             :         DIMENSION(:, :, :, :, :), INTENT(IN)   :: sb
     541             :      ${type1}$, DIMENSION(:, :, :, :), &
     542             :         INTENT(OUT)                            :: rb
     543             :      INTEGER, INTENT(IN)                      :: count, group
     544             : 
     545             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_alltoall_${nametype1}$54'
     546             : 
     547             :      INTEGER                                  :: handle, ierr
     548             : #if defined(__parallel)
     549             :      INTEGER                                  :: msglen, np
     550             : #endif
     551             : 
     552        6748 :      ierr = 0
     553        6748 :      CALL mp_timeset(routineN, handle)
     554             : 
     555             : #if defined(__parallel)
     556             :      CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
     557        6748 :                        rb, count, ${mpi_type1}$, group, ierr)
     558        6748 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
     559        6748 :      CALL mpi_comm_size(group, np, ierr)
     560        6748 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
     561        6748 :      msglen = 2*count*np
     562        6748 :      CALL add_perf(perf_id=6, count=1, msg_size=msglen*${bytes1}$)
     563             : #else
     564             :      MARK_USED(count)
     565             :      MARK_USED(group)
     566             :      rb = RESHAPE(sb, SHAPE(rb))
     567             : #endif
     568        6748 :      CALL mp_timestop(handle)
     569             : 
     570        6748 :   END SUBROUTINE mp_alltoall_${nametype1}$54
     571             : 
     572             : ! *****************************************************************************
     573             : !> \brief Send one datum to another process
     574             : !> \param[in] msg             Scalar to send
     575             : !> \param[in] dest            Destination process
     576             : !> \param[in] tag             Transfer identifier
     577             : !> \param[in] gid             Message passing environment identifier
     578             : !> \par MPI mapping
     579             : !>      mpi_send
     580             : ! *****************************************************************************
     581         854 :   SUBROUTINE mp_send_${nametype1}$ (msg, dest, tag, gid)
     582             :      ${type1}$                                  :: msg
     583             :      INTEGER                                  :: dest, tag, gid
     584             : 
     585             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_send_${nametype1}$'
     586             : 
     587             :      INTEGER                                  :: handle, ierr, msglen
     588             : 
     589         854 :      ierr = 0
     590         854 :      CALL mp_timeset(routineN, handle)
     591             : 
     592         854 :      msglen = 1
     593             : #if defined(__parallel)
     594         854 :      CALL mpi_send(msg, msglen, ${mpi_type1}$, dest, tag, gid, ierr)
     595         854 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_send @ "//routineN)
     596         854 :      CALL add_perf(perf_id=13, count=1, msg_size=msglen*${bytes1}$)
     597             : #else
     598             :      MARK_USED(msg)
     599             :      MARK_USED(dest)
     600             :      MARK_USED(tag)
     601             :      MARK_USED(gid)
     602             :      ! only defined in parallel
     603             :      CPABORT("not in parallel mode")
     604             : #endif
     605         854 :      CALL mp_timestop(handle)
     606         854 :   END SUBROUTINE mp_send_${nametype1}$
     607             : 
     608             : ! *****************************************************************************
     609             : !> \brief Send rank-1 data to another process
     610             : !> \param[in] msg             Rank-1 data to send
     611             : !> \param dest ...
     612             : !> \param tag ...
     613             : !> \param gid ...
     614             : !> \note see mp_send_${nametype1}$
     615             : ! *****************************************************************************
     616      130606 :   SUBROUTINE mp_send_${nametype1}$v(msg, dest, tag, gid)
     617             :      ${type1}$                                  :: msg(:)
     618             :      INTEGER                                  :: dest, tag, gid
     619             : 
     620             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_send_${nametype1}$v'
     621             : 
     622             :      INTEGER                                  :: handle, ierr, msglen
     623             : 
     624      130606 :      ierr = 0
     625      130606 :      CALL mp_timeset(routineN, handle)
     626             : 
     627      130606 :      msglen = SIZE(msg)
     628             : #if defined(__parallel)
     629      130606 :      CALL mpi_send(msg, msglen, ${mpi_type1}$, dest, tag, gid, ierr)
     630      130606 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_send @ "//routineN)
     631      130606 :      CALL add_perf(perf_id=13, count=1, msg_size=msglen*${bytes1}$)
     632             : #else
     633             :      MARK_USED(msg)
     634             :      MARK_USED(dest)
     635             :      MARK_USED(tag)
     636             :      MARK_USED(gid)
     637             :      ! only defined in parallel
     638             :      CPABORT("not in parallel mode")
     639             : #endif
     640      130606 :      CALL mp_timestop(handle)
     641      130606 :   END SUBROUTINE mp_send_${nametype1}$v
     642             : 
     643             : ! *****************************************************************************
     644             : !> \brief Send rank-2 data to another process
     645             : !> \param[in] msg             Rank-2 data to send
     646             : !> \param dest ...
     647             : !> \param tag ...
     648             : !> \param gid ...
     649             : !> \note see mp_send_${nametype1}$
     650             : ! *****************************************************************************
     651          36 :   SUBROUTINE mp_send_${nametype1}$m2(msg, dest, tag, gid)
     652             :      ${type1}$                                  :: msg(:, :)
     653             :      INTEGER                                  :: dest, tag, gid
     654             : 
     655             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_send_${nametype1}$m2'
     656             : 
     657             :      INTEGER                                  :: handle, ierr, msglen
     658             : 
     659          36 :      ierr = 0
     660          36 :      CALL mp_timeset(routineN, handle)
     661             : 
     662          36 :      msglen = SIZE(msg)
     663             : #if defined(__parallel)
     664          36 :      CALL mpi_send(msg, msglen, ${mpi_type1}$, dest, tag, gid, ierr)
     665          36 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_send @ "//routineN)
     666          36 :      CALL add_perf(perf_id=13, count=1, msg_size=msglen*${bytes1}$)
     667             : #else
     668             :      MARK_USED(msg)
     669             :      MARK_USED(dest)
     670             :      MARK_USED(tag)
     671             :      MARK_USED(gid)
     672             :      ! only defined in parallel
     673             :      CPABORT("not in parallel mode")
     674             : #endif
     675          36 :      CALL mp_timestop(handle)
     676          36 :   END SUBROUTINE mp_send_${nametype1}$m2
     677             : 
     678             : ! *****************************************************************************
     679             : !> \brief Send rank-3 data to another process
     680             : !> \param[in] msg             Rank-3 data to send
     681             : !> \param dest ...
     682             : !> \param tag ...
     683             : !> \param gid ...
     684             : !> \note see mp_send_${nametype1}$
     685             : ! *****************************************************************************
     686          39 :   SUBROUTINE mp_send_${nametype1}$m3(msg, dest, tag, gid)
     687             :      ${type1}$                                  :: msg(:,:, :)
     688             :      INTEGER                                  :: dest, tag, gid
     689             : 
     690             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_send_${nametype1}m3'
     691             : 
     692             :      INTEGER                                  :: handle, ierr, msglen
     693             : 
     694          39 :      ierr = 0
     695          39 :      CALL mp_timeset(routineN, handle)
     696             : 
     697          39 :      msglen = SIZE(msg)
     698             : #if defined(__parallel)
     699          39 :      CALL mpi_send(msg, msglen, ${mpi_type1}$, dest, tag, gid, ierr)
     700          39 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_send @ "//routineN)
     701          39 :      CALL add_perf(perf_id=13, count=1, msg_size=msglen*${bytes1}$)
     702             : #else
     703             :      MARK_USED(msg)
     704             :      MARK_USED(dest)
     705             :      MARK_USED(tag)
     706             :      MARK_USED(gid)
     707             :      ! only defined in parallel
     708             :      CPABORT("not in parallel mode")
     709             : #endif
     710          39 :      CALL mp_timestop(handle)
     711          39 :   END SUBROUTINE mp_send_${nametype1}$m3
     712             : 
     713             : ! *****************************************************************************
     714             : !> \brief Receive one datum from another process
     715             : !> \param[in,out] msg         Place received data into this variable
     716             : !> \param[in,out] source      Process to receive from
     717             : !> \param[in,out] tag         Transfer identifier
     718             : !> \param[in] gid             Message passing environment identifier
     719             : !> \par MPI mapping
     720             : !>      mpi_send
     721             : ! *****************************************************************************
     722         854 :   SUBROUTINE mp_recv_${nametype1}$ (msg, source, tag, gid)
     723             :      ${type1}$, INTENT(INOUT)                   :: msg
     724             :      INTEGER, INTENT(INOUT)                   :: source, tag
     725             :      INTEGER, INTENT(IN)                      :: gid
     726             : 
     727             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_recv_${nametype1}$'
     728             : 
     729             :      INTEGER                                  :: handle, ierr, msglen
     730             : #if defined(__parallel)
     731         854 :      INTEGER, ALLOCATABLE, DIMENSION(:)       :: status
     732             : #endif
     733             : 
     734         854 :      ierr = 0
     735         854 :      CALL mp_timeset(routineN, handle)
     736             : 
     737         854 :      msglen = 1
     738             : #if defined(__parallel)
     739         854 :      ALLOCATE (status(MPI_STATUS_SIZE))
     740         854 :      CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, gid, status, ierr)
     741         854 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
     742         854 :      CALL add_perf(perf_id=14, count=1, msg_size=msglen*${bytes1}$)
     743         854 :      source = status(MPI_SOURCE)
     744         854 :      tag = status(MPI_TAG)
     745         854 :      DEALLOCATE (status)
     746             : #else
     747             :      MARK_USED(msg)
     748             :      MARK_USED(source)
     749             :      MARK_USED(tag)
     750             :      MARK_USED(gid)
     751             :      ! only defined in parallel
     752             :      CPABORT("not in parallel mode")
     753             : #endif
     754         854 :      CALL mp_timestop(handle)
     755         854 :   END SUBROUTINE mp_recv_${nametype1}$
     756             : 
     757             : ! *****************************************************************************
     758             : !> \brief Receive rank-1 data from another process
     759             : !> \param[in,out] msg         Place received data into this rank-1 array
     760             : !> \param source ...
     761             : !> \param tag ...
     762             : !> \param gid ...
     763             : !> \note see mp_recv_${nametype1}$
     764             : ! *****************************************************************************
     765      130586 :   SUBROUTINE mp_recv_${nametype1}$v(msg, source, tag, gid)
     766             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
     767             :      INTEGER, INTENT(INOUT)                   :: source, tag
     768             :      INTEGER, INTENT(IN)                      :: gid
     769             : 
     770             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_recv_${nametype1}$v'
     771             : 
     772             :      INTEGER                                  :: handle, ierr, msglen
     773             : #if defined(__parallel)
     774      130586 :      INTEGER, ALLOCATABLE, DIMENSION(:)       :: status
     775             : #endif
     776             : 
     777      130586 :      ierr = 0
     778      130586 :      CALL mp_timeset(routineN, handle)
     779             : 
     780      130586 :      msglen = SIZE(msg)
     781             : #if defined(__parallel)
     782      130586 :      ALLOCATE (status(MPI_STATUS_SIZE))
     783      130586 :      CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, gid, status, ierr)
     784      130586 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
     785      130586 :      CALL add_perf(perf_id=14, count=1, msg_size=msglen*${bytes1}$)
     786      130586 :      source = status(MPI_SOURCE)
     787      130586 :      tag = status(MPI_TAG)
     788      130586 :      DEALLOCATE (status)
     789             : #else
     790             :      MARK_USED(msg)
     791             :      MARK_USED(source)
     792             :      MARK_USED(tag)
     793             :      MARK_USED(gid)
     794             :      ! only defined in parallel
     795             :      CPABORT("not in parallel mode")
     796             : #endif
     797      130586 :      CALL mp_timestop(handle)
     798      130586 :   END SUBROUTINE mp_recv_${nametype1}$v
     799             : 
     800             : ! *****************************************************************************
     801             : !> \brief Receive rank-2 data from another process
     802             : !> \param[in,out] msg         Place received data into this rank-2 array
     803             : !> \param source ...
     804             : !> \param tag ...
     805             : !> \param gid ...
     806             : !> \note see mp_recv_${nametype1}$
     807             : ! *****************************************************************************
     808          36 :   SUBROUTINE mp_recv_${nametype1}$m2(msg, source, tag, gid)
     809             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :)
     810             :      INTEGER, INTENT(INOUT)                   :: source, tag
     811             :      INTEGER, INTENT(IN)                      :: gid
     812             : 
     813             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_recv_${nametype1}$m2'
     814             : 
     815             :      INTEGER                                  :: handle, ierr, msglen
     816             : #if defined(__parallel)
     817          36 :      INTEGER, ALLOCATABLE, DIMENSION(:)       :: status
     818             : #endif
     819             : 
     820          36 :      ierr = 0
     821          36 :      CALL mp_timeset(routineN, handle)
     822             : 
     823          36 :      msglen = SIZE(msg)
     824             : #if defined(__parallel)
     825          36 :      ALLOCATE (status(MPI_STATUS_SIZE))
     826          36 :      CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, gid, status, ierr)
     827          36 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
     828          36 :      CALL add_perf(perf_id=14, count=1, msg_size=msglen*${bytes1}$)
     829          36 :      source = status(MPI_SOURCE)
     830          36 :      tag = status(MPI_TAG)
     831          36 :      DEALLOCATE (status)
     832             : #else
     833             :      MARK_USED(msg)
     834             :      MARK_USED(source)
     835             :      MARK_USED(tag)
     836             :      MARK_USED(gid)
     837             :      ! only defined in parallel
     838             :      CPABORT("not in parallel mode")
     839             : #endif
     840          36 :      CALL mp_timestop(handle)
     841          36 :   END SUBROUTINE mp_recv_${nametype1}$m2
     842             : 
     843             : ! *****************************************************************************
     844             : !> \brief Receive rank-3 data from another process
     845             : !> \param[in,out] msg         Place received data into this rank-3 array
     846             : !> \param source ...
     847             : !> \param tag ...
     848             : !> \param gid ...
     849             : !> \note see mp_recv_${nametype1}$
     850             : ! *****************************************************************************
     851          39 :   SUBROUTINE mp_recv_${nametype1}$m3(msg, source, tag, gid)
     852             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :, :)
     853             :      INTEGER, INTENT(INOUT)                   :: source, tag
     854             :      INTEGER, INTENT(IN)                      :: gid
     855             : 
     856             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_recv_${nametype1}$m3'
     857             : 
     858             :      INTEGER                                  :: handle, ierr, msglen
     859             : #if defined(__parallel)
     860          39 :      INTEGER, ALLOCATABLE, DIMENSION(:)       :: status
     861             : #endif
     862             : 
     863          39 :      ierr = 0
     864          39 :      CALL mp_timeset(routineN, handle)
     865             : 
     866          39 :      msglen = SIZE(msg)
     867             : #if defined(__parallel)
     868          39 :      ALLOCATE (status(MPI_STATUS_SIZE))
     869          39 :      CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, gid, status, ierr)
     870          39 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
     871          39 :      CALL add_perf(perf_id=14, count=1, msg_size=msglen*${bytes1}$)
     872          39 :      source = status(MPI_SOURCE)
     873          39 :      tag = status(MPI_TAG)
     874          39 :      DEALLOCATE (status)
     875             : #else
     876             :      MARK_USED(msg)
     877             :      MARK_USED(source)
     878             :      MARK_USED(tag)
     879             :      MARK_USED(gid)
     880             :      ! only defined in parallel
     881             :      CPABORT("not in parallel mode")
     882             : #endif
     883          39 :      CALL mp_timestop(handle)
     884          39 :   END SUBROUTINE mp_recv_${nametype1}$m3
     885             : 
     886             : ! *****************************************************************************
     887             : !> \brief Broadcasts a datum to all processes.
     888             : !> \param[in] msg             Datum to broadcast
     889             : !> \param[in] source          Processes which broadcasts
     890             : !> \param[in] gid             Message passing environment identifier
     891             : !> \par MPI mapping
     892             : !>      mpi_bcast
     893             : ! *****************************************************************************
     894     3013351 :   SUBROUTINE mp_bcast_${nametype1}$ (msg, source, gid)
     895             :      ${type1}$                                  :: msg
     896             :      INTEGER                                  :: source, gid
     897             : 
     898             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_bcast_${nametype1}$'
     899             : 
     900             :      INTEGER                                  :: handle, ierr, msglen
     901             : 
     902     3013351 :      ierr = 0
     903     3013351 :      CALL mp_timeset(routineN, handle)
     904             : 
     905     3013351 :      msglen = 1
     906             : #if defined(__parallel)
     907     3013351 :      CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, gid, ierr)
     908     3013351 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
     909     3013351 :      CALL add_perf(perf_id=2, count=1, msg_size=msglen*${bytes1}$)
     910             : #else
     911             :      MARK_USED(msg)
     912             :      MARK_USED(source)
     913             :      MARK_USED(gid)
     914             : #endif
     915     3013351 :      CALL mp_timestop(handle)
     916     3013351 :   END SUBROUTINE mp_bcast_${nametype1}$
     917             : 
     918             : ! *****************************************************************************
     919             : !> \brief Broadcasts a datum to all processes.
     920             : !> \param[in] msg             Datum to broadcast
     921             : !> \param[in] source          Processes which broadcasts
     922             : !> \param[in] gid             Message passing environment identifier
     923             : !> \par MPI mapping
     924             : !>      mpi_bcast
     925             : ! *****************************************************************************
     926           0 :   SUBROUTINE mp_ibcast_${nametype1}$ (msg, source, gid, request)
     927             :      ${type1}$                                  :: msg
     928             :      INTEGER                                  :: source, gid
     929             :      INTEGER, INTENT(INOUT)                   :: request
     930             : 
     931             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_ibcast_${nametype1}$'
     932             : 
     933             :      INTEGER                                  :: handle, ierr, msglen
     934             : 
     935           0 :      ierr = 0
     936           0 :      CALL mp_timeset(routineN, handle)
     937             : 
     938           0 :      msglen = 1
     939             : #if defined(__parallel)
     940             : #if __MPI_VERSION > 2
     941           0 :      CALL mpi_ibcast(msg, msglen, ${mpi_type1}$, source, gid, request, ierr)
     942           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ibcast @ "//routineN)
     943           0 :      CALL add_perf(perf_id=22, count=1, msg_size=msglen*${bytes1}$)
     944             : #else
     945             :      MARK_USED(msg)
     946             :      MARK_USED(source)
     947             :      MARK_USED(gid)
     948             :      request = mp_request_null
     949             :      CPABORT("mp_ibcast requires MPI-3 standard")
     950             : #endif
     951             : #else
     952             :      MARK_USED(msg)
     953             :      MARK_USED(source)
     954             :      MARK_USED(gid)
     955             :      request = mp_request_null
     956             : #endif
     957           0 :      CALL mp_timestop(handle)
     958           0 :   END SUBROUTINE mp_ibcast_${nametype1}$
     959             : 
     960             : ! *****************************************************************************
     961             : !> \brief Broadcasts rank-1 data to all processes
     962             : !> \param[in] msg             Data to broadcast
     963             : !> \param source ...
     964             : !> \param gid ...
     965             : !> \note see mp_bcast_${nametype1}$1
     966             : ! *****************************************************************************
     967     1900598 :   SUBROUTINE mp_bcast_${nametype1}$v(msg, source, gid)
     968             :      ${type1}$                                  :: msg(:)
     969             :      INTEGER                                  :: source, gid
     970             : 
     971             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_bcast_${nametype1}$v'
     972             : 
     973             :      INTEGER                                  :: handle, ierr, msglen
     974             : 
     975     1900598 :      ierr = 0
     976     1900598 :      CALL mp_timeset(routineN, handle)
     977             : 
     978     1900598 :      msglen = SIZE(msg)
     979             : #if defined(__parallel)
     980     1900598 :      CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, gid, ierr)
     981     1900598 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
     982     1900598 :      CALL add_perf(perf_id=2, count=1, msg_size=msglen*${bytes1}$)
     983             : #else
     984             :      MARK_USED(source)
     985             :      MARK_USED(gid)
     986             : #endif
     987     1900598 :      CALL mp_timestop(handle)
     988     1900598 :   END SUBROUTINE mp_bcast_${nametype1}$v
     989             : 
     990             : ! *****************************************************************************
     991             : !> \brief Broadcasts rank-1 data to all processes
     992             : !> \param[in] msg             Data to broadcast
     993             : !> \param source ...
     994             : !> \param gid ...
     995             : !> \note see mp_bcast_${nametype1}$1
     996             : ! *****************************************************************************
     997           0 :   SUBROUTINE mp_ibcast_${nametype1}$v(msg, source, gid, request)
     998             :      ${type1}$                                  :: msg(:)
     999             :      INTEGER                                  :: source, gid
    1000             :      INTEGER, INTENT(INOUT)                   :: request
    1001             : 
    1002             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_ibcast_${nametype1}$v'
    1003             : 
    1004             :      INTEGER                                  :: handle, ierr, msglen
    1005             : 
    1006           0 :      ierr = 0
    1007           0 :      CALL mp_timeset(routineN, handle)
    1008             : 
    1009           0 :      msglen = SIZE(msg)
    1010             : #if defined(__parallel)
    1011             : #if __MPI_VERSION > 2
    1012           0 :      CALL mpi_ibcast(msg, msglen, ${mpi_type1}$, source, gid, request, ierr)
    1013           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ibcast @ "//routineN)
    1014           0 :      CALL add_perf(perf_id=22, count=1, msg_size=msglen*${bytes1}$)
    1015             : #else
    1016             :      MARK_USED(source)
    1017             :      MARK_USED(gid)
    1018             :      request = mp_request_null
    1019             :      CPABORT("mp_ibcast requires MPI-3 standard")
    1020             : #endif
    1021             : #else
    1022             :      MARK_USED(source)
    1023             :      MARK_USED(gid)
    1024             :      request = mp_request_null
    1025             : #endif
    1026           0 :      CALL mp_timestop(handle)
    1027           0 :   END SUBROUTINE mp_ibcast_${nametype1}$v
    1028             : 
    1029             : ! *****************************************************************************
    1030             : !> \brief Broadcasts rank-2 data to all processes
    1031             : !> \param[in] msg             Data to broadcast
    1032             : !> \param source ...
    1033             : !> \param gid ...
    1034             : !> \note see mp_bcast_${nametype1}$1
    1035             : ! *****************************************************************************
    1036      742807 :   SUBROUTINE mp_bcast_${nametype1}$m(msg, source, gid)
    1037             :      ${type1}$                                  :: msg(:, :)
    1038             :      INTEGER                                  :: source, gid
    1039             : 
    1040             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_bcast_im'
    1041             : 
    1042             :      INTEGER                                  :: handle, ierr, msglen
    1043             : 
    1044      742807 :      ierr = 0
    1045      742807 :      CALL mp_timeset(routineN, handle)
    1046             : 
    1047      742807 :      msglen = SIZE(msg)
    1048             : #if defined(__parallel)
    1049      742807 :      CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, gid, ierr)
    1050      742807 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
    1051      742807 :      CALL add_perf(perf_id=2, count=1, msg_size=msglen*${bytes1}$)
    1052             : #else
    1053             :      MARK_USED(source)
    1054             :      MARK_USED(gid)
    1055             : #endif
    1056      742807 :      CALL mp_timestop(handle)
    1057      742807 :   END SUBROUTINE mp_bcast_${nametype1}$m
    1058             : 
    1059             : ! *****************************************************************************
    1060             : !> \brief Broadcasts rank-3 data to all processes
    1061             : !> \param[in] msg             Data to broadcast
    1062             : !> \param source ...
    1063             : !> \param gid ...
    1064             : !> \note see mp_bcast_${nametype1}$1
    1065             : ! *****************************************************************************
    1066         224 :   SUBROUTINE mp_bcast_${nametype1}$3(msg, source, gid)
    1067             :      ${type1}$                                  :: msg(:, :, :)
    1068             :      INTEGER                                  :: source, gid
    1069             : 
    1070             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_bcast_${nametype1}$3'
    1071             : 
    1072             :      INTEGER                                  :: handle, ierr, msglen
    1073             : 
    1074         224 :      ierr = 0
    1075         224 :      CALL mp_timeset(routineN, handle)
    1076             : 
    1077         224 :      msglen = SIZE(msg)
    1078             : #if defined(__parallel)
    1079         224 :      CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, gid, ierr)
    1080         224 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
    1081         224 :      CALL add_perf(perf_id=2, count=1, msg_size=msglen*${bytes1}$)
    1082             : #else
    1083             :      MARK_USED(source)
    1084             :      MARK_USED(gid)
    1085             : #endif
    1086         224 :      CALL mp_timestop(handle)
    1087         224 :   END SUBROUTINE mp_bcast_${nametype1}$3
    1088             : 
    1089             : ! *****************************************************************************
    1090             : !> \brief Sums a datum from all processes with result left on all processes.
    1091             : !> \param[in,out] msg         Datum to sum (input) and result (output)
    1092             : !> \param[in] gid             Message passing environment identifier
    1093             : !> \par MPI mapping
    1094             : !>      mpi_allreduce
    1095             : ! *****************************************************************************
    1096    17516162 :   SUBROUTINE mp_sum_${nametype1}$ (msg, gid)
    1097             :      ${type1}$, INTENT(INOUT)                   :: msg
    1098             :      INTEGER, INTENT(IN)                      :: gid
    1099             : 
    1100             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$'
    1101             : 
    1102             :      INTEGER                                  :: handle, ierr, msglen
    1103             : 
    1104    17516162 :      ierr = 0
    1105    17516162 :      CALL mp_timeset(routineN, handle)
    1106             : 
    1107    17516162 :      msglen = 1
    1108             : #if defined(__parallel)
    1109    17516162 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1110    17516162 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1111    17516162 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1112             : #else
    1113             :      MARK_USED(msg)
    1114             :      MARK_USED(gid)
    1115             : #endif
    1116    17516162 :      CALL mp_timestop(handle)
    1117    17516162 :   END SUBROUTINE mp_sum_${nametype1}$
    1118             : 
    1119             : ! *****************************************************************************
    1120             : !> \brief Element-wise sum of a rank-1 array on all processes.
    1121             : !> \param[in,out] msg         Vector to sum and result
    1122             : !> \param gid ...
    1123             : !> \note see mp_sum_${nametype1}$
    1124             : ! *****************************************************************************
    1125     3116283 :   SUBROUTINE mp_sum_${nametype1}$v(msg, gid)
    1126             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1127             :      INTEGER, INTENT(IN)                      :: gid
    1128             : 
    1129             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$v'
    1130             : 
    1131             :      INTEGER                                  :: handle, ierr
    1132             : #if defined(__parallel)
    1133             :      INTEGER                                  :: msglen
    1134             : #endif
    1135             : 
    1136     3116283 :      ierr = 0
    1137     3116283 :      CALL mp_timeset(routineN, handle)
    1138             : 
    1139             : #if defined(__parallel)
    1140     3116283 :      msglen = SIZE(msg)
    1141     3116283 :      IF (msglen > 0) THEN
    1142     3360874 :         CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1143     3017914 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1144             :      END IF
    1145     3116283 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1146             : #else
    1147             :      MARK_USED(msg)
    1148             :      MARK_USED(gid)
    1149             : #endif
    1150     3116283 :      CALL mp_timestop(handle)
    1151     3116283 :   END SUBROUTINE mp_sum_${nametype1}$v
    1152             : 
    1153             : ! *****************************************************************************
    1154             : !> \brief Element-wise sum of a rank-1 array on all processes.
    1155             : !> \param[in,out] msg         Vector to sum and result
    1156             : !> \param gid ...
    1157             : !> \note see mp_sum_${nametype1}$
    1158             : ! *****************************************************************************
    1159           0 :   SUBROUTINE mp_isum_${nametype1}$v(msg, gid, request)
    1160             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1161             :      INTEGER, INTENT(IN)                      :: gid
    1162             :      INTEGER, INTENT(INOUT)                   :: request
    1163             : 
    1164             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isum_${nametype1}$v'
    1165             : 
    1166             :      INTEGER                                  :: handle, ierr
    1167             : #if defined(__parallel)
    1168             :      INTEGER                                  :: msglen
    1169             : #endif
    1170             : 
    1171           0 :      ierr = 0
    1172           0 :      CALL mp_timeset(routineN, handle)
    1173             : 
    1174             : #if defined(__parallel)
    1175             : #if __MPI_VERSION > 2
    1176           0 :      msglen = SIZE(msg)
    1177           0 :      IF (msglen > 0) THEN
    1178           0 :         CALL mpi_iallreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, gid, request, ierr)
    1179           0 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallreduce @ "//routineN)
    1180             :      ELSE
    1181           0 :         request = mp_request_null
    1182             :      ENDIF
    1183           0 :      CALL add_perf(perf_id=23, count=1, msg_size=msglen*${bytes1}$)
    1184             : #else
    1185             :      MARK_USED(msg)
    1186             :      MARK_USED(msglen)
    1187             :      MARK_USED(gid)
    1188             :      request = mp_request_null
    1189             :      CPABORT("mp_isum requires MPI-3 standard")
    1190             : #endif
    1191             : #else
    1192             :      MARK_USED(msg)
    1193             :      MARK_USED(gid)
    1194             :      request = mp_request_null
    1195             : #endif
    1196           0 :      CALL mp_timestop(handle)
    1197           0 :   END SUBROUTINE mp_isum_${nametype1}$v
    1198             : 
    1199             : ! *****************************************************************************
    1200             : !> \brief Element-wise sum of a rank-2 array on all processes.
    1201             : !> \param[in] msg             Matrix to sum and result
    1202             : !> \param gid ...
    1203             : !> \note see mp_sum_${nametype1}$
    1204             : ! *****************************************************************************
    1205     2232758 :   SUBROUTINE mp_sum_${nametype1}$m(msg, gid)
    1206             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :)
    1207             :      INTEGER, INTENT(IN)                      :: gid
    1208             : 
    1209             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m'
    1210             : 
    1211             :      INTEGER                                  :: handle, ierr
    1212             : #if defined(__parallel)
    1213             :      INTEGER, PARAMETER :: max_msg = 2**25
    1214             :      INTEGER                                  :: m1, msglen, step, msglensum
    1215             : #endif
    1216             : 
    1217     2232758 :      ierr = 0
    1218     2232758 :      CALL mp_timeset(routineN, handle)
    1219             : 
    1220             : #if defined(__parallel)
    1221             :      ! chunk up the call so that message sizes are limited, to avoid overflows in mpich triggered in large rpa calcs
    1222     2232758 :      step = MAX(1, SIZE(msg, 2)/MAX(1, SIZE(msg)/max_msg))
    1223     2232758 :      msglensum = 0
    1224     6698174 :      DO m1 = LBOUND(msg, 2), UBOUND(msg, 2), step
    1225     2232708 :         msglen = SIZE(msg, 1)*(MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1)
    1226     2232708 :         msglensum = msglensum + msglen
    1227     4465466 :         IF (msglen > 0) THEN
    1228     2232700 :            CALL mpi_allreduce(MPI_IN_PLACE, msg(LBOUND(msg, 1), m1), msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1229     2232700 :            IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1230             :         END IF
    1231             :      ENDDO
    1232     2232758 :      CALL add_perf(perf_id=3, count=1, msg_size=msglensum*${bytes1}$)
    1233             : #else
    1234             :      MARK_USED(msg)
    1235             :      MARK_USED(gid)
    1236             : #endif
    1237     2232758 :      CALL mp_timestop(handle)
    1238     2232758 :   END SUBROUTINE mp_sum_${nametype1}$m
    1239             : 
    1240             : ! *****************************************************************************
    1241             : !> \brief Element-wise sum of a rank-3 array on all processes.
    1242             : !> \param[in] msg             Array to sum and result
    1243             : !> \param gid ...
    1244             : !> \note see mp_sum_${nametype1}$
    1245             : ! *****************************************************************************
    1246       50267 :   SUBROUTINE mp_sum_${nametype1}$m3(msg, gid)
    1247             :      ${type1}$, INTENT(INOUT), CONTIGUOUS     :: msg(:, :, :)
    1248             :      INTEGER, INTENT(IN)                      :: gid
    1249             : 
    1250             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m3'
    1251             : 
    1252             :      INTEGER                                  :: handle, ierr, &
    1253             :                                                  msglen
    1254       50267 :      ierr = 0
    1255       50267 :      CALL mp_timeset(routineN, handle)
    1256             : 
    1257       50267 :      msglen = SIZE(msg)
    1258             : #if defined(__parallel)
    1259       50267 :      IF (msglen > 0) THEN
    1260       50267 :         CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1261       50267 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1262             :      END IF
    1263       50267 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1264             : #else
    1265             :      MARK_USED(gid)
    1266             : #endif
    1267       50267 :      CALL mp_timestop(handle)
    1268       50267 :   END SUBROUTINE mp_sum_${nametype1}$m3
    1269             : 
    1270             : ! *****************************************************************************
    1271             : !> \brief Element-wise sum of a rank-4 array on all processes.
    1272             : !> \param[in] msg             Array to sum and result
    1273             : !> \param gid ...
    1274             : !> \note see mp_sum_${nametype1}$
    1275             : ! *****************************************************************************
    1276         190 :   SUBROUTINE mp_sum_${nametype1}$m4(msg, gid)
    1277             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :, :, :)
    1278             :      INTEGER, INTENT(IN)                      :: gid
    1279             : 
    1280             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m4'
    1281             : 
    1282             :      INTEGER                                  :: handle, ierr, &
    1283             :                                                  msglen
    1284             : 
    1285         190 :      ierr = 0
    1286         190 :      CALL mp_timeset(routineN, handle)
    1287             : 
    1288         190 :      msglen = SIZE(msg)
    1289             : #if defined(__parallel)
    1290         190 :      IF (msglen > 0) THEN
    1291         190 :         CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1292         190 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1293             :      END IF
    1294         190 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1295             : #else
    1296             :      MARK_USED(gid)
    1297             : #endif
    1298         190 :      CALL mp_timestop(handle)
    1299         190 :   END SUBROUTINE mp_sum_${nametype1}$m4
    1300             : 
    1301             : ! *****************************************************************************
    1302             : !> \brief Element-wise sum of data from all processes with result left only on
    1303             : !>        one.
    1304             : !> \param[in,out] msg         Vector to sum (input) and (only on process root)
    1305             : !>                            result (output)
    1306             : !> \param root ...
    1307             : !> \param[in] gid             Message passing environment identifier
    1308             : !> \par MPI mapping
    1309             : !>      mpi_reduce
    1310             : ! *****************************************************************************
    1311          54 :   SUBROUTINE mp_sum_root_${nametype1}$v(msg, root, gid)
    1312             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1313             :      INTEGER, INTENT(IN)                      :: root, gid
    1314             : 
    1315             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_root_${nametype1}$v'
    1316             : 
    1317             :      INTEGER                                  :: handle, ierr, msglen
    1318             : #if defined(__parallel)
    1319             :      INTEGER                                  :: m1, taskid
    1320          54 :      ${type1}$, ALLOCATABLE                     :: res(:)
    1321             : #endif
    1322             : 
    1323          54 :      ierr = 0
    1324          54 :      CALL mp_timeset(routineN, handle)
    1325             : 
    1326          54 :      msglen = SIZE(msg)
    1327             : #if defined(__parallel)
    1328          54 :      CALL mpi_comm_rank(gid, taskid, ierr)
    1329          54 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
    1330          54 :      IF (msglen > 0) THEN
    1331          54 :         m1 = SIZE(msg, 1)
    1332         162 :         ALLOCATE (res(m1))
    1333             :         CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_SUM, &
    1334          54 :                         root, gid, ierr)
    1335          54 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN)
    1336          54 :         IF (taskid == root) THEN
    1337         135 :            msg = res
    1338             :         END IF
    1339          54 :         DEALLOCATE (res)
    1340             :      END IF
    1341          54 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1342             : #else
    1343             :      MARK_USED(root)
    1344             :      MARK_USED(gid)
    1345             : #endif
    1346          54 :      CALL mp_timestop(handle)
    1347          54 :   END SUBROUTINE mp_sum_root_${nametype1}$v
    1348             : 
    1349             : ! *****************************************************************************
    1350             : !> \brief Element-wise sum of data from all processes with result left only on
    1351             : !>        one.
    1352             : !> \param[in,out] msg         Matrix to sum (input) and (only on process root)
    1353             : !>                            result (output)
    1354             : !> \param root ...
    1355             : !> \param gid ...
    1356             : !> \note see mp_sum_root_${nametype1}$v
    1357             : ! *****************************************************************************
    1358           0 :   SUBROUTINE mp_sum_root_${nametype1}$m(msg, root, gid)
    1359             :      ${type1}$, INTENT(INOUT)                   :: msg(:, :)
    1360             :      INTEGER, INTENT(IN)                      :: root, gid
    1361             : 
    1362             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_root_rm'
    1363             : 
    1364             :      INTEGER                                  :: handle, ierr, msglen
    1365             : #if defined(__parallel)
    1366             :      INTEGER                                  :: m1, m2, taskid
    1367           0 :      ${type1}$, ALLOCATABLE                     :: res(:, :)
    1368             : #endif
    1369             : 
    1370           0 :      ierr = 0
    1371           0 :      CALL mp_timeset(routineN, handle)
    1372             : 
    1373           0 :      msglen = SIZE(msg)
    1374             : #if defined(__parallel)
    1375           0 :      CALL mpi_comm_rank(gid, taskid, ierr)
    1376           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
    1377           0 :      IF (msglen > 0) THEN
    1378           0 :         m1 = SIZE(msg, 1)
    1379           0 :         m2 = SIZE(msg, 2)
    1380           0 :         ALLOCATE (res(m1, m2))
    1381           0 :         CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_SUM, root, gid, ierr)
    1382           0 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN)
    1383           0 :         IF (taskid == root) THEN
    1384           0 :            msg = res
    1385             :         END IF
    1386           0 :         DEALLOCATE (res)
    1387             :      END IF
    1388           0 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1389             : #else
    1390             :      MARK_USED(root)
    1391             :      MARK_USED(gid)
    1392             : #endif
    1393           0 :      CALL mp_timestop(handle)
    1394           0 :   END SUBROUTINE mp_sum_root_${nametype1}$m
    1395             : 
    1396             : ! *****************************************************************************
    1397             : !> \brief Partial sum of data from all processes with result on each process.
    1398             : !> \param[in] msg          Matrix to sum (input)
    1399             : !> \param[out] res         Matrix containing result (output)
    1400             : !> \param[in] gid          Message passing environment identifier
    1401             : ! *****************************************************************************
    1402          54 :   SUBROUTINE mp_sum_partial_${nametype1}$m(msg, res, gid)
    1403             :      ${type1}$, CONTIGUOUS, INTENT(IN)   :: msg(:, :)
    1404             :      ${type1}$, CONTIGUOUS, INTENT(OUT)  :: res(:, :)
    1405             :      INTEGER, INTENT(IN)                 :: gid
    1406             : 
    1407             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_partial_${nametype1}$m'
    1408             : 
    1409             :      INTEGER                     :: handle, ierr, msglen
    1410             : #if defined(__parallel)
    1411             :      INTEGER                     :: taskid
    1412             : #endif
    1413             : 
    1414          54 :      ierr = 0
    1415          54 :      CALL mp_timeset(routineN, handle)
    1416             : 
    1417          54 :      msglen = SIZE(msg)
    1418             : #if defined(__parallel)
    1419          54 :      CALL mpi_comm_rank(gid, taskid, ierr)
    1420          54 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
    1421          54 :      IF (msglen > 0) THEN
    1422          54 :         CALL mpi_scan(msg, res, msglen, ${mpi_type1}$, MPI_SUM, gid, ierr)
    1423          54 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_scan @ "//routineN)
    1424             :      END IF
    1425          54 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1426             :      ! perf_id is same as for other summation routines
    1427             : #else
    1428             :      res = msg
    1429             :      MARK_USED(gid)
    1430             : #endif
    1431          54 :      CALL mp_timestop(handle)
    1432          54 :   END SUBROUTINE mp_sum_partial_${nametype1}$m
    1433             : 
    1434             : ! *****************************************************************************
    1435             : !> \brief Finds the maximum of a datum with the result left on all processes.
    1436             : !> \param[in,out] msg         Find maximum among these data (input) and
    1437             : !>                            maximum (output)
    1438             : !> \param[in] gid             Message passing environment identifier
    1439             : !> \par MPI mapping
    1440             : !>      mpi_allreduce
    1441             : ! *****************************************************************************
    1442     9368895 :   SUBROUTINE mp_max_${nametype1}$ (msg, gid)
    1443             :      ${type1}$, INTENT(INOUT)                   :: msg
    1444             :      INTEGER, INTENT(IN)                      :: gid
    1445             : 
    1446             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_${nametype1}$'
    1447             : 
    1448             :      INTEGER                                  :: handle, ierr, msglen
    1449             : 
    1450     9368895 :      ierr = 0
    1451     9368895 :      CALL mp_timeset(routineN, handle)
    1452             : 
    1453     9368895 :      msglen = 1
    1454             : #if defined(__parallel)
    1455     9368895 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_MAX, gid, ierr)
    1456     9368895 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1457     9368895 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1458             : #else
    1459             :      MARK_USED(msg)
    1460             :      MARK_USED(gid)
    1461             : #endif
    1462     9368895 :      CALL mp_timestop(handle)
    1463     9368895 :   END SUBROUTINE mp_max_${nametype1}$
    1464             : 
    1465             : ! *****************************************************************************
    1466             : !> \brief Finds the element-wise maximum of a vector with the result left on
    1467             : !>        all processes.
    1468             : !> \param[in,out] msg         Find maximum among these data (input) and
    1469             : !>                            maximum (output)
    1470             : !> \param gid ...
    1471             : !> \note see mp_max_${nametype1}$
    1472             : ! *****************************************************************************
    1473       23020 :   SUBROUTINE mp_max_${nametype1}$v(msg, gid)
    1474             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1475             :      INTEGER, INTENT(IN)                      :: gid
    1476             : 
    1477             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_${nametype1}$v'
    1478             : 
    1479             :      INTEGER                                  :: handle, ierr, msglen
    1480             : 
    1481       23020 :      ierr = 0
    1482       23020 :      CALL mp_timeset(routineN, handle)
    1483             : 
    1484       23020 :      msglen = SIZE(msg)
    1485             : #if defined(__parallel)
    1486       23020 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_MAX, gid, ierr)
    1487       23020 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1488       23020 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1489             : #else
    1490             :      MARK_USED(gid)
    1491             : #endif
    1492       23020 :      CALL mp_timestop(handle)
    1493       23020 :   END SUBROUTINE mp_max_${nametype1}$v
    1494             : 
    1495             : ! *****************************************************************************
    1496             : !> \brief Finds the minimum of a datum with the result left on all processes.
    1497             : !> \param[in,out] msg         Find minimum among these data (input) and
    1498             : !>                            maximum (output)
    1499             : !> \param[in] gid             Message passing environment identifier
    1500             : !> \par MPI mapping
    1501             : !>      mpi_allreduce
    1502             : ! *****************************************************************************
    1503         586 :   SUBROUTINE mp_min_${nametype1}$ (msg, gid)
    1504             :      ${type1}$, INTENT(INOUT)                   :: msg
    1505             :      INTEGER, INTENT(IN)                      :: gid
    1506             : 
    1507             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_min_${nametype1}$'
    1508             : 
    1509             :      INTEGER                                  :: handle, ierr, msglen
    1510             : 
    1511         586 :      ierr = 0
    1512         586 :      CALL mp_timeset(routineN, handle)
    1513             : 
    1514         586 :      msglen = 1
    1515             : #if defined(__parallel)
    1516         586 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_MIN, gid, ierr)
    1517         586 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1518         586 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1519             : #else
    1520             :      MARK_USED(msg)
    1521             :      MARK_USED(gid)
    1522             : #endif
    1523         586 :      CALL mp_timestop(handle)
    1524         586 :   END SUBROUTINE mp_min_${nametype1}$
    1525             : 
    1526             : ! *****************************************************************************
    1527             : !> \brief Finds the element-wise minimum of vector with the result left on
    1528             : !>        all processes.
    1529             : !> \param[in,out] msg         Find minimum among these data (input) and
    1530             : !>                            maximum (output)
    1531             : !> \param gid ...
    1532             : !> \par MPI mapping
    1533             : !>      mpi_allreduce
    1534             : !> \note see mp_min_${nametype1}$
    1535             : ! *****************************************************************************
    1536       33499 :   SUBROUTINE mp_min_${nametype1}$v(msg, gid)
    1537             :      ${type1}$, INTENT(INOUT), CONTIGUOUS     :: msg(:)
    1538             :      INTEGER, INTENT(IN)                      :: gid
    1539             : 
    1540             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_min_${nametype1}$v'
    1541             : 
    1542             :      INTEGER                                  :: handle, ierr, msglen
    1543             : 
    1544       33499 :      ierr = 0
    1545       33499 :      CALL mp_timeset(routineN, handle)
    1546             : 
    1547       33499 :      msglen = SIZE(msg)
    1548             : #if defined(__parallel)
    1549       33499 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_MIN, gid, ierr)
    1550       33499 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1551       33499 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1552             : #else
    1553             :      MARK_USED(gid)
    1554             : #endif
    1555       33499 :      CALL mp_timestop(handle)
    1556       33499 :   END SUBROUTINE mp_min_${nametype1}$v
    1557             : 
    1558             : ! *****************************************************************************
    1559             : !> \brief Multiplies a set of numbers scattered across a number of processes,
    1560             : !>        then replicates the result.
    1561             : !> \param[in,out] msg         a number to multiply (input) and result (output)
    1562             : !> \param[in] gid             message passing environment identifier
    1563             : !> \par MPI mapping
    1564             : !>      mpi_allreduce
    1565             : ! *****************************************************************************
    1566        6288 :   SUBROUTINE mp_prod_${nametype1}$ (msg, gid)
    1567             :      ${type1}$, INTENT(INOUT)                   :: msg
    1568             :      INTEGER, INTENT(IN)                      :: gid
    1569             : 
    1570             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$'
    1571             : 
    1572             :      INTEGER                                  :: handle, ierr, msglen
    1573             : 
    1574        6288 :      ierr = 0
    1575        6288 :      CALL mp_timeset(routineN, handle)
    1576             : 
    1577        6288 :      msglen = 1
    1578             : #if defined(__parallel)
    1579        6288 :      CALL mpi_allreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_PROD, gid, ierr)
    1580        6288 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
    1581        6288 :      CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
    1582             : #else
    1583             :      MARK_USED(msg)
    1584             :      MARK_USED(gid)
    1585             : #endif
    1586        6288 :      CALL mp_timestop(handle)
    1587        6288 :   END SUBROUTINE mp_prod_${nametype1}$
    1588             : 
    1589             : ! *****************************************************************************
    1590             : !> \brief Scatters data from one processes to all others
    1591             : !> \param[in] msg_scatter     Data to scatter (for root process)
    1592             : !> \param[out] msg            Received data
    1593             : !> \param[in] root            Process which scatters data
    1594             : !> \param[in] gid             Message passing environment identifier
    1595             : !> \par MPI mapping
    1596             : !>      mpi_scatter
    1597             : ! *****************************************************************************
    1598           0 :   SUBROUTINE mp_scatter_${nametype1}$v(msg_scatter, msg, root, gid)
    1599             :      ${type1}$, INTENT(IN)                      :: msg_scatter(:)
    1600             :      ${type1}$, INTENT(OUT)                     :: msg(:)
    1601             :      INTEGER, INTENT(IN)                      :: root, gid
    1602             : 
    1603             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_scatter_${nametype1}$v'
    1604             : 
    1605             :      INTEGER                                  :: handle, ierr, msglen
    1606             : 
    1607           0 :      ierr = 0
    1608           0 :      CALL mp_timeset(routineN, handle)
    1609             : 
    1610           0 :      msglen = SIZE(msg)
    1611             : #if defined(__parallel)
    1612             :      CALL mpi_scatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
    1613           0 :                       msglen, ${mpi_type1}$, root, gid, ierr)
    1614           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_scatter @ "//routineN)
    1615           0 :      CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
    1616             : #else
    1617             :      MARK_USED(root)
    1618             :      MARK_USED(gid)
    1619             :      msg = msg_scatter
    1620             : #endif
    1621           0 :      CALL mp_timestop(handle)
    1622           0 :   END SUBROUTINE mp_scatter_${nametype1}$v
    1623             : 
    1624             : ! *****************************************************************************
    1625             : !> \brief Scatters data from one processes to all others
    1626             : !> \param[in] msg_scatter     Data to scatter (for root process)
    1627             : !> \param[in] root            Process which scatters data
    1628             : !> \param[in] gid             Message passing environment identifier
    1629             : !> \par MPI mapping
    1630             : !>      mpi_scatter
    1631             : ! *****************************************************************************
    1632           0 :   SUBROUTINE mp_iscatter_${nametype1}$ (msg_scatter, msg, root, gid, request)
    1633             :      ${type1}$, INTENT(IN)                      :: msg_scatter(:)
    1634             :      ${type1}$, INTENT(INOUT)                   :: msg
    1635             :      INTEGER, INTENT(IN)                      :: root, gid
    1636             :      INTEGER, INTENT(INOUT)                   :: request
    1637             : 
    1638             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatter_${nametype1}$'
    1639             : 
    1640             :      INTEGER                                  :: handle, ierr, msglen
    1641             : 
    1642           0 :      ierr = 0
    1643           0 :      CALL mp_timeset(routineN, handle)
    1644             : 
    1645           0 :      msglen = 1
    1646             : #if defined(__parallel)
    1647             : #if __MPI_VERSION > 2
    1648             :      CALL mpi_iscatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
    1649           0 :                        msglen, ${mpi_type1}$, root, gid, request, ierr)
    1650           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatter @ "//routineN)
    1651           0 :      CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
    1652             : #else
    1653             :      MARK_USED(msg_scatter)
    1654             :      MARK_USED(msg)
    1655             :      MARK_USED(root)
    1656             :      MARK_USED(gid)
    1657             :      request = mp_request_null
    1658             :      CPABORT("mp_iscatter requires MPI-3 standard")
    1659             : #endif
    1660             : #else
    1661             :      MARK_USED(root)
    1662             :      MARK_USED(gid)
    1663             :      msg = msg_scatter(1)
    1664             :      request = mp_request_null
    1665             : #endif
    1666           0 :      CALL mp_timestop(handle)
    1667           0 :   END SUBROUTINE mp_iscatter_${nametype1}$
    1668             : 
    1669             : ! *****************************************************************************
    1670             : !> \brief Scatters data from one processes to all others
    1671             : !> \param[in] msg_scatter     Data to scatter (for root process)
    1672             : !> \param[in] root            Process which scatters data
    1673             : !> \param[in] gid             Message passing environment identifier
    1674             : !> \par MPI mapping
    1675             : !>      mpi_scatter
    1676             : ! *****************************************************************************
    1677           0 :   SUBROUTINE mp_iscatter_${nametype1}$v2(msg_scatter, msg, root, gid, request)
    1678             :      ${type1}$, INTENT(IN)                      :: msg_scatter(:, :)
    1679             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1680             :      INTEGER, INTENT(IN)                      :: root, gid
    1681             :      INTEGER, INTENT(INOUT)                   :: request
    1682             : 
    1683             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatter_${nametype1}$v2'
    1684             : 
    1685             :      INTEGER                                  :: handle, ierr, msglen
    1686             : 
    1687           0 :      ierr = 0
    1688           0 :      CALL mp_timeset(routineN, handle)
    1689             : 
    1690           0 :      msglen = SIZE(msg)
    1691             : #if defined(__parallel)
    1692             : #if __MPI_VERSION > 2
    1693             :      CALL mpi_iscatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
    1694           0 :                        msglen, ${mpi_type1}$, root, gid, request, ierr)
    1695           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatter @ "//routineN)
    1696           0 :      CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
    1697             : #else
    1698             :      MARK_USED(msg_scatter)
    1699             :      MARK_USED(msg)
    1700             :      MARK_USED(root)
    1701             :      MARK_USED(gid)
    1702             :      request = mp_request_null
    1703             :      CPABORT("mp_iscatter requires MPI-3 standard")
    1704             : #endif
    1705             : #else
    1706             :      MARK_USED(root)
    1707             :      MARK_USED(gid)
    1708             :      msg(:) = msg_scatter(:, 1)
    1709             :      request = mp_request_null
    1710             : #endif
    1711           0 :      CALL mp_timestop(handle)
    1712           0 :   END SUBROUTINE mp_iscatter_${nametype1}$v2
    1713             : 
    1714             : ! *****************************************************************************
    1715             : !> \brief Scatters data from one processes to all others
    1716             : !> \param[in] msg_scatter     Data to scatter (for root process)
    1717             : !> \param[in] root            Process which scatters data
    1718             : !> \param[in] gid             Message passing environment identifier
    1719             : !> \par MPI mapping
    1720             : !>      mpi_scatter
    1721             : ! *****************************************************************************
    1722           0 :   SUBROUTINE mp_iscatterv_${nametype1}$v(msg_scatter, sendcounts, displs, msg, recvcount, root, gid, request)
    1723             :      ${type1}$, INTENT(IN)                      :: msg_scatter(:)
    1724             :      INTEGER, INTENT(IN)                      :: sendcounts(:), displs(:)
    1725             :      ${type1}$, INTENT(INOUT)                   :: msg(:)
    1726             :      INTEGER, INTENT(IN)                      :: recvcount, root, gid
    1727             :      INTEGER, INTENT(INOUT)                   :: request
    1728             : 
    1729             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatterv_${nametype1}$v'
    1730             : 
    1731             :      INTEGER                                  :: handle, ierr
    1732             : 
    1733           0 :      ierr = 0
    1734           0 :      CALL mp_timeset(routineN, handle)
    1735             : 
    1736             : #if defined(__parallel)
    1737             : #if __MPI_VERSION > 2
    1738             :      CALL mpi_iscatterv(msg_scatter, sendcounts, displs, ${mpi_type1}$, msg, &
    1739           0 :                         recvcount, ${mpi_type1}$, root, gid, request, ierr)
    1740           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatterv @ "//routineN)
    1741           0 :      CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
    1742             : #else
    1743             :      MARK_USED(msg_scatter)
    1744             :      MARK_USED(sendcounts)
    1745             :      MARK_USED(displs)
    1746             :      MARK_USED(msg)
    1747             :      MARK_USED(recvcount)
    1748             :      MARK_USED(root)
    1749             :      MARK_USED(gid)
    1750             :      request = mp_request_null
    1751             :      CPABORT("mp_iscatterv requires MPI-3 standard")
    1752             : #endif
    1753             : #else
    1754             :      MARK_USED(sendcounts)
    1755             :      MARK_USED(displs)
    1756             :      MARK_USED(recvcount)
    1757             :      MARK_USED(root)
    1758             :      MARK_USED(gid)
    1759             :      msg(1:recvcount) = msg_scatter(1 + displs(1):1 + displs(1) + sendcounts(1))
    1760             :      request = mp_request_null
    1761             : #endif
    1762           0 :      CALL mp_timestop(handle)
    1763           0 :   END SUBROUTINE mp_iscatterv_${nametype1}$v
    1764             : 
    1765             : ! *****************************************************************************
    1766             : !> \brief Gathers a datum from all processes to one
    1767             : !> \param[in] msg             Datum to send to root
    1768             : !> \param[out] msg_gather     Received data (on root)
    1769             : !> \param[in] root            Process which gathers the data
    1770             : !> \param[in] gid             Message passing environment identifier
    1771             : !> \par MPI mapping
    1772             : !>      mpi_gather
    1773             : ! *****************************************************************************
    1774          46 :   SUBROUTINE mp_gather_${nametype1}$ (msg, msg_gather, root, gid)
    1775             :      ${type1}$, INTENT(IN)                      :: msg
    1776             :      ${type1}$, INTENT(OUT)                     :: msg_gather(:)
    1777             :      INTEGER, INTENT(IN)                      :: root, gid
    1778             : 
    1779             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$'
    1780             : 
    1781             :      INTEGER                                  :: handle, ierr, msglen
    1782             : 
    1783          46 :      ierr = 0
    1784          46 :      CALL mp_timeset(routineN, handle)
    1785             : 
    1786          46 :      msglen = 1
    1787             : #if defined(__parallel)
    1788             :      CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
    1789          46 :                      msglen, ${mpi_type1}$, root, gid, ierr)
    1790          46 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
    1791          46 :      CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
    1792             : #else
    1793             :      MARK_USED(root)
    1794             :      MARK_USED(gid)
    1795             :      msg_gather(1) = msg
    1796             : #endif
    1797          46 :      CALL mp_timestop(handle)
    1798          46 :   END SUBROUTINE mp_gather_${nametype1}$
    1799             : 
    1800             : ! *****************************************************************************
    1801             : !> \brief Gathers data from all processes to one
    1802             : !> \param[in] msg             Datum to send to root
    1803             : !> \param msg_gather ...
    1804             : !> \param root ...
    1805             : !> \param gid ...
    1806             : !> \par Data length
    1807             : !>      All data (msg) is equal-sized
    1808             : !> \par MPI mapping
    1809             : !>      mpi_gather
    1810             : !> \note see mp_gather_${nametype1}$
    1811             : ! *****************************************************************************
    1812           0 :   SUBROUTINE mp_gather_${nametype1}$v(msg, msg_gather, root, gid)
    1813             :      ${type1}$, INTENT(IN)                      :: msg(:)
    1814             :      ${type1}$, INTENT(OUT)                     :: msg_gather(:)
    1815             :      INTEGER, INTENT(IN)                      :: root, gid
    1816             : 
    1817             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$v'
    1818             : 
    1819             :      INTEGER                                  :: handle, ierr, msglen
    1820             : 
    1821           0 :      ierr = 0
    1822           0 :      CALL mp_timeset(routineN, handle)
    1823             : 
    1824           0 :      msglen = SIZE(msg)
    1825             : #if defined(__parallel)
    1826             :      CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
    1827           0 :                      msglen, ${mpi_type1}$, root, gid, ierr)
    1828           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
    1829           0 :      CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
    1830             : #else
    1831             :      MARK_USED(root)
    1832             :      MARK_USED(gid)
    1833             :      msg_gather = msg
    1834             : #endif
    1835           0 :      CALL mp_timestop(handle)
    1836           0 :   END SUBROUTINE mp_gather_${nametype1}$v
    1837             : 
    1838             : ! *****************************************************************************
    1839             : !> \brief Gathers data from all processes to one
    1840             : !> \param[in] msg             Datum to send to root
    1841             : !> \param msg_gather ...
    1842             : !> \param root ...
    1843             : !> \param gid ...
    1844             : !> \par Data length
    1845             : !>      All data (msg) is equal-sized
    1846             : !> \par MPI mapping
    1847             : !>      mpi_gather
    1848             : !> \note see mp_gather_${nametype1}$
    1849             : ! *****************************************************************************
    1850          70 :   SUBROUTINE mp_gather_${nametype1}$m(msg, msg_gather, root, gid)
    1851             :      ${type1}$, INTENT(IN)                      :: msg(:, :)
    1852             :      ${type1}$, INTENT(OUT)                     :: msg_gather(:, :)
    1853             :      INTEGER, INTENT(IN)                      :: root, gid
    1854             : 
    1855             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$m'
    1856             : 
    1857             :      INTEGER                                  :: handle, ierr, msglen
    1858             : 
    1859          70 :      ierr = 0
    1860          70 :      CALL mp_timeset(routineN, handle)
    1861             : 
    1862          70 :      msglen = SIZE(msg)
    1863             : #if defined(__parallel)
    1864             :      CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
    1865          70 :                      msglen, ${mpi_type1}$, root, gid, ierr)
    1866          70 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
    1867          70 :      CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
    1868             : #else
    1869             :      MARK_USED(root)
    1870             :      MARK_USED(gid)
    1871             :      msg_gather = msg
    1872             : #endif
    1873          70 :      CALL mp_timestop(handle)
    1874          70 :   END SUBROUTINE mp_gather_${nametype1}$m
    1875             : 
    1876             : ! *****************************************************************************
    1877             : !> \brief Gathers data from all processes to one.
    1878             : !> \param[in] sendbuf         Data to send to root
    1879             : !> \param[out] recvbuf        Received data (on root)
    1880             : !> \param[in] recvcounts      Sizes of data received from processes
    1881             : !> \param[in] displs          Offsets of data received from processes
    1882             : !> \param[in] root            Process which gathers the data
    1883             : !> \param[in] comm            Message passing environment identifier
    1884             : !> \par Data length
    1885             : !>      Data can have different lengths
    1886             : !> \par Offsets
    1887             : !>      Offsets start at 0
    1888             : !> \par MPI mapping
    1889             : !>      mpi_gather
    1890             : ! *****************************************************************************
    1891         322 :   SUBROUTINE mp_gatherv_${nametype1}$v(sendbuf, recvbuf, recvcounts, displs, root, comm)
    1892             : 
    1893             :      ${type1}$, DIMENSION(:), INTENT(IN)        :: sendbuf
    1894             :      ${type1}$, DIMENSION(:), INTENT(OUT)       :: recvbuf
    1895             :      INTEGER, DIMENSION(:), INTENT(IN)        :: recvcounts, displs
    1896             :      INTEGER, INTENT(IN)                      :: root, comm
    1897             : 
    1898             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_gatherv_${nametype1}$v'
    1899             : 
    1900             :      INTEGER                                  :: handle, ierr
    1901             : #if defined(__parallel)
    1902             :      INTEGER                                  :: sendcount
    1903             : #endif
    1904             : 
    1905         322 :      ierr = 0
    1906         322 :      CALL mp_timeset(routineN, handle)
    1907             : 
    1908             : #if defined(__parallel)
    1909         322 :      sendcount = SIZE(sendbuf)
    1910             :      CALL mpi_gatherv(sendbuf, sendcount, ${mpi_type1}$, &
    1911             :                       recvbuf, recvcounts, displs, ${mpi_type1}$, &
    1912         322 :                       root, comm, ierr)
    1913         322 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
    1914             :      CALL add_perf(perf_id=4, &
    1915             :                    count=1, &
    1916         322 :                    msg_size=sendcount*${bytes1}$)
    1917             : #else
    1918             :      MARK_USED(recvcounts)
    1919             :      MARK_USED(root)
    1920             :      MARK_USED(comm)
    1921             :      recvbuf(1 + displs(1):) = sendbuf
    1922             : #endif
    1923         322 :      CALL mp_timestop(handle)
    1924         322 :   END SUBROUTINE mp_gatherv_${nametype1}$v
    1925             : 
    1926             : ! *****************************************************************************
    1927             : !> \brief Gathers data from all processes to one.
    1928             : !> \param[in] sendbuf         Data to send to root
    1929             : !> \param[out] recvbuf        Received data (on root)
    1930             : !> \param[in] recvcounts      Sizes of data received from processes
    1931             : !> \param[in] displs          Offsets of data received from processes
    1932             : !> \param[in] root            Process which gathers the data
    1933             : !> \param[in] comm            Message passing environment identifier
    1934             : !> \par Data length
    1935             : !>      Data can have different lengths
    1936             : !> \par Offsets
    1937             : !>      Offsets start at 0
    1938             : !> \par MPI mapping
    1939             : !>      mpi_gather
    1940             : ! *****************************************************************************
    1941           0 :   SUBROUTINE mp_igatherv_${nametype1}$v(sendbuf, sendcount, recvbuf, recvcounts, displs, root, comm, request)
    1942             :      ${type1}$, DIMENSION(:), INTENT(IN)        :: sendbuf
    1943             :      ${type1}$, DIMENSION(:), INTENT(OUT)       :: recvbuf
    1944             :      INTEGER, DIMENSION(:), INTENT(IN)        :: recvcounts, displs
    1945             :      INTEGER, INTENT(IN)                      :: sendcount, root, comm
    1946             :      INTEGER, INTENT(INOUT)                   :: request
    1947             : 
    1948             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_igatherv_${nametype1}$v'
    1949             : 
    1950             :      INTEGER                                  :: handle, ierr
    1951             : 
    1952           0 :      ierr = 0
    1953           0 :      CALL mp_timeset(routineN, handle)
    1954             : 
    1955             : #if defined(__parallel)
    1956             : #if __MPI_VERSION > 2
    1957             :      CALL mpi_igatherv(sendbuf, sendcount, ${mpi_type1}$, &
    1958             :                        recvbuf, recvcounts, displs, ${mpi_type1}$, &
    1959           0 :                        root, comm, request, ierr)
    1960           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
    1961             :      CALL add_perf(perf_id=24, &
    1962             :                    count=1, &
    1963           0 :                    msg_size=sendcount*${bytes1}$)
    1964             : #else
    1965             :      MARK_USED(sendbuf)
    1966             :      MARK_USED(sendcount)
    1967             :      MARK_USED(recvbuf)
    1968             :      MARK_USED(recvcounts)
    1969             :      MARK_USED(displs)
    1970             :      MARK_USED(root)
    1971             :      MARK_USED(comm)
    1972             :      request = mp_request_null
    1973             :      CPABORT("mp_igatherv requires MPI-3 standard")
    1974             : #endif
    1975             : #else
    1976             :      MARK_USED(sendcount)
    1977             :      MARK_USED(recvcounts)
    1978             :      MARK_USED(root)
    1979             :      MARK_USED(comm)
    1980             :      recvbuf(1 + displs(1):1 + displs(1) + recvcounts(1)) = sendbuf(1:sendcount)
    1981             :      request = mp_request_null
    1982             : #endif
    1983           0 :      CALL mp_timestop(handle)
    1984           0 :   END SUBROUTINE mp_igatherv_${nametype1}$v
    1985             : 
    1986             : ! *****************************************************************************
    1987             : !> \brief Gathers a datum from all processes and all processes receive the
    1988             : !>        same data
    1989             : !> \param[in] msgout          Datum to send
    1990             : !> \param[out] msgin          Received data
    1991             : !> \param[in] gid             Message passing environment identifier
    1992             : !> \par Data size
    1993             : !>      All processes send equal-sized data
    1994             : !> \par MPI mapping
    1995             : !>      mpi_allgather
    1996             : ! *****************************************************************************
    1997      568288 :   SUBROUTINE mp_allgather_${nametype1}$ (msgout, msgin, gid)
    1998             :      ${type1}$, INTENT(IN)                      :: msgout
    1999             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2000             :      INTEGER, INTENT(IN)                      :: gid
    2001             : 
    2002             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$'
    2003             : 
    2004             :      INTEGER                                  :: handle, ierr
    2005             : #if defined(__parallel)
    2006             :      INTEGER                                  :: rcount, scount
    2007             : #endif
    2008             : 
    2009      568288 :      ierr = 0
    2010      568288 :      CALL mp_timeset(routineN, handle)
    2011             : 
    2012             : #if defined(__parallel)
    2013      568288 :      scount = 1
    2014      568288 :      rcount = 1
    2015             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2016             :                         msgin, rcount, ${mpi_type1}$, &
    2017      568288 :                         gid, ierr)
    2018      568288 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2019             : #else
    2020             :      MARK_USED(gid)
    2021             :      msgin = msgout
    2022             : #endif
    2023      568288 :      CALL mp_timestop(handle)
    2024      568288 :   END SUBROUTINE mp_allgather_${nametype1}$
    2025             : 
    2026             : ! *****************************************************************************
    2027             : !> \brief Gathers a datum from all processes and all processes receive the
    2028             : !>        same data
    2029             : !> \param[in] msgout          Datum to send
    2030             : !> \param[out] msgin          Received data
    2031             : !> \param[in] gid             Message passing environment identifier
    2032             : !> \par Data size
    2033             : !>      All processes send equal-sized data
    2034             : !> \par MPI mapping
    2035             : !>      mpi_allgather
    2036             : ! *****************************************************************************
    2037           0 :   SUBROUTINE mp_allgather_${nametype1}$2(msgout, msgin, gid)
    2038             :      ${type1}$, INTENT(IN)                      :: msgout
    2039             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :)
    2040             :      INTEGER, INTENT(IN)                      :: gid
    2041             : 
    2042             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$2'
    2043             : 
    2044             :      INTEGER                                  :: handle, ierr
    2045             : #if defined(__parallel)
    2046             :      INTEGER                                  :: rcount, scount
    2047             : #endif
    2048             : 
    2049           0 :      ierr = 0
    2050           0 :      CALL mp_timeset(routineN, handle)
    2051             : 
    2052             : #if defined(__parallel)
    2053           0 :      scount = 1
    2054           0 :      rcount = 1
    2055             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2056             :                         msgin, rcount, ${mpi_type1}$, &
    2057           0 :                         gid, ierr)
    2058           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2059             : #else
    2060             :      MARK_USED(gid)
    2061             :      msgin = msgout
    2062             : #endif
    2063           0 :      CALL mp_timestop(handle)
    2064           0 :   END SUBROUTINE mp_allgather_${nametype1}$2
    2065             : 
    2066             : ! *****************************************************************************
    2067             : !> \brief Gathers a datum from all processes and all processes receive the
    2068             : !>        same data
    2069             : !> \param[in] msgout          Datum to send
    2070             : !> \param[out] msgin          Received data
    2071             : !> \param[in] gid             Message passing environment identifier
    2072             : !> \par Data size
    2073             : !>      All processes send equal-sized data
    2074             : !> \par MPI mapping
    2075             : !>      mpi_allgather
    2076             : ! *****************************************************************************
    2077           0 :   SUBROUTINE mp_iallgather_${nametype1}$ (msgout, msgin, gid, request)
    2078             :      ${type1}$, INTENT(IN)                      :: msgout
    2079             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2080             :      INTEGER, INTENT(IN)                      :: gid
    2081             :      INTEGER, INTENT(INOUT)                   :: request
    2082             : 
    2083             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$'
    2084             : 
    2085             :      INTEGER                                  :: handle, ierr
    2086             : #if defined(__parallel)
    2087             :      INTEGER                                  :: rcount, scount
    2088             : #endif
    2089             : 
    2090           0 :      ierr = 0
    2091           0 :      CALL mp_timeset(routineN, handle)
    2092             : 
    2093             : #if defined(__parallel)
    2094           0 :      scount = 1
    2095           0 :      rcount = 1
    2096             : #if __MPI_VERSION > 2
    2097             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2098             :                          msgin, rcount, ${mpi_type1}$, &
    2099           0 :                          gid, request, ierr)
    2100           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2101             : #else
    2102             :      MARK_USED(gid)
    2103             :      request = mp_request_null
    2104             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2105             : #endif
    2106             : #else
    2107             :      MARK_USED(gid)
    2108             :      msgin = msgout
    2109             :      request = mp_request_null
    2110             : #endif
    2111           0 :      CALL mp_timestop(handle)
    2112           0 :   END SUBROUTINE mp_iallgather_${nametype1}$
    2113             : 
    2114             : ! *****************************************************************************
    2115             : !> \brief Gathers vector data from all processes and all processes receive the
    2116             : !>        same data
    2117             : !> \param[in] msgout          Rank-1 data to send
    2118             : !> \param[out] msgin          Received data
    2119             : !> \param[in] gid             Message passing environment identifier
    2120             : !> \par Data size
    2121             : !>      All processes send equal-sized data
    2122             : !> \par Ranks
    2123             : !>      The last rank counts the processes
    2124             : !> \par MPI mapping
    2125             : !>      mpi_allgather
    2126             : ! *****************************************************************************
    2127        2628 :   SUBROUTINE mp_allgather_${nametype1}$12(msgout, msgin, gid)
    2128             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2129             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :)
    2130             :      INTEGER, INTENT(IN)                      :: gid
    2131             : 
    2132             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$12'
    2133             : 
    2134             :      INTEGER                                  :: handle, ierr
    2135             : #if defined(__parallel)
    2136             :      INTEGER                                  :: rcount, scount
    2137             : #endif
    2138             : 
    2139        2628 :      ierr = 0
    2140        2628 :      CALL mp_timeset(routineN, handle)
    2141             : 
    2142             : #if defined(__parallel)
    2143        2628 :      scount = SIZE(msgout(:))
    2144        2628 :      rcount = scount
    2145             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2146             :                         msgin, rcount, ${mpi_type1}$, &
    2147        2628 :                         gid, ierr)
    2148        2628 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2149             : #else
    2150             :      MARK_USED(gid)
    2151             :      msgin(:, 1) = msgout(:)
    2152             : #endif
    2153        2628 :      CALL mp_timestop(handle)
    2154        2628 :   END SUBROUTINE mp_allgather_${nametype1}$12
    2155             : 
    2156             : ! *****************************************************************************
    2157             : !> \brief Gathers matrix data from all processes and all processes receive the
    2158             : !>        same data
    2159             : !> \param[in] msgout          Rank-2 data to send
    2160             : !> \param msgin ...
    2161             : !> \param gid ...
    2162             : !> \note see mp_allgather_${nametype1}$12
    2163             : ! *****************************************************************************
    2164       88262 :   SUBROUTINE mp_allgather_${nametype1}$23(msgout, msgin, gid)
    2165             :      ${type1}$, INTENT(IN)                      :: msgout(:, :)
    2166             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :, :)
    2167             :      INTEGER, INTENT(IN)                      :: gid
    2168             : 
    2169             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$23'
    2170             : 
    2171             :      INTEGER                                  :: handle, ierr
    2172             : #if defined(__parallel)
    2173             :      INTEGER                                  :: rcount, scount
    2174             : #endif
    2175             : 
    2176       88262 :      ierr = 0
    2177       88262 :      CALL mp_timeset(routineN, handle)
    2178             : 
    2179             : #if defined(__parallel)
    2180       88262 :      scount = SIZE(msgout(:, :))
    2181       88262 :      rcount = scount
    2182             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2183             :                         msgin, rcount, ${mpi_type1}$, &
    2184       88262 :                         gid, ierr)
    2185       88262 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2186             : #else
    2187             :      MARK_USED(gid)
    2188             :      msgin(:, :, 1) = msgout(:, :)
    2189             : #endif
    2190       88262 :      CALL mp_timestop(handle)
    2191       88262 :   END SUBROUTINE mp_allgather_${nametype1}$23
    2192             : 
    2193             : ! *****************************************************************************
    2194             : !> \brief Gathers rank-3 data from all processes and all processes receive the
    2195             : !>        same data
    2196             : !> \param[in] msgout          Rank-3 data to send
    2197             : !> \param msgin ...
    2198             : !> \param gid ...
    2199             : !> \note see mp_allgather_${nametype1}$12
    2200             : ! *****************************************************************************
    2201         342 :   SUBROUTINE mp_allgather_${nametype1}$34(msgout, msgin, gid)
    2202             :      ${type1}$, INTENT(IN)                      :: msgout(:, :, :)
    2203             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :, :, :)
    2204             :      INTEGER, INTENT(IN)                      :: gid
    2205             : 
    2206             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$34'
    2207             : 
    2208             :      INTEGER                                  :: handle, ierr
    2209             : #if defined(__parallel)
    2210             :      INTEGER                                  :: rcount, scount
    2211             : #endif
    2212             : 
    2213         342 :      ierr = 0
    2214         342 :      CALL mp_timeset(routineN, handle)
    2215             : 
    2216             : #if defined(__parallel)
    2217         342 :      scount = SIZE(msgout(:, :, :))
    2218         342 :      rcount = scount
    2219             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2220             :                         msgin, rcount, ${mpi_type1}$, &
    2221         342 :                         gid, ierr)
    2222         342 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2223             : #else
    2224             :      MARK_USED(gid)
    2225             :      msgin(:, :, :, 1) = msgout(:, :, :)
    2226             : #endif
    2227         342 :      CALL mp_timestop(handle)
    2228         342 :   END SUBROUTINE mp_allgather_${nametype1}$34
    2229             : 
    2230             : ! *****************************************************************************
    2231             : !> \brief Gathers rank-2 data from all processes and all processes receive the
    2232             : !>        same data
    2233             : !> \param[in] msgout          Rank-2 data to send
    2234             : !> \param msgin ...
    2235             : !> \param gid ...
    2236             : !> \note see mp_allgather_${nametype1}$12
    2237             : ! *****************************************************************************
    2238           0 :   SUBROUTINE mp_allgather_${nametype1}$22(msgout, msgin, gid)
    2239             :      ${type1}$, INTENT(IN)                      :: msgout(:, :)
    2240             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :)
    2241             :      INTEGER, INTENT(IN)                      :: gid
    2242             : 
    2243             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$22'
    2244             : 
    2245             :      INTEGER                                  :: handle, ierr
    2246             : #if defined(__parallel)
    2247             :      INTEGER                                  :: rcount, scount
    2248             : #endif
    2249             : 
    2250           0 :      ierr = 0
    2251           0 :      CALL mp_timeset(routineN, handle)
    2252             : 
    2253             : #if defined(__parallel)
    2254           0 :      scount = SIZE(msgout(:, :))
    2255           0 :      rcount = scount
    2256             :      CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
    2257             :                         msgin, rcount, ${mpi_type1}$, &
    2258           0 :                         gid, ierr)
    2259           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
    2260             : #else
    2261             :      MARK_USED(gid)
    2262             :      msgin(:, :) = msgout(:, :)
    2263             : #endif
    2264           0 :      CALL mp_timestop(handle)
    2265           0 :   END SUBROUTINE mp_allgather_${nametype1}$22
    2266             : 
    2267             : ! *****************************************************************************
    2268             : !> \brief Gathers rank-1 data from all processes and all processes receive the
    2269             : !>        same data
    2270             : !> \param[in] msgout          Rank-1 data to send
    2271             : !> \param msgin ...
    2272             : !> \param gid ...
    2273             : !> \param request ...
    2274             : !> \note see mp_allgather_${nametype1}$11
    2275             : ! *****************************************************************************
    2276           0 :   SUBROUTINE mp_iallgather_${nametype1}$11(msgout, msgin, gid, request)
    2277             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2278             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2279             :      INTEGER, INTENT(IN)                      :: gid
    2280             :      INTEGER, INTENT(OUT)                     :: request
    2281             : 
    2282             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$11'
    2283             : 
    2284             :      INTEGER                                  :: handle, ierr
    2285             : #if defined(__parallel)
    2286             :      INTEGER                                  :: rcount, scount
    2287             : #endif
    2288             : 
    2289           0 :      ierr = 0
    2290           0 :      CALL mp_timeset(routineN, handle)
    2291             : 
    2292             : #if defined(__parallel)
    2293             : #if __MPI_VERSION > 2
    2294           0 :      scount = SIZE(msgout(:))
    2295           0 :      rcount = scount
    2296             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2297             :                          msgin, rcount, ${mpi_type1}$, &
    2298           0 :                          gid, request, ierr)
    2299           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
    2300             : #else
    2301             :      MARK_USED(msgout)
    2302             :      MARK_USED(msgin)
    2303             :      MARK_USED(rcount)
    2304             :      MARK_USED(scount)
    2305             :      MARK_USED(gid)
    2306             :      request = mp_request_null
    2307             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2308             : #endif
    2309             : #else
    2310             :      MARK_USED(gid)
    2311             :      msgin = msgout
    2312             :      request = mp_request_null
    2313             : #endif
    2314           0 :      CALL mp_timestop(handle)
    2315           0 :   END SUBROUTINE mp_iallgather_${nametype1}$11
    2316             : 
    2317             : ! *****************************************************************************
    2318             : !> \brief Gathers rank-2 data from all processes and all processes receive the
    2319             : !>        same data
    2320             : !> \param[in] msgout          Rank-2 data to send
    2321             : !> \param msgin ...
    2322             : !> \param gid ...
    2323             : !> \param request ...
    2324             : !> \note see mp_allgather_${nametype1}$12
    2325             : ! *****************************************************************************
    2326           0 :   SUBROUTINE mp_iallgather_${nametype1}$13(msgout, msgin, gid, request)
    2327             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2328             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :, :)
    2329             :      INTEGER, INTENT(IN)                      :: gid
    2330             :      INTEGER, INTENT(OUT)                     :: request
    2331             : 
    2332             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$13'
    2333             : 
    2334             :      INTEGER                                  :: handle, ierr
    2335             : #if defined(__parallel)
    2336             :      INTEGER                                  :: rcount, scount
    2337             : #endif
    2338             : 
    2339           0 :      ierr = 0
    2340           0 :      CALL mp_timeset(routineN, handle)
    2341             : 
    2342             : #if defined(__parallel)
    2343             : #if __MPI_VERSION > 2
    2344           0 :      scount = SIZE(msgout(:))
    2345           0 :      rcount = scount
    2346             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2347             :                          msgin, rcount, ${mpi_type1}$, &
    2348           0 :                          gid, request, ierr)
    2349           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
    2350             : #else
    2351             :      MARK_USED(msgout)
    2352             :      MARK_USED(msgin)
    2353             :      MARK_USED(rcount)
    2354             :      MARK_USED(scount)
    2355             :      MARK_USED(gid)
    2356             :      request = mp_request_null
    2357             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2358             : #endif
    2359             : #else
    2360             :      MARK_USED(gid)
    2361             :      msgin(:, 1, 1) = msgout(:)
    2362             :      request = mp_request_null
    2363             : #endif
    2364           0 :      CALL mp_timestop(handle)
    2365           0 :   END SUBROUTINE mp_iallgather_${nametype1}$13
    2366             : 
    2367             : ! *****************************************************************************
    2368             : !> \brief Gathers rank-2 data from all processes and all processes receive the
    2369             : !>        same data
    2370             : !> \param[in] msgout          Rank-2 data to send
    2371             : !> \param msgin ...
    2372             : !> \param gid ...
    2373             : !> \param request ...
    2374             : !> \note see mp_allgather_${nametype1}$12
    2375             : ! *****************************************************************************
    2376           0 :   SUBROUTINE mp_iallgather_${nametype1}$22(msgout, msgin, gid, request)
    2377             :      ${type1}$, INTENT(IN)                      :: msgout(:, :)
    2378             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :)
    2379             :      INTEGER, INTENT(IN)                      :: gid
    2380             :      INTEGER, INTENT(OUT)                     :: request
    2381             : 
    2382             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$22'
    2383             : 
    2384             :      INTEGER                                  :: handle, ierr
    2385             : #if defined(__parallel)
    2386             :      INTEGER                                  :: rcount, scount
    2387             : #endif
    2388             : 
    2389           0 :      ierr = 0
    2390           0 :      CALL mp_timeset(routineN, handle)
    2391             : 
    2392             : #if defined(__parallel)
    2393             : #if __MPI_VERSION > 2
    2394           0 :      scount = SIZE(msgout(:, :))
    2395           0 :      rcount = scount
    2396             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2397             :                          msgin, rcount, ${mpi_type1}$, &
    2398           0 :                          gid, request, ierr)
    2399           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
    2400             : #else
    2401             :      MARK_USED(msgout)
    2402             :      MARK_USED(msgin)
    2403             :      MARK_USED(rcount)
    2404             :      MARK_USED(scount)
    2405             :      MARK_USED(gid)
    2406             :      request = mp_request_null
    2407             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2408             : #endif
    2409             : #else
    2410             :      MARK_USED(gid)
    2411             :      msgin(:, :) = msgout(:, :)
    2412             :      request = mp_request_null
    2413             : #endif
    2414           0 :      CALL mp_timestop(handle)
    2415           0 :   END SUBROUTINE mp_iallgather_${nametype1}$22
    2416             : 
    2417             : ! *****************************************************************************
    2418             : !> \brief Gathers rank-2 data from all processes and all processes receive the
    2419             : !>        same data
    2420             : !> \param[in] msgout          Rank-2 data to send
    2421             : !> \param msgin ...
    2422             : !> \param gid ...
    2423             : !> \param request ...
    2424             : !> \note see mp_allgather_${nametype1}$12
    2425             : ! *****************************************************************************
    2426           0 :   SUBROUTINE mp_iallgather_${nametype1}$24(msgout, msgin, gid, request)
    2427             :      ${type1}$, INTENT(IN)                      :: msgout(:, :)
    2428             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :, :, :)
    2429             :      INTEGER, INTENT(IN)                      :: gid
    2430             :      INTEGER, INTENT(OUT)                     :: request
    2431             : 
    2432             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$24'
    2433             : 
    2434             :      INTEGER                                  :: handle, ierr
    2435             : #if defined(__parallel)
    2436             :      INTEGER                                  :: rcount, scount
    2437             : #endif
    2438             : 
    2439           0 :      ierr = 0
    2440           0 :      CALL mp_timeset(routineN, handle)
    2441             : 
    2442             : #if defined(__parallel)
    2443             : #if __MPI_VERSION > 2
    2444           0 :      scount = SIZE(msgout(:, :))
    2445           0 :      rcount = scount
    2446             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2447             :                          msgin, rcount, ${mpi_type1}$, &
    2448           0 :                          gid, request, ierr)
    2449           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
    2450             : #else
    2451             :      MARK_USED(msgout)
    2452             :      MARK_USED(msgin)
    2453             :      MARK_USED(rcount)
    2454             :      MARK_USED(scount)
    2455             :      MARK_USED(gid)
    2456             :      request = mp_request_null
    2457             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2458             : #endif
    2459             : #else
    2460             :      MARK_USED(gid)
    2461             :      msgin(:, :, 1, 1) = msgout(:, :)
    2462             :      request = mp_request_null
    2463             : #endif
    2464           0 :      CALL mp_timestop(handle)
    2465           0 :   END SUBROUTINE mp_iallgather_${nametype1}$24
    2466             : 
    2467             : ! *****************************************************************************
    2468             : !> \brief Gathers rank-3 data from all processes and all processes receive the
    2469             : !>        same data
    2470             : !> \param[in] msgout          Rank-3 data to send
    2471             : !> \param msgin ...
    2472             : !> \param gid ...
    2473             : !> \param request ...
    2474             : !> \note see mp_allgather_${nametype1}$12
    2475             : ! *****************************************************************************
    2476           0 :   SUBROUTINE mp_iallgather_${nametype1}$33(msgout, msgin, gid, request)
    2477             :      ${type1}$, INTENT(IN)                      :: msgout(:, :, :)
    2478             :      ${type1}$, INTENT(OUT)                     :: msgin(:, :, :)
    2479             :      INTEGER, INTENT(IN)                      :: gid
    2480             :      INTEGER, INTENT(OUT)                     :: request
    2481             : 
    2482             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$33'
    2483             : 
    2484             :      INTEGER                                  :: handle, ierr
    2485             : #if defined(__parallel)
    2486             :      INTEGER                                  :: rcount, scount
    2487             : #endif
    2488             : 
    2489           0 :      ierr = 0
    2490           0 :      CALL mp_timeset(routineN, handle)
    2491             : 
    2492             : #if defined(__parallel)
    2493             : #if __MPI_VERSION > 2
    2494           0 :      scount = SIZE(msgout(:, :, :))
    2495           0 :      rcount = scount
    2496             :      CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
    2497             :                          msgin, rcount, ${mpi_type1}$, &
    2498           0 :                          gid, request, ierr)
    2499             : #else
    2500             :      MARK_USED(msgout)
    2501             :      MARK_USED(msgin)
    2502             :      MARK_USED(rcount)
    2503             :      MARK_USED(scount)
    2504             :      MARK_USED(gid)
    2505             :      request = mp_request_null
    2506             :      CPABORT("mp_iallgather requires MPI-3 standard")
    2507             : #endif
    2508           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
    2509             : #else
    2510             :      MARK_USED(gid)
    2511             :      msgin(:, :, :) = msgout(:, :, :)
    2512             :      request = mp_request_null
    2513             : #endif
    2514           0 :      CALL mp_timestop(handle)
    2515           0 :   END SUBROUTINE mp_iallgather_${nametype1}$33
    2516             : 
    2517             : ! *****************************************************************************
    2518             : !> \brief Gathers vector data from all processes and all processes receive the
    2519             : !>        same data
    2520             : !> \param[in] msgout          Rank-1 data to send
    2521             : !> \param[out] msgin          Received data
    2522             : !> \param[in] rcount          Size of sent data for every process
    2523             : !> \param[in] rdispl          Offset of sent data for every process
    2524             : !> \param[in] gid             Message passing environment identifier
    2525             : !> \par Data size
    2526             : !>      Processes can send different-sized data
    2527             : !> \par Ranks
    2528             : !>      The last rank counts the processes
    2529             : !> \par Offsets
    2530             : !>      Offsets are from 0
    2531             : !> \par MPI mapping
    2532             : !>      mpi_allgather
    2533             : ! *****************************************************************************
    2534      264056 :   SUBROUTINE mp_allgatherv_${nametype1}$v(msgout, msgin, rcount, rdispl, gid)
    2535             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2536             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2537             :      INTEGER, INTENT(IN)                      :: rcount(:), rdispl(:), gid
    2538             : 
    2539             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgatherv_${nametype1}$v'
    2540             : 
    2541             :      INTEGER                                  :: handle, ierr
    2542             : #if defined(__parallel)
    2543             :      INTEGER                                  :: scount
    2544             : #endif
    2545             : 
    2546      264056 :      ierr = 0
    2547      264056 :      CALL mp_timeset(routineN, handle)
    2548             : 
    2549             : #if defined(__parallel)
    2550      264056 :      scount = SIZE(msgout)
    2551             :      CALL MPI_ALLGATHERV(msgout, scount, ${mpi_type1}$, msgin, rcount, &
    2552      264056 :                          rdispl, ${mpi_type1}$, gid, ierr)
    2553      264056 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgatherv @ "//routineN)
    2554             : #else
    2555             :      MARK_USED(rcount)
    2556             :      MARK_USED(rdispl)
    2557             :      MARK_USED(gid)
    2558             :      msgin = msgout
    2559             : #endif
    2560      264056 :      CALL mp_timestop(handle)
    2561      264056 :   END SUBROUTINE mp_allgatherv_${nametype1}$v
    2562             : 
    2563             : ! *****************************************************************************
    2564             : !> \brief Gathers vector data from all processes and all processes receive the
    2565             : !>        same data
    2566             : !> \param[in] msgout          Rank-1 data to send
    2567             : !> \param[out] msgin          Received data
    2568             : !> \param[in] rcount          Size of sent data for every process
    2569             : !> \param[in] rdispl          Offset of sent data for every process
    2570             : !> \param[in] gid             Message passing environment identifier
    2571             : !> \par Data size
    2572             : !>      Processes can send different-sized data
    2573             : !> \par Ranks
    2574             : !>      The last rank counts the processes
    2575             : !> \par Offsets
    2576             : !>      Offsets are from 0
    2577             : !> \par MPI mapping
    2578             : !>      mpi_allgather
    2579             : ! *****************************************************************************
    2580           0 :   SUBROUTINE mp_iallgatherv_${nametype1}$v(msgout, msgin, rcount, rdispl, gid, request)
    2581             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2582             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2583             :      INTEGER, INTENT(IN)                      :: rcount(:), rdispl(:), gid
    2584             :      INTEGER, INTENT(INOUT)                   :: request
    2585             : 
    2586             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgatherv_${nametype1}$v'
    2587             : 
    2588             :      INTEGER                                  :: handle, ierr
    2589             : #if defined(__parallel)
    2590             :      INTEGER                                  :: scount, rsize
    2591             : #endif
    2592             : 
    2593           0 :      ierr = 0
    2594           0 :      CALL mp_timeset(routineN, handle)
    2595             : 
    2596             : #if defined(__parallel)
    2597           0 :      scount = SIZE(msgout)
    2598           0 :      rsize = SIZE(rcount)
    2599             : #if __MPI_VERSION > 2
    2600             :      CALL mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, &
    2601           0 :                                                  rdispl, gid, request, ierr)
    2602           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgatherv @ "//routineN)
    2603             : #else
    2604             :      MARK_USED(rcount)
    2605             :      MARK_USED(rdispl)
    2606             :      MARK_USED(gid)
    2607             :      MARK_USED(msgin)
    2608             :      request = mp_request_null
    2609             :      CPABORT("mp_iallgatherv requires MPI-3 standard")
    2610             : #endif
    2611             : #else
    2612             :      MARK_USED(rcount)
    2613             :      MARK_USED(rdispl)
    2614             :      MARK_USED(gid)
    2615             :      msgin = msgout
    2616             :      request = mp_request_null
    2617             : #endif
    2618           0 :      CALL mp_timestop(handle)
    2619           0 :   END SUBROUTINE mp_iallgatherv_${nametype1}$v
    2620             : 
    2621             : ! *****************************************************************************
    2622             : !> \brief Gathers vector data from all processes and all processes receive the
    2623             : !>        same data
    2624             : !> \param[in] msgout          Rank-1 data to send
    2625             : !> \param[out] msgin          Received data
    2626             : !> \param[in] rcount          Size of sent data for every process
    2627             : !> \param[in] rdispl          Offset of sent data for every process
    2628             : !> \param[in] gid             Message passing environment identifier
    2629             : !> \par Data size
    2630             : !>      Processes can send different-sized data
    2631             : !> \par Ranks
    2632             : !>      The last rank counts the processes
    2633             : !> \par Offsets
    2634             : !>      Offsets are from 0
    2635             : !> \par MPI mapping
    2636             : !>      mpi_allgather
    2637             : ! *****************************************************************************
    2638           0 :   SUBROUTINE mp_iallgatherv_${nametype1}$v2(msgout, msgin, rcount, rdispl, gid, request)
    2639             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2640             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2641             :      INTEGER, INTENT(IN)                      :: rcount(:, :), rdispl(:, :), gid
    2642             :      INTEGER, INTENT(INOUT)                   :: request
    2643             : 
    2644             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgatherv_${nametype1}$v2'
    2645             : 
    2646             :      INTEGER                                  :: handle, ierr
    2647             : #if defined(__parallel)
    2648             :      INTEGER                                  :: scount, rsize
    2649             : #endif
    2650             : 
    2651           0 :      ierr = 0
    2652           0 :      CALL mp_timeset(routineN, handle)
    2653             : 
    2654             : #if defined(__parallel)
    2655           0 :      scount = SIZE(msgout)
    2656           0 :      rsize = SIZE(rcount)
    2657             : #if __MPI_VERSION > 2
    2658             :      CALL mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, &
    2659           0 :                                                  rdispl, gid, request, ierr)
    2660           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgatherv @ "//routineN)
    2661             : #else
    2662             :      MARK_USED(rcount)
    2663             :      MARK_USED(rdispl)
    2664             :      MARK_USED(gid)
    2665             :      MARK_USED(msgin)
    2666             :      request = mp_request_null
    2667             :      CPABORT("mp_iallgatherv requires MPI-3 standard")
    2668             : #endif
    2669             : #else
    2670             :      MARK_USED(rcount)
    2671             :      MARK_USED(rdispl)
    2672             :      MARK_USED(gid)
    2673             :      msgin = msgout
    2674             :      request = mp_request_null
    2675             : #endif
    2676           0 :      CALL mp_timestop(handle)
    2677           0 :   END SUBROUTINE mp_iallgatherv_${nametype1}$v2
    2678             : 
    2679             : ! **************************************************************************************************
    2680             : !> \brief wrapper needed to deal with interfaces as present in openmpi 1.8.1
    2681             : !>        the issue is with the rank of rcount and rdispl
    2682             : !> \param count ...
    2683             : !> \param array_of_requests ...
    2684             : !> \param array_of_statuses ...
    2685             : !> \param ierr ...
    2686             : !> \author Alfio Lazzaro
    2687             : ! **************************************************************************************************
    2688             : #if defined(__parallel) && (__MPI_VERSION > 2)
    2689           0 :   SUBROUTINE mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, rdispl, gid, request, ierr)
    2690             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2691             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2692             :      INTEGER, INTENT(IN)                      :: rsize
    2693             :      INTEGER, INTENT(IN)                      :: rcount(rsize), rdispl(rsize), gid, scount
    2694             :      INTEGER, INTENT(INOUT)                   :: request, ierr
    2695             : 
    2696             :      CALL MPI_IALLGATHERV(msgout, scount, ${mpi_type1}$, msgin, rcount, &
    2697           0 :                           rdispl, ${mpi_type1}$, gid, request, ierr)
    2698             : 
    2699           0 :   END SUBROUTINE mp_iallgatherv_${nametype1}$v_internal
    2700             : #endif
    2701             : 
    2702             : ! *****************************************************************************
    2703             : !> \brief Sums a vector and partitions the result among processes
    2704             : !> \param[in] msgout          Data to sum
    2705             : !> \param[out] msgin          Received portion of summed data
    2706             : !> \param[in] rcount          Partition sizes of the summed data for
    2707             : !>                            every process
    2708             : !> \param[in] gid             Message passing environment identifier
    2709             : ! *****************************************************************************
    2710           0 :   SUBROUTINE mp_sum_scatter_${nametype1}$v(msgout, msgin, rcount, gid)
    2711             :      ${type1}$, INTENT(IN)                      :: msgout(:)
    2712             :      ${type1}$, INTENT(OUT)                     :: msgin(:)
    2713             :      INTEGER, INTENT(IN)                      :: rcount(:), gid
    2714             : 
    2715             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_scatter_${nametype1}$v'
    2716             : 
    2717             :      INTEGER                                  :: handle, ierr
    2718             : 
    2719           0 :      ierr = 0
    2720           0 :      CALL mp_timeset(routineN, handle)
    2721             : 
    2722             : #if defined(__parallel)
    2723             :      CALL MPI_REDUCE_SCATTER(msgout, msgin, rcount, ${mpi_type1}$, MPI_SUM, &
    2724           0 :                              gid, ierr)
    2725           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce_scatter @ "//routineN)
    2726             : 
    2727             :      CALL add_perf(perf_id=3, count=1, &
    2728           0 :                    msg_size=rcount(1)*2*${bytes1}$)
    2729             : #else
    2730             :      MARK_USED(rcount)
    2731             :      MARK_USED(gid)
    2732             :      msgin = msgout
    2733             : #endif
    2734           0 :      CALL mp_timestop(handle)
    2735           0 :   END SUBROUTINE mp_sum_scatter_${nametype1}$v
    2736             : 
    2737             : ! *****************************************************************************
    2738             : !> \brief Sends and receives vector data
    2739             : !> \param[in] msgin           Data to send
    2740             : !> \param[in] dest            Process to send data to
    2741             : !> \param[out] msgout         Received data
    2742             : !> \param[in] source          Process from which to receive
    2743             : !> \param[in] comm            Message passing environment identifier
    2744             : !> \param[in] tag             Send and recv tag (default: 0)
    2745             : ! *****************************************************************************
    2746          54 :   SUBROUTINE mp_sendrecv_${nametype1}$v(msgin, dest, msgout, source, comm, tag)
    2747             :      ${type1}$, INTENT(IN)                      :: msgin(:)
    2748             :      INTEGER, INTENT(IN)                      :: dest
    2749             :      ${type1}$, INTENT(OUT)                     :: msgout(:)
    2750             :      INTEGER, INTENT(IN)                      :: source, comm
    2751             :      INTEGER, INTENT(IN), OPTIONAL            :: tag
    2752             : 
    2753             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$v'
    2754             : 
    2755             :      INTEGER                                  :: handle, ierr
    2756             : #if defined(__parallel)
    2757             :      INTEGER                                  :: msglen_in, msglen_out, &
    2758             :                                                  recv_tag, send_tag
    2759             : #endif
    2760             : 
    2761          54 :      ierr = 0
    2762          54 :      CALL mp_timeset(routineN, handle)
    2763             : 
    2764             : #if defined(__parallel)
    2765          54 :      msglen_in = SIZE(msgin)
    2766          54 :      msglen_out = SIZE(msgout)
    2767          54 :      send_tag = 0 ! cannot think of something better here, this might be dangerous
    2768          54 :      recv_tag = 0 ! cannot think of something better here, this might be dangerous
    2769          54 :      IF (PRESENT(tag)) THEN
    2770           0 :         send_tag = tag
    2771           0 :         recv_tag = tag
    2772             :      END IF
    2773             :      CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
    2774          54 :                        msglen_out, ${mpi_type1}$, source, recv_tag, comm, MPI_STATUS_IGNORE, ierr)
    2775          54 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
    2776             :      CALL add_perf(perf_id=7, count=1, &
    2777          54 :                    msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
    2778             : #else
    2779             :      MARK_USED(dest)
    2780             :      MARK_USED(source)
    2781             :      MARK_USED(comm)
    2782             :      MARK_USED(tag)
    2783             :      msgout = msgin
    2784             : #endif
    2785          54 :      CALL mp_timestop(handle)
    2786          54 :   END SUBROUTINE mp_sendrecv_${nametype1}$v
    2787             : 
    2788             : ! *****************************************************************************
    2789             : !> \brief Sends and receives matrix data
    2790             : !> \param msgin ...
    2791             : !> \param dest ...
    2792             : !> \param msgout ...
    2793             : !> \param source ...
    2794             : !> \param comm ...
    2795             : !> \param tag ...
    2796             : !> \note see mp_sendrecv_${nametype1}$v
    2797             : ! *****************************************************************************
    2798      146626 :   SUBROUTINE mp_sendrecv_${nametype1}$m2(msgin, dest, msgout, source, comm, tag)
    2799             :      ${type1}$, INTENT(IN)                      :: msgin(:, :)
    2800             :      INTEGER, INTENT(IN)                      :: dest
    2801             :      ${type1}$, INTENT(OUT)                     :: msgout(:, :)
    2802             :      INTEGER, INTENT(IN)                      :: source, comm
    2803             :      INTEGER, INTENT(IN), OPTIONAL            :: tag
    2804             : 
    2805             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m2'
    2806             : 
    2807             :      INTEGER                                  :: handle, ierr
    2808             : #if defined(__parallel)
    2809             :      INTEGER                                  :: msglen_in, msglen_out, &
    2810             :                                                  recv_tag, send_tag
    2811             : #endif
    2812             : 
    2813      146626 :      ierr = 0
    2814      146626 :      CALL mp_timeset(routineN, handle)
    2815             : 
    2816             : #if defined(__parallel)
    2817      146626 :      msglen_in = SIZE(msgin, 1)*SIZE(msgin, 2)
    2818      146626 :      msglen_out = SIZE(msgout, 1)*SIZE(msgout, 2)
    2819      146626 :      send_tag = 0 ! cannot think of something better here, this might be dangerous
    2820      146626 :      recv_tag = 0 ! cannot think of something better here, this might be dangerous
    2821      146626 :      IF (PRESENT(tag)) THEN
    2822           0 :         send_tag = tag
    2823           0 :         recv_tag = tag
    2824             :      END IF
    2825             :      CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
    2826      199086 :                        msglen_out, ${mpi_type1}$, source, recv_tag, comm, MPI_STATUS_IGNORE, ierr)
    2827      146626 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
    2828             :      CALL add_perf(perf_id=7, count=1, &
    2829      146626 :                    msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
    2830             : #else
    2831             :      MARK_USED(dest)
    2832             :      MARK_USED(source)
    2833             :      MARK_USED(comm)
    2834             :      MARK_USED(tag)
    2835             :      msgout = msgin
    2836             : #endif
    2837      146626 :      CALL mp_timestop(handle)
    2838      146626 :   END SUBROUTINE mp_sendrecv_${nametype1}$m2
    2839             : 
    2840             : ! *****************************************************************************
    2841             : !> \brief Sends and receives rank-3 data
    2842             : !> \param msgin ...
    2843             : !> \param dest ...
    2844             : !> \param msgout ...
    2845             : !> \param source ...
    2846             : !> \param comm ...
    2847             : !> \note see mp_sendrecv_${nametype1}$v
    2848             : ! *****************************************************************************
    2849       89066 :   SUBROUTINE mp_sendrecv_${nametype1}$m3(msgin, dest, msgout, source, comm, tag)
    2850             :      ${type1}$, INTENT(IN)                      :: msgin(:, :, :)
    2851             :      INTEGER, INTENT(IN)                      :: dest
    2852             :      ${type1}$, INTENT(OUT)                     :: msgout(:, :, :)
    2853             :      INTEGER, INTENT(IN)                      :: source, comm
    2854             :      INTEGER, INTENT(IN), OPTIONAL            :: tag
    2855             : 
    2856             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m3'
    2857             : 
    2858             :      INTEGER                                  :: handle, ierr
    2859             : #if defined(__parallel)
    2860             :      INTEGER                                  :: msglen_in, msglen_out, &
    2861             :                                                  recv_tag, send_tag
    2862             : #endif
    2863             : 
    2864       89066 :      ierr = 0
    2865       89066 :      CALL mp_timeset(routineN, handle)
    2866             : 
    2867             : #if defined(__parallel)
    2868       89066 :      msglen_in = SIZE(msgin)
    2869       89066 :      msglen_out = SIZE(msgout)
    2870       89066 :      send_tag = 0 ! cannot think of something better here, this might be dangerous
    2871       89066 :      recv_tag = 0 ! cannot think of something better here, this might be dangerous
    2872       89066 :      IF (PRESENT(tag)) THEN
    2873         610 :         send_tag = tag
    2874         610 :         recv_tag = tag
    2875             :      END IF
    2876             :      CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
    2877       89066 :                        msglen_out, ${mpi_type1}$, source, recv_tag, comm, MPI_STATUS_IGNORE, ierr)
    2878       89066 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
    2879             :      CALL add_perf(perf_id=7, count=1, &
    2880       89066 :                    msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
    2881             : #else
    2882             :      MARK_USED(dest)
    2883             :      MARK_USED(source)
    2884             :      MARK_USED(comm)
    2885             :      MARK_USED(tag)
    2886             :      msgout = msgin
    2887             : #endif
    2888       89066 :      CALL mp_timestop(handle)
    2889       89066 :   END SUBROUTINE mp_sendrecv_${nametype1}$m3
    2890             : 
    2891             : ! *****************************************************************************
    2892             : !> \brief Sends and receives rank-4 data
    2893             : !> \param msgin ...
    2894             : !> \param dest ...
    2895             : !> \param msgout ...
    2896             : !> \param source ...
    2897             : !> \param comm ...
    2898             : !> \note see mp_sendrecv_${nametype1}$v
    2899             : ! *****************************************************************************
    2900           0 :   SUBROUTINE mp_sendrecv_${nametype1}$m4(msgin, dest, msgout, source, comm, tag)
    2901             :      ${type1}$, INTENT(IN)                      :: msgin(:, :, :, :)
    2902             :      INTEGER, INTENT(IN)                      :: dest
    2903             :      ${type1}$, INTENT(OUT)                     :: msgout(:, :, :, :)
    2904             :      INTEGER, INTENT(IN)                      :: source, comm
    2905             :      INTEGER, INTENT(IN), OPTIONAL            :: tag
    2906             : 
    2907             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m4'
    2908             : 
    2909             :      INTEGER                                  :: handle, ierr
    2910             : #if defined(__parallel)
    2911             :      INTEGER                                  :: msglen_in, msglen_out, &
    2912             :                                                  recv_tag, send_tag
    2913             : #endif
    2914             : 
    2915           0 :      ierr = 0
    2916           0 :      CALL mp_timeset(routineN, handle)
    2917             : 
    2918             : #if defined(__parallel)
    2919           0 :      msglen_in = SIZE(msgin)
    2920           0 :      msglen_out = SIZE(msgout)
    2921           0 :      send_tag = 0 ! cannot think of something better here, this might be dangerous
    2922           0 :      recv_tag = 0 ! cannot think of something better here, this might be dangerous
    2923           0 :      IF (PRESENT(tag)) THEN
    2924           0 :         send_tag = tag
    2925           0 :         recv_tag = tag
    2926             :      END IF
    2927             :      CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
    2928           0 :                        msglen_out, ${mpi_type1}$, source, recv_tag, comm, MPI_STATUS_IGNORE, ierr)
    2929           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
    2930             :      CALL add_perf(perf_id=7, count=1, &
    2931           0 :                    msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
    2932             : #else
    2933             :      MARK_USED(dest)
    2934             :      MARK_USED(source)
    2935             :      MARK_USED(comm)
    2936             :      MARK_USED(tag)
    2937             :      msgout = msgin
    2938             : #endif
    2939           0 :      CALL mp_timestop(handle)
    2940           0 :   END SUBROUTINE mp_sendrecv_${nametype1}$m4
    2941             : 
    2942             : ! *****************************************************************************
    2943             : !> \brief Non-blocking send and receive of a scalar
    2944             : !> \param[in] msgin           Scalar data to send
    2945             : !> \param[in] dest            Which process to send to
    2946             : !> \param[out] msgout         Receive data into this pointer
    2947             : !> \param[in] source          Process to receive from
    2948             : !> \param[in] comm            Message passing environment identifier
    2949             : !> \param[out] send_request   Request handle for the send
    2950             : !> \param[out] recv_request   Request handle for the receive
    2951             : !> \param[in] tag             (optional) tag to differentiate requests
    2952             : !> \par Implementation
    2953             : !>      Calls mpi_isend and mpi_irecv.
    2954             : !> \par History
    2955             : !>      02.2005 created [Alfio Lazzaro]
    2956             : ! *****************************************************************************
    2957           0 :   SUBROUTINE mp_isendrecv_${nametype1}$ (msgin, dest, msgout, source, comm, send_request, &
    2958             :                                          recv_request, tag)
    2959             :      ${type1}$                                  :: msgin
    2960             :      INTEGER, INTENT(IN)                      :: dest
    2961             :      ${type1}$                                  :: msgout
    2962             :      INTEGER, INTENT(IN)                      :: source, comm
    2963             :      INTEGER, INTENT(out)                     :: send_request, recv_request
    2964             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    2965             : 
    2966             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isendrecv_${nametype1}$'
    2967             : 
    2968             :      INTEGER                                  :: handle, ierr
    2969             : #if defined(__parallel)
    2970             :      INTEGER                                  :: my_tag
    2971             : #endif
    2972             : 
    2973           0 :      ierr = 0
    2974           0 :      CALL mp_timeset(routineN, handle)
    2975             : 
    2976             : #if defined(__parallel)
    2977           0 :      my_tag = 0
    2978           0 :      IF (PRESENT(tag)) my_tag = tag
    2979             : 
    2980             :      CALL mpi_irecv(msgout, 1, ${mpi_type1}$, source, my_tag, &
    2981           0 :                     comm, recv_request, ierr)
    2982           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
    2983             : 
    2984             :      CALL mpi_isend(msgin, 1, ${mpi_type1}$, dest, my_tag, &
    2985           0 :                     comm, send_request, ierr)
    2986           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    2987             : 
    2988           0 :      CALL add_perf(perf_id=8, count=1, msg_size=2*${bytes1}$)
    2989             : #else
    2990             :      MARK_USED(dest)
    2991             :      MARK_USED(source)
    2992             :      MARK_USED(comm)
    2993             :      MARK_USED(tag)
    2994             :      send_request = 0
    2995             :      recv_request = 0
    2996             :      msgout = msgin
    2997             : #endif
    2998           0 :      CALL mp_timestop(handle)
    2999           0 :   END SUBROUTINE mp_isendrecv_${nametype1}$
    3000             : 
    3001             : ! *****************************************************************************
    3002             : !> \brief Non-blocking send and receive of a vector
    3003             : !> \param[in] msgin           Vector data to send
    3004             : !> \param[in] dest            Which process to send to
    3005             : !> \param[out] msgout         Receive data into this pointer
    3006             : !> \param[in] source          Process to receive from
    3007             : !> \param[in] comm            Message passing environment identifier
    3008             : !> \param[out] send_request   Request handle for the send
    3009             : !> \param[out] recv_request   Request handle for the receive
    3010             : !> \param[in] tag             (optional) tag to differentiate requests
    3011             : !> \par Implementation
    3012             : !>      Calls mpi_isend and mpi_irecv.
    3013             : !> \par History
    3014             : !>      11.2004 created [Joost VandeVondele]
    3015             : !> \note
    3016             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3017             : ! *****************************************************************************
    3018      971116 :   SUBROUTINE mp_isendrecv_${nametype1}$v(msgin, dest, msgout, source, comm, send_request, &
    3019             :                                          recv_request, tag)
    3020             :      ${type1}$, DIMENSION(:)                    :: msgin
    3021             :      INTEGER, INTENT(IN)                      :: dest
    3022             :      ${type1}$, DIMENSION(:)                    :: msgout
    3023             :      INTEGER, INTENT(IN)                      :: source, comm
    3024             :      INTEGER, INTENT(out)                     :: send_request, recv_request
    3025             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3026             : 
    3027             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isendrecv_${nametype1}$v'
    3028             : 
    3029             :      INTEGER                                  :: handle, ierr
    3030             : #if defined(__parallel)
    3031             :      INTEGER                                  :: msglen, my_tag
    3032             :      ${type1}$                                  :: foo
    3033             : #endif
    3034             : 
    3035      971116 :      ierr = 0
    3036      971116 :      CALL mp_timeset(routineN, handle)
    3037             : 
    3038             : #if defined(__parallel)
    3039      971116 :      my_tag = 0
    3040      971116 :      IF (PRESENT(tag)) my_tag = tag
    3041             : 
    3042      971116 :      msglen = SIZE(msgout, 1)
    3043      971116 :      IF (msglen > 0) THEN
    3044             :         CALL mpi_irecv(msgout(1), msglen, ${mpi_type1}$, source, my_tag, &
    3045      971116 :                        comm, recv_request, ierr)
    3046             :      ELSE
    3047             :         CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
    3048           0 :                        comm, recv_request, ierr)
    3049             :      END IF
    3050      971116 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
    3051             : 
    3052      971116 :      msglen = SIZE(msgin, 1)
    3053      971116 :      IF (msglen > 0) THEN
    3054             :         CALL mpi_isend(msgin(1), msglen, ${mpi_type1}$, dest, my_tag, &
    3055      971116 :                        comm, send_request, ierr)
    3056             :      ELSE
    3057             :         CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
    3058           0 :                        comm, send_request, ierr)
    3059             :      END IF
    3060      971116 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    3061             : 
    3062      971116 :      msglen = (msglen + SIZE(msgout, 1) + 1)/2
    3063      971116 :      CALL add_perf(perf_id=8, count=1, msg_size=msglen*${bytes1}$)
    3064             : #else
    3065             :      MARK_USED(dest)
    3066             :      MARK_USED(source)
    3067             :      MARK_USED(comm)
    3068             :      MARK_USED(tag)
    3069             :      send_request = 0
    3070             :      recv_request = 0
    3071             :      msgout = msgin
    3072             : #endif
    3073      971116 :      CALL mp_timestop(handle)
    3074      971116 :   END SUBROUTINE mp_isendrecv_${nametype1}$v
    3075             : 
    3076             : ! *****************************************************************************
    3077             : !> \brief Non-blocking send of vector data
    3078             : !> \param msgin ...
    3079             : !> \param dest ...
    3080             : !> \param comm ...
    3081             : !> \param request ...
    3082             : !> \param tag ...
    3083             : !> \par History
    3084             : !>      08.2003 created [f&j]
    3085             : !> \note see mp_isendrecv_${nametype1}$v
    3086             : !> \note
    3087             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3088             : ! *****************************************************************************
    3089      848357 :   SUBROUTINE mp_isend_${nametype1}$v(msgin, dest, comm, request, tag)
    3090             :      ${type1}$, DIMENSION(:)                    :: msgin
    3091             :      INTEGER, INTENT(IN)                      :: dest, comm
    3092             :      INTEGER, INTENT(out)                     :: request
    3093             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3094             : 
    3095             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$v'
    3096             : 
    3097             :      INTEGER                                  :: handle, ierr
    3098             : #if defined(__parallel)
    3099             :      INTEGER                                  :: msglen, my_tag
    3100             :      ${type1}$                                  :: foo(1)
    3101             : #endif
    3102             : 
    3103      848357 :      ierr = 0
    3104      848357 :      CALL mp_timeset(routineN, handle)
    3105             : 
    3106             : #if defined(__parallel)
    3107      848357 :      my_tag = 0
    3108      848357 :      IF (PRESENT(tag)) my_tag = tag
    3109             : 
    3110      848357 :      msglen = SIZE(msgin)
    3111      848357 :      IF (msglen > 0) THEN
    3112             :         CALL mpi_isend(msgin(1), msglen, ${mpi_type1}$, dest, my_tag, &
    3113      848327 :                        comm, request, ierr)
    3114             :      ELSE
    3115             :         CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
    3116          30 :                        comm, request, ierr)
    3117             :      END IF
    3118      848357 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    3119             : 
    3120      848357 :      CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
    3121             : #else
    3122             :      MARK_USED(msgin)
    3123             :      MARK_USED(dest)
    3124             :      MARK_USED(comm)
    3125             :      MARK_USED(request)
    3126             :      MARK_USED(tag)
    3127             :      ierr = 1
    3128             :      request = 0
    3129             :      CALL mp_stop(ierr, "mp_isend called in non parallel case")
    3130             : #endif
    3131      848357 :      CALL mp_timestop(handle)
    3132      848357 :   END SUBROUTINE mp_isend_${nametype1}$v
    3133             : 
    3134             : ! *****************************************************************************
    3135             : !> \brief Non-blocking send of matrix data
    3136             : !> \param msgin ...
    3137             : !> \param dest ...
    3138             : !> \param comm ...
    3139             : !> \param request ...
    3140             : !> \param tag ...
    3141             : !> \par History
    3142             : !>      2009-11-25 [UB] Made type-generic for templates
    3143             : !> \author fawzi
    3144             : !> \note see mp_isendrecv_${nametype1}$v
    3145             : !> \note see mp_isend_${nametype1}$v
    3146             : !> \note
    3147             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3148             : ! *****************************************************************************
    3149      280799 :   SUBROUTINE mp_isend_${nametype1}$m2(msgin, dest, comm, request, tag)
    3150             :      ${type1}$, DIMENSION(:, :)                 :: msgin
    3151             :      INTEGER, INTENT(IN)                      :: dest, comm
    3152             :      INTEGER, INTENT(out)                     :: request
    3153             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3154             : 
    3155             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m2'
    3156             : 
    3157             :      INTEGER                                  :: handle, ierr
    3158             : #if defined(__parallel)
    3159             :      INTEGER                                  :: msglen, my_tag
    3160             :      ${type1}$                                  :: foo(1)
    3161             : #endif
    3162             : 
    3163      280799 :      ierr = 0
    3164      280799 :      CALL mp_timeset(routineN, handle)
    3165             : 
    3166             : #if defined(__parallel)
    3167      280799 :      my_tag = 0
    3168      280799 :      IF (PRESENT(tag)) my_tag = tag
    3169             : 
    3170      280799 :      msglen = SIZE(msgin, 1)*SIZE(msgin, 2)
    3171      280799 :      IF (msglen > 0) THEN
    3172             :         CALL mpi_isend(msgin(1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
    3173      280799 :                        comm, request, ierr)
    3174             :      ELSE
    3175             :         CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
    3176           0 :                        comm, request, ierr)
    3177             :      END IF
    3178      280799 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    3179             : 
    3180      280799 :      CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
    3181             : #else
    3182             :      MARK_USED(msgin)
    3183             :      MARK_USED(dest)
    3184             :      MARK_USED(comm)
    3185             :      MARK_USED(request)
    3186             :      MARK_USED(tag)
    3187             :      ierr = 1
    3188             :      request = 0
    3189             :      CALL mp_stop(ierr, "mp_isend called in non parallel case")
    3190             : #endif
    3191      280799 :      CALL mp_timestop(handle)
    3192      280799 :   END SUBROUTINE mp_isend_${nametype1}$m2
    3193             : 
    3194             : ! *****************************************************************************
    3195             : !> \brief Non-blocking send of rank-3 data
    3196             : !> \param msgin ...
    3197             : !> \param dest ...
    3198             : !> \param comm ...
    3199             : !> \param request ...
    3200             : !> \param tag ...
    3201             : !> \par History
    3202             : !>      9.2008 added _rm3 subroutine [Iain Bethune]
    3203             : !>     (c) The Numerical Algorithms Group (NAG) Ltd, 2008 on behalf of the HECToR project
    3204             : !>      2009-11-25 [UB] Made type-generic for templates
    3205             : !> \author fawzi
    3206             : !> \note see mp_isendrecv_${nametype1}$v
    3207             : !> \note see mp_isend_${nametype1}$v
    3208             : !> \note
    3209             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3210             : ! *****************************************************************************
    3211        8282 :   SUBROUTINE mp_isend_${nametype1}$m3(msgin, dest, comm, request, tag)
    3212             :      ${type1}$, DIMENSION(:, :, :)              :: msgin
    3213             :      INTEGER, INTENT(IN)                      :: dest, comm
    3214             :      INTEGER, INTENT(out)                     :: request
    3215             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3216             : 
    3217             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m3'
    3218             : 
    3219             :      INTEGER                                  :: handle, ierr
    3220             : #if defined(__parallel)
    3221             :      INTEGER                                  :: msglen, my_tag
    3222             :      ${type1}$                                  :: foo(1)
    3223             : #endif
    3224             : 
    3225        8282 :      ierr = 0
    3226        8282 :      CALL mp_timeset(routineN, handle)
    3227             : 
    3228             : #if defined(__parallel)
    3229        8282 :      my_tag = 0
    3230        8282 :      IF (PRESENT(tag)) my_tag = tag
    3231             : 
    3232        8282 :      msglen = SIZE(msgin, 1)*SIZE(msgin, 2)*SIZE(msgin, 3)
    3233        8282 :      IF (msglen > 0) THEN
    3234             :         CALL mpi_isend(msgin(1, 1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
    3235        8282 :                        comm, request, ierr)
    3236             :      ELSE
    3237             :         CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
    3238           0 :                        comm, request, ierr)
    3239             :      END IF
    3240        8282 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    3241             : 
    3242        8282 :      CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
    3243             : #else
    3244             :      MARK_USED(msgin)
    3245             :      MARK_USED(dest)
    3246             :      MARK_USED(comm)
    3247             :      MARK_USED(request)
    3248             :      MARK_USED(tag)
    3249             :      ierr = 1
    3250             :      request = 0
    3251             :      CALL mp_stop(ierr, "mp_isend called in non parallel case")
    3252             : #endif
    3253        8282 :      CALL mp_timestop(handle)
    3254        8282 :   END SUBROUTINE mp_isend_${nametype1}$m3
    3255             : 
    3256             : ! *****************************************************************************
    3257             : !> \brief Non-blocking send of rank-4 data
    3258             : !> \param msgin the input message
    3259             : !> \param dest the destination processor
    3260             : !> \param comm the communicator object
    3261             : !> \param request the communication request id
    3262             : !> \param tag the message tag
    3263             : !> \par History
    3264             : !>      2.2016 added _${nametype1}$m4 subroutine [Nico Holmberg]
    3265             : !> \author fawzi
    3266             : !> \note see mp_isend_${nametype1}$v
    3267             : !> \note
    3268             : !>     arrays can be pointers or assumed shape, but they must be contiguous!
    3269             : ! *****************************************************************************
    3270          56 :   SUBROUTINE mp_isend_${nametype1}$m4(msgin, dest, comm, request, tag)
    3271             :      ${type1}$, DIMENSION(:, :, :, :)           :: msgin
    3272             :      INTEGER, INTENT(IN)                      :: dest, comm
    3273             :      INTEGER, INTENT(out)                     :: request
    3274             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3275             : 
    3276             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m4'
    3277             : 
    3278             :      INTEGER                                  :: handle, ierr
    3279             : #if defined(__parallel)
    3280             :      INTEGER                                  :: msglen, my_tag
    3281             :      ${type1}$                                  :: foo(1)
    3282             : #endif
    3283             : 
    3284          56 :      ierr = 0
    3285          56 :      CALL mp_timeset(routineN, handle)
    3286             : 
    3287             : #if defined(__parallel)
    3288          56 :      my_tag = 0
    3289          56 :      IF (PRESENT(tag)) my_tag = tag
    3290             : 
    3291          56 :      msglen = SIZE(msgin, 1)*SIZE(msgin, 2)*SIZE(msgin, 3)*SIZE(msgin, 4)
    3292          56 :      IF (msglen > 0) THEN
    3293             :         CALL mpi_isend(msgin(1, 1, 1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
    3294          56 :                        comm, request, ierr)
    3295             :      ELSE
    3296             :         CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
    3297           0 :                        comm, request, ierr)
    3298             :      END IF
    3299          56 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
    3300             : 
    3301          56 :      CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
    3302             : #else
    3303             :      MARK_USED(msgin)
    3304             :      MARK_USED(dest)
    3305             :      MARK_USED(comm)
    3306             :      MARK_USED(request)
    3307             :      MARK_USED(tag)
    3308             :      ierr = 1
    3309             :      request = 0
    3310             :      CALL mp_stop(ierr, "mp_isend called in non parallel case")
    3311             : #endif
    3312          56 :      CALL mp_timestop(handle)
    3313          56 :   END SUBROUTINE mp_isend_${nametype1}$m4
    3314             : 
    3315             : ! *****************************************************************************
    3316             : !> \brief Non-blocking receive of vector data
    3317             : !> \param msgout ...
    3318             : !> \param source ...
    3319             : !> \param comm ...
    3320             : !> \param request ...
    3321             : !> \param tag ...
    3322             : !> \par History
    3323             : !>      08.2003 created [f&j]
    3324             : !>      2009-11-25 [UB] Made type-generic for templates
    3325             : !> \note see mp_isendrecv_${nametype1}$v
    3326             : !> \note
    3327             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3328             : ! *****************************************************************************
    3329      848377 :   SUBROUTINE mp_irecv_${nametype1}$v(msgout, source, comm, request, tag)
    3330             :      ${type1}$, DIMENSION(:)                    :: msgout
    3331             :      INTEGER, INTENT(IN)                      :: source, comm
    3332             :      INTEGER, INTENT(out)                     :: request
    3333             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3334             : 
    3335             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$v'
    3336             : 
    3337             :      INTEGER                                  :: handle, ierr
    3338             : #if defined(__parallel)
    3339             :      INTEGER                                  :: msglen, my_tag
    3340             :      ${type1}$                                  :: foo(1)
    3341             : #endif
    3342             : 
    3343      848377 :      ierr = 0
    3344      848377 :      CALL mp_timeset(routineN, handle)
    3345             : 
    3346             : #if defined(__parallel)
    3347      848377 :      my_tag = 0
    3348      848377 :      IF (PRESENT(tag)) my_tag = tag
    3349             : 
    3350      848377 :      msglen = SIZE(msgout)
    3351      848377 :      IF (msglen > 0) THEN
    3352             :         CALL mpi_irecv(msgout(1), msglen, ${mpi_type1}$, source, my_tag, &
    3353      848332 :                        comm, request, ierr)
    3354             :      ELSE
    3355             :         CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
    3356          45 :                        comm, request, ierr)
    3357             :      END IF
    3358      848377 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
    3359             : 
    3360      848377 :      CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
    3361             : #else
    3362             :      CPABORT("mp_irecv called in non parallel case")
    3363             :      MARK_USED(msgout)
    3364             :      MARK_USED(source)
    3365             :      MARK_USED(comm)
    3366             :      MARK_USED(request)
    3367             :      MARK_USED(tag)
    3368             :      request = 0
    3369             : #endif
    3370      848377 :      CALL mp_timestop(handle)
    3371      848377 :   END SUBROUTINE mp_irecv_${nametype1}$v
    3372             : 
    3373             : ! *****************************************************************************
    3374             : !> \brief Non-blocking receive of matrix data
    3375             : !> \param msgout ...
    3376             : !> \param source ...
    3377             : !> \param comm ...
    3378             : !> \param request ...
    3379             : !> \param tag ...
    3380             : !> \par History
    3381             : !>      2009-11-25 [UB] Made type-generic for templates
    3382             : !> \author fawzi
    3383             : !> \note see mp_isendrecv_${nametype1}$v
    3384             : !> \note see mp_irecv_${nametype1}$v
    3385             : !> \note
    3386             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3387             : ! *****************************************************************************
    3388      280799 :   SUBROUTINE mp_irecv_${nametype1}$m2(msgout, source, comm, request, tag)
    3389             :      ${type1}$, DIMENSION(:, :)                 :: msgout
    3390             :      INTEGER, INTENT(IN)                      :: source, comm
    3391             :      INTEGER, INTENT(out)                     :: request
    3392             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3393             : 
    3394             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m2'
    3395             : 
    3396             :      INTEGER                                  :: handle, ierr
    3397             : #if defined(__parallel)
    3398             :      INTEGER                                  :: msglen, my_tag
    3399             :      ${type1}$                                  :: foo(1)
    3400             : #endif
    3401             : 
    3402      280799 :      ierr = 0
    3403      280799 :      CALL mp_timeset(routineN, handle)
    3404             : 
    3405             : #if defined(__parallel)
    3406      280799 :      my_tag = 0
    3407      280799 :      IF (PRESENT(tag)) my_tag = tag
    3408             : 
    3409      280799 :      msglen = SIZE(msgout, 1)*SIZE(msgout, 2)
    3410      280799 :      IF (msglen > 0) THEN
    3411             :         CALL mpi_irecv(msgout(1, 1), msglen, ${mpi_type1}$, source, my_tag, &
    3412      280799 :                        comm, request, ierr)
    3413             :      ELSE
    3414             :         CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
    3415           0 :                        comm, request, ierr)
    3416             :      END IF
    3417      280799 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
    3418             : 
    3419      280799 :      CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
    3420             : #else
    3421             :      MARK_USED(msgout)
    3422             :      MARK_USED(source)
    3423             :      MARK_USED(comm)
    3424             :      MARK_USED(request)
    3425             :      MARK_USED(tag)
    3426             :      request = 0
    3427             :      CPABORT("mp_irecv called in non parallel case")
    3428             : #endif
    3429      280799 :      CALL mp_timestop(handle)
    3430      280799 :   END SUBROUTINE mp_irecv_${nametype1}$m2
    3431             : 
    3432             : ! *****************************************************************************
    3433             : !> \brief Non-blocking send of rank-3 data
    3434             : !> \param msgout ...
    3435             : !> \param source ...
    3436             : !> \param comm ...
    3437             : !> \param request ...
    3438             : !> \param tag ...
    3439             : !> \par History
    3440             : !>      9.2008 added _rm3 subroutine [Iain Bethune] (c) The Numerical Algorithms Group (NAG) Ltd, 2008 on behalf of the HECToR project
    3441             : !>      2009-11-25 [UB] Made type-generic for templates
    3442             : !> \author fawzi
    3443             : !> \note see mp_isendrecv_${nametype1}$v
    3444             : !> \note see mp_irecv_${nametype1}$v
    3445             : !> \note
    3446             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3447             : ! *****************************************************************************
    3448        8282 :   SUBROUTINE mp_irecv_${nametype1}$m3(msgout, source, comm, request, tag)
    3449             :      ${type1}$, DIMENSION(:, :, :)              :: msgout
    3450             :      INTEGER, INTENT(IN)                      :: source, comm
    3451             :      INTEGER, INTENT(out)                     :: request
    3452             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3453             : 
    3454             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m3'
    3455             : 
    3456             :      INTEGER                                  :: handle, ierr
    3457             : #if defined(__parallel)
    3458             :      INTEGER                                  :: msglen, my_tag
    3459             :      ${type1}$                                  :: foo(1)
    3460             : #endif
    3461             : 
    3462        8282 :      ierr = 0
    3463        8282 :      CALL mp_timeset(routineN, handle)
    3464             : 
    3465             : #if defined(__parallel)
    3466        8282 :      my_tag = 0
    3467        8282 :      IF (PRESENT(tag)) my_tag = tag
    3468             : 
    3469        8282 :      msglen = SIZE(msgout, 1)*SIZE(msgout, 2)*SIZE(msgout, 3)
    3470        8282 :      IF (msglen > 0) THEN
    3471             :         CALL mpi_irecv(msgout(1, 1, 1), msglen, ${mpi_type1}$, source, my_tag, &
    3472        8282 :                        comm, request, ierr)
    3473             :      ELSE
    3474             :         CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
    3475           0 :                        comm, request, ierr)
    3476             :      END IF
    3477        8282 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN)
    3478             : 
    3479        8282 :      CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
    3480             : #else
    3481             :      MARK_USED(msgout)
    3482             :      MARK_USED(source)
    3483             :      MARK_USED(comm)
    3484             :      MARK_USED(request)
    3485             :      MARK_USED(tag)
    3486             :      request = 0
    3487             :      CPABORT("mp_irecv called in non parallel case")
    3488             : #endif
    3489        8282 :      CALL mp_timestop(handle)
    3490        8282 :   END SUBROUTINE mp_irecv_${nametype1}$m3
    3491             : 
    3492             : ! *****************************************************************************
    3493             : !> \brief Non-blocking receive of rank-4 data
    3494             : !> \param msgout the output message
    3495             : !> \param source the source processor
    3496             : !> \param comm the communicator object
    3497             : !> \param request the communication request id
    3498             : !> \param tag the message tag
    3499             : !> \par History
    3500             : !>      2.2016 added _${nametype1}$m4 subroutine [Nico Holmberg]
    3501             : !> \author fawzi
    3502             : !> \note see mp_irecv_${nametype1}$v
    3503             : !> \note
    3504             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3505             : ! *****************************************************************************
    3506          56 :   SUBROUTINE mp_irecv_${nametype1}$m4(msgout, source, comm, request, tag)
    3507             :      ${type1}$, DIMENSION(:, :, :, :)           :: msgout
    3508             :      INTEGER, INTENT(IN)                      :: source, comm
    3509             :      INTEGER, INTENT(out)                     :: request
    3510             :      INTEGER, INTENT(in), OPTIONAL            :: tag
    3511             : 
    3512             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m4'
    3513             : 
    3514             :      INTEGER                                  :: handle, ierr
    3515             : #if defined(__parallel)
    3516             :      INTEGER                                  :: msglen, my_tag
    3517             :      ${type1}$                                  :: foo(1)
    3518             : #endif
    3519             : 
    3520          56 :      ierr = 0
    3521          56 :      CALL mp_timeset(routineN, handle)
    3522             : 
    3523             : #if defined(__parallel)
    3524          56 :      my_tag = 0
    3525          56 :      IF (PRESENT(tag)) my_tag = tag
    3526             : 
    3527          56 :      msglen = SIZE(msgout, 1)*SIZE(msgout, 2)*SIZE(msgout, 3)*SIZE(msgout, 4)
    3528          56 :      IF (msglen > 0) THEN
    3529             :         CALL mpi_irecv(msgout(1, 1, 1, 1), msglen, ${mpi_type1}$, source, my_tag, &
    3530          56 :                        comm, request, ierr)
    3531             :      ELSE
    3532             :         CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
    3533           0 :                        comm, request, ierr)
    3534             :      END IF
    3535          56 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN)
    3536             : 
    3537          56 :      CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
    3538             : #else
    3539             :      MARK_USED(msgout)
    3540             :      MARK_USED(source)
    3541             :      MARK_USED(comm)
    3542             :      MARK_USED(request)
    3543             :      MARK_USED(tag)
    3544             :      request = 0
    3545             :      CPABORT("mp_irecv called in non parallel case")
    3546             : #endif
    3547          56 :      CALL mp_timestop(handle)
    3548          56 :   END SUBROUTINE mp_irecv_${nametype1}$m4
    3549             : 
    3550             : ! *****************************************************************************
    3551             : !> \brief Window initialization function for vector data
    3552             : !> \param base ...
    3553             : !> \param comm ...
    3554             : !> \param win ...
    3555             : !> \par History
    3556             : !>      02.2015 created [Alfio Lazzaro]
    3557             : !> \note
    3558             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3559             : ! *****************************************************************************
    3560           0 :   SUBROUTINE mp_win_create_${nametype1}$v(base, comm, win)
    3561             :      ${type1}$, DIMENSION(:)          :: base
    3562             :      INTEGER, INTENT(IN)            :: comm
    3563             :      INTEGER, INTENT(INOUT)         :: win
    3564             : 
    3565             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_win_create_${nametype1}$v'
    3566             : 
    3567             :      INTEGER                                  :: ierr, handle
    3568             : #if defined(__parallel)
    3569             :      INTEGER(kind=mpi_address_kind)           :: len
    3570             :      ${type1}$                                  :: foo(1)
    3571             : #endif
    3572             : 
    3573           0 :      ierr = 0
    3574           0 :      CALL mp_timeset(routineN, handle)
    3575             : 
    3576             : #if defined(__parallel)
    3577             : 
    3578           0 :      len = SIZE(base)*${bytes1}$
    3579           0 :      IF (len > 0) THEN
    3580           0 :         CALL mpi_win_create(base(1), len, ${bytes1}$, MPI_INFO_NULL, comm, win, ierr)
    3581             :      ELSE
    3582           0 :         CALL mpi_win_create(foo, len, ${bytes1}$, MPI_INFO_NULL, comm, win, ierr)
    3583             :      ENDIF
    3584           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_win_create @ "//routineN)
    3585             : 
    3586           0 :      CALL add_perf(perf_id=20, count=1)
    3587             : #else
    3588             :      MARK_USED(base)
    3589             :      MARK_USED(comm)
    3590             :      win = mp_win_null
    3591             : #endif
    3592           0 :      CALL mp_timestop(handle)
    3593           0 :   END SUBROUTINE mp_win_create_${nametype1}$v
    3594             : 
    3595             : ! *****************************************************************************
    3596             : !> \brief Single-sided get function for vector data
    3597             : !> \param base ...
    3598             : !> \param comm ...
    3599             : !> \param win ...
    3600             : !> \par History
    3601             : !>      02.2015 created [Alfio Lazzaro]
    3602             : !> \note
    3603             : !>      arrays can be pointers or assumed shape, but they must be contiguous!
    3604             : ! *****************************************************************************
    3605           0 :   SUBROUTINE mp_rget_${nametype1}$v(base, source, win, win_data, myproc, disp, request, &
    3606             :                                     origin_datatype, target_datatype)
    3607             :      ${type1}$, DIMENSION(:)                               :: base
    3608             :      INTEGER, INTENT(IN)                                 :: source, win
    3609             :      ${type1}$, DIMENSION(:)                               :: win_data
    3610             :      INTEGER, INTENT(IN), OPTIONAL                       :: myproc, disp
    3611             :      INTEGER, INTENT(OUT)                                :: request
    3612             :      TYPE(mp_type_descriptor_type), INTENT(IN), OPTIONAL :: origin_datatype, target_datatype
    3613             : 
    3614             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_rget_${nametype1}$v'
    3615             : 
    3616             :      INTEGER                                  :: ierr, handle
    3617             : #if defined(__parallel) && (__MPI_VERSION > 2)
    3618             :      INTEGER                                  :: len, &
    3619             :                                                  handle_origin_datatype, &
    3620             :                                                  handle_target_datatype, &
    3621             :                                                  origin_len, target_len
    3622             :      LOGICAL                                  :: do_local_copy
    3623             :      INTEGER(kind=mpi_address_kind)           :: disp_aint
    3624             : #endif
    3625             : 
    3626           0 :      ierr = 0
    3627           0 :      CALL mp_timeset(routineN, handle)
    3628             : 
    3629             : #if defined(__parallel)
    3630             : #if __MPI_VERSION > 2
    3631           0 :      len = SIZE(base)
    3632           0 :      disp_aint = 0
    3633           0 :      IF (PRESENT(disp)) THEN
    3634           0 :         disp_aint = INT(disp, KIND=mpi_address_kind)
    3635             :      ENDIF
    3636           0 :      handle_origin_datatype = ${mpi_type1}$
    3637           0 :      origin_len = len
    3638           0 :      IF (PRESENT(origin_datatype)) THEN
    3639           0 :         handle_origin_datatype = origin_datatype%type_handle
    3640           0 :         origin_len = 1
    3641             :      ENDIF
    3642           0 :      handle_target_datatype = ${mpi_type1}$
    3643           0 :      target_len = len
    3644           0 :      IF (PRESENT(target_datatype)) THEN
    3645           0 :         handle_target_datatype = target_datatype%type_handle
    3646           0 :         target_len = 1
    3647             :      ENDIF
    3648           0 :      IF (len > 0) THEN
    3649           0 :         do_local_copy = .FALSE.
    3650           0 :         IF (PRESENT(myproc) .AND. .NOT. PRESENT(origin_datatype) .AND. .NOT. PRESENT(target_datatype)) THEN
    3651           0 :            IF (myproc .EQ. source) do_local_copy = .TRUE.
    3652             :         ENDIF
    3653             :         IF (do_local_copy) THEN
    3654           0 :            !$OMP PARALLEL WORKSHARE DEFAULT(none) SHARED(base,win_data,disp_aint,len)
    3655             :            base(:) = win_data(disp_aint + 1:disp_aint + len)
    3656             :            !$OMP END PARALLEL WORKSHARE
    3657           0 :            request = mp_request_null
    3658             :            ierr = 0
    3659             :         ELSE
    3660             :            CALL mpi_rget(base(1), origin_len, handle_origin_datatype, source, disp_aint, &
    3661           0 :                          target_len, handle_target_datatype, win, request, ierr)
    3662             :         ENDIF
    3663             :      ELSE
    3664           0 :         request = mp_request_null
    3665             :         ierr = 0
    3666             :      ENDIF
    3667             : #else
    3668             :      MARK_USED(source)
    3669             :      MARK_USED(win)
    3670             :      MARK_USED(disp)
    3671             :      MARK_USED(myproc)
    3672             :      MARK_USED(origin_datatype)
    3673             :      MARK_USED(target_datatype)
    3674             :      MARK_USED(win_data)
    3675             : 
    3676             :      request = mp_request_null
    3677             :      CPABORT("mp_rget requires MPI-3 standard")
    3678             : #endif
    3679           0 :      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_rget @ "//routineN)
    3680             : 
    3681           0 :      CALL add_perf(perf_id=25, count=1, msg_size=SIZE(base)*${bytes1}$)
    3682             : #else
    3683             :      MARK_USED(source)
    3684             :      MARK_USED(win)
    3685             :      MARK_USED(myproc)
    3686             :      MARK_USED(origin_datatype)
    3687             :      MARK_USED(target_datatype)
    3688             : 
    3689             :      request = mp_request_null
    3690             :      !
    3691             :      IF (PRESENT(disp)) THEN
    3692             :         base(:) = win_data(disp + 1:disp + SIZE(base))
    3693             :      ELSE
    3694             :         base(:) = win_data(:SIZE(base))
    3695             :      ENDIF
    3696             : 
    3697             : #endif
    3698           0 :      CALL mp_timestop(handle)
    3699           0 :   END SUBROUTINE mp_rget_${nametype1}$v
    3700             : 
    3701             : ! *****************************************************************************
    3702             : !> \brief ...
    3703             : !> \param count ...
    3704             : !> \param lengths ...
    3705             : !> \param displs ...
    3706             : !> \return ...
    3707             : ! ***************************************************************************
    3708           0 :   FUNCTION mp_type_indexed_make_${nametype1}$ (count, lengths, displs) &
    3709             :      RESULT(type_descriptor)
    3710             :      INTEGER, INTENT(IN)                      :: count
    3711             :      INTEGER, DIMENSION(1:count), INTENT(IN), TARGET  :: lengths, displs
    3712             :      TYPE(mp_type_descriptor_type)            :: type_descriptor
    3713             : 
    3714             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_type_indexed_make_${nametype1}$'
    3715             : 
    3716             :      INTEGER :: ierr, handle
    3717             : 
    3718           0 :      ierr = 0
    3719           0 :      CALL mp_timeset(routineN, handle)
    3720             : 
    3721             : #if defined(__parallel)
    3722             :      CALL mpi_type_indexed(count, lengths, displs, ${mpi_type1}$, &
    3723           0 :                            type_descriptor%type_handle, ierr)
    3724           0 :      IF (ierr /= 0) &
    3725           0 :         CPABORT("MPI_Type_Indexed @ "//routineN)
    3726           0 :      CALL mpi_type_commit(type_descriptor%type_handle, ierr)
    3727           0 :      IF (ierr /= 0) &
    3728           0 :         CPABORT("MPI_Type_commit @ "//routineN)
    3729             : #else
    3730             :      type_descriptor%type_handle = ${handle1}$
    3731             : #endif
    3732           0 :      type_descriptor%length = count
    3733           0 :      NULLIFY (type_descriptor%subtype)
    3734           0 :      type_descriptor%vector_descriptor(1:2) = 1
    3735           0 :      type_descriptor%has_indexing = .TRUE.
    3736           0 :      type_descriptor%index_descriptor%index => lengths
    3737           0 :      type_descriptor%index_descriptor%chunks => displs
    3738             : 
    3739           0 :      CALL mp_timestop(handle)
    3740             : 
    3741           0 :   END FUNCTION mp_type_indexed_make_${nametype1}$
    3742             : 
    3743             : ! *****************************************************************************
    3744             : !> \brief Allocates special parallel memory
    3745             : !> \param[in]  DATA      pointer to integer array to allocate
    3746             : !> \param[in]  len       number of integers to allocate
    3747             : !> \param[out] stat      (optional) allocation status result
    3748             : !> \author UB
    3749             : ! *****************************************************************************
    3750           0 :   SUBROUTINE mp_allocate_${nametype1}$ (DATA, len, stat)
    3751             :      ${type1}$, DIMENSION(:), POINTER      :: DATA
    3752             :      INTEGER, INTENT(IN)                 :: len
    3753             :      INTEGER, INTENT(OUT), OPTIONAL      :: stat
    3754             : 
    3755             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_allocate_${nametype1}$'
    3756             : 
    3757             :      INTEGER                             :: ierr, handle
    3758             : 
    3759           0 :      CALL mp_timeset(routineN, handle)
    3760             : 
    3761             :      ierr = 0
    3762             : #if defined(__parallel)
    3763           0 :      NULLIFY (DATA)
    3764           0 :      CALL mp_alloc_mem(DATA, len, stat=ierr)
    3765           0 :      IF (ierr /= 0 .AND. .NOT. PRESENT(stat)) &
    3766           0 :         CALL mp_stop(ierr, "mpi_alloc_mem @ "//routineN)
    3767           0 :      CALL add_perf(perf_id=15, count=1)
    3768             : #else
    3769             :      ALLOCATE (DATA(len), stat=ierr)
    3770             :      IF (ierr /= 0 .AND. .NOT. PRESENT(stat)) &
    3771             :         CALL mp_stop(ierr, "ALLOCATE @ "//routineN)
    3772             : #endif
    3773           0 :      IF (PRESENT(stat)) stat = ierr
    3774           0 :      CALL mp_timestop(handle)
    3775           0 :   END SUBROUTINE mp_allocate_${nametype1}$
    3776             : 
    3777             : ! *****************************************************************************
    3778             : !> \brief Deallocates special parallel memory
    3779             : !> \param[in] DATA         pointer to special memory to deallocate
    3780             : !> \param stat ...
    3781             : !> \author UB
    3782             : ! *****************************************************************************
    3783           0 :   SUBROUTINE mp_deallocate_${nametype1}$ (DATA, stat)
    3784             :      ${type1}$, DIMENSION(:), POINTER      :: DATA
    3785             :      INTEGER, INTENT(OUT), OPTIONAL      :: stat
    3786             : 
    3787             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_deallocate_${nametype1}$'
    3788             : 
    3789             :      INTEGER                             :: ierr, handle
    3790             : 
    3791           0 :      CALL mp_timeset(routineN, handle)
    3792             : 
    3793             :      ierr = 0
    3794             : #if defined(__parallel)
    3795           0 :      CALL mp_free_mem(DATA, ierr)
    3796           0 :      IF (PRESENT(stat)) THEN
    3797           0 :         stat = ierr
    3798             :      ELSE
    3799           0 :         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_free_mem @ "//routineN)
    3800             :      ENDIF
    3801           0 :      NULLIFY (DATA)
    3802           0 :      CALL add_perf(perf_id=15, count=1)
    3803             : #else
    3804             :      DEALLOCATE (DATA)
    3805             :      IF (PRESENT(stat)) stat = 0
    3806             : #endif
    3807           0 :      CALL mp_timestop(handle)
    3808           0 :   END SUBROUTINE mp_deallocate_${nametype1}$
    3809             : 
    3810             : ! *****************************************************************************
    3811             : !> \brief (parallel) Blocking individual file write using explicit offsets
    3812             : !>        (serial) Unformatted stream write
    3813             : !> \param[in] fh     file handle (file storage unit)
    3814             : !> \param[in] offset file offset (position)
    3815             : !> \param[in] msg    data to be written to the file
    3816             : !> \param msglen ...
    3817             : !> \par MPI-I/O mapping   mpi_file_write_at
    3818             : !> \par STREAM-I/O mapping   WRITE
    3819             : !> \param[in](optional) msglen number of the elements of data
    3820             : ! *****************************************************************************
    3821           0 :   SUBROUTINE mp_file_write_at_${nametype1}$v(fh, offset, msg, msglen)
    3822             :      ${type1}$, INTENT(IN)                      :: msg(:)
    3823             :      INTEGER, INTENT(IN)                        :: fh
    3824             :      INTEGER, INTENT(IN), OPTIONAL              :: msglen
    3825             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3826             : 
    3827             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_${nametype1}$v'
    3828             : 
    3829             :      INTEGER                                    :: ierr, msg_len
    3830             : 
    3831           0 :      ierr = 0
    3832           0 :      msg_len = SIZE(msg)
    3833           0 :      IF (PRESENT(msglen)) msg_len = msglen
    3834             : #if defined(__parallel)
    3835           0 :      CALL MPI_FILE_WRITE_AT(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3836           0 :      IF (ierr .NE. 0) &
    3837           0 :         CPABORT("mpi_file_write_at_${nametype1}$v @ "//routineN)
    3838             : #else
    3839             :      WRITE (UNIT=fh, POS=offset + 1) msg(1:msg_len)
    3840             : #endif
    3841           0 :   END SUBROUTINE mp_file_write_at_${nametype1}$v
    3842             : 
    3843             : ! *****************************************************************************
    3844             : !> \brief ...
    3845             : !> \param fh ...
    3846             : !> \param offset ...
    3847             : !> \param msg ...
    3848             : ! *****************************************************************************
    3849           0 :   SUBROUTINE mp_file_write_at_${nametype1}$ (fh, offset, msg)
    3850             :      ${type1}$, INTENT(IN)               :: msg
    3851             :      INTEGER, INTENT(IN)                        :: fh
    3852             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3853             : 
    3854             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_${nametype1}$'
    3855             : 
    3856             :      INTEGER                                    :: ierr
    3857             : 
    3858           0 :      ierr = 0
    3859             : #if defined(__parallel)
    3860           0 :      CALL MPI_FILE_WRITE_AT(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3861           0 :      IF (ierr .NE. 0) &
    3862           0 :         CPABORT("mpi_file_write_at_${nametype1}$ @ "//routineN)
    3863             : #else
    3864             :      WRITE (UNIT=fh, POS=offset + 1) msg
    3865             : #endif
    3866           0 :   END SUBROUTINE mp_file_write_at_${nametype1}$
    3867             : 
    3868             : ! *****************************************************************************
    3869             : !> \brief (parallel) Blocking collective file write using explicit offsets
    3870             : !>        (serial) Unformatted stream write
    3871             : !> \param fh ...
    3872             : !> \param offset ...
    3873             : !> \param msg ...
    3874             : !> \param msglen ...
    3875             : !> \par MPI-I/O mapping   mpi_file_write_at_all
    3876             : !> \par STREAM-I/O mapping   WRITE
    3877             : ! *****************************************************************************
    3878           0 :   SUBROUTINE mp_file_write_at_all_${nametype1}$v(fh, offset, msg, msglen)
    3879             :      ${type1}$, INTENT(IN)                      :: msg(:)
    3880             :      INTEGER, INTENT(IN)                        :: fh
    3881             :      INTEGER, INTENT(IN), OPTIONAL              :: msglen
    3882             :      INTEGER                                    :: msg_len
    3883             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3884             : 
    3885             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_all_${nametype1}$v'
    3886             : 
    3887             :      INTEGER                                    :: ierr
    3888             : 
    3889           0 :      ierr = 0
    3890           0 :      msg_len = SIZE(msg)
    3891           0 :      IF (PRESENT(msglen)) msg_len = msglen
    3892             : #if defined(__parallel)
    3893           0 :      CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3894           0 :      IF (ierr .NE. 0) &
    3895           0 :         CPABORT("mpi_file_write_at_all_${nametype1}$v @ "//routineN)
    3896             : #else
    3897             :      WRITE (UNIT=fh, POS=offset + 1) msg(1:msg_len)
    3898             : #endif
    3899           0 :   END SUBROUTINE mp_file_write_at_all_${nametype1}$v
    3900             : 
    3901             : ! *****************************************************************************
    3902             : !> \brief ...
    3903             : !> \param fh ...
    3904             : !> \param offset ...
    3905             : !> \param msg ...
    3906             : ! *****************************************************************************
    3907           0 :   SUBROUTINE mp_file_write_at_all_${nametype1}$ (fh, offset, msg)
    3908             :      ${type1}$, INTENT(IN)               :: msg
    3909             :      INTEGER, INTENT(IN)                        :: fh
    3910             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3911             : 
    3912             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_all_${nametype1}$'
    3913             : 
    3914             :      INTEGER                                    :: ierr
    3915             : 
    3916           0 :      ierr = 0
    3917             : #if defined(__parallel)
    3918           0 :      CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3919           0 :      IF (ierr .NE. 0) &
    3920           0 :         CPABORT("mpi_file_write_at_all_${nametype1}$ @ "//routineN)
    3921             : #else
    3922             :      WRITE (UNIT=fh, POS=offset + 1) msg
    3923             : #endif
    3924           0 :   END SUBROUTINE mp_file_write_at_all_${nametype1}$
    3925             : 
    3926             : ! *****************************************************************************
    3927             : !> \brief (parallel) Blocking individual file read using explicit offsets
    3928             : !>        (serial) Unformatted stream read
    3929             : !> \param[in] fh     file handle (file storage unit)
    3930             : !> \param[in] offset file offset (position)
    3931             : !> \param[out] msg   data to be read from the file
    3932             : !> \param msglen ...
    3933             : !> \par MPI-I/O mapping   mpi_file_read_at
    3934             : !> \par STREAM-I/O mapping   READ
    3935             : !> \param[in](optional) msglen  number of elements of data
    3936             : ! *****************************************************************************
    3937           0 :   SUBROUTINE mp_file_read_at_${nametype1}$v(fh, offset, msg, msglen)
    3938             :      ${type1}$, INTENT(OUT)                     :: msg(:)
    3939             :      INTEGER, INTENT(IN)                        :: fh
    3940             :      INTEGER, INTENT(IN), OPTIONAL              :: msglen
    3941             :      INTEGER                                    :: msg_len
    3942             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3943             : 
    3944             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_${nametype1}$v'
    3945             : 
    3946             :      INTEGER                                    :: ierr
    3947             : 
    3948           0 :      ierr = 0
    3949           0 :      msg_len = SIZE(msg)
    3950           0 :      IF (PRESENT(msglen)) msg_len = msglen
    3951             : #if defined(__parallel)
    3952           0 :      CALL MPI_FILE_READ_AT(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3953           0 :      IF (ierr .NE. 0) &
    3954           0 :         CPABORT("mpi_file_read_at_${nametype1}$v @ "//routineN)
    3955             : #else
    3956             :      READ (UNIT=fh, POS=offset + 1) msg(1:msg_len)
    3957             : #endif
    3958           0 :   END SUBROUTINE mp_file_read_at_${nametype1}$v
    3959             : 
    3960             : ! *****************************************************************************
    3961             : !> \brief ...
    3962             : !> \param fh ...
    3963             : !> \param offset ...
    3964             : !> \param msg ...
    3965             : ! *****************************************************************************
    3966           0 :   SUBROUTINE mp_file_read_at_${nametype1}$ (fh, offset, msg)
    3967             :      ${type1}$, INTENT(OUT)               :: msg
    3968             :      INTEGER, INTENT(IN)                        :: fh
    3969             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    3970             : 
    3971             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_${nametype1}$'
    3972             : 
    3973             :      INTEGER                                    :: ierr
    3974             : 
    3975           0 :      ierr = 0
    3976             : #if defined(__parallel)
    3977           0 :      CALL MPI_FILE_READ_AT(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    3978           0 :      IF (ierr .NE. 0) &
    3979           0 :         CPABORT("mpi_file_read_at_${nametype1}$ @ "//routineN)
    3980             : #else
    3981             :      READ (UNIT=fh, POS=offset + 1) msg
    3982             : #endif
    3983           0 :   END SUBROUTINE mp_file_read_at_${nametype1}$
    3984             : 
    3985             : ! *****************************************************************************
    3986             : !> \brief (parallel) Blocking collective file read using explicit offsets
    3987             : !>        (serial) Unformatted stream read
    3988             : !> \param fh ...
    3989             : !> \param offset ...
    3990             : !> \param msg ...
    3991             : !> \param msglen ...
    3992             : !> \par MPI-I/O mapping    mpi_file_read_at_all
    3993             : !> \par STREAM-I/O mapping   READ
    3994             : ! *****************************************************************************
    3995           0 :   SUBROUTINE mp_file_read_at_all_${nametype1}$v(fh, offset, msg, msglen)
    3996             :      ${type1}$, INTENT(OUT)                     :: msg(:)
    3997             :      INTEGER, INTENT(IN)                        :: fh
    3998             :      INTEGER, INTENT(IN), OPTIONAL              :: msglen
    3999             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    4000             : 
    4001             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_all_${nametype1}$v'
    4002             : 
    4003             :      INTEGER                                    :: ierr, msg_len
    4004             : 
    4005           0 :      ierr = 0
    4006           0 :      msg_len = SIZE(msg)
    4007           0 :      IF (PRESENT(msglen)) msg_len = msglen
    4008             : #if defined(__parallel)
    4009           0 :      CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    4010           0 :      IF (ierr .NE. 0) &
    4011           0 :         CPABORT("mpi_file_read_at_all_${nametype1}$v @ "//routineN)
    4012             : #else
    4013             :      READ (UNIT=fh, POS=offset + 1) msg(1:msg_len)
    4014             : #endif
    4015           0 :   END SUBROUTINE mp_file_read_at_all_${nametype1}$v
    4016             : 
    4017             : ! *****************************************************************************
    4018             : !> \brief ...
    4019             : !> \param fh ...
    4020             : !> \param offset ...
    4021             : !> \param msg ...
    4022             : ! *****************************************************************************
    4023           0 :   SUBROUTINE mp_file_read_at_all_${nametype1}$ (fh, offset, msg)
    4024             :      ${type1}$, INTENT(OUT)               :: msg
    4025             :      INTEGER, INTENT(IN)                        :: fh
    4026             :      INTEGER(kind=file_offset), INTENT(IN)      :: offset
    4027             : 
    4028             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_all_${nametype1}$'
    4029             : 
    4030             :      INTEGER                                    :: ierr
    4031             : 
    4032           0 :      ierr = 0
    4033             : #if defined(__parallel)
    4034           0 :      CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
    4035           0 :      IF (ierr .NE. 0) &
    4036           0 :         CPABORT("mpi_file_read_at_all_${nametype1}$ @ "//routineN)
    4037             : #else
    4038             :      READ (UNIT=fh, POS=offset + 1) msg
    4039             : #endif
    4040           0 :   END SUBROUTINE mp_file_read_at_all_${nametype1}$
    4041             : 
    4042             : ! *****************************************************************************
    4043             : !> \brief ...
    4044             : !> \param ptr ...
    4045             : !> \param vector_descriptor ...
    4046             : !> \param index_descriptor ...
    4047             : !> \return ...
    4048             : ! *****************************************************************************
    4049           0 :   FUNCTION mp_type_make_${nametype1}$ (ptr, &
    4050             :                                        vector_descriptor, index_descriptor) &
    4051             :      RESULT(type_descriptor)
    4052             :      ${type1}$, DIMENSION(:), POINTER                    :: ptr
    4053             :      INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL       :: vector_descriptor
    4054             :      TYPE(mp_indexing_meta_type), INTENT(IN), OPTIONAL :: index_descriptor
    4055             :      TYPE(mp_type_descriptor_type)                     :: type_descriptor
    4056             : 
    4057             :      CHARACTER(len=*), PARAMETER :: routineN = 'mp_type_make_${nametype1}$'
    4058             : 
    4059             :      INTEGER :: ierr
    4060             : 
    4061           0 :      ierr = 0
    4062           0 :      NULLIFY (type_descriptor%subtype)
    4063           0 :      type_descriptor%length = SIZE(ptr)
    4064             : #if defined(__parallel)
    4065           0 :      type_descriptor%type_handle = ${mpi_type1}$
    4066           0 :      CALL MPI_Get_address(ptr, type_descriptor%base, ierr)
    4067           0 :      IF (ierr /= 0) &
    4068           0 :         CPABORT("MPI_Get_address @ "//routineN)
    4069             : #else
    4070             :      type_descriptor%type_handle = ${handle1}$
    4071             : #endif
    4072           0 :      type_descriptor%vector_descriptor(1:2) = 1
    4073           0 :      type_descriptor%has_indexing = .FALSE.
    4074           0 :      type_descriptor%data_${nametype1}$ => ptr
    4075           0 :      IF (PRESENT(vector_descriptor) .OR. PRESENT(index_descriptor)) THEN
    4076           0 :         CPABORT(routineN//": Vectors and indices NYI")
    4077             :      ENDIF
    4078           0 :   END FUNCTION mp_type_make_${nametype1}$
    4079             : 
    4080             : ! *****************************************************************************
    4081             : !> \brief Allocates an array, using MPI_ALLOC_MEM ... this is hackish
    4082             : !>        as the Fortran version returns an integer, which we take to be a C_PTR
    4083             : !> \param DATA           data array to allocate
    4084             : !> \param[in] len        length (in data elements) of data array allocation
    4085             : !> \param[out] stat      (optional) allocation status result
    4086             : ! *****************************************************************************
    4087           0 :   SUBROUTINE mp_alloc_mem_${nametype1}$ (DATA, len, stat)
    4088             :      ${type1}$, DIMENSION(:), POINTER           :: DATA
    4089             :      INTEGER, INTENT(IN)                      :: len
    4090             :      INTEGER, INTENT(OUT), OPTIONAL           :: stat
    4091             : 
    4092             : #if defined(__parallel)
    4093             :      INTEGER                                  :: size, ierr, length, &
    4094             :                                                  mp_info, mp_res
    4095             :      INTEGER(KIND=MPI_ADDRESS_KIND)           :: mp_size
    4096             :      TYPE(C_PTR)                              :: mp_baseptr
    4097             : 
    4098           0 :      length = MAX(len, 1)
    4099           0 :      CALL MPI_TYPE_SIZE(${mpi_type1}$, size, ierr)
    4100           0 :      mp_size = INT(length, KIND=MPI_ADDRESS_KIND)*size
    4101           0 :      IF (mp_size .GT. mp_max_memory_size) THEN
    4102           0 :         CPABORT("MPI cannot allocate more than 2 GiByte")
    4103             :      ENDIF
    4104           0 :      mp_info = MPI_INFO_NULL
    4105           0 :      CALL MPI_ALLOC_MEM(mp_size, mp_info, mp_baseptr, mp_res)
    4106           0 :      CALL C_F_POINTER(mp_baseptr, DATA, (/length/))
    4107           0 :      IF (PRESENT(stat)) stat = mp_res
    4108             : #else
    4109             :      INTEGER                                 :: length, mystat
    4110             :      length = MAX(len, 1)
    4111             :      IF (PRESENT(stat)) THEN
    4112             :         ALLOCATE (DATA(length), stat=mystat)
    4113             :         stat = mystat ! show to convention checker that stat is used
    4114             :      ELSE
    4115             :         ALLOCATE (DATA(length))
    4116             :      ENDIF
    4117             : #endif
    4118           0 :   END SUBROUTINE mp_alloc_mem_${nametype1}$
    4119             : 
    4120             : ! *****************************************************************************
    4121             : !> \brief Deallocates am array, ... this is hackish
    4122             : !>        as the Fortran version takes an integer, which we hope to get by reference
    4123             : !> \param DATA           data array to allocate
    4124             : !> \param[out] stat      (optional) allocation status result
    4125             : ! *****************************************************************************
    4126           0 :   SUBROUTINE mp_free_mem_${nametype1}$ (DATA, stat)
    4127             :      ${type1}$, DIMENSION(:), &
    4128             :         POINTER                                :: DATA
    4129             :      INTEGER, INTENT(OUT), OPTIONAL           :: stat
    4130             : 
    4131             : #if defined(__parallel)
    4132             :      INTEGER                                  :: mp_res
    4133           0 :      CALL MPI_FREE_MEM(DATA, mp_res)
    4134           0 :      IF (PRESENT(stat)) stat = mp_res
    4135             : #else
    4136             :      DEALLOCATE (DATA)
    4137             :      IF (PRESENT(stat)) stat = 0
    4138             : #endif
    4139           0 :   END SUBROUTINE mp_free_mem_${nametype1}$
    4140             : #:endfor
    4141             : 

Generated by: LCOV version 1.15