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