Line data Source code
1 : #!-------------------------------------------------------------------------------------------------!
2 : #! CP2K: A general program to perform molecular dynamics simulations !
3 : #! Copyright 2000-2026 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 3846 : 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 1282 : CALL mp_timeset(routineN, handle)
48 :
49 : #if defined(__parallel)
50 1282 : CALL mpi_comm_rank(comm%handle, myrank, ierror)
51 1282 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_rank @ "//routineN)
52 1282 : CALL mpi_comm_size(comm%handle, nprocs, ierror)
53 1282 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_size @ "//routineN)
54 1282 : IF (PRESENT(displ_in)) THEN
55 0 : displ = displ_in
56 : ELSE
57 : displ = 1
58 : END IF
59 1282 : right = MODULO(myrank + displ, nprocs)
60 1282 : left = MODULO(myrank - displ, nprocs)
61 1282 : tag = 17
62 3846 : msglen = SIZE(msg)
63 : CALL mpi_sendrecv_replace(msg, msglen, ${mpi_type1}$, right, tag, left, tag, &
64 1282 : comm%handle, MPI_STATUS_IGNORE, ierror)
65 1282 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_sendrecv_replace @ "//routineN)
66 1282 : 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 1282 : CALL mp_timestop(handle)
73 :
74 1282 : 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 11544 : 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 3848 : CALL mp_timeset(routineN, handle)
104 :
105 : #if defined(__parallel)
106 3848 : CALL mpi_comm_rank(comm%handle, myrank, ierror)
107 3848 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_rank @ "//routineN)
108 3848 : CALL mpi_comm_size(comm%handle, nprocs, ierror)
109 3848 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_comm_size @ "//routineN)
110 3848 : IF (PRESENT(displ_in)) THEN
111 6 : displ = displ_in
112 : ELSE
113 : displ = 1
114 : END IF
115 3848 : right = MODULO(myrank + displ, nprocs)
116 3848 : left = MODULO(myrank - displ, nprocs)
117 3848 : tag = 19
118 3848 : msglen = SIZE(msg)
119 : CALL mpi_sendrecv_replace(msg, msglen, ${mpi_type1}$, right, tag, left, &
120 3848 : tag, comm%handle, MPI_STATUS_IGNORE, ierror)
121 3848 : IF (ierror /= 0) CALL mp_stop(ierror, "mpi_sendrecv_replace @ "//routineN)
122 3848 : 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 3848 : CALL mp_timestop(handle)
129 :
130 3848 : 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 80402 : 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 80402 : CALL mp_timeset(routineN, handle)
169 :
170 : #if defined(__parallel)
171 : CALL mpi_alltoallv(sb, scount, sdispl, ${mpi_type1}$, &
172 80402 : rb, rcount, rdispl, ${mpi_type1}$, comm%handle, ierr)
173 80402 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoallv @ "//routineN)
174 402080 : msglen = SUM(scount) + SUM(rcount)
175 80402 : 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 80402 : CALL mp_timestop(handle)
186 :
187 80402 : 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 3163510 : 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 3163510 : CALL mp_timeset(routineN, handle)
220 :
221 : #if defined(__parallel)
222 : CALL mpi_alltoallv(sb, scount, sdispl, ${mpi_type1}$, &
223 3163510 : rb, rcount, rdispl, ${mpi_type1}$, comm%handle, ierr)
224 3163510 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoallv @ "//routineN)
225 18981060 : msglen = SUM(scount) + SUM(rcount)
226 3163510 : 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 3163510 : CALL mp_timestop(handle)
236 :
237 3163510 : 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 1835212 : 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 917606 : CALL mp_timeset(routineN, handle)
269 :
270 : #if defined(__parallel)
271 : CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
272 917606 : rb, count, ${mpi_type1}$, comm%handle, ierr)
273 917606 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
274 917606 : CALL mpi_comm_size(comm%handle, np, ierr)
275 917606 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
276 917606 : msglen = 2*count*np
277 917606 : 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 917606 : CALL mp_timestop(handle)
284 :
285 917606 : 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 27092 : 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 13546 : CALL mp_timeset(routineN, handle)
481 :
482 : #if defined(__parallel)
483 : CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
484 13546 : rb, count, ${mpi_type1}$, comm%handle, ierr)
485 13546 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
486 13546 : CALL mpi_comm_size(comm%handle, np, ierr)
487 13546 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
488 13546 : msglen = 2*count*np
489 13546 : 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 13546 : CALL mp_timestop(handle)
496 :
497 13546 : 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 12 : 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 6 : CALL mp_timeset(routineN, handle)
525 :
526 : #if defined(__parallel)
527 : CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
528 6 : rb, count, ${mpi_type1}$, comm%handle, ierr)
529 6 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
530 6 : CALL mpi_comm_size(comm%handle, np, ierr)
531 6 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
532 6 : msglen = 2*count*np
533 6 : 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 6 : CALL mp_timestop(handle)
540 :
541 6 : 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 26376 : 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 13188 : CALL mp_timeset(routineN, handle)
569 :
570 : #if defined(__parallel)
571 : CALL mpi_alltoall(sb, count, ${mpi_type1}$, &
572 13188 : rb, count, ${mpi_type1}$, comm%handle, ierr)
573 13188 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_alltoall @ "//routineN)
574 13188 : CALL mpi_comm_size(comm%handle, np, ierr)
575 13188 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
576 13188 : msglen = 2*count*np
577 13188 : 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 13188 : CALL mp_timestop(handle)
584 :
585 13188 : 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 112294 : 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 112294 : CALL mp_timeset(routineN, handle)
647 :
648 : #if defined(__parallel)
649 112294 : msglen = SIZE(msg)
650 112294 : CALL mpi_send(msg, msglen, ${mpi_type1}$, dest, tag, comm%handle, ierr)
651 112294 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_send @ "//routineN)
652 112294 : 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 112294 : CALL mp_timestop(handle)
662 112294 : 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 112274 : 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 112274 : CALL mp_timeset(routineN, handle)
809 :
810 : #if defined(__parallel)
811 112274 : msglen = SIZE(msg)
812 112274 : IF (source /= mp_any_source .AND. tag /= mp_any_tag) THEN
813 103964 : CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, comm%handle, MPI_STATUS_IGNORE, ierr)
814 103964 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
815 : ELSE
816 8310 : CALL mpi_recv(msg, msglen, ${mpi_type1}$, source, tag, comm%handle, status, ierr)
817 8310 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_recv @ "//routineN)
818 8310 : CALL add_perf(perf_id=14, count=1, msg_size=msglen*${bytes1}$)
819 8310 : source = status MPI_STATUS_EXTRACT(MPI_SOURCE)
820 8310 : 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 112274 : CALL mp_timestop(handle)
831 112274 : 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 852514 : 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 852514 : CALL mp_timeset(routineN, handle)
946 :
947 : #if defined(__parallel)
948 852514 : msglen = 1
949 852514 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, comm%handle, ierr)
950 852514 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
951 852514 : 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 852514 : CALL mp_timestop(handle)
958 852514 : 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 364009 : 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 364009 : CALL mp_timeset(routineN, handle)
979 :
980 : #if defined(__parallel)
981 364009 : msglen = 1
982 364009 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
983 364009 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
984 364009 : 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 364009 : CALL mp_timestop(handle)
990 364009 : 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 3826152 : 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 3826152 : CALL mp_timeset(routineN, handle)
1049 :
1050 : #if defined(__parallel)
1051 3826152 : msglen = SIZE(msg)
1052 3826152 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, comm%handle, ierr)
1053 3826152 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1054 3826152 : 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 3826152 : CALL mp_timestop(handle)
1061 3826152 : 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 97584 : 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 97584 : CALL mp_timeset(routineN, handle)
1081 :
1082 : #if defined(__parallel)
1083 97584 : msglen = SIZE(msg)
1084 97584 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
1085 97584 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1086 97584 : 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 97584 : CALL mp_timestop(handle)
1092 97584 : 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) .OR. SIZE(msg) == 0)
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 1725055 : 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 1725055 : CALL mp_timeset(routineN, handle)
1153 :
1154 : #if defined(__parallel)
1155 5175165 : msglen = SIZE(msg)
1156 1725055 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, comm%handle, ierr)
1157 1725055 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1158 1725055 : 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 1725055 : CALL mp_timestop(handle)
1165 1725055 : 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 10465 : 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 10465 : CALL mp_timeset(routineN, handle)
1186 :
1187 : #if defined(__parallel)
1188 31395 : msglen = SIZE(msg)
1189 10465 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
1190 10465 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1191 10465 : 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 10465 : CALL mp_timestop(handle)
1197 10465 : 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 1436 : 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 1436 : CALL mp_timeset(routineN, handle)
1219 :
1220 : #if defined(__parallel)
1221 5744 : msglen = SIZE(msg)
1222 1436 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, source, comm%handle, ierr)
1223 1436 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1224 1436 : 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 1436 : CALL mp_timestop(handle)
1231 1436 : 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 100 : 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 100 : CALL mp_timeset(routineN, handle)
1252 :
1253 : #if defined(__parallel)
1254 400 : msglen = SIZE(msg)
1255 100 : CALL mpi_bcast(msg, msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
1256 100 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
1257 100 : 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 100 : CALL mp_timestop(handle)
1263 100 : 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 30197795 : 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 : ${type1}$ :: res
1282 : #endif
1283 :
1284 30197795 : CALL mp_timeset(routineN, handle)
1285 :
1286 : #if defined(__parallel)
1287 30197795 : msglen = 1
1288 30197795 : IF (comm%num_pe > 1) THEN
1289 28856578 : CALL mpi_allreduce(msg, res, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1290 28856578 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1291 28856578 : msg = res
1292 : END IF
1293 30197795 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1294 : #else
1295 : MARK_USED(msg)
1296 : MARK_USED(comm)
1297 : #endif
1298 30197795 : CALL mp_timestop(handle)
1299 30197795 : END SUBROUTINE mp_sum_${nametype1}$
1300 :
1301 : ! **************************************************************************************************
1302 : !> \brief Element-wise sum of a rank-1 array on all processes.
1303 : !> \param[in,out] msg Vector to sum and result
1304 : !> \param comm ...
1305 : !> \note see mp_sum_${nametype1}$
1306 : ! **************************************************************************************************
1307 10019447 : SUBROUTINE mp_sum_${nametype1}$v(msg, comm)
1308 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:)
1309 : CLASS(mp_comm_type), INTENT(IN) :: comm
1310 :
1311 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$v'
1312 :
1313 : INTEGER :: handle
1314 : #if defined(__parallel)
1315 : INTEGER :: ierr, msglen
1316 10019447 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1317 : #endif
1318 :
1319 10019447 : CALL mp_timeset(routineN, handle)
1320 :
1321 : #if defined(__parallel)
1322 10019447 : msglen = SIZE(msg)
1323 10019447 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1324 26469264 : ALLOCATE (msgbuf(msglen))
1325 8823088 : CALL mpi_allreduce(msg, msgbuf, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1326 8823088 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1327 280847658 : msg = msgbuf
1328 : END IF
1329 10019447 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1330 : #else
1331 : MARK_USED(msg)
1332 : MARK_USED(comm)
1333 : #endif
1334 10019447 : CALL mp_timestop(handle)
1335 10019447 : END SUBROUTINE mp_sum_${nametype1}$v
1336 :
1337 : ! **************************************************************************************************
1338 : !> \brief Element-wise sum of a rank-1 array on all processes.
1339 : !> \param[in,out] msg Vector to sum and result
1340 : !> \param comm ...
1341 : !> \note see mp_sum_${nametype1}$
1342 : ! **************************************************************************************************
1343 0 : SUBROUTINE mp_isum_${nametype1}$v(msg, comm, request)
1344 : ${type1}$, INTENT(INOUT) :: msg(:)
1345 : CLASS(mp_comm_type), INTENT(IN) :: comm
1346 : TYPE(mp_request_type), INTENT(OUT) :: request
1347 :
1348 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isum_${nametype1}$v'
1349 :
1350 : INTEGER :: handle
1351 : #if defined(__parallel)
1352 : INTEGER :: ierr, msglen
1353 : #endif
1354 :
1355 0 : CALL mp_timeset(routineN, handle)
1356 :
1357 : #if defined(__parallel)
1358 : #if !defined(__GNUC__) || __GNUC__ >= 9
1359 0 : CPASSERT(IS_CONTIGUOUS(msg) .OR. SIZE(msg) == 0)
1360 : #endif
1361 0 : msglen = SIZE(msg)
1362 0 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1363 0 : CALL mpi_iallreduce(MPI_IN_PLACE, msg, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, request%handle, ierr)
1364 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallreduce @ "//routineN)
1365 : ELSE
1366 0 : request = mp_request_null
1367 : END IF
1368 0 : CALL add_perf(perf_id=23, count=1, msg_size=msglen*${bytes1}$)
1369 : #else
1370 : MARK_USED(msg)
1371 : MARK_USED(comm)
1372 : request = mp_request_null
1373 : #endif
1374 0 : CALL mp_timestop(handle)
1375 0 : END SUBROUTINE mp_isum_${nametype1}$v
1376 :
1377 : ! **************************************************************************************************
1378 : !> \brief Element-wise sum of a rank-2 array on all processes.
1379 : !> \param[in] msg Matrix to sum and result
1380 : !> \param comm ...
1381 : !> \note see mp_sum_${nametype1}$
1382 : ! **************************************************************************************************
1383 3293974 : SUBROUTINE mp_sum_${nametype1}$m(msg, comm)
1384 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :)
1385 : CLASS(mp_comm_type), INTENT(IN) :: comm
1386 :
1387 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m'
1388 :
1389 : INTEGER :: handle
1390 : #if defined(__parallel)
1391 : INTEGER, PARAMETER :: max_msg = 2**25
1392 : INTEGER :: ierr, m1, msglen, ncols, step, msglensum
1393 3293974 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1394 : #endif
1395 :
1396 3293974 : CALL mp_timeset(routineN, handle)
1397 :
1398 : #if defined(__parallel)
1399 : ! chunk up the call so that message sizes are limited, to avoid overflows in mpich triggered in large rpa calcs
1400 9881922 : step = MAX(1, SIZE(msg, 2)/MAX(1, SIZE(msg)/max_msg))
1401 3293974 : msglensum = 0
1402 9881822 : DO m1 = LBOUND(msg, 2), UBOUND(msg, 2), step
1403 3293924 : msglen = SIZE(msg, 1)*(MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1)
1404 3293924 : msglensum = msglensum + msglen
1405 6587898 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1406 3077094 : ncols = MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1
1407 9231282 : ALLOCATE (msgbuf(msglen))
1408 3077094 : CALL mpi_allreduce(msg(LBOUND(msg, 1), m1), msgbuf, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1409 3077094 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1410 9231282 : msg(:, m1:m1 + ncols - 1) = RESHAPE(msgbuf, [SIZE(msg, 1), ncols])
1411 3077094 : DEALLOCATE (msgbuf)
1412 : END IF
1413 : END DO
1414 3293974 : CALL add_perf(perf_id=3, count=1, msg_size=msglensum*${bytes1}$)
1415 : #else
1416 : MARK_USED(msg)
1417 : MARK_USED(comm)
1418 : #endif
1419 3293974 : CALL mp_timestop(handle)
1420 3293974 : END SUBROUTINE mp_sum_${nametype1}$m
1421 :
1422 : ! **************************************************************************************************
1423 : !> \brief Element-wise sum of a rank-3 array on all processes.
1424 : !> \param[in] msg Array to sum and result
1425 : !> \param comm ...
1426 : !> \note see mp_sum_${nametype1}$
1427 : ! **************************************************************************************************
1428 98429 : SUBROUTINE mp_sum_${nametype1}$m3(msg, comm)
1429 : ${type1}$, INTENT(INOUT), CONTIGUOUS :: msg(:, :, :)
1430 : CLASS(mp_comm_type), INTENT(IN) :: comm
1431 :
1432 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m3'
1433 :
1434 : INTEGER :: handle
1435 : #if defined(__parallel)
1436 : INTEGER :: ierr, msglen
1437 98429 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1438 : #endif
1439 :
1440 98429 : CALL mp_timeset(routineN, handle)
1441 :
1442 : #if defined(__parallel)
1443 393716 : msglen = SIZE(msg)
1444 98429 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1445 250512 : ALLOCATE (msgbuf(msglen))
1446 83504 : CALL mpi_allreduce(msg, msgbuf, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1447 83504 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1448 334016 : msg = RESHAPE(msgbuf, SHAPE(msg))
1449 : END IF
1450 98429 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1451 : #else
1452 : MARK_USED(msg)
1453 : MARK_USED(comm)
1454 : #endif
1455 98429 : CALL mp_timestop(handle)
1456 98429 : END SUBROUTINE mp_sum_${nametype1}$m3
1457 :
1458 : ! **************************************************************************************************
1459 : !> \brief Element-wise sum of a rank-4 array on all processes.
1460 : !> \param[in] msg Array to sum and result
1461 : !> \param comm ...
1462 : !> \note see mp_sum_${nametype1}$
1463 : ! **************************************************************************************************
1464 252 : SUBROUTINE mp_sum_${nametype1}$m4(msg, comm)
1465 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :, :, :)
1466 : CLASS(mp_comm_type), INTENT(IN) :: comm
1467 :
1468 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_${nametype1}$m4'
1469 :
1470 : INTEGER :: handle
1471 : #if defined(__parallel)
1472 : INTEGER :: ierr, msglen
1473 252 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1474 : #endif
1475 :
1476 252 : CALL mp_timeset(routineN, handle)
1477 :
1478 : #if defined(__parallel)
1479 1260 : msglen = SIZE(msg)
1480 252 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1481 756 : ALLOCATE (msgbuf(msglen))
1482 252 : CALL mpi_allreduce(msg, msgbuf, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1483 252 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1484 1260 : msg = RESHAPE(msgbuf, SHAPE(msg))
1485 : END IF
1486 252 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1487 : #else
1488 : MARK_USED(msg)
1489 : MARK_USED(comm)
1490 : #endif
1491 252 : CALL mp_timestop(handle)
1492 252 : END SUBROUTINE mp_sum_${nametype1}$m4
1493 :
1494 : ! **************************************************************************************************
1495 : !> \brief Element-wise sum of data from all processes with result left only on
1496 : !> one.
1497 : !> \param[in,out] msg Vector to sum (input) and (only on process root)
1498 : !> result (output)
1499 : !> \param root ...
1500 : !> \param[in] comm Message passing environment identifier
1501 : !> \par MPI mapping
1502 : !> mpi_reduce
1503 : ! **************************************************************************************************
1504 54 : SUBROUTINE mp_sum_root_${nametype1}$v(msg, root, comm)
1505 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:)
1506 : INTEGER, INTENT(IN) :: root
1507 : CLASS(mp_comm_type), INTENT(IN) :: comm
1508 :
1509 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_root_${nametype1}$v'
1510 :
1511 : INTEGER :: handle
1512 : #if defined(__parallel)
1513 : INTEGER :: ierr, m1, msglen, taskid
1514 54 : ${type1}$, ALLOCATABLE :: res(:)
1515 : #endif
1516 :
1517 54 : CALL mp_timeset(routineN, handle)
1518 :
1519 : #if defined(__parallel)
1520 54 : msglen = SIZE(msg)
1521 54 : CALL mpi_comm_rank(comm%handle, taskid, ierr)
1522 54 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
1523 54 : IF (msglen > 0) THEN
1524 54 : m1 = SIZE(msg, 1)
1525 162 : ALLOCATE (res(m1))
1526 : CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_SUM, &
1527 54 : root, comm%handle, ierr)
1528 54 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN)
1529 54 : IF (taskid == root) THEN
1530 135 : msg = res
1531 : END IF
1532 54 : DEALLOCATE (res)
1533 : END IF
1534 54 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1535 : #else
1536 : MARK_USED(msg)
1537 : MARK_USED(root)
1538 : MARK_USED(comm)
1539 : #endif
1540 54 : CALL mp_timestop(handle)
1541 54 : END SUBROUTINE mp_sum_root_${nametype1}$v
1542 :
1543 : ! **************************************************************************************************
1544 : !> \brief Element-wise sum of data from all processes with result left only on
1545 : !> one.
1546 : !> \param[in,out] msg Matrix to sum (input) and (only on process root)
1547 : !> result (output)
1548 : !> \param root ...
1549 : !> \param comm ...
1550 : !> \note see mp_sum_root_${nametype1}$v
1551 : ! **************************************************************************************************
1552 0 : SUBROUTINE mp_sum_root_${nametype1}$m(msg, root, comm)
1553 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :)
1554 : INTEGER, INTENT(IN) :: root
1555 : CLASS(mp_comm_type), INTENT(IN) :: comm
1556 :
1557 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_root_rm'
1558 :
1559 : INTEGER :: handle
1560 : #if defined(__parallel)
1561 : INTEGER :: ierr, m1, m2, msglen, taskid
1562 0 : ${type1}$, ALLOCATABLE :: res(:, :)
1563 : #endif
1564 :
1565 0 : CALL mp_timeset(routineN, handle)
1566 :
1567 : #if defined(__parallel)
1568 0 : msglen = SIZE(msg)
1569 0 : CALL mpi_comm_rank(comm%handle, taskid, ierr)
1570 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
1571 0 : IF (msglen > 0) THEN
1572 0 : m1 = SIZE(msg, 1)
1573 0 : m2 = SIZE(msg, 2)
1574 0 : ALLOCATE (res(m1, m2))
1575 0 : CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_SUM, root, comm%handle, ierr)
1576 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN)
1577 0 : IF (taskid == root) THEN
1578 0 : msg = res
1579 : END IF
1580 0 : DEALLOCATE (res)
1581 : END IF
1582 0 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1583 : #else
1584 : MARK_USED(root)
1585 : MARK_USED(msg)
1586 : MARK_USED(comm)
1587 : #endif
1588 0 : CALL mp_timestop(handle)
1589 0 : END SUBROUTINE mp_sum_root_${nametype1}$m
1590 :
1591 : ! **************************************************************************************************
1592 : !> \brief Partial sum of data from all processes with result on each process.
1593 : !> \param[in] msg Matrix to sum (input)
1594 : !> \param[out] res Matrix containing result (output)
1595 : !> \param[in] comm Message passing environment identifier
1596 : ! **************************************************************************************************
1597 108 : SUBROUTINE mp_sum_partial_${nametype1}$m(msg, res, comm)
1598 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:, :)
1599 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: res(:, :)
1600 : CLASS(mp_comm_type), INTENT(IN) :: comm
1601 :
1602 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_partial_${nametype1}$m'
1603 :
1604 : INTEGER :: handle
1605 : #if defined(__parallel)
1606 : INTEGER :: ierr, msglen, taskid
1607 : #endif
1608 :
1609 54 : CALL mp_timeset(routineN, handle)
1610 :
1611 : #if defined(__parallel)
1612 162 : msglen = SIZE(msg)
1613 54 : CALL mpi_comm_rank(comm%handle, taskid, ierr)
1614 54 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN)
1615 54 : IF (msglen > 0) THEN
1616 54 : CALL mpi_scan(msg, res, msglen, ${mpi_type1}$, MPI_SUM, comm%handle, ierr)
1617 54 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_scan @ "//routineN)
1618 : END IF
1619 54 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1620 : ! perf_id is same as for other summation routines
1621 : #else
1622 : res = msg
1623 : MARK_USED(comm)
1624 : #endif
1625 54 : CALL mp_timestop(handle)
1626 54 : END SUBROUTINE mp_sum_partial_${nametype1}$m
1627 :
1628 : ! **************************************************************************************************
1629 : !> \brief Finds the maximum of a datum with the result left on all processes.
1630 : !> \param[in,out] msg Find maximum among these data (input) and
1631 : !> maximum (output)
1632 : !> \param[in] comm Message passing environment identifier
1633 : !> \par MPI mapping
1634 : !> mpi_allreduce
1635 : ! **************************************************************************************************
1636 14509636 : SUBROUTINE mp_max_${nametype1}$ (msg, comm)
1637 : ${type1}$, INTENT(INOUT) :: msg
1638 : CLASS(mp_comm_type), INTENT(IN) :: comm
1639 :
1640 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_${nametype1}$'
1641 :
1642 : INTEGER :: handle
1643 : #if defined(__parallel)
1644 : INTEGER :: ierr, msglen
1645 : ${type1}$ :: res
1646 : #endif
1647 :
1648 14509636 : CALL mp_timeset(routineN, handle)
1649 :
1650 : #if defined(__parallel)
1651 14509636 : msglen = 1
1652 14509636 : IF (comm%num_pe > 1) THEN
1653 14143074 : CALL mpi_allreduce(msg, res, msglen, ${mpi_type1}$, MPI_MAX, comm%handle, ierr)
1654 14143074 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1655 14143074 : msg = res
1656 : END IF
1657 14509636 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1658 : #else
1659 : MARK_USED(msg)
1660 : MARK_USED(comm)
1661 : #endif
1662 14509636 : CALL mp_timestop(handle)
1663 14509636 : END SUBROUTINE mp_max_${nametype1}$
1664 :
1665 : ! **************************************************************************************************
1666 : !> \brief Finds the maximum of a datum with the result left on all processes.
1667 : !> \param[in,out] msg Find maximum among these data (input) and
1668 : !> maximum (output)
1669 : !> \param[in] comm Message passing environment identifier
1670 : !> \par MPI mapping
1671 : !> mpi_allreduce
1672 : ! **************************************************************************************************
1673 56 : SUBROUTINE mp_max_root_${nametype1}$ (msg, root, comm)
1674 : ${type1}$, INTENT(INOUT) :: msg
1675 : INTEGER, INTENT(IN) :: root
1676 : CLASS(mp_comm_type), INTENT(IN) :: comm
1677 :
1678 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_root_${nametype1}$'
1679 :
1680 : INTEGER :: handle
1681 : #if defined(__parallel)
1682 : INTEGER :: ierr, msglen
1683 : ${type1}$ :: res
1684 : #endif
1685 :
1686 56 : CALL mp_timeset(routineN, handle)
1687 :
1688 : #if defined(__parallel)
1689 56 : msglen = 1
1690 56 : CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_MAX, root, comm%handle, ierr)
1691 56 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN)
1692 56 : IF (root == comm%mepos) msg = res
1693 56 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1694 : #else
1695 : MARK_USED(msg)
1696 : MARK_USED(comm)
1697 : MARK_USED(root)
1698 : #endif
1699 56 : CALL mp_timestop(handle)
1700 56 : END SUBROUTINE mp_max_root_${nametype1}$
1701 :
1702 : ! **************************************************************************************************
1703 : !> \brief Finds the element-wise maximum of a vector with the result left on
1704 : !> all processes.
1705 : !> \param[in,out] msg Find maximum among these data (input) and
1706 : !> maximum (output)
1707 : !> \param comm ...
1708 : !> \note see mp_max_${nametype1}$
1709 : ! **************************************************************************************************
1710 502886 : SUBROUTINE mp_max_${nametype1}$v(msg, comm)
1711 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:)
1712 : CLASS(mp_comm_type), INTENT(IN) :: comm
1713 :
1714 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_${nametype1}$v'
1715 :
1716 : INTEGER :: handle
1717 : #if defined(__parallel)
1718 : INTEGER :: ierr, msglen
1719 502886 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1720 : #endif
1721 :
1722 502886 : CALL mp_timeset(routineN, handle)
1723 :
1724 : #if defined(__parallel)
1725 502886 : msglen = SIZE(msg)
1726 502886 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1727 1508646 : ALLOCATE (msgbuf(msglen))
1728 502882 : CALL mpi_allreduce(msg, msgbuf, msglen, ${mpi_type1}$, MPI_MAX, comm%handle, ierr)
1729 502882 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1730 1518842 : msg = msgbuf
1731 : END IF
1732 502886 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1733 : #else
1734 : MARK_USED(msg)
1735 : MARK_USED(comm)
1736 : #endif
1737 502886 : CALL mp_timestop(handle)
1738 502886 : END SUBROUTINE mp_max_${nametype1}$v
1739 :
1740 : ! **************************************************************************************************
1741 : !> \brief Finds the element-wise maximum of a rank2-array with the result left on
1742 : !> all processes.
1743 : !> \param[in] msg Matrix - Find maximum among these data (input) and
1744 : !> maximum (output)
1745 : !> \param comm ...
1746 : !> \note see mp_max_${nametype1}$
1747 : ! **************************************************************************************************
1748 68 : SUBROUTINE mp_max_${nametype1}$m(msg, comm)
1749 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :)
1750 : CLASS(mp_comm_type), INTENT(IN) :: comm
1751 :
1752 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_${nametype1}$m'
1753 :
1754 : INTEGER :: handle
1755 : #if defined(__parallel)
1756 : INTEGER, PARAMETER :: max_msg = 2**25
1757 : INTEGER :: ierr, m1, msglen, ncols, step, msglensum
1758 68 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1759 : #endif
1760 :
1761 68 : CALL mp_timeset(routineN, handle)
1762 :
1763 : #if defined(__parallel)
1764 : ! chunk up the call so that message sizes are limited, to avoid overflows in mpich triggered in large rpa calcs
1765 204 : step = MAX(1, SIZE(msg, 2)/MAX(1, SIZE(msg)/max_msg))
1766 68 : msglensum = 0
1767 204 : DO m1 = LBOUND(msg, 2), UBOUND(msg, 2), step
1768 68 : msglen = SIZE(msg, 1)*(MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1)
1769 68 : msglensum = msglensum + msglen
1770 136 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1771 68 : ncols = MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1
1772 204 : ALLOCATE (msgbuf(msglen))
1773 68 : CALL mpi_allreduce(msg(LBOUND(msg, 1), m1), msgbuf, msglen, ${mpi_type1}$, MPI_MAX, comm%handle, ierr)
1774 68 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1775 204 : msg(:, m1:m1 + ncols - 1) = RESHAPE(msgbuf, [SIZE(msg, 1), ncols])
1776 68 : DEALLOCATE (msgbuf)
1777 : END IF
1778 : END DO
1779 68 : CALL add_perf(perf_id=3, count=1, msg_size=msglensum*${bytes1}$)
1780 : #else
1781 : MARK_USED(msg)
1782 : MARK_USED(comm)
1783 : #endif
1784 68 : CALL mp_timestop(handle)
1785 68 : END SUBROUTINE mp_max_${nametype1}$m
1786 :
1787 : ! **************************************************************************************************
1788 : !> \brief Finds the element-wise maximum of a vector with the result left on
1789 : !> all processes.
1790 : !> \param[in,out] msg Find maximum among these data (input) and
1791 : !> maximum (output)
1792 : !> \param comm ...
1793 : !> \note see mp_max_${nametype1}$
1794 : ! **************************************************************************************************
1795 2 : SUBROUTINE mp_max_root_${nametype1}$m(msg, root, comm)
1796 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :)
1797 : INTEGER :: root
1798 : CLASS(mp_comm_type), INTENT(IN) :: comm
1799 :
1800 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_max_root_${nametype1}$m'
1801 :
1802 : INTEGER :: handle
1803 : #if defined(__parallel)
1804 : INTEGER :: ierr, msglen
1805 4 : ${type1}$ :: res(SIZE(msg, 1), SIZE(msg, 2))
1806 : #endif
1807 :
1808 2 : CALL mp_timeset(routineN, handle)
1809 :
1810 : #if defined(__parallel)
1811 6 : msglen = SIZE(msg)
1812 2 : CALL mpi_reduce(msg, res, msglen, ${mpi_type1}$, MPI_MAX, root, comm%handle, ierr)
1813 2 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1814 9 : IF (root == comm%mepos) msg = res
1815 2 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1816 : #else
1817 : MARK_USED(msg)
1818 : MARK_USED(comm)
1819 : MARK_USED(root)
1820 : #endif
1821 2 : CALL mp_timestop(handle)
1822 2 : END SUBROUTINE mp_max_root_${nametype1}$m
1823 :
1824 : ! **************************************************************************************************
1825 : !> \brief Finds the minimum of a datum with the result left on all processes.
1826 : !> \param[in,out] msg Find minimum among these data (input) and
1827 : !> maximum (output)
1828 : !> \param[in] comm Message passing environment identifier
1829 : !> \par MPI mapping
1830 : !> mpi_allreduce
1831 : ! **************************************************************************************************
1832 13056 : SUBROUTINE mp_min_${nametype1}$ (msg, comm)
1833 : ${type1}$, INTENT(INOUT) :: msg
1834 : CLASS(mp_comm_type), INTENT(IN) :: comm
1835 :
1836 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_min_${nametype1}$'
1837 :
1838 : INTEGER :: handle
1839 : #if defined(__parallel)
1840 : INTEGER :: ierr, msglen
1841 : ${type1}$ :: res
1842 : #endif
1843 :
1844 13056 : CALL mp_timeset(routineN, handle)
1845 :
1846 : #if defined(__parallel)
1847 13056 : msglen = 1
1848 13056 : IF (comm%num_pe > 1) THEN
1849 13006 : CALL mpi_allreduce(msg, res, msglen, ${mpi_type1}$, MPI_MIN, comm%handle, ierr)
1850 13006 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1851 13006 : msg = res
1852 : END IF
1853 13056 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1854 : #else
1855 : MARK_USED(msg)
1856 : MARK_USED(comm)
1857 : #endif
1858 13056 : CALL mp_timestop(handle)
1859 13056 : END SUBROUTINE mp_min_${nametype1}$
1860 :
1861 : ! **************************************************************************************************
1862 : !> \brief Finds the element-wise minimum of vector with the result left on
1863 : !> all processes.
1864 : !> \param[in,out] msg Find minimum among these data (input) and
1865 : !> maximum (output)
1866 : !> \param comm ...
1867 : !> \par MPI mapping
1868 : !> mpi_allreduce
1869 : !> \note see mp_min_${nametype1}$
1870 : ! **************************************************************************************************
1871 49857 : SUBROUTINE mp_min_${nametype1}$v(msg, comm)
1872 : ${type1}$, INTENT(INOUT), CONTIGUOUS :: msg(:)
1873 : CLASS(mp_comm_type), INTENT(IN) :: comm
1874 :
1875 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_min_${nametype1}$v'
1876 :
1877 : INTEGER :: handle
1878 : #if defined(__parallel)
1879 : INTEGER :: ierr, msglen
1880 49857 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1881 : #endif
1882 :
1883 49857 : CALL mp_timeset(routineN, handle)
1884 :
1885 : #if defined(__parallel)
1886 49857 : msglen = SIZE(msg)
1887 49857 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1888 148806 : ALLOCATE (msgbuf(msglen))
1889 49602 : CALL mpi_allreduce(msg, msgbuf, msglen, ${mpi_type1}$, MPI_MIN, comm%handle, ierr)
1890 49602 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1891 172572 : msg = msgbuf
1892 : END IF
1893 49857 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1894 : #else
1895 : MARK_USED(msg)
1896 : MARK_USED(comm)
1897 : #endif
1898 49857 : CALL mp_timestop(handle)
1899 49857 : END SUBROUTINE mp_min_${nametype1}$v
1900 :
1901 : ! **************************************************************************************************
1902 : !> \brief Finds the element-wise minimum of a rank2-array with the result left on
1903 : !> all processes.
1904 : !> \param[in] msg Matrix - Find maximum among these data (input) and
1905 : !> minimum (output)
1906 : !> \param comm ...
1907 : !> \note see mp_min_${nametype1}$
1908 : ! **************************************************************************************************
1909 68 : SUBROUTINE mp_min_${nametype1}$m(msg, comm)
1910 : ${type1}$, CONTIGUOUS, INTENT(INOUT) :: msg(:, :)
1911 : CLASS(mp_comm_type), INTENT(IN) :: comm
1912 :
1913 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_min_${nametype1}$m'
1914 :
1915 : INTEGER :: handle
1916 : #if defined(__parallel)
1917 : INTEGER, PARAMETER :: max_msg = 2**25
1918 : INTEGER :: ierr, m1, msglen, ncols, step, msglensum
1919 68 : ${type1}$, ALLOCATABLE :: msgbuf(:)
1920 : #endif
1921 :
1922 68 : CALL mp_timeset(routineN, handle)
1923 :
1924 : #if defined(__parallel)
1925 : ! chunk up the call so that message sizes are limited, to avoid overflows in mpich triggered in large rpa calcs
1926 204 : step = MAX(1, SIZE(msg, 2)/MAX(1, SIZE(msg)/max_msg))
1927 68 : msglensum = 0
1928 204 : DO m1 = LBOUND(msg, 2), UBOUND(msg, 2), step
1929 68 : msglen = SIZE(msg, 1)*(MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1)
1930 68 : msglensum = msglensum + msglen
1931 136 : IF (msglen > 0 .AND. comm%num_pe > 1) THEN
1932 68 : ncols = MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1
1933 204 : ALLOCATE (msgbuf(msglen))
1934 68 : CALL mpi_allreduce(msg(LBOUND(msg, 1), m1), msgbuf, msglen, ${mpi_type1}$, MPI_MIN, comm%handle, ierr)
1935 68 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1936 204 : msg(:, m1:m1 + ncols - 1) = RESHAPE(msgbuf, [SIZE(msg, 1), ncols])
1937 68 : DEALLOCATE (msgbuf)
1938 : END IF
1939 : END DO
1940 68 : CALL add_perf(perf_id=3, count=1, msg_size=msglensum*${bytes1}$)
1941 : #else
1942 : MARK_USED(msg)
1943 : MARK_USED(comm)
1944 : #endif
1945 68 : CALL mp_timestop(handle)
1946 68 : END SUBROUTINE mp_min_${nametype1}$m
1947 :
1948 : ! **************************************************************************************************
1949 : !> \brief Multiplies a set of numbers scattered across a number of processes,
1950 : !> then replicates the result.
1951 : !> \param[in,out] msg a number to multiply (input) and result (output)
1952 : !> \param[in] comm message passing environment identifier
1953 : !> \par MPI mapping
1954 : !> mpi_allreduce
1955 : ! **************************************************************************************************
1956 6356 : SUBROUTINE mp_prod_${nametype1}$ (msg, comm)
1957 : ${type1}$, INTENT(INOUT) :: msg
1958 : CLASS(mp_comm_type), INTENT(IN) :: comm
1959 :
1960 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_prod_${nametype1}$'
1961 :
1962 : INTEGER :: handle
1963 : #if defined(__parallel)
1964 : INTEGER :: ierr, msglen
1965 : ${type1}$ :: res
1966 : #endif
1967 :
1968 6356 : CALL mp_timeset(routineN, handle)
1969 :
1970 : #if defined(__parallel)
1971 6356 : msglen = 1
1972 6356 : IF (comm%num_pe > 1) THEN
1973 6356 : CALL mpi_allreduce(msg, res, msglen, ${mpi_type1}$, MPI_PROD, comm%handle, ierr)
1974 6356 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN)
1975 6356 : msg = res
1976 : END IF
1977 6356 : CALL add_perf(perf_id=3, count=1, msg_size=msglen*${bytes1}$)
1978 : #else
1979 : MARK_USED(msg)
1980 : MARK_USED(comm)
1981 : #endif
1982 6356 : CALL mp_timestop(handle)
1983 6356 : END SUBROUTINE mp_prod_${nametype1}$
1984 :
1985 : ! **************************************************************************************************
1986 : !> \brief Scatters data from one processes to all others
1987 : !> \param[in] msg_scatter Data to scatter (for root process)
1988 : !> \param[out] msg Received data
1989 : !> \param[in] root Process which scatters data
1990 : !> \param[in] comm Message passing environment identifier
1991 : !> \par MPI mapping
1992 : !> mpi_scatter
1993 : ! **************************************************************************************************
1994 0 : SUBROUTINE mp_scatter_${nametype1}$v(msg_scatter, msg, root, comm)
1995 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg_scatter(:)
1996 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg(:)
1997 : INTEGER, INTENT(IN) :: root
1998 : CLASS(mp_comm_type), INTENT(IN) :: comm
1999 :
2000 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_scatter_${nametype1}$v'
2001 :
2002 : INTEGER :: handle
2003 : #if defined(__parallel)
2004 : INTEGER :: ierr, msglen
2005 : #endif
2006 :
2007 0 : CALL mp_timeset(routineN, handle)
2008 :
2009 : #if defined(__parallel)
2010 0 : msglen = SIZE(msg)
2011 : CALL mpi_scatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
2012 0 : msglen, ${mpi_type1}$, root, comm%handle, ierr)
2013 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_scatter @ "//routineN)
2014 0 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2015 : #else
2016 : MARK_USED(root)
2017 : MARK_USED(comm)
2018 : msg = msg_scatter
2019 : #endif
2020 0 : CALL mp_timestop(handle)
2021 0 : END SUBROUTINE mp_scatter_${nametype1}$v
2022 :
2023 : ! **************************************************************************************************
2024 : !> \brief Scatters data from one processes to all others
2025 : !> \param[in] msg_scatter Data to scatter (for root process)
2026 : !> \param[in] root Process which scatters data
2027 : !> \param[in] comm Message passing environment identifier
2028 : !> \par MPI mapping
2029 : !> mpi_scatter
2030 : ! **************************************************************************************************
2031 0 : SUBROUTINE mp_iscatter_${nametype1}$ (msg_scatter, msg, root, comm, request)
2032 : ${type1}$, INTENT(IN) :: msg_scatter(:)
2033 : ${type1}$, INTENT(INOUT) :: msg
2034 : INTEGER, INTENT(IN) :: root
2035 : CLASS(mp_comm_type), INTENT(IN) :: comm
2036 : TYPE(mp_request_type), INTENT(OUT) :: request
2037 :
2038 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatter_${nametype1}$'
2039 :
2040 : INTEGER :: handle
2041 : #if defined(__parallel)
2042 : INTEGER :: ierr, msglen
2043 : #endif
2044 :
2045 0 : CALL mp_timeset(routineN, handle)
2046 :
2047 : #if defined(__parallel)
2048 : #if !defined(__GNUC__) || __GNUC__ >= 9
2049 0 : CPASSERT(IS_CONTIGUOUS(msg_scatter) .OR. SIZE(msg_scatter) == 0)
2050 : #endif
2051 0 : msglen = 1
2052 : CALL mpi_iscatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
2053 0 : msglen, ${mpi_type1}$, root, comm%handle, request%handle, ierr)
2054 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatter @ "//routineN)
2055 0 : CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
2056 : #else
2057 : MARK_USED(root)
2058 : MARK_USED(comm)
2059 : msg = msg_scatter(1)
2060 : request = mp_request_null
2061 : #endif
2062 0 : CALL mp_timestop(handle)
2063 0 : END SUBROUTINE mp_iscatter_${nametype1}$
2064 :
2065 : ! **************************************************************************************************
2066 : !> \brief Scatters data from one processes to all others
2067 : !> \param[in] msg_scatter Data to scatter (for root process)
2068 : !> \param[in] root Process which scatters data
2069 : !> \param[in] comm Message passing environment identifier
2070 : !> \par MPI mapping
2071 : !> mpi_scatter
2072 : ! **************************************************************************************************
2073 0 : SUBROUTINE mp_iscatter_${nametype1}$v2(msg_scatter, msg, root, comm, request)
2074 : ${type1}$, INTENT(IN) :: msg_scatter(:, :)
2075 : ${type1}$, INTENT(INOUT) :: msg(:)
2076 : INTEGER, INTENT(IN) :: root
2077 : CLASS(mp_comm_type), INTENT(IN) :: comm
2078 : TYPE(mp_request_type), INTENT(OUT) :: request
2079 :
2080 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatter_${nametype1}$v2'
2081 :
2082 : INTEGER :: handle
2083 : #if defined(__parallel)
2084 : INTEGER :: ierr, msglen
2085 : #endif
2086 :
2087 0 : CALL mp_timeset(routineN, handle)
2088 :
2089 : #if defined(__parallel)
2090 : #if !defined(__GNUC__) || __GNUC__ >= 9
2091 0 : CPASSERT(IS_CONTIGUOUS(msg_scatter) .OR. SIZE(msg_scatter) == 0)
2092 : #endif
2093 0 : msglen = SIZE(msg)
2094 : CALL mpi_iscatter(msg_scatter, msglen, ${mpi_type1}$, msg, &
2095 0 : msglen, ${mpi_type1}$, root, comm%handle, request%handle, ierr)
2096 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatter @ "//routineN)
2097 0 : CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
2098 : #else
2099 : MARK_USED(root)
2100 : MARK_USED(comm)
2101 : msg(:) = msg_scatter(:, 1)
2102 : request = mp_request_null
2103 : #endif
2104 0 : CALL mp_timestop(handle)
2105 0 : END SUBROUTINE mp_iscatter_${nametype1}$v2
2106 :
2107 : ! **************************************************************************************************
2108 : !> \brief Scatters data from one processes to all others
2109 : !> \param[in] msg_scatter Data to scatter (for root process)
2110 : !> \param[in] root Process which scatters data
2111 : !> \param[in] comm Message passing environment identifier
2112 : !> \par MPI mapping
2113 : !> mpi_scatter
2114 : ! **************************************************************************************************
2115 0 : SUBROUTINE mp_iscatterv_${nametype1}$v(msg_scatter, sendcounts, displs, msg, recvcount, root, comm, request)
2116 : ${type1}$, INTENT(IN) :: msg_scatter(:)
2117 : INTEGER, INTENT(IN) :: sendcounts(:), displs(:)
2118 : ${type1}$, INTENT(INOUT) :: msg(:)
2119 : INTEGER, INTENT(IN) :: recvcount, root
2120 : CLASS(mp_comm_type), INTENT(IN) :: comm
2121 : TYPE(mp_request_type), INTENT(OUT) :: request
2122 :
2123 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iscatterv_${nametype1}$v'
2124 :
2125 : INTEGER :: handle
2126 : #if defined(__parallel)
2127 : INTEGER :: ierr
2128 : #endif
2129 :
2130 0 : CALL mp_timeset(routineN, handle)
2131 :
2132 : #if defined(__parallel)
2133 : #if !defined(__GNUC__) || __GNUC__ >= 9
2134 0 : CPASSERT(IS_CONTIGUOUS(msg_scatter) .OR. SIZE(msg_scatter) == 0)
2135 0 : CPASSERT(IS_CONTIGUOUS(msg) .OR. SIZE(msg) == 0)
2136 0 : CPASSERT(IS_CONTIGUOUS(sendcounts) .OR. SIZE(sendcounts) == 0)
2137 0 : CPASSERT(IS_CONTIGUOUS(displs) .OR. SIZE(displs) == 0)
2138 : #endif
2139 : CALL mpi_iscatterv(msg_scatter, sendcounts, displs, ${mpi_type1}$, msg, &
2140 0 : recvcount, ${mpi_type1}$, root, comm%handle, request%handle, ierr)
2141 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iscatterv @ "//routineN)
2142 0 : CALL add_perf(perf_id=24, count=1, msg_size=1*${bytes1}$)
2143 : #else
2144 : MARK_USED(sendcounts)
2145 : MARK_USED(displs)
2146 : MARK_USED(recvcount)
2147 : MARK_USED(root)
2148 : MARK_USED(comm)
2149 : msg(1:recvcount) = msg_scatter(1 + displs(1):1 + displs(1) + sendcounts(1))
2150 : request = mp_request_null
2151 : #endif
2152 0 : CALL mp_timestop(handle)
2153 0 : END SUBROUTINE mp_iscatterv_${nametype1}$v
2154 :
2155 : ! **************************************************************************************************
2156 : !> \brief Gathers a datum from all processes to one
2157 : !> \param[in] msg Datum to send to root
2158 : !> \param[out] msg_gather Received data (on root)
2159 : !> \param[in] root Process which gathers the data
2160 : !> \param[in] comm Message passing environment identifier
2161 : !> \par MPI mapping
2162 : !> mpi_gather
2163 : ! **************************************************************************************************
2164 0 : SUBROUTINE mp_gather_${nametype1}$ (msg, msg_gather, root, comm)
2165 : ${type1}$, INTENT(IN) :: msg
2166 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:)
2167 : INTEGER, INTENT(IN) :: root
2168 : CLASS(mp_comm_type), INTENT(IN) :: comm
2169 :
2170 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$'
2171 :
2172 : INTEGER :: handle
2173 : #if defined(__parallel)
2174 : INTEGER :: ierr, msglen
2175 : #endif
2176 :
2177 0 : CALL mp_timeset(routineN, handle)
2178 :
2179 : #if defined(__parallel)
2180 0 : msglen = 1
2181 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2182 0 : msglen, ${mpi_type1}$, root, comm%handle, ierr)
2183 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2184 0 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2185 : #else
2186 : MARK_USED(root)
2187 : MARK_USED(comm)
2188 : msg_gather(1) = msg
2189 : #endif
2190 0 : CALL mp_timestop(handle)
2191 0 : END SUBROUTINE mp_gather_${nametype1}$
2192 :
2193 : ! **************************************************************************************************
2194 : !> \brief Gathers a datum from all processes to one, uses the source process of comm
2195 : !> \param[in] msg Datum to send to root
2196 : !> \param[out] msg_gather Received data (on root)
2197 : !> \param[in] comm Message passing environment identifier
2198 : !> \par MPI mapping
2199 : !> mpi_gather
2200 : ! **************************************************************************************************
2201 30 : SUBROUTINE mp_gather_${nametype1}$_src(msg, msg_gather, comm)
2202 : ${type1}$, INTENT(IN) :: msg
2203 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:)
2204 : CLASS(mp_comm_type), INTENT(IN) :: comm
2205 :
2206 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$_src'
2207 :
2208 : INTEGER :: handle
2209 : #if defined(__parallel)
2210 : INTEGER :: ierr, msglen
2211 : #endif
2212 :
2213 30 : CALL mp_timeset(routineN, handle)
2214 :
2215 : #if defined(__parallel)
2216 30 : msglen = 1
2217 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2218 30 : msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
2219 30 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2220 30 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2221 : #else
2222 : MARK_USED(comm)
2223 : msg_gather(1) = msg
2224 : #endif
2225 30 : CALL mp_timestop(handle)
2226 30 : END SUBROUTINE mp_gather_${nametype1}$_src
2227 :
2228 : ! **************************************************************************************************
2229 : !> \brief Gathers data from all processes to one
2230 : !> \param[in] msg Datum to send to root
2231 : !> \param msg_gather ...
2232 : !> \param root ...
2233 : !> \param comm ...
2234 : !> \par Data length
2235 : !> All data (msg) is equal-sized
2236 : !> \par MPI mapping
2237 : !> mpi_gather
2238 : !> \note see mp_gather_${nametype1}$
2239 : ! **************************************************************************************************
2240 0 : SUBROUTINE mp_gather_${nametype1}$v(msg, msg_gather, root, comm)
2241 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:)
2242 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:)
2243 : INTEGER, INTENT(IN) :: root
2244 : CLASS(mp_comm_type), INTENT(IN) :: comm
2245 :
2246 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$v'
2247 :
2248 : INTEGER :: handle
2249 : #if defined(__parallel)
2250 : INTEGER :: ierr, msglen
2251 : #endif
2252 :
2253 0 : CALL mp_timeset(routineN, handle)
2254 :
2255 : #if defined(__parallel)
2256 0 : msglen = SIZE(msg)
2257 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2258 0 : msglen, ${mpi_type1}$, root, comm%handle, ierr)
2259 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2260 0 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2261 : #else
2262 : MARK_USED(root)
2263 : MARK_USED(comm)
2264 : msg_gather = msg
2265 : #endif
2266 0 : CALL mp_timestop(handle)
2267 0 : END SUBROUTINE mp_gather_${nametype1}$v
2268 :
2269 : ! **************************************************************************************************
2270 : !> \brief Gathers data from all processes to one. Gathers from comm%source
2271 : !> \param[in] msg Datum to send to root
2272 : !> \param msg_gather ...
2273 : !> \param comm ...
2274 : !> \par Data length
2275 : !> All data (msg) is equal-sized
2276 : !> \par MPI mapping
2277 : !> mpi_gather
2278 : !> \note see mp_gather_${nametype1}$
2279 : ! **************************************************************************************************
2280 0 : SUBROUTINE mp_gather_${nametype1}$v_src(msg, msg_gather, comm)
2281 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:)
2282 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:)
2283 : CLASS(mp_comm_type), INTENT(IN) :: comm
2284 :
2285 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$v_src'
2286 :
2287 : INTEGER :: handle
2288 : #if defined(__parallel)
2289 : INTEGER :: ierr, msglen
2290 : #endif
2291 :
2292 0 : CALL mp_timeset(routineN, handle)
2293 :
2294 : #if defined(__parallel)
2295 0 : msglen = SIZE(msg)
2296 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2297 0 : msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
2298 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2299 0 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2300 : #else
2301 : MARK_USED(comm)
2302 : msg_gather = msg
2303 : #endif
2304 0 : CALL mp_timestop(handle)
2305 0 : END SUBROUTINE mp_gather_${nametype1}$v_src
2306 :
2307 : ! **************************************************************************************************
2308 : !> \brief Gathers data from all processes to one
2309 : !> \param[in] msg Datum to send to root
2310 : !> \param msg_gather ...
2311 : !> \param root ...
2312 : !> \param comm ...
2313 : !> \par Data length
2314 : !> All data (msg) is equal-sized
2315 : !> \par MPI mapping
2316 : !> mpi_gather
2317 : !> \note see mp_gather_${nametype1}$
2318 : ! **************************************************************************************************
2319 0 : SUBROUTINE mp_gather_${nametype1}$m(msg, msg_gather, root, comm)
2320 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:, :)
2321 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:, :)
2322 : INTEGER, INTENT(IN) :: root
2323 : CLASS(mp_comm_type), INTENT(IN) :: comm
2324 :
2325 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$m'
2326 :
2327 : INTEGER :: handle
2328 : #if defined(__parallel)
2329 : INTEGER :: ierr, msglen
2330 : #endif
2331 :
2332 0 : CALL mp_timeset(routineN, handle)
2333 :
2334 : #if defined(__parallel)
2335 0 : msglen = SIZE(msg)
2336 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2337 0 : msglen, ${mpi_type1}$, root, comm%handle, ierr)
2338 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2339 0 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2340 : #else
2341 : MARK_USED(root)
2342 : MARK_USED(comm)
2343 : msg_gather = msg
2344 : #endif
2345 0 : CALL mp_timestop(handle)
2346 0 : END SUBROUTINE mp_gather_${nametype1}$m
2347 :
2348 : ! **************************************************************************************************
2349 : !> \brief Gathers data from all processes to one. Gathers from comm%source
2350 : !> \param[in] msg Datum to send to root
2351 : !> \param msg_gather ...
2352 : !> \param comm ...
2353 : !> \par Data length
2354 : !> All data (msg) is equal-sized
2355 : !> \par MPI mapping
2356 : !> mpi_gather
2357 : !> \note see mp_gather_${nametype1}$
2358 : ! **************************************************************************************************
2359 102 : SUBROUTINE mp_gather_${nametype1}$m_src(msg, msg_gather, comm)
2360 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:, :)
2361 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msg_gather(:, :)
2362 : CLASS(mp_comm_type), INTENT(IN) :: comm
2363 :
2364 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gather_${nametype1}$m_src'
2365 :
2366 : INTEGER :: handle
2367 : #if defined(__parallel)
2368 : INTEGER :: ierr, msglen
2369 : #endif
2370 :
2371 102 : CALL mp_timeset(routineN, handle)
2372 :
2373 : #if defined(__parallel)
2374 306 : msglen = SIZE(msg)
2375 : CALL mpi_gather(msg, msglen, ${mpi_type1}$, msg_gather, &
2376 102 : msglen, ${mpi_type1}$, comm%source, comm%handle, ierr)
2377 102 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gather @ "//routineN)
2378 102 : CALL add_perf(perf_id=4, count=1, msg_size=msglen*${bytes1}$)
2379 : #else
2380 : MARK_USED(comm)
2381 : msg_gather = msg
2382 : #endif
2383 102 : CALL mp_timestop(handle)
2384 102 : END SUBROUTINE mp_gather_${nametype1}$m_src
2385 :
2386 : ! **************************************************************************************************
2387 : !> \brief Gathers data from all processes to one.
2388 : !> \param[in] sendbuf Data to send to root
2389 : !> \param[out] recvbuf Received data (on root)
2390 : !> \param[in] recvcounts Sizes of data received from processes
2391 : !> \param[in] displs Offsets of data received from processes
2392 : !> \param[in] root Process which gathers the data
2393 : !> \param[in] comm Message passing environment identifier
2394 : !> \par Data length
2395 : !> Data can have different lengths
2396 : !> \par Offsets
2397 : !> Offsets start at 0
2398 : !> \par MPI mapping
2399 : !> mpi_gather
2400 : ! **************************************************************************************************
2401 0 : SUBROUTINE mp_gatherv_${nametype1}$v(sendbuf, recvbuf, recvcounts, displs, root, comm)
2402 :
2403 : ${type1}$, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: sendbuf
2404 : ${type1}$, DIMENSION(:), CONTIGUOUS, INTENT(OUT) :: recvbuf
2405 : INTEGER, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: recvcounts, displs
2406 : INTEGER, INTENT(IN) :: root
2407 : CLASS(mp_comm_type), INTENT(IN) :: comm
2408 :
2409 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gatherv_${nametype1}$v'
2410 :
2411 : INTEGER :: handle
2412 : #if defined(__parallel)
2413 : INTEGER :: ierr, sendcount
2414 : #endif
2415 :
2416 0 : CALL mp_timeset(routineN, handle)
2417 :
2418 : #if defined(__parallel)
2419 0 : sendcount = SIZE(sendbuf)
2420 : CALL mpi_gatherv(sendbuf, sendcount, ${mpi_type1}$, &
2421 : recvbuf, recvcounts, displs, ${mpi_type1}$, &
2422 0 : root, comm%handle, ierr)
2423 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
2424 : CALL add_perf(perf_id=4, &
2425 : count=1, &
2426 0 : msg_size=sendcount*${bytes1}$)
2427 : #else
2428 : MARK_USED(recvcounts)
2429 : MARK_USED(root)
2430 : MARK_USED(comm)
2431 : recvbuf(1 + displs(1):) = sendbuf
2432 : #endif
2433 0 : CALL mp_timestop(handle)
2434 0 : END SUBROUTINE mp_gatherv_${nametype1}$v
2435 :
2436 : ! **************************************************************************************************
2437 : !> \brief Gathers data from all processes to one. Gathers from comm%source
2438 : !> \param[in] sendbuf Data to send to root
2439 : !> \param[out] recvbuf Received data (on root)
2440 : !> \param[in] recvcounts Sizes of data received from processes
2441 : !> \param[in] displs Offsets of data received from processes
2442 : !> \param[in] comm Message passing environment identifier
2443 : !> \par Data length
2444 : !> Data can have different lengths
2445 : !> \par Offsets
2446 : !> Offsets start at 0
2447 : !> \par MPI mapping
2448 : !> mpi_gather
2449 : ! **************************************************************************************************
2450 210 : SUBROUTINE mp_gatherv_${nametype1}$v_src(sendbuf, recvbuf, recvcounts, displs, comm)
2451 :
2452 : ${type1}$, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: sendbuf
2453 : ${type1}$, DIMENSION(:), CONTIGUOUS, INTENT(OUT) :: recvbuf
2454 : INTEGER, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: recvcounts, displs
2455 : CLASS(mp_comm_type), INTENT(IN) :: comm
2456 :
2457 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gatherv_${nametype1}$v_src'
2458 :
2459 : INTEGER :: handle
2460 : #if defined(__parallel)
2461 : INTEGER :: ierr, sendcount
2462 : #endif
2463 :
2464 210 : CALL mp_timeset(routineN, handle)
2465 :
2466 : #if defined(__parallel)
2467 210 : sendcount = SIZE(sendbuf)
2468 : CALL mpi_gatherv(sendbuf, sendcount, ${mpi_type1}$, &
2469 : recvbuf, recvcounts, displs, ${mpi_type1}$, &
2470 210 : comm%source, comm%handle, ierr)
2471 210 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
2472 : CALL add_perf(perf_id=4, &
2473 : count=1, &
2474 210 : msg_size=sendcount*${bytes1}$)
2475 : #else
2476 : MARK_USED(recvcounts)
2477 : MARK_USED(comm)
2478 : recvbuf(1 + displs(1):) = sendbuf
2479 : #endif
2480 210 : CALL mp_timestop(handle)
2481 210 : END SUBROUTINE mp_gatherv_${nametype1}$v_src
2482 :
2483 : ! **************************************************************************************************
2484 : !> \brief Gathers data from all processes to one.
2485 : !> \param[in] sendbuf Data to send to root
2486 : !> \param[out] recvbuf Received data (on root)
2487 : !> \param[in] recvcounts Sizes of data received from processes
2488 : !> \param[in] displs Offsets of data received from processes
2489 : !> \param[in] root Process which gathers the data
2490 : !> \param[in] comm Message passing environment identifier
2491 : !> \par Data length
2492 : !> Data can have different lengths
2493 : !> \par Offsets
2494 : !> Offsets start at 0
2495 : !> \par MPI mapping
2496 : !> mpi_gather
2497 : ! **************************************************************************************************
2498 0 : SUBROUTINE mp_gatherv_${nametype1}$m2(sendbuf, recvbuf, recvcounts, displs, root, comm)
2499 :
2500 : ${type1}$, DIMENSION(:, :), CONTIGUOUS, INTENT(IN) :: sendbuf
2501 : ${type1}$, DIMENSION(:, :), CONTIGUOUS, INTENT(OUT) :: recvbuf
2502 : INTEGER, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: recvcounts, displs
2503 : INTEGER, INTENT(IN) :: root
2504 : CLASS(mp_comm_type), INTENT(IN) :: comm
2505 :
2506 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gatherv_${nametype1}$m2'
2507 :
2508 : INTEGER :: handle
2509 : #if defined(__parallel)
2510 : INTEGER :: ierr, sendcount
2511 : #endif
2512 :
2513 0 : CALL mp_timeset(routineN, handle)
2514 :
2515 : #if defined(__parallel)
2516 0 : sendcount = SIZE(sendbuf)
2517 : CALL mpi_gatherv(sendbuf, sendcount, ${mpi_type1}$, &
2518 : recvbuf, recvcounts, displs, ${mpi_type1}$, &
2519 0 : root, comm%handle, ierr)
2520 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
2521 : CALL add_perf(perf_id=4, &
2522 : count=1, &
2523 0 : msg_size=sendcount*${bytes1}$)
2524 : #else
2525 : MARK_USED(recvcounts)
2526 : MARK_USED(root)
2527 : MARK_USED(comm)
2528 : recvbuf(:, 1 + displs(1):) = sendbuf
2529 : #endif
2530 0 : CALL mp_timestop(handle)
2531 0 : END SUBROUTINE mp_gatherv_${nametype1}$m2
2532 :
2533 : ! **************************************************************************************************
2534 : !> \brief Gathers data from all processes to one.
2535 : !> \param[in] sendbuf Data to send to root
2536 : !> \param[out] recvbuf Received data (on root)
2537 : !> \param[in] recvcounts Sizes of data received from processes
2538 : !> \param[in] displs Offsets of data received from processes
2539 : !> \param[in] comm Message passing environment identifier
2540 : !> \par Data length
2541 : !> Data can have different lengths
2542 : !> \par Offsets
2543 : !> Offsets start at 0
2544 : !> \par MPI mapping
2545 : !> mpi_gather
2546 : ! **************************************************************************************************
2547 0 : SUBROUTINE mp_gatherv_${nametype1}$m2_src(sendbuf, recvbuf, recvcounts, displs, comm)
2548 :
2549 : ${type1}$, DIMENSION(:, :), CONTIGUOUS, INTENT(IN) :: sendbuf
2550 : ${type1}$, DIMENSION(:, :), CONTIGUOUS, INTENT(OUT) :: recvbuf
2551 : INTEGER, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: recvcounts, displs
2552 : CLASS(mp_comm_type), INTENT(IN) :: comm
2553 :
2554 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_gatherv_${nametype1}$m2_src'
2555 :
2556 : INTEGER :: handle
2557 : #if defined(__parallel)
2558 : INTEGER :: ierr, sendcount
2559 : #endif
2560 :
2561 0 : CALL mp_timeset(routineN, handle)
2562 :
2563 : #if defined(__parallel)
2564 0 : sendcount = SIZE(sendbuf)
2565 : CALL mpi_gatherv(sendbuf, sendcount, ${mpi_type1}$, &
2566 : recvbuf, recvcounts, displs, ${mpi_type1}$, &
2567 0 : comm%source, comm%handle, ierr)
2568 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
2569 : CALL add_perf(perf_id=4, &
2570 : count=1, &
2571 0 : msg_size=sendcount*${bytes1}$)
2572 : #else
2573 : MARK_USED(recvcounts)
2574 : MARK_USED(comm)
2575 : recvbuf(:, 1 + displs(1):) = sendbuf
2576 : #endif
2577 0 : CALL mp_timestop(handle)
2578 0 : END SUBROUTINE mp_gatherv_${nametype1}$m2_src
2579 :
2580 : ! **************************************************************************************************
2581 : !> \brief Gathers data from all processes to one.
2582 : !> \param[in] sendbuf Data to send to root
2583 : !> \param[out] recvbuf Received data (on root)
2584 : !> \param[in] recvcounts Sizes of data received from processes
2585 : !> \param[in] displs Offsets of data received from processes
2586 : !> \param[in] root Process which gathers the data
2587 : !> \param[in] comm Message passing environment identifier
2588 : !> \par Data length
2589 : !> Data can have different lengths
2590 : !> \par Offsets
2591 : !> Offsets start at 0
2592 : !> \par MPI mapping
2593 : !> mpi_gather
2594 : ! **************************************************************************************************
2595 0 : SUBROUTINE mp_igatherv_${nametype1}$v(sendbuf, sendcount, recvbuf, recvcounts, displs, root, comm, request)
2596 : ${type1}$, DIMENSION(:), INTENT(IN) :: sendbuf
2597 : ${type1}$, DIMENSION(:), INTENT(OUT) :: recvbuf
2598 : INTEGER, DIMENSION(:), CONTIGUOUS, INTENT(IN) :: recvcounts, displs
2599 : INTEGER, INTENT(IN) :: sendcount, root
2600 : CLASS(mp_comm_type), INTENT(IN) :: comm
2601 : TYPE(mp_request_type), INTENT(OUT) :: request
2602 :
2603 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_igatherv_${nametype1}$v'
2604 :
2605 : INTEGER :: handle
2606 : #if defined(__parallel)
2607 : INTEGER :: ierr
2608 : #endif
2609 :
2610 0 : CALL mp_timeset(routineN, handle)
2611 :
2612 : #if defined(__parallel)
2613 : #if !defined(__GNUC__) || __GNUC__ >= 9
2614 0 : CPASSERT(IS_CONTIGUOUS(sendbuf) .OR. SIZE(sendbuf) == 0)
2615 0 : CPASSERT(IS_CONTIGUOUS(recvbuf) .OR. SIZE(recvbuf) == 0)
2616 0 : CPASSERT(IS_CONTIGUOUS(recvcounts) .OR. SIZE(recvcounts) == 0)
2617 0 : CPASSERT(IS_CONTIGUOUS(displs) .OR. SIZE(displs) == 0)
2618 : #endif
2619 : CALL mpi_igatherv(sendbuf, sendcount, ${mpi_type1}$, &
2620 : recvbuf, recvcounts, displs, ${mpi_type1}$, &
2621 0 : root, comm%handle, request%handle, ierr)
2622 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_gatherv @ "//routineN)
2623 : CALL add_perf(perf_id=24, &
2624 : count=1, &
2625 0 : msg_size=sendcount*${bytes1}$)
2626 : #else
2627 : MARK_USED(sendcount)
2628 : MARK_USED(recvcounts)
2629 : MARK_USED(root)
2630 : MARK_USED(comm)
2631 : recvbuf(1 + displs(1):1 + displs(1) + recvcounts(1)) = sendbuf(1:sendcount)
2632 : request = mp_request_null
2633 : #endif
2634 0 : CALL mp_timestop(handle)
2635 0 : END SUBROUTINE mp_igatherv_${nametype1}$v
2636 :
2637 : ! **************************************************************************************************
2638 : !> \brief Gathers a datum from all processes and all processes receive the
2639 : !> same data
2640 : !> \param[in] msgout Datum to send
2641 : !> \param[out] msgin Received data
2642 : !> \param[in] comm Message passing environment identifier
2643 : !> \par Data size
2644 : !> All processes send equal-sized data
2645 : !> \par MPI mapping
2646 : !> mpi_allgather
2647 : ! **************************************************************************************************
2648 1336466 : SUBROUTINE mp_allgather_${nametype1}$ (msgout, msgin, comm)
2649 : ${type1}$, INTENT(IN) :: msgout
2650 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:)
2651 : CLASS(mp_comm_type), INTENT(IN) :: comm
2652 :
2653 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$'
2654 :
2655 : INTEGER :: handle
2656 : #if defined(__parallel)
2657 : INTEGER :: ierr, rcount, scount
2658 : #endif
2659 :
2660 1336466 : CALL mp_timeset(routineN, handle)
2661 :
2662 : #if defined(__parallel)
2663 1336466 : scount = 1
2664 1336466 : rcount = 1
2665 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2666 : msgin, rcount, ${mpi_type1}$, &
2667 1336466 : comm%handle, ierr)
2668 1336466 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2669 : #else
2670 : MARK_USED(comm)
2671 : msgin = msgout
2672 : #endif
2673 1336466 : CALL mp_timestop(handle)
2674 1336466 : END SUBROUTINE mp_allgather_${nametype1}$
2675 :
2676 : ! **************************************************************************************************
2677 : !> \brief Gathers a datum from all processes and all processes receive the
2678 : !> same data
2679 : !> \param[in] msgout Datum to send
2680 : !> \param[out] msgin Received data
2681 : !> \param[in] comm Message passing environment identifier
2682 : !> \par Data size
2683 : !> All processes send equal-sized data
2684 : !> \par MPI mapping
2685 : !> mpi_allgather
2686 : ! **************************************************************************************************
2687 0 : SUBROUTINE mp_allgather_${nametype1}$2(msgout, msgin, comm)
2688 : ${type1}$, INTENT(IN) :: msgout
2689 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:, :)
2690 : CLASS(mp_comm_type), INTENT(IN) :: comm
2691 :
2692 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$2'
2693 :
2694 : INTEGER :: handle
2695 : #if defined(__parallel)
2696 : INTEGER :: ierr, rcount, scount
2697 : #endif
2698 :
2699 0 : CALL mp_timeset(routineN, handle)
2700 :
2701 : #if defined(__parallel)
2702 0 : scount = 1
2703 0 : rcount = 1
2704 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2705 : msgin, rcount, ${mpi_type1}$, &
2706 0 : comm%handle, ierr)
2707 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2708 : #else
2709 : MARK_USED(comm)
2710 : msgin = msgout
2711 : #endif
2712 0 : CALL mp_timestop(handle)
2713 0 : END SUBROUTINE mp_allgather_${nametype1}$2
2714 :
2715 : ! **************************************************************************************************
2716 : !> \brief Gathers a datum from all processes and all processes receive the
2717 : !> same data
2718 : !> \param[in] msgout Datum to send
2719 : !> \param[out] msgin Received data
2720 : !> \param[in] comm Message passing environment identifier
2721 : !> \par Data size
2722 : !> All processes send equal-sized data
2723 : !> \par MPI mapping
2724 : !> mpi_allgather
2725 : ! **************************************************************************************************
2726 0 : SUBROUTINE mp_iallgather_${nametype1}$ (msgout, msgin, comm, request)
2727 : ${type1}$, INTENT(IN) :: msgout
2728 : ${type1}$, INTENT(OUT) :: msgin(:)
2729 : CLASS(mp_comm_type), INTENT(IN) :: comm
2730 : TYPE(mp_request_type), INTENT(OUT) :: request
2731 :
2732 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$'
2733 :
2734 : INTEGER :: handle
2735 : #if defined(__parallel)
2736 : INTEGER :: ierr, rcount, scount
2737 : #endif
2738 :
2739 0 : CALL mp_timeset(routineN, handle)
2740 :
2741 : #if defined(__parallel)
2742 : #if !defined(__GNUC__) || __GNUC__ >= 9
2743 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
2744 : #endif
2745 0 : scount = 1
2746 0 : rcount = 1
2747 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
2748 : msgin, rcount, ${mpi_type1}$, &
2749 0 : comm%handle, request%handle, ierr)
2750 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2751 : #else
2752 : MARK_USED(comm)
2753 : msgin = msgout
2754 : request = mp_request_null
2755 : #endif
2756 0 : CALL mp_timestop(handle)
2757 0 : END SUBROUTINE mp_iallgather_${nametype1}$
2758 :
2759 : ! **************************************************************************************************
2760 : !> \brief Gathers vector data from all processes and all processes receive the
2761 : !> same data
2762 : !> \param[in] msgout Rank-1 data to send
2763 : !> \param[out] msgin Received data
2764 : !> \param[in] comm Message passing environment identifier
2765 : !> \par Data size
2766 : !> All processes send equal-sized data
2767 : !> \par Ranks
2768 : !> The last rank counts the processes
2769 : !> \par MPI mapping
2770 : !> mpi_allgather
2771 : ! **************************************************************************************************
2772 4990 : SUBROUTINE mp_allgather_${nametype1}$12(msgout, msgin, comm)
2773 : ${type1}$, INTENT(IN), CONTIGUOUS :: msgout(:)
2774 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:, :)
2775 : CLASS(mp_comm_type), INTENT(IN) :: comm
2776 :
2777 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$12'
2778 :
2779 : INTEGER :: handle
2780 : #if defined(__parallel)
2781 : INTEGER :: ierr, rcount, scount
2782 : #endif
2783 :
2784 4990 : CALL mp_timeset(routineN, handle)
2785 :
2786 : #if defined(__parallel)
2787 4990 : scount = SIZE(msgout(:))
2788 4990 : rcount = scount
2789 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2790 : msgin, rcount, ${mpi_type1}$, &
2791 4990 : comm%handle, ierr)
2792 4990 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2793 : #else
2794 : MARK_USED(comm)
2795 : msgin(:, 1) = msgout(:)
2796 : #endif
2797 4990 : CALL mp_timestop(handle)
2798 4990 : END SUBROUTINE mp_allgather_${nametype1}$12
2799 :
2800 : ! **************************************************************************************************
2801 : !> \brief Gathers matrix data from all processes and all processes receive the
2802 : !> same data
2803 : !> \param[in] msgout Rank-2 data to send
2804 : !> \param msgin ...
2805 : !> \param comm ...
2806 : !> \note see mp_allgather_${nametype1}$12
2807 : ! **************************************************************************************************
2808 89356 : SUBROUTINE mp_allgather_${nametype1}$23(msgout, msgin, comm)
2809 : ${type1}$, INTENT(IN), CONTIGUOUS :: msgout(:, :)
2810 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:, :, :)
2811 : CLASS(mp_comm_type), INTENT(IN) :: comm
2812 :
2813 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$23'
2814 :
2815 : INTEGER :: handle
2816 : #if defined(__parallel)
2817 : INTEGER :: ierr, rcount, scount
2818 : #endif
2819 :
2820 89356 : CALL mp_timeset(routineN, handle)
2821 :
2822 : #if defined(__parallel)
2823 268068 : scount = SIZE(msgout(:, :))
2824 89356 : rcount = scount
2825 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2826 : msgin, rcount, ${mpi_type1}$, &
2827 89356 : comm%handle, ierr)
2828 89356 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2829 : #else
2830 : MARK_USED(comm)
2831 : msgin(:, :, 1) = msgout(:, :)
2832 : #endif
2833 89356 : CALL mp_timestop(handle)
2834 89356 : END SUBROUTINE mp_allgather_${nametype1}$23
2835 :
2836 : ! **************************************************************************************************
2837 : !> \brief Gathers rank-3 data from all processes and all processes receive the
2838 : !> same data
2839 : !> \param[in] msgout Rank-3 data to send
2840 : !> \param msgin ...
2841 : !> \param comm ...
2842 : !> \note see mp_allgather_${nametype1}$12
2843 : ! **************************************************************************************************
2844 442 : SUBROUTINE mp_allgather_${nametype1}$34(msgout, msgin, comm)
2845 : ${type1}$, INTENT(IN), CONTIGUOUS :: msgout(:, :, :)
2846 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:, :, :, :)
2847 : CLASS(mp_comm_type), INTENT(IN) :: comm
2848 :
2849 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$34'
2850 :
2851 : INTEGER :: handle
2852 : #if defined(__parallel)
2853 : INTEGER :: ierr, rcount, scount
2854 : #endif
2855 :
2856 442 : CALL mp_timeset(routineN, handle)
2857 :
2858 : #if defined(__parallel)
2859 1768 : scount = SIZE(msgout(:, :, :))
2860 442 : rcount = scount
2861 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2862 : msgin, rcount, ${mpi_type1}$, &
2863 442 : comm%handle, ierr)
2864 442 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2865 : #else
2866 : MARK_USED(comm)
2867 : msgin(:, :, :, 1) = msgout(:, :, :)
2868 : #endif
2869 442 : CALL mp_timestop(handle)
2870 442 : END SUBROUTINE mp_allgather_${nametype1}$34
2871 :
2872 : ! **************************************************************************************************
2873 : !> \brief Gathers rank-2 data from all processes and all processes receive the
2874 : !> same data
2875 : !> \param[in] msgout Rank-2 data to send
2876 : !> \param msgin ...
2877 : !> \param comm ...
2878 : !> \note see mp_allgather_${nametype1}$12
2879 : ! **************************************************************************************************
2880 0 : SUBROUTINE mp_allgather_${nametype1}$22(msgout, msgin, comm)
2881 : ${type1}$, INTENT(IN), CONTIGUOUS :: msgout(:, :)
2882 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msgin(:, :)
2883 : CLASS(mp_comm_type), INTENT(IN) :: comm
2884 :
2885 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgather_${nametype1}$22'
2886 :
2887 : INTEGER :: handle
2888 : #if defined(__parallel)
2889 : INTEGER :: ierr, rcount, scount
2890 : #endif
2891 :
2892 0 : CALL mp_timeset(routineN, handle)
2893 :
2894 : #if defined(__parallel)
2895 0 : scount = SIZE(msgout(:, :))
2896 0 : rcount = scount
2897 : CALL MPI_ALLGATHER(msgout, scount, ${mpi_type1}$, &
2898 : msgin, rcount, ${mpi_type1}$, &
2899 0 : comm%handle, ierr)
2900 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgather @ "//routineN)
2901 : #else
2902 : MARK_USED(comm)
2903 : msgin(:, :) = msgout(:, :)
2904 : #endif
2905 0 : CALL mp_timestop(handle)
2906 0 : END SUBROUTINE mp_allgather_${nametype1}$22
2907 :
2908 : ! **************************************************************************************************
2909 : !> \brief Gathers rank-1 data from all processes and all processes receive the
2910 : !> same data
2911 : !> \param[in] msgout Rank-1 data to send
2912 : !> \param msgin ...
2913 : !> \param comm ...
2914 : !> \param request ...
2915 : !> \note see mp_allgather_${nametype1}$11
2916 : ! **************************************************************************************************
2917 0 : SUBROUTINE mp_iallgather_${nametype1}$11(msgout, msgin, comm, request)
2918 : ${type1}$, INTENT(IN) :: msgout(:)
2919 : ${type1}$, INTENT(OUT) :: msgin(:)
2920 : CLASS(mp_comm_type), INTENT(IN) :: comm
2921 : TYPE(mp_request_type), INTENT(OUT) :: request
2922 :
2923 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$11'
2924 :
2925 : INTEGER :: handle
2926 : #if defined(__parallel)
2927 : INTEGER :: ierr, rcount, scount
2928 : #endif
2929 :
2930 0 : CALL mp_timeset(routineN, handle)
2931 :
2932 : #if defined(__parallel)
2933 : #if !defined(__GNUC__) || __GNUC__ >= 9
2934 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
2935 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
2936 : #endif
2937 0 : scount = SIZE(msgout(:))
2938 0 : rcount = scount
2939 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
2940 : msgin, rcount, ${mpi_type1}$, &
2941 0 : comm%handle, request%handle, ierr)
2942 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
2943 : #else
2944 : MARK_USED(comm)
2945 : msgin = msgout
2946 : request = mp_request_null
2947 : #endif
2948 0 : CALL mp_timestop(handle)
2949 0 : END SUBROUTINE mp_iallgather_${nametype1}$11
2950 :
2951 : ! **************************************************************************************************
2952 : !> \brief Gathers rank-2 data from all processes and all processes receive the
2953 : !> same data
2954 : !> \param[in] msgout Rank-2 data to send
2955 : !> \param msgin ...
2956 : !> \param comm ...
2957 : !> \param request ...
2958 : !> \note see mp_allgather_${nametype1}$12
2959 : ! **************************************************************************************************
2960 0 : SUBROUTINE mp_iallgather_${nametype1}$13(msgout, msgin, comm, request)
2961 : ${type1}$, INTENT(IN) :: msgout(:)
2962 : ${type1}$, INTENT(OUT) :: msgin(:, :, :)
2963 : CLASS(mp_comm_type), INTENT(IN) :: comm
2964 : TYPE(mp_request_type), INTENT(OUT) :: request
2965 :
2966 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$13'
2967 :
2968 : INTEGER :: handle
2969 : #if defined(__parallel)
2970 : INTEGER :: ierr, rcount, scount
2971 : #endif
2972 :
2973 0 : CALL mp_timeset(routineN, handle)
2974 :
2975 : #if defined(__parallel)
2976 : #if !defined(__GNUC__) || __GNUC__ >= 9
2977 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
2978 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
2979 : #endif
2980 :
2981 0 : scount = SIZE(msgout(:))
2982 0 : rcount = scount
2983 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
2984 : msgin, rcount, ${mpi_type1}$, &
2985 0 : comm%handle, request%handle, ierr)
2986 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
2987 : #else
2988 : MARK_USED(comm)
2989 : msgin(:, 1, 1) = msgout(:)
2990 : request = mp_request_null
2991 : #endif
2992 0 : CALL mp_timestop(handle)
2993 0 : END SUBROUTINE mp_iallgather_${nametype1}$13
2994 :
2995 : ! **************************************************************************************************
2996 : !> \brief Gathers rank-2 data from all processes and all processes receive the
2997 : !> same data
2998 : !> \param[in] msgout Rank-2 data to send
2999 : !> \param msgin ...
3000 : !> \param comm ...
3001 : !> \param request ...
3002 : !> \note see mp_allgather_${nametype1}$12
3003 : ! **************************************************************************************************
3004 0 : SUBROUTINE mp_iallgather_${nametype1}$22(msgout, msgin, comm, request)
3005 : ${type1}$, INTENT(IN) :: msgout(:, :)
3006 : ${type1}$, INTENT(OUT) :: msgin(:, :)
3007 : CLASS(mp_comm_type), INTENT(IN) :: comm
3008 : TYPE(mp_request_type), INTENT(OUT) :: request
3009 :
3010 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$22'
3011 :
3012 : INTEGER :: handle
3013 : #if defined(__parallel)
3014 : INTEGER :: ierr, rcount, scount
3015 : #endif
3016 :
3017 0 : CALL mp_timeset(routineN, handle)
3018 :
3019 : #if defined(__parallel)
3020 : #if !defined(__GNUC__) || __GNUC__ >= 9
3021 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3022 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3023 : #endif
3024 :
3025 0 : scount = SIZE(msgout(:, :))
3026 0 : rcount = scount
3027 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
3028 : msgin, rcount, ${mpi_type1}$, &
3029 0 : comm%handle, request%handle, ierr)
3030 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
3031 : #else
3032 : MARK_USED(comm)
3033 : msgin(:, :) = msgout(:, :)
3034 : request = mp_request_null
3035 : #endif
3036 0 : CALL mp_timestop(handle)
3037 0 : END SUBROUTINE mp_iallgather_${nametype1}$22
3038 :
3039 : ! **************************************************************************************************
3040 : !> \brief Gathers rank-2 data from all processes and all processes receive the
3041 : !> same data
3042 : !> \param[in] msgout Rank-2 data to send
3043 : !> \param msgin ...
3044 : !> \param comm ...
3045 : !> \param request ...
3046 : !> \note see mp_allgather_${nametype1}$12
3047 : ! **************************************************************************************************
3048 0 : SUBROUTINE mp_iallgather_${nametype1}$24(msgout, msgin, comm, request)
3049 : ${type1}$, INTENT(IN) :: msgout(:, :)
3050 : ${type1}$, INTENT(OUT) :: msgin(:, :, :, :)
3051 : CLASS(mp_comm_type), INTENT(IN) :: comm
3052 : TYPE(mp_request_type), INTENT(OUT) :: request
3053 :
3054 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$24'
3055 :
3056 : INTEGER :: handle
3057 : #if defined(__parallel)
3058 : INTEGER :: ierr, rcount, scount
3059 : #endif
3060 :
3061 0 : CALL mp_timeset(routineN, handle)
3062 :
3063 : #if defined(__parallel)
3064 : #if !defined(__GNUC__) || __GNUC__ >= 9
3065 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3066 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3067 : #endif
3068 :
3069 0 : scount = SIZE(msgout(:, :))
3070 0 : rcount = scount
3071 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
3072 : msgin, rcount, ${mpi_type1}$, &
3073 0 : comm%handle, request%handle, ierr)
3074 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
3075 : #else
3076 : MARK_USED(comm)
3077 : msgin(:, :, 1, 1) = msgout(:, :)
3078 : request = mp_request_null
3079 : #endif
3080 0 : CALL mp_timestop(handle)
3081 0 : END SUBROUTINE mp_iallgather_${nametype1}$24
3082 :
3083 : ! **************************************************************************************************
3084 : !> \brief Gathers rank-3 data from all processes and all processes receive the
3085 : !> same data
3086 : !> \param[in] msgout Rank-3 data to send
3087 : !> \param msgin ...
3088 : !> \param comm ...
3089 : !> \param request ...
3090 : !> \note see mp_allgather_${nametype1}$12
3091 : ! **************************************************************************************************
3092 0 : SUBROUTINE mp_iallgather_${nametype1}$33(msgout, msgin, comm, request)
3093 : ${type1}$, INTENT(IN) :: msgout(:, :, :)
3094 : ${type1}$, INTENT(OUT) :: msgin(:, :, :)
3095 : CLASS(mp_comm_type), INTENT(IN) :: comm
3096 : TYPE(mp_request_type), INTENT(OUT) :: request
3097 :
3098 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgather_${nametype1}$33'
3099 :
3100 : INTEGER :: handle
3101 : #if defined(__parallel)
3102 : INTEGER :: ierr, rcount, scount
3103 : #endif
3104 :
3105 0 : CALL mp_timeset(routineN, handle)
3106 :
3107 : #if defined(__parallel)
3108 : #if !defined(__GNUC__) || __GNUC__ >= 9
3109 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3110 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3111 : #endif
3112 :
3113 0 : scount = SIZE(msgout(:, :, :))
3114 0 : rcount = scount
3115 : CALL MPI_IALLGATHER(msgout, scount, ${mpi_type1}$, &
3116 : msgin, rcount, ${mpi_type1}$, &
3117 0 : comm%handle, request%handle, ierr)
3118 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgather @ "//routineN)
3119 : #else
3120 : MARK_USED(comm)
3121 : msgin(:, :, :) = msgout(:, :, :)
3122 : request = mp_request_null
3123 : #endif
3124 0 : CALL mp_timestop(handle)
3125 0 : END SUBROUTINE mp_iallgather_${nametype1}$33
3126 :
3127 : ! **************************************************************************************************
3128 : !> \brief Gathers vector data from all processes and all processes receive the
3129 : !> same data
3130 : !> \param[in] msgout Rank-1 data to send
3131 : !> \param[out] msgin Received data
3132 : !> \param[in] rcount Size of sent data for every process
3133 : !> \param[in] rdispl Offset of sent data for every process
3134 : !> \param[in] comm Message passing environment identifier
3135 : !> \par Data size
3136 : !> Processes can send different-sized data
3137 : !> \par Ranks
3138 : !> The last rank counts the processes
3139 : !> \par Offsets
3140 : !> Offsets are from 0
3141 : !> \par MPI mapping
3142 : !> mpi_allgather
3143 : ! **************************************************************************************************
3144 269300 : SUBROUTINE mp_allgatherv_${nametype1}$v(msgout, msgin, rcount, rdispl, comm)
3145 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgout(:)
3146 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgin(:)
3147 : INTEGER, CONTIGUOUS, INTENT(IN) :: rcount(:), rdispl(:)
3148 : CLASS(mp_comm_type), INTENT(IN) :: comm
3149 :
3150 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgatherv_${nametype1}$v'
3151 :
3152 : INTEGER :: handle
3153 : #if defined(__parallel)
3154 : INTEGER :: ierr, scount
3155 : #endif
3156 :
3157 269300 : CALL mp_timeset(routineN, handle)
3158 :
3159 : #if defined(__parallel)
3160 269300 : scount = SIZE(msgout)
3161 : CALL MPI_ALLGATHERV(msgout, scount, ${mpi_type1}$, msgin, rcount, &
3162 269300 : rdispl, ${mpi_type1}$, comm%handle, ierr)
3163 269300 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgatherv @ "//routineN)
3164 : #else
3165 : MARK_USED(rcount)
3166 : MARK_USED(rdispl)
3167 : MARK_USED(comm)
3168 : msgin = msgout
3169 : #endif
3170 269300 : CALL mp_timestop(handle)
3171 269300 : END SUBROUTINE mp_allgatherv_${nametype1}$v
3172 :
3173 : ! **************************************************************************************************
3174 : !> \brief Gathers vector data from all processes and all processes receive the
3175 : !> same data
3176 : !> \param[in] msgout Rank-1 data to send
3177 : !> \param[out] msgin Received data
3178 : !> \param[in] rcount Size of sent data for every process
3179 : !> \param[in] rdispl Offset of sent data for every process
3180 : !> \param[in] comm Message passing environment identifier
3181 : !> \par Data size
3182 : !> Processes can send different-sized data
3183 : !> \par Ranks
3184 : !> The last rank counts the processes
3185 : !> \par Offsets
3186 : !> Offsets are from 0
3187 : !> \par MPI mapping
3188 : !> mpi_allgather
3189 : ! **************************************************************************************************
3190 4 : SUBROUTINE mp_allgatherv_${nametype1}$m2(msgout, msgin, rcount, rdispl, comm)
3191 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgout(:, :)
3192 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgin(:, :)
3193 : INTEGER, CONTIGUOUS, INTENT(IN) :: rcount(:), rdispl(:)
3194 : CLASS(mp_comm_type), INTENT(IN) :: comm
3195 :
3196 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allgatherv_${nametype1}$v'
3197 :
3198 : INTEGER :: handle
3199 : #if defined(__parallel)
3200 : INTEGER :: ierr, scount
3201 : #endif
3202 :
3203 4 : CALL mp_timeset(routineN, handle)
3204 :
3205 : #if defined(__parallel)
3206 12 : scount = SIZE(msgout)
3207 : CALL MPI_ALLGATHERV(msgout, scount, ${mpi_type1}$, msgin, rcount, &
3208 4 : rdispl, ${mpi_type1}$, comm%handle, ierr)
3209 4 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allgatherv @ "//routineN)
3210 : #else
3211 : MARK_USED(rcount)
3212 : MARK_USED(rdispl)
3213 : MARK_USED(comm)
3214 : msgin = msgout
3215 : #endif
3216 4 : CALL mp_timestop(handle)
3217 4 : END SUBROUTINE mp_allgatherv_${nametype1}$m2
3218 :
3219 : ! **************************************************************************************************
3220 : !> \brief Gathers vector data from all processes and all processes receive the
3221 : !> same data
3222 : !> \param[in] msgout Rank-1 data to send
3223 : !> \param[out] msgin Received data
3224 : !> \param[in] rcount Size of sent data for every process
3225 : !> \param[in] rdispl Offset of sent data for every process
3226 : !> \param[in] comm Message passing environment identifier
3227 : !> \par Data size
3228 : !> Processes can send different-sized data
3229 : !> \par Ranks
3230 : !> The last rank counts the processes
3231 : !> \par Offsets
3232 : !> Offsets are from 0
3233 : !> \par MPI mapping
3234 : !> mpi_allgather
3235 : ! **************************************************************************************************
3236 0 : SUBROUTINE mp_iallgatherv_${nametype1}$v(msgout, msgin, rcount, rdispl, comm, request)
3237 : ${type1}$, INTENT(IN) :: msgout(:)
3238 : ${type1}$, INTENT(OUT) :: msgin(:)
3239 : INTEGER, CONTIGUOUS, INTENT(IN) :: rcount(:), rdispl(:)
3240 : CLASS(mp_comm_type), INTENT(IN) :: comm
3241 : TYPE(mp_request_type), INTENT(OUT) :: request
3242 :
3243 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgatherv_${nametype1}$v'
3244 :
3245 : INTEGER :: handle
3246 : #if defined(__parallel)
3247 : INTEGER :: ierr, scount, rsize
3248 : #endif
3249 :
3250 0 : CALL mp_timeset(routineN, handle)
3251 :
3252 : #if defined(__parallel)
3253 : #if !defined(__GNUC__) || __GNUC__ >= 9
3254 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3255 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3256 0 : CPASSERT(IS_CONTIGUOUS(rcount) .OR. SIZE(rcount) == 0)
3257 0 : CPASSERT(IS_CONTIGUOUS(rdispl) .OR. SIZE(rdispl) == 0)
3258 : #endif
3259 :
3260 0 : scount = SIZE(msgout)
3261 0 : rsize = SIZE(rcount)
3262 : CALL mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, &
3263 0 : rdispl, comm, request, ierr)
3264 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgatherv @ "//routineN)
3265 : #else
3266 : MARK_USED(rcount)
3267 : MARK_USED(rdispl)
3268 : MARK_USED(comm)
3269 : msgin = msgout
3270 : request = mp_request_null
3271 : #endif
3272 0 : CALL mp_timestop(handle)
3273 0 : END SUBROUTINE mp_iallgatherv_${nametype1}$v
3274 :
3275 : ! **************************************************************************************************
3276 : !> \brief Gathers vector data from all processes and all processes receive the
3277 : !> same data
3278 : !> \param[in] msgout Rank-1 data to send
3279 : !> \param[out] msgin Received data
3280 : !> \param[in] rcount Size of sent data for every process
3281 : !> \param[in] rdispl Offset of sent data for every process
3282 : !> \param[in] comm Message passing environment identifier
3283 : !> \par Data size
3284 : !> Processes can send different-sized data
3285 : !> \par Ranks
3286 : !> The last rank counts the processes
3287 : !> \par Offsets
3288 : !> Offsets are from 0
3289 : !> \par MPI mapping
3290 : !> mpi_allgather
3291 : ! **************************************************************************************************
3292 0 : SUBROUTINE mp_iallgatherv_${nametype1}$v2(msgout, msgin, rcount, rdispl, comm, request)
3293 : ${type1}$, INTENT(IN) :: msgout(:)
3294 : ${type1}$, INTENT(OUT) :: msgin(:)
3295 : INTEGER, INTENT(IN) :: rcount(:, :), rdispl(:, :)
3296 : CLASS(mp_comm_type), INTENT(IN) :: comm
3297 : TYPE(mp_request_type), INTENT(OUT) :: request
3298 :
3299 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_iallgatherv_${nametype1}$v2'
3300 :
3301 : INTEGER :: handle
3302 : #if defined(__parallel)
3303 : INTEGER :: ierr, scount, rsize
3304 : #endif
3305 :
3306 0 : CALL mp_timeset(routineN, handle)
3307 :
3308 : #if defined(__parallel)
3309 : #if !defined(__GNUC__) || __GNUC__ >= 9
3310 0 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3311 0 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3312 0 : CPASSERT(IS_CONTIGUOUS(rcount) .OR. SIZE(rcount) == 0)
3313 0 : CPASSERT(IS_CONTIGUOUS(rdispl) .OR. SIZE(rdispl) == 0)
3314 : #endif
3315 :
3316 0 : scount = SIZE(msgout)
3317 0 : rsize = SIZE(rcount)
3318 : CALL mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, &
3319 0 : rdispl, comm, request, ierr)
3320 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iallgatherv @ "//routineN)
3321 : #else
3322 : MARK_USED(rcount)
3323 : MARK_USED(rdispl)
3324 : MARK_USED(comm)
3325 : msgin = msgout
3326 : request = mp_request_null
3327 : #endif
3328 0 : CALL mp_timestop(handle)
3329 0 : END SUBROUTINE mp_iallgatherv_${nametype1}$v2
3330 :
3331 : ! **************************************************************************************************
3332 : !> \brief wrapper needed to deal with interfaces as present in openmpi 1.8.1
3333 : !> the issue is with the rank of rcount and rdispl
3334 : !> \param count ...
3335 : !> \param array_of_requests ...
3336 : !> \param array_of_statuses ...
3337 : !> \param ierr ...
3338 : !> \author Alfio Lazzaro
3339 : ! **************************************************************************************************
3340 : #if defined(__parallel)
3341 0 : SUBROUTINE mp_iallgatherv_${nametype1}$v_internal(msgout, scount, msgin, rsize, rcount, rdispl, comm, request, ierr)
3342 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgout(:)
3343 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgin(:)
3344 : INTEGER, INTENT(IN) :: rsize
3345 : INTEGER, INTENT(IN) :: rcount(rsize), rdispl(rsize), scount
3346 : CLASS(mp_comm_type), INTENT(IN) :: comm
3347 : TYPE(mp_request_type), INTENT(OUT) :: request
3348 : INTEGER, INTENT(INOUT) :: ierr
3349 :
3350 : CALL MPI_IALLGATHERV(msgout, scount, ${mpi_type1}$, msgin, rcount, &
3351 0 : rdispl, ${mpi_type1}$, comm%handle, request%handle, ierr)
3352 :
3353 0 : END SUBROUTINE mp_iallgatherv_${nametype1}$v_internal
3354 : #endif
3355 :
3356 : ! **************************************************************************************************
3357 : !> \brief Sums a vector and partitions the result among processes
3358 : !> \param[in] msgout Data to sum
3359 : !> \param[out] msgin Received portion of summed data
3360 : !> \param[in] rcount Partition sizes of the summed data for
3361 : !> every process
3362 : !> \param[in] comm Message passing environment identifier
3363 : ! **************************************************************************************************
3364 6 : SUBROUTINE mp_sum_scatter_${nametype1}$v(msgout, msgin, rcount, comm)
3365 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgout(:, :)
3366 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgin(:)
3367 : INTEGER, CONTIGUOUS, INTENT(IN) :: rcount(:)
3368 : CLASS(mp_comm_type), INTENT(IN) :: comm
3369 :
3370 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sum_scatter_${nametype1}$v'
3371 :
3372 : INTEGER :: handle
3373 : #if defined(__parallel)
3374 : INTEGER :: ierr
3375 : #endif
3376 :
3377 6 : CALL mp_timeset(routineN, handle)
3378 :
3379 : #if defined(__parallel)
3380 : CALL MPI_REDUCE_SCATTER(msgout, msgin, rcount, ${mpi_type1}$, MPI_SUM, &
3381 6 : comm%handle, ierr)
3382 6 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce_scatter @ "//routineN)
3383 :
3384 : CALL add_perf(perf_id=3, count=1, &
3385 6 : msg_size=rcount(1)*2*${bytes1}$)
3386 : #else
3387 : MARK_USED(rcount)
3388 : MARK_USED(comm)
3389 : msgin = msgout(:, 1)
3390 : #endif
3391 6 : CALL mp_timestop(handle)
3392 6 : END SUBROUTINE mp_sum_scatter_${nametype1}$v
3393 :
3394 : ! **************************************************************************************************
3395 : !> \brief Sends and receives vector data
3396 : !> \param[in] msgin Data to send
3397 : !> \param[in] dest Process to send data to
3398 : !> \param[out] msgout Received data
3399 : !> \param[in] source Process from which to receive
3400 : !> \param[in] comm Message passing environment identifier
3401 : !> \param[in] tag Send and recv tag (default: 0)
3402 : ! **************************************************************************************************
3403 0 : SUBROUTINE mp_sendrecv_${nametype1}$ (msgin, dest, msgout, source, comm, tag)
3404 : ${type1}$, INTENT(IN) :: msgin
3405 : INTEGER, INTENT(IN) :: dest
3406 : ${type1}$, INTENT(OUT) :: msgout
3407 : INTEGER, INTENT(IN) :: source
3408 : CLASS(mp_comm_type), INTENT(IN) :: comm
3409 : INTEGER, INTENT(IN), OPTIONAL :: tag
3410 :
3411 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$'
3412 :
3413 : INTEGER :: handle
3414 : #if defined(__parallel)
3415 : INTEGER :: ierr, msglen_in, msglen_out, &
3416 : recv_tag, send_tag
3417 : #endif
3418 :
3419 0 : CALL mp_timeset(routineN, handle)
3420 :
3421 : #if defined(__parallel)
3422 0 : msglen_in = 1
3423 0 : msglen_out = 1
3424 0 : send_tag = 0 ! cannot think of something better here, this might be dangerous
3425 0 : recv_tag = 0 ! cannot think of something better here, this might be dangerous
3426 0 : IF (PRESENT(tag)) THEN
3427 0 : send_tag = tag
3428 0 : recv_tag = tag
3429 : END IF
3430 : CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
3431 0 : msglen_out, ${mpi_type1}$, source, recv_tag, comm%handle, MPI_STATUS_IGNORE, ierr)
3432 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
3433 : CALL add_perf(perf_id=7, count=1, &
3434 0 : msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
3435 : #else
3436 : MARK_USED(dest)
3437 : MARK_USED(source)
3438 : MARK_USED(comm)
3439 : MARK_USED(tag)
3440 : msgout = msgin
3441 : #endif
3442 0 : CALL mp_timestop(handle)
3443 0 : END SUBROUTINE mp_sendrecv_${nametype1}$
3444 :
3445 : ! **************************************************************************************************
3446 : !> \brief Sends and receives vector data
3447 : !> \param[in] msgin Data to send
3448 : !> \param[in] dest Process to send data to
3449 : !> \param[out] msgout Received data
3450 : !> \param[in] source Process from which to receive
3451 : !> \param[in] comm Message passing environment identifier
3452 : !> \param[in] tag Send and recv tag (default: 0)
3453 : ! **************************************************************************************************
3454 1027440 : SUBROUTINE mp_sendrecv_${nametype1}$v(msgin, dest, msgout, source, comm, tag)
3455 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgin(:)
3456 : INTEGER, INTENT(IN) :: dest
3457 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgout(:)
3458 : INTEGER, INTENT(IN) :: source
3459 : CLASS(mp_comm_type), INTENT(IN) :: comm
3460 : INTEGER, INTENT(IN), OPTIONAL :: tag
3461 :
3462 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$v'
3463 :
3464 : INTEGER :: handle
3465 : #if defined(__parallel)
3466 : INTEGER :: ierr, msglen_in, msglen_out, &
3467 : recv_tag, send_tag
3468 : #endif
3469 :
3470 1027440 : CALL mp_timeset(routineN, handle)
3471 :
3472 : #if defined(__parallel)
3473 1027440 : msglen_in = SIZE(msgin)
3474 1027440 : msglen_out = SIZE(msgout)
3475 1027440 : send_tag = 0 ! cannot think of something better here, this might be dangerous
3476 1027440 : recv_tag = 0 ! cannot think of something better here, this might be dangerous
3477 1027440 : IF (PRESENT(tag)) THEN
3478 1027314 : send_tag = tag
3479 1027314 : recv_tag = tag
3480 : END IF
3481 : CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
3482 1027440 : msglen_out, ${mpi_type1}$, source, recv_tag, comm%handle, MPI_STATUS_IGNORE, ierr)
3483 1027440 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
3484 : CALL add_perf(perf_id=7, count=1, &
3485 1027440 : msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
3486 : #else
3487 : MARK_USED(dest)
3488 : MARK_USED(source)
3489 : MARK_USED(comm)
3490 : MARK_USED(tag)
3491 : msgout = msgin
3492 : #endif
3493 1027440 : CALL mp_timestop(handle)
3494 1027440 : END SUBROUTINE mp_sendrecv_${nametype1}$v
3495 :
3496 : ! **************************************************************************************************
3497 : !> \brief Sends and receives matrix data
3498 : !> \param msgin ...
3499 : !> \param dest ...
3500 : !> \param msgout ...
3501 : !> \param source ...
3502 : !> \param comm ...
3503 : !> \param tag ...
3504 : !> \note see mp_sendrecv_${nametype1}$v
3505 : ! **************************************************************************************************
3506 152968 : SUBROUTINE mp_sendrecv_${nametype1}$m2(msgin, dest, msgout, source, comm, tag)
3507 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgin(:, :)
3508 : INTEGER, INTENT(IN) :: dest
3509 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgout(:, :)
3510 : INTEGER, INTENT(IN) :: source
3511 : CLASS(mp_comm_type), INTENT(IN) :: comm
3512 : INTEGER, INTENT(IN), OPTIONAL :: tag
3513 :
3514 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m2'
3515 :
3516 : INTEGER :: handle
3517 : #if defined(__parallel)
3518 : INTEGER :: ierr, msglen_in, msglen_out, &
3519 : recv_tag, send_tag
3520 : #endif
3521 :
3522 152968 : CALL mp_timeset(routineN, handle)
3523 :
3524 : #if defined(__parallel)
3525 152968 : msglen_in = SIZE(msgin, 1)*SIZE(msgin, 2)
3526 152968 : msglen_out = SIZE(msgout, 1)*SIZE(msgout, 2)
3527 152968 : send_tag = 0 ! cannot think of something better here, this might be dangerous
3528 152968 : recv_tag = 0 ! cannot think of something better here, this might be dangerous
3529 152968 : IF (PRESENT(tag)) THEN
3530 646 : send_tag = tag
3531 646 : recv_tag = tag
3532 : END IF
3533 : CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
3534 152968 : msglen_out, ${mpi_type1}$, source, recv_tag, comm%handle, MPI_STATUS_IGNORE, ierr)
3535 152968 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
3536 : CALL add_perf(perf_id=7, count=1, &
3537 152968 : msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
3538 : #else
3539 : MARK_USED(dest)
3540 : MARK_USED(source)
3541 : MARK_USED(comm)
3542 : MARK_USED(tag)
3543 : msgout = msgin
3544 : #endif
3545 152968 : CALL mp_timestop(handle)
3546 152968 : END SUBROUTINE mp_sendrecv_${nametype1}$m2
3547 :
3548 : ! **************************************************************************************************
3549 : !> \brief Sends and receives rank-3 data
3550 : !> \param msgin ...
3551 : !> \param dest ...
3552 : !> \param msgout ...
3553 : !> \param source ...
3554 : !> \param comm ...
3555 : !> \note see mp_sendrecv_${nametype1}$v
3556 : ! **************************************************************************************************
3557 87834 : SUBROUTINE mp_sendrecv_${nametype1}$m3(msgin, dest, msgout, source, comm, tag)
3558 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgin(:, :, :)
3559 : INTEGER, INTENT(IN) :: dest
3560 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgout(:, :, :)
3561 : INTEGER, INTENT(IN) :: source
3562 : CLASS(mp_comm_type), INTENT(IN) :: comm
3563 : INTEGER, INTENT(IN), OPTIONAL :: tag
3564 :
3565 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m3'
3566 :
3567 : INTEGER :: handle
3568 : #if defined(__parallel)
3569 : INTEGER :: ierr, msglen_in, msglen_out, &
3570 : recv_tag, send_tag
3571 : #endif
3572 :
3573 87834 : CALL mp_timeset(routineN, handle)
3574 :
3575 : #if defined(__parallel)
3576 351336 : msglen_in = SIZE(msgin)
3577 351336 : msglen_out = SIZE(msgout)
3578 87834 : send_tag = 0 ! cannot think of something better here, this might be dangerous
3579 87834 : recv_tag = 0 ! cannot think of something better here, this might be dangerous
3580 87834 : IF (PRESENT(tag)) THEN
3581 484 : send_tag = tag
3582 484 : recv_tag = tag
3583 : END IF
3584 : CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
3585 87834 : msglen_out, ${mpi_type1}$, source, recv_tag, comm%handle, MPI_STATUS_IGNORE, ierr)
3586 87834 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
3587 : CALL add_perf(perf_id=7, count=1, &
3588 87834 : msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
3589 : #else
3590 : MARK_USED(dest)
3591 : MARK_USED(source)
3592 : MARK_USED(comm)
3593 : MARK_USED(tag)
3594 : msgout = msgin
3595 : #endif
3596 87834 : CALL mp_timestop(handle)
3597 87834 : END SUBROUTINE mp_sendrecv_${nametype1}$m3
3598 :
3599 : ! **************************************************************************************************
3600 : !> \brief Sends and receives rank-4 data
3601 : !> \param msgin ...
3602 : !> \param dest ...
3603 : !> \param msgout ...
3604 : !> \param source ...
3605 : !> \param comm ...
3606 : !> \note see mp_sendrecv_${nametype1}$v
3607 : ! **************************************************************************************************
3608 0 : SUBROUTINE mp_sendrecv_${nametype1}$m4(msgin, dest, msgout, source, comm, tag)
3609 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msgin(:, :, :, :)
3610 : INTEGER, INTENT(IN) :: dest
3611 : ${type1}$, CONTIGUOUS, INTENT(OUT) :: msgout(:, :, :, :)
3612 : INTEGER, INTENT(IN) :: source
3613 : CLASS(mp_comm_type), INTENT(IN) :: comm
3614 : INTEGER, INTENT(IN), OPTIONAL :: tag
3615 :
3616 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_sendrecv_${nametype1}$m4'
3617 :
3618 : INTEGER :: handle
3619 : #if defined(__parallel)
3620 : INTEGER :: ierr, msglen_in, msglen_out, &
3621 : recv_tag, send_tag
3622 : #endif
3623 :
3624 0 : CALL mp_timeset(routineN, handle)
3625 :
3626 : #if defined(__parallel)
3627 0 : msglen_in = SIZE(msgin)
3628 0 : msglen_out = SIZE(msgout)
3629 0 : send_tag = 0 ! cannot think of something better here, this might be dangerous
3630 0 : recv_tag = 0 ! cannot think of something better here, this might be dangerous
3631 0 : IF (PRESENT(tag)) THEN
3632 0 : send_tag = tag
3633 0 : recv_tag = tag
3634 : END IF
3635 : CALL mpi_sendrecv(msgin, msglen_in, ${mpi_type1}$, dest, send_tag, msgout, &
3636 0 : msglen_out, ${mpi_type1}$, source, recv_tag, comm%handle, MPI_STATUS_IGNORE, ierr)
3637 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
3638 : CALL add_perf(perf_id=7, count=1, &
3639 0 : msg_size=(msglen_in + msglen_out)*${bytes1}$/2)
3640 : #else
3641 : MARK_USED(dest)
3642 : MARK_USED(source)
3643 : MARK_USED(comm)
3644 : MARK_USED(tag)
3645 : msgout = msgin
3646 : #endif
3647 0 : CALL mp_timestop(handle)
3648 0 : END SUBROUTINE mp_sendrecv_${nametype1}$m4
3649 :
3650 : ! **************************************************************************************************
3651 : !> \brief Non-blocking send and receive of a scalar
3652 : !> \param[in] msgin Scalar data to send
3653 : !> \param[in] dest Which process to send to
3654 : !> \param[out] msgout Receive data into this pointer
3655 : !> \param[in] source Process to receive from
3656 : !> \param[in] comm Message passing environment identifier
3657 : !> \param[out] send_request Request handle for the send
3658 : !> \param[out] recv_request Request handle for the receive
3659 : !> \param[in] tag (optional) tag to differentiate requests
3660 : !> \par Implementation
3661 : !> Calls mpi_isend and mpi_irecv.
3662 : !> \par History
3663 : !> 02.2005 created [Alfio Lazzaro]
3664 : ! **************************************************************************************************
3665 0 : SUBROUTINE mp_isendrecv_${nametype1}$ (msgin, dest, msgout, source, comm, send_request, &
3666 : recv_request, tag)
3667 : ${type1}$, INTENT(IN) :: msgin
3668 : INTEGER, INTENT(IN) :: dest
3669 : ${type1}$, INTENT(INOUT) :: msgout
3670 : INTEGER, INTENT(IN) :: source
3671 : CLASS(mp_comm_type), INTENT(IN) :: comm
3672 : TYPE(mp_request_type), INTENT(out) :: send_request, recv_request
3673 : INTEGER, INTENT(in), OPTIONAL :: tag
3674 :
3675 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isendrecv_${nametype1}$'
3676 :
3677 : INTEGER :: handle
3678 : #if defined(__parallel)
3679 : INTEGER :: ierr, my_tag
3680 : #endif
3681 :
3682 0 : CALL mp_timeset(routineN, handle)
3683 :
3684 : #if defined(__parallel)
3685 0 : my_tag = 0
3686 0 : IF (PRESENT(tag)) my_tag = tag
3687 :
3688 : CALL mpi_irecv(msgout, 1, ${mpi_type1}$, source, my_tag, &
3689 0 : comm%handle, recv_request%handle, ierr)
3690 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
3691 :
3692 : CALL mpi_isend(msgin, 1, ${mpi_type1}$, dest, my_tag, &
3693 0 : comm%handle, send_request%handle, ierr)
3694 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
3695 :
3696 0 : CALL add_perf(perf_id=8, count=1, msg_size=2*${bytes1}$)
3697 : #else
3698 : MARK_USED(dest)
3699 : MARK_USED(source)
3700 : MARK_USED(comm)
3701 : MARK_USED(tag)
3702 : send_request = mp_request_null
3703 : recv_request = mp_request_null
3704 : msgout = msgin
3705 : #endif
3706 0 : CALL mp_timestop(handle)
3707 0 : END SUBROUTINE mp_isendrecv_${nametype1}$
3708 :
3709 : ! **************************************************************************************************
3710 : !> \brief Non-blocking send and receive of a vector
3711 : !> \param[in] msgin Vector data to send
3712 : !> \param[in] dest Which process to send to
3713 : !> \param[out] msgout Receive data into this pointer
3714 : !> \param[in] source Process to receive from
3715 : !> \param[in] comm Message passing environment identifier
3716 : !> \param[out] send_request Request handle for the send
3717 : !> \param[out] recv_request Request handle for the receive
3718 : !> \param[in] tag (optional) tag to differentiate requests
3719 : !> \par Implementation
3720 : !> Calls mpi_isend and mpi_irecv.
3721 : !> \par History
3722 : !> 11.2004 created [Joost VandeVondele]
3723 : !> \note
3724 : !> arrays can be pointers or assumed shape, but they must be contiguous!
3725 : ! **************************************************************************************************
3726 1031654 : SUBROUTINE mp_isendrecv_${nametype1}$v(msgin, dest, msgout, source, comm, send_request, &
3727 : recv_request, tag)
3728 : ${type1}$, DIMENSION(:), INTENT(IN) :: msgin
3729 : INTEGER, INTENT(IN) :: dest
3730 : ${type1}$, DIMENSION(:), INTENT(INOUT) :: msgout
3731 : INTEGER, INTENT(IN) :: source
3732 : CLASS(mp_comm_type), INTENT(IN) :: comm
3733 : TYPE(mp_request_type), INTENT(out) :: send_request, recv_request
3734 : INTEGER, INTENT(in), OPTIONAL :: tag
3735 :
3736 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isendrecv_${nametype1}$v'
3737 :
3738 : INTEGER :: handle
3739 : #if defined(__parallel)
3740 : INTEGER :: ierr, msglen, my_tag
3741 : ${type1}$ :: foo
3742 : #endif
3743 :
3744 1031654 : CALL mp_timeset(routineN, handle)
3745 :
3746 : #if defined(__parallel)
3747 : #if !defined(__GNUC__) || __GNUC__ >= 9
3748 1031654 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
3749 1031654 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3750 : #endif
3751 :
3752 1031654 : my_tag = 0
3753 1031654 : IF (PRESENT(tag)) my_tag = tag
3754 :
3755 1031654 : msglen = SIZE(msgout, 1)
3756 1031654 : IF (msglen > 0) THEN
3757 : CALL mpi_irecv(msgout(1), msglen, ${mpi_type1}$, source, my_tag, &
3758 1031654 : comm%handle, recv_request%handle, ierr)
3759 : ELSE
3760 : CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
3761 0 : comm%handle, recv_request%handle, ierr)
3762 : END IF
3763 1031654 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
3764 :
3765 1031654 : msglen = SIZE(msgin, 1)
3766 1031654 : IF (msglen > 0) THEN
3767 : CALL mpi_isend(msgin(1), msglen, ${mpi_type1}$, dest, my_tag, &
3768 1031654 : comm%handle, send_request%handle, ierr)
3769 : ELSE
3770 : CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
3771 0 : comm%handle, send_request%handle, ierr)
3772 : END IF
3773 1031654 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
3774 :
3775 1031654 : msglen = (msglen + SIZE(msgout, 1) + 1)/2
3776 1031654 : CALL add_perf(perf_id=8, count=1, msg_size=msglen*${bytes1}$)
3777 : #else
3778 : MARK_USED(dest)
3779 : MARK_USED(source)
3780 : MARK_USED(comm)
3781 : MARK_USED(tag)
3782 : send_request = mp_request_null
3783 : recv_request = mp_request_null
3784 : msgout = msgin
3785 : #endif
3786 1031654 : CALL mp_timestop(handle)
3787 1031654 : END SUBROUTINE mp_isendrecv_${nametype1}$v
3788 :
3789 : ! **************************************************************************************************
3790 : !> \brief Non-blocking send of vector data
3791 : !> \param msgin ...
3792 : !> \param dest ...
3793 : !> \param comm ...
3794 : !> \param request ...
3795 : !> \param tag ...
3796 : !> \par History
3797 : !> 08.2003 created [f&j]
3798 : !> \note see mp_isendrecv_${nametype1}$v
3799 : !> \note
3800 : !> arrays can be pointers or assumed shape, but they must be contiguous!
3801 : ! **************************************************************************************************
3802 2611082 : SUBROUTINE mp_isend_${nametype1}$v(msgin, dest, comm, request, tag)
3803 : ${type1}$, DIMENSION(:), INTENT(IN) :: msgin
3804 : INTEGER, INTENT(IN) :: dest
3805 : CLASS(mp_comm_type), INTENT(IN) :: comm
3806 : TYPE(mp_request_type), INTENT(out) :: request
3807 : INTEGER, INTENT(in), OPTIONAL :: tag
3808 :
3809 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$v'
3810 :
3811 : INTEGER :: handle, ierr
3812 : #if defined(__parallel)
3813 : INTEGER :: msglen, my_tag
3814 : ${type1}$ :: foo(1)
3815 : #endif
3816 :
3817 2611082 : CALL mp_timeset(routineN, handle)
3818 :
3819 : #if defined(__parallel)
3820 : #if !defined(__GNUC__) || __GNUC__ >= 9
3821 2611082 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3822 : #endif
3823 2611082 : my_tag = 0
3824 2611082 : IF (PRESENT(tag)) my_tag = tag
3825 :
3826 2611082 : msglen = SIZE(msgin)
3827 2611082 : IF (msglen > 0) THEN
3828 : CALL mpi_isend(msgin(1), msglen, ${mpi_type1}$, dest, my_tag, &
3829 2611052 : comm%handle, request%handle, ierr)
3830 : ELSE
3831 : CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
3832 30 : comm%handle, request%handle, ierr)
3833 : END IF
3834 2611082 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
3835 :
3836 2611082 : CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
3837 : #else
3838 : MARK_USED(msgin)
3839 : MARK_USED(dest)
3840 : MARK_USED(comm)
3841 : MARK_USED(request)
3842 : MARK_USED(tag)
3843 : ierr = 1
3844 : request = mp_request_null
3845 : CALL mp_stop(ierr, "mp_isend called in non parallel case")
3846 : #endif
3847 2611082 : CALL mp_timestop(handle)
3848 2611082 : END SUBROUTINE mp_isend_${nametype1}$v
3849 :
3850 : ! **************************************************************************************************
3851 : !> \brief Non-blocking send of matrix data
3852 : !> \param msgin ...
3853 : !> \param dest ...
3854 : !> \param comm ...
3855 : !> \param request ...
3856 : !> \param tag ...
3857 : !> \par History
3858 : !> 2009-11-25 [UB] Made type-generic for templates
3859 : !> \author fawzi
3860 : !> \note see mp_isendrecv_${nametype1}$v
3861 : !> \note see mp_isend_${nametype1}$v
3862 : !> \note
3863 : !> arrays can be pointers or assumed shape, but they must be contiguous!
3864 : ! **************************************************************************************************
3865 1303009 : SUBROUTINE mp_isend_${nametype1}$m2(msgin, dest, comm, request, tag)
3866 : ${type1}$, DIMENSION(:, :), INTENT(IN) :: msgin
3867 : INTEGER, INTENT(IN) :: dest
3868 : CLASS(mp_comm_type), INTENT(IN) :: comm
3869 : TYPE(mp_request_type), INTENT(out) :: request
3870 : INTEGER, INTENT(in), OPTIONAL :: tag
3871 :
3872 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m2'
3873 :
3874 : INTEGER :: handle, ierr
3875 : #if defined(__parallel)
3876 : INTEGER :: msglen, my_tag
3877 : ${type1}$ :: foo(1)
3878 : #endif
3879 :
3880 1303009 : CALL mp_timeset(routineN, handle)
3881 :
3882 : #if defined(__parallel)
3883 : #if !defined(__GNUC__) || __GNUC__ >= 9
3884 3909027 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3885 : #endif
3886 :
3887 1303009 : my_tag = 0
3888 1303009 : IF (PRESENT(tag)) my_tag = tag
3889 :
3890 1303009 : msglen = SIZE(msgin, 1)*SIZE(msgin, 2)
3891 1303009 : IF (msglen > 0) THEN
3892 : CALL mpi_isend(msgin(1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
3893 1303009 : comm%handle, request%handle, ierr)
3894 : ELSE
3895 : CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
3896 0 : comm%handle, request%handle, ierr)
3897 : END IF
3898 1303009 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
3899 :
3900 1303009 : CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
3901 : #else
3902 : MARK_USED(msgin)
3903 : MARK_USED(dest)
3904 : MARK_USED(comm)
3905 : MARK_USED(request)
3906 : MARK_USED(tag)
3907 : ierr = 1
3908 : request = mp_request_null
3909 : CALL mp_stop(ierr, "mp_isend called in non parallel case")
3910 : #endif
3911 1303009 : CALL mp_timestop(handle)
3912 1303009 : END SUBROUTINE mp_isend_${nametype1}$m2
3913 :
3914 : ! **************************************************************************************************
3915 : !> \brief Non-blocking send of rank-3 data
3916 : !> \param msgin ...
3917 : !> \param dest ...
3918 : !> \param comm ...
3919 : !> \param request ...
3920 : !> \param tag ...
3921 : !> \par History
3922 : !> 9.2008 added _rm3 subroutine [Iain Bethune]
3923 : !> (c) The Numerical Algorithms Group (NAG) Ltd, 2008 on behalf of the HECToR project
3924 : !> 2009-11-25 [UB] Made type-generic for templates
3925 : !> \author fawzi
3926 : !> \note see mp_isendrecv_${nametype1}$v
3927 : !> \note see mp_isend_${nametype1}$v
3928 : !> \note
3929 : !> arrays can be pointers or assumed shape, but they must be contiguous!
3930 : ! **************************************************************************************************
3931 65507 : SUBROUTINE mp_isend_${nametype1}$m3(msgin, dest, comm, request, tag)
3932 : ${type1}$, DIMENSION(:, :, :), INTENT(IN) :: msgin
3933 : INTEGER, INTENT(IN) :: dest
3934 : CLASS(mp_comm_type), INTENT(IN) :: comm
3935 : TYPE(mp_request_type), INTENT(out) :: request
3936 : INTEGER, INTENT(in), OPTIONAL :: tag
3937 :
3938 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m3'
3939 :
3940 : INTEGER :: handle, ierr
3941 : #if defined(__parallel)
3942 : INTEGER :: msglen, my_tag
3943 : ${type1}$ :: foo(1)
3944 : #endif
3945 :
3946 65507 : CALL mp_timeset(routineN, handle)
3947 :
3948 : #if defined(__parallel)
3949 : #if !defined(__GNUC__) || __GNUC__ >= 9
3950 262028 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
3951 : #endif
3952 :
3953 65507 : my_tag = 0
3954 65507 : IF (PRESENT(tag)) my_tag = tag
3955 :
3956 65507 : msglen = SIZE(msgin, 1)*SIZE(msgin, 2)*SIZE(msgin, 3)
3957 65507 : IF (msglen > 0) THEN
3958 : CALL mpi_isend(msgin(1, 1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
3959 65507 : comm%handle, request%handle, ierr)
3960 : ELSE
3961 : CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
3962 0 : comm%handle, request%handle, ierr)
3963 : END IF
3964 65507 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
3965 :
3966 65507 : CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
3967 : #else
3968 : MARK_USED(msgin)
3969 : MARK_USED(dest)
3970 : MARK_USED(comm)
3971 : MARK_USED(request)
3972 : MARK_USED(tag)
3973 : ierr = 1
3974 : request = mp_request_null
3975 : CALL mp_stop(ierr, "mp_isend called in non parallel case")
3976 : #endif
3977 65507 : CALL mp_timestop(handle)
3978 65507 : END SUBROUTINE mp_isend_${nametype1}$m3
3979 :
3980 : ! **************************************************************************************************
3981 : !> \brief Non-blocking send of rank-4 data
3982 : !> \param msgin the input message
3983 : !> \param dest the destination processor
3984 : !> \param comm the communicator object
3985 : !> \param request the communication request id
3986 : !> \param tag the message tag
3987 : !> \par History
3988 : !> 2.2016 added _${nametype1}$m4 subroutine [Nico Holmberg]
3989 : !> \author fawzi
3990 : !> \note see mp_isend_${nametype1}$v
3991 : !> \note
3992 : !> arrays can be pointers or assumed shape, but they must be contiguous!
3993 : ! **************************************************************************************************
3994 56 : SUBROUTINE mp_isend_${nametype1}$m4(msgin, dest, comm, request, tag)
3995 : ${type1}$, DIMENSION(:, :, :, :), INTENT(IN) :: msgin
3996 : INTEGER, INTENT(IN) :: dest
3997 : CLASS(mp_comm_type), INTENT(IN) :: comm
3998 : TYPE(mp_request_type), INTENT(out) :: request
3999 : INTEGER, INTENT(in), OPTIONAL :: tag
4000 :
4001 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_${nametype1}$m4'
4002 :
4003 : INTEGER :: handle, ierr
4004 : #if defined(__parallel)
4005 : INTEGER :: msglen, my_tag
4006 : ${type1}$ :: foo(1)
4007 : #endif
4008 :
4009 56 : CALL mp_timeset(routineN, handle)
4010 :
4011 : #if defined(__parallel)
4012 : #if !defined(__GNUC__) || __GNUC__ >= 9
4013 280 : CPASSERT(IS_CONTIGUOUS(msgin) .OR. SIZE(msgin) == 0)
4014 : #endif
4015 :
4016 56 : my_tag = 0
4017 56 : IF (PRESENT(tag)) my_tag = tag
4018 :
4019 56 : msglen = SIZE(msgin, 1)*SIZE(msgin, 2)*SIZE(msgin, 3)*SIZE(msgin, 4)
4020 56 : IF (msglen > 0) THEN
4021 : CALL mpi_isend(msgin(1, 1, 1, 1), msglen, ${mpi_type1}$, dest, my_tag, &
4022 56 : comm%handle, request%handle, ierr)
4023 : ELSE
4024 : CALL mpi_isend(foo, msglen, ${mpi_type1}$, dest, my_tag, &
4025 0 : comm%handle, request%handle, ierr)
4026 : END IF
4027 56 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
4028 :
4029 56 : CALL add_perf(perf_id=11, count=1, msg_size=msglen*${bytes1}$)
4030 : #else
4031 : MARK_USED(msgin)
4032 : MARK_USED(dest)
4033 : MARK_USED(comm)
4034 : MARK_USED(request)
4035 : MARK_USED(tag)
4036 : ierr = 1
4037 : request = mp_request_null
4038 : CALL mp_stop(ierr, "mp_isend called in non parallel case")
4039 : #endif
4040 56 : CALL mp_timestop(handle)
4041 56 : END SUBROUTINE mp_isend_${nametype1}$m4
4042 :
4043 : ! **************************************************************************************************
4044 : !> \brief Non-blocking receive of vector data
4045 : !> \param msgout ...
4046 : !> \param source ...
4047 : !> \param comm ...
4048 : !> \param request ...
4049 : !> \param tag ...
4050 : !> \par History
4051 : !> 08.2003 created [f&j]
4052 : !> 2009-11-25 [UB] Made type-generic for templates
4053 : !> \note see mp_isendrecv_${nametype1}$v
4054 : !> \note
4055 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4056 : ! **************************************************************************************************
4057 2611102 : SUBROUTINE mp_irecv_${nametype1}$v(msgout, source, comm, request, tag)
4058 : ${type1}$, DIMENSION(:), INTENT(INOUT) :: msgout
4059 : INTEGER, INTENT(IN) :: source
4060 : CLASS(mp_comm_type), INTENT(IN) :: comm
4061 : TYPE(mp_request_type), INTENT(out) :: request
4062 : INTEGER, INTENT(in), OPTIONAL :: tag
4063 :
4064 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$v'
4065 :
4066 : INTEGER :: handle
4067 : #if defined(__parallel)
4068 : INTEGER :: ierr, msglen, my_tag
4069 : ${type1}$ :: foo(1)
4070 : #endif
4071 :
4072 2611102 : CALL mp_timeset(routineN, handle)
4073 :
4074 : #if defined(__parallel)
4075 : #if !defined(__GNUC__) || __GNUC__ >= 9
4076 2611102 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
4077 : #endif
4078 :
4079 2611102 : my_tag = 0
4080 2611102 : IF (PRESENT(tag)) my_tag = tag
4081 :
4082 2611102 : msglen = SIZE(msgout)
4083 2611102 : IF (msglen > 0) THEN
4084 : CALL mpi_irecv(msgout(1), msglen, ${mpi_type1}$, source, my_tag, &
4085 2611057 : comm%handle, request%handle, ierr)
4086 : ELSE
4087 : CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
4088 45 : comm%handle, request%handle, ierr)
4089 : END IF
4090 2611102 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
4091 :
4092 2611102 : CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
4093 : #else
4094 : CPABORT("mp_irecv called in non parallel case")
4095 : MARK_USED(msgout)
4096 : MARK_USED(source)
4097 : MARK_USED(comm)
4098 : MARK_USED(tag)
4099 : request = mp_request_null
4100 : #endif
4101 2611102 : CALL mp_timestop(handle)
4102 2611102 : END SUBROUTINE mp_irecv_${nametype1}$v
4103 :
4104 : ! **************************************************************************************************
4105 : !> \brief Non-blocking receive of matrix data
4106 : !> \param msgout ...
4107 : !> \param source ...
4108 : !> \param comm ...
4109 : !> \param request ...
4110 : !> \param tag ...
4111 : !> \par History
4112 : !> 2009-11-25 [UB] Made type-generic for templates
4113 : !> \author fawzi
4114 : !> \note see mp_isendrecv_${nametype1}$v
4115 : !> \note see mp_irecv_${nametype1}$v
4116 : !> \note
4117 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4118 : ! **************************************************************************************************
4119 1303009 : SUBROUTINE mp_irecv_${nametype1}$m2(msgout, source, comm, request, tag)
4120 : ${type1}$, DIMENSION(:, :), INTENT(INOUT) :: msgout
4121 : INTEGER, INTENT(IN) :: source
4122 : CLASS(mp_comm_type), INTENT(IN) :: comm
4123 : TYPE(mp_request_type), INTENT(out) :: request
4124 : INTEGER, INTENT(in), OPTIONAL :: tag
4125 :
4126 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m2'
4127 :
4128 : INTEGER :: handle
4129 : #if defined(__parallel)
4130 : INTEGER :: ierr, msglen, my_tag
4131 : ${type1}$ :: foo(1)
4132 : #endif
4133 :
4134 1303009 : CALL mp_timeset(routineN, handle)
4135 :
4136 : #if defined(__parallel)
4137 : #if !defined(__GNUC__) || __GNUC__ >= 9
4138 3909027 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
4139 : #endif
4140 :
4141 1303009 : my_tag = 0
4142 1303009 : IF (PRESENT(tag)) my_tag = tag
4143 :
4144 1303009 : msglen = SIZE(msgout, 1)*SIZE(msgout, 2)
4145 1303009 : IF (msglen > 0) THEN
4146 : CALL mpi_irecv(msgout(1, 1), msglen, ${mpi_type1}$, source, my_tag, &
4147 1303009 : comm%handle, request%handle, ierr)
4148 : ELSE
4149 : CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
4150 0 : comm%handle, request%handle, ierr)
4151 : END IF
4152 1303009 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
4153 :
4154 1303009 : CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
4155 : #else
4156 : MARK_USED(msgout)
4157 : MARK_USED(source)
4158 : MARK_USED(comm)
4159 : MARK_USED(tag)
4160 : request = mp_request_null
4161 : CPABORT("mp_irecv called in non parallel case")
4162 : #endif
4163 1303009 : CALL mp_timestop(handle)
4164 1303009 : END SUBROUTINE mp_irecv_${nametype1}$m2
4165 :
4166 : ! **************************************************************************************************
4167 : !> \brief Non-blocking send of rank-3 data
4168 : !> \param msgout ...
4169 : !> \param source ...
4170 : !> \param comm ...
4171 : !> \param request ...
4172 : !> \param tag ...
4173 : !> \par History
4174 : !> 9.2008 added _rm3 subroutine [Iain Bethune] (c) The Numerical Algorithms Group (NAG) Ltd, 2008 on behalf of the HECToR project
4175 : !> 2009-11-25 [UB] Made type-generic for templates
4176 : !> \author fawzi
4177 : !> \note see mp_isendrecv_${nametype1}$v
4178 : !> \note see mp_irecv_${nametype1}$v
4179 : !> \note
4180 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4181 : ! **************************************************************************************************
4182 65507 : SUBROUTINE mp_irecv_${nametype1}$m3(msgout, source, comm, request, tag)
4183 : ${type1}$, DIMENSION(:, :, :), INTENT(INOUT) :: msgout
4184 : INTEGER, INTENT(IN) :: source
4185 : CLASS(mp_comm_type), INTENT(IN) :: comm
4186 : TYPE(mp_request_type), INTENT(out) :: request
4187 : INTEGER, INTENT(in), OPTIONAL :: tag
4188 :
4189 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m3'
4190 :
4191 : INTEGER :: handle
4192 : #if defined(__parallel)
4193 : INTEGER :: ierr, msglen, my_tag
4194 : ${type1}$ :: foo(1)
4195 : #endif
4196 :
4197 65507 : CALL mp_timeset(routineN, handle)
4198 :
4199 : #if defined(__parallel)
4200 : #if !defined(__GNUC__) || __GNUC__ >= 9
4201 262028 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
4202 : #endif
4203 :
4204 65507 : my_tag = 0
4205 65507 : IF (PRESENT(tag)) my_tag = tag
4206 :
4207 65507 : msglen = SIZE(msgout, 1)*SIZE(msgout, 2)*SIZE(msgout, 3)
4208 65507 : IF (msglen > 0) THEN
4209 : CALL mpi_irecv(msgout(1, 1, 1), msglen, ${mpi_type1}$, source, my_tag, &
4210 65507 : comm%handle, request%handle, ierr)
4211 : ELSE
4212 : CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
4213 0 : comm%handle, request%handle, ierr)
4214 : END IF
4215 65507 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN)
4216 :
4217 65507 : CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
4218 : #else
4219 : MARK_USED(msgout)
4220 : MARK_USED(source)
4221 : MARK_USED(comm)
4222 : MARK_USED(tag)
4223 : request = mp_request_null
4224 : CPABORT("mp_irecv called in non parallel case")
4225 : #endif
4226 65507 : CALL mp_timestop(handle)
4227 65507 : END SUBROUTINE mp_irecv_${nametype1}$m3
4228 :
4229 : ! **************************************************************************************************
4230 : !> \brief Non-blocking receive of rank-4 data
4231 : !> \param msgout the output message
4232 : !> \param source the source processor
4233 : !> \param comm the communicator object
4234 : !> \param request the communication request id
4235 : !> \param tag the message tag
4236 : !> \par History
4237 : !> 2.2016 added _${nametype1}$m4 subroutine [Nico Holmberg]
4238 : !> \author fawzi
4239 : !> \note see mp_irecv_${nametype1}$v
4240 : !> \note
4241 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4242 : ! **************************************************************************************************
4243 56 : SUBROUTINE mp_irecv_${nametype1}$m4(msgout, source, comm, request, tag)
4244 : ${type1}$, DIMENSION(:, :, :, :), INTENT(INOUT) :: msgout
4245 : INTEGER, INTENT(IN) :: source
4246 : CLASS(mp_comm_type), INTENT(IN) :: comm
4247 : TYPE(mp_request_type), INTENT(out) :: request
4248 : INTEGER, INTENT(in), OPTIONAL :: tag
4249 :
4250 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_${nametype1}$m4'
4251 :
4252 : INTEGER :: handle
4253 : #if defined(__parallel)
4254 : INTEGER :: ierr, msglen, my_tag
4255 : ${type1}$ :: foo(1)
4256 : #endif
4257 :
4258 56 : CALL mp_timeset(routineN, handle)
4259 :
4260 : #if defined(__parallel)
4261 : #if !defined(__GNUC__) || __GNUC__ >= 9
4262 280 : CPASSERT(IS_CONTIGUOUS(msgout) .OR. SIZE(msgout) == 0)
4263 : #endif
4264 :
4265 56 : my_tag = 0
4266 56 : IF (PRESENT(tag)) my_tag = tag
4267 :
4268 56 : msglen = SIZE(msgout, 1)*SIZE(msgout, 2)*SIZE(msgout, 3)*SIZE(msgout, 4)
4269 56 : IF (msglen > 0) THEN
4270 : CALL mpi_irecv(msgout(1, 1, 1, 1), msglen, ${mpi_type1}$, source, my_tag, &
4271 56 : comm%handle, request%handle, ierr)
4272 : ELSE
4273 : CALL mpi_irecv(foo, msglen, ${mpi_type1}$, source, my_tag, &
4274 0 : comm%handle, request%handle, ierr)
4275 : END IF
4276 56 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN)
4277 :
4278 56 : CALL add_perf(perf_id=12, count=1, msg_size=msglen*${bytes1}$)
4279 : #else
4280 : MARK_USED(msgout)
4281 : MARK_USED(source)
4282 : MARK_USED(comm)
4283 : MARK_USED(tag)
4284 : request = mp_request_null
4285 : CPABORT("mp_irecv called in non parallel case")
4286 : #endif
4287 56 : CALL mp_timestop(handle)
4288 56 : END SUBROUTINE mp_irecv_${nametype1}$m4
4289 :
4290 : ! **************************************************************************************************
4291 : !> \brief Window initialization function for vector data
4292 : !> \param base ...
4293 : !> \param comm ...
4294 : !> \param win ...
4295 : !> \par History
4296 : !> 02.2015 created [Alfio Lazzaro]
4297 : !> \note
4298 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4299 : ! **************************************************************************************************
4300 0 : SUBROUTINE mp_win_create_${nametype1}$v(base, comm, win)
4301 : ${type1}$, DIMENSION(:), INTENT(INOUT), CONTIGUOUS :: base
4302 : TYPE(mp_comm_type), INTENT(IN) :: comm
4303 : CLASS(mp_win_type), INTENT(INOUT) :: win
4304 :
4305 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_win_create_${nametype1}$v'
4306 :
4307 : INTEGER :: handle
4308 : #if defined(__parallel)
4309 : INTEGER :: ierr
4310 : INTEGER(kind=mpi_address_kind) :: len
4311 : ${type1}$ :: foo(1)
4312 : #endif
4313 :
4314 0 : CALL mp_timeset(routineN, handle)
4315 :
4316 : #if defined(__parallel)
4317 :
4318 0 : len = SIZE(base)*${bytes1}$
4319 0 : IF (len > 0) THEN
4320 0 : CALL mpi_win_create(base(1), len, ${bytes1}$, MPI_INFO_NULL, comm%handle, win%handle, ierr)
4321 : ELSE
4322 0 : CALL mpi_win_create(foo, len, ${bytes1}$, MPI_INFO_NULL, comm%handle, win%handle, ierr)
4323 : END IF
4324 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_win_create @ "//routineN)
4325 :
4326 0 : CALL add_perf(perf_id=20, count=1)
4327 : #else
4328 : MARK_USED(base)
4329 : MARK_USED(comm)
4330 : win%handle = mp_win_null_handle
4331 : #endif
4332 0 : CALL mp_timestop(handle)
4333 0 : END SUBROUTINE mp_win_create_${nametype1}$v
4334 :
4335 : ! **************************************************************************************************
4336 : !> \brief Single-sided get function for vector data
4337 : !> \param base ...
4338 : !> \param comm ...
4339 : !> \param win ...
4340 : !> \par History
4341 : !> 02.2015 created [Alfio Lazzaro]
4342 : !> \note
4343 : !> arrays can be pointers or assumed shape, but they must be contiguous!
4344 : ! **************************************************************************************************
4345 0 : SUBROUTINE mp_rget_${nametype1}$v(base, source, win, win_data, myproc, disp, request, &
4346 : origin_datatype, target_datatype)
4347 : ${type1}$, DIMENSION(:), CONTIGUOUS, INTENT(INOUT) :: base
4348 : INTEGER, INTENT(IN) :: source
4349 : CLASS(mp_win_type), INTENT(IN) :: win
4350 : ${type1}$, DIMENSION(:), INTENT(IN) :: win_data
4351 : INTEGER, INTENT(IN), OPTIONAL :: myproc, disp
4352 : TYPE(mp_request_type), INTENT(OUT) :: request
4353 : TYPE(mp_type_descriptor_type), INTENT(IN), OPTIONAL :: origin_datatype, target_datatype
4354 :
4355 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_rget_${nametype1}$v'
4356 :
4357 : INTEGER :: handle
4358 : #if defined(__parallel)
4359 : INTEGER :: ierr, len, &
4360 : origin_len, target_len
4361 : LOGICAL :: do_local_copy
4362 : INTEGER(kind=mpi_address_kind) :: disp_aint
4363 : MPI_DATA_TYPE :: handle_origin_datatype, handle_target_datatype
4364 : #endif
4365 :
4366 0 : CALL mp_timeset(routineN, handle)
4367 :
4368 : #if defined(__parallel)
4369 0 : len = SIZE(base)
4370 0 : disp_aint = 0
4371 0 : IF (PRESENT(disp)) THEN
4372 0 : disp_aint = INT(disp, KIND=mpi_address_kind)
4373 : END IF
4374 0 : handle_origin_datatype = ${mpi_type1}$
4375 0 : origin_len = len
4376 0 : IF (PRESENT(origin_datatype)) THEN
4377 0 : handle_origin_datatype = origin_datatype%type_handle
4378 0 : origin_len = 1
4379 : END IF
4380 0 : handle_target_datatype = ${mpi_type1}$
4381 0 : target_len = len
4382 0 : IF (PRESENT(target_datatype)) THEN
4383 0 : handle_target_datatype = target_datatype%type_handle
4384 0 : target_len = 1
4385 : END IF
4386 0 : IF (len > 0) THEN
4387 0 : do_local_copy = .FALSE.
4388 0 : IF (PRESENT(myproc) .AND. .NOT. PRESENT(origin_datatype) .AND. .NOT. PRESENT(target_datatype)) THEN
4389 0 : IF (myproc .EQ. source) do_local_copy = .TRUE.
4390 : END IF
4391 : IF (do_local_copy) THEN
4392 0 : !$OMP PARALLEL WORKSHARE DEFAULT(none) SHARED(base,win_data,disp_aint,len)
4393 : base(:) = win_data(disp_aint + 1:disp_aint + len)
4394 : !$OMP END PARALLEL WORKSHARE
4395 0 : request = mp_request_null
4396 0 : ierr = 0
4397 : ELSE
4398 : CALL mpi_rget(base(1), origin_len, handle_origin_datatype, source, disp_aint, &
4399 0 : target_len, handle_target_datatype, win%handle, request%handle, ierr)
4400 : END IF
4401 : ELSE
4402 0 : request = mp_request_null
4403 0 : ierr = 0
4404 : END IF
4405 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_rget @ "//routineN)
4406 :
4407 0 : CALL add_perf(perf_id=25, count=1, msg_size=SIZE(base)*${bytes1}$)
4408 : #else
4409 : MARK_USED(source)
4410 : MARK_USED(win)
4411 : MARK_USED(myproc)
4412 : MARK_USED(origin_datatype)
4413 : MARK_USED(target_datatype)
4414 :
4415 : request = mp_request_null
4416 : !
4417 : IF (PRESENT(disp)) THEN
4418 : base(:) = win_data(disp + 1:disp + SIZE(base))
4419 : ELSE
4420 : base(:) = win_data(:SIZE(base))
4421 : END IF
4422 :
4423 : #endif
4424 0 : CALL mp_timestop(handle)
4425 0 : END SUBROUTINE mp_rget_${nametype1}$v
4426 :
4427 : ! **************************************************************************************************
4428 : !> \brief ...
4429 : !> \param count ...
4430 : !> \param lengths ...
4431 : !> \param displs ...
4432 : !> \return ...
4433 : ! ***************************************************************************
4434 0 : FUNCTION mp_type_indexed_make_${nametype1}$ (count, lengths, displs) &
4435 0 : RESULT(type_descriptor)
4436 : INTEGER, INTENT(IN) :: count
4437 : INTEGER, DIMENSION(1:count), INTENT(IN), TARGET :: lengths, displs
4438 : TYPE(mp_type_descriptor_type) :: type_descriptor
4439 :
4440 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_type_indexed_make_${nametype1}$'
4441 :
4442 : INTEGER :: handle
4443 : #if defined(__parallel)
4444 : INTEGER :: ierr
4445 : #endif
4446 :
4447 0 : CALL mp_timeset(routineN, handle)
4448 :
4449 : #if defined(__parallel)
4450 : CALL mpi_type_indexed(count, lengths, displs, ${mpi_type1}$, &
4451 0 : type_descriptor%type_handle, ierr)
4452 0 : IF (ierr /= 0) &
4453 0 : CPABORT("MPI_Type_Indexed @ "//routineN)
4454 0 : CALL mpi_type_commit(type_descriptor%type_handle, ierr)
4455 0 : IF (ierr /= 0) &
4456 0 : CPABORT("MPI_Type_commit @ "//routineN)
4457 : #else
4458 : type_descriptor%type_handle = ${handle1}$
4459 : #endif
4460 0 : type_descriptor%length = count
4461 0 : NULLIFY (type_descriptor%subtype)
4462 0 : type_descriptor%vector_descriptor(1:2) = 1
4463 0 : type_descriptor%has_indexing = .TRUE.
4464 0 : type_descriptor%index_descriptor%index => lengths
4465 0 : type_descriptor%index_descriptor%chunks => displs
4466 :
4467 0 : CALL mp_timestop(handle)
4468 :
4469 0 : END FUNCTION mp_type_indexed_make_${nametype1}$
4470 :
4471 : ! **************************************************************************************************
4472 : !> \brief Allocates special parallel memory
4473 : !> \param[in] DATA pointer to integer array to allocate
4474 : !> \param[in] len number of integers to allocate
4475 : !> \param[out] stat (optional) allocation status result
4476 : !> \author UB
4477 : ! **************************************************************************************************
4478 0 : SUBROUTINE mp_allocate_${nametype1}$ (DATA, len, stat)
4479 : ${type1}$, CONTIGUOUS, DIMENSION(:), POINTER :: DATA
4480 : INTEGER, INTENT(IN) :: len
4481 : INTEGER, INTENT(OUT), OPTIONAL :: stat
4482 :
4483 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_allocate_${nametype1}$'
4484 :
4485 : INTEGER :: handle, ierr
4486 :
4487 0 : CALL mp_timeset(routineN, handle)
4488 :
4489 : #if defined(__parallel)
4490 0 : NULLIFY (DATA)
4491 0 : CALL mp_alloc_mem(DATA, len, stat=ierr)
4492 0 : IF (ierr /= 0 .AND. .NOT. PRESENT(stat)) &
4493 0 : CALL mp_stop(ierr, "mpi_alloc_mem @ "//routineN)
4494 0 : CALL add_perf(perf_id=15, count=1)
4495 : #else
4496 : ALLOCATE (DATA(len), stat=ierr)
4497 : IF (ierr /= 0 .AND. .NOT. PRESENT(stat)) &
4498 : CALL mp_stop(ierr, "ALLOCATE @ "//routineN)
4499 : #endif
4500 0 : IF (PRESENT(stat)) stat = ierr
4501 0 : CALL mp_timestop(handle)
4502 0 : END SUBROUTINE mp_allocate_${nametype1}$
4503 :
4504 : ! **************************************************************************************************
4505 : !> \brief Deallocates special parallel memory
4506 : !> \param[in] DATA pointer to special memory to deallocate
4507 : !> \param stat ...
4508 : !> \author UB
4509 : ! **************************************************************************************************
4510 0 : SUBROUTINE mp_deallocate_${nametype1}$ (DATA, stat)
4511 : ${type1}$, CONTIGUOUS, DIMENSION(:), POINTER :: DATA
4512 : INTEGER, INTENT(OUT), OPTIONAL :: stat
4513 :
4514 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_deallocate_${nametype1}$'
4515 :
4516 : INTEGER :: handle
4517 : #if defined(__parallel)
4518 : INTEGER :: ierr
4519 : #endif
4520 :
4521 0 : CALL mp_timeset(routineN, handle)
4522 :
4523 : #if defined(__parallel)
4524 0 : CALL mp_free_mem(DATA, ierr)
4525 0 : IF (PRESENT(stat)) THEN
4526 0 : stat = ierr
4527 : ELSE
4528 0 : IF (ierr /= 0) CALL mp_stop(ierr, "mpi_free_mem @ "//routineN)
4529 : END IF
4530 0 : NULLIFY (DATA)
4531 0 : CALL add_perf(perf_id=15, count=1)
4532 : #else
4533 : DEALLOCATE (DATA)
4534 : IF (PRESENT(stat)) stat = 0
4535 : #endif
4536 0 : CALL mp_timestop(handle)
4537 0 : END SUBROUTINE mp_deallocate_${nametype1}$
4538 :
4539 : ! **************************************************************************************************
4540 : !> \brief (parallel) Blocking individual file write using explicit offsets
4541 : !> (serial) Unformatted stream write
4542 : !> \param[in] fh file handle (file storage unit)
4543 : !> \param[in] offset file offset (position)
4544 : !> \param[in] msg data to be written to the file
4545 : !> \param msglen ...
4546 : !> \par MPI-I/O mapping mpi_file_write_at
4547 : !> \par STREAM-I/O mapping WRITE
4548 : !> \param[in](optional) msglen number of the elements of data
4549 : ! **************************************************************************************************
4550 0 : SUBROUTINE mp_file_write_at_${nametype1}$v(fh, offset, msg, msglen)
4551 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:)
4552 : CLASS(mp_file_type), INTENT(IN) :: fh
4553 : INTEGER, INTENT(IN), OPTIONAL :: msglen
4554 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4555 :
4556 : INTEGER :: msg_len
4557 : #if defined(__parallel)
4558 : INTEGER :: ierr
4559 : #endif
4560 :
4561 0 : msg_len = SIZE(msg)
4562 0 : IF (PRESENT(msglen)) msg_len = msglen
4563 : #if defined(__parallel)
4564 0 : CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4565 0 : IF (ierr .NE. 0) &
4566 0 : CPABORT("mpi_file_write_at_${nametype1}$v @ mp_file_write_at_${nametype1}$v")
4567 : #else
4568 : WRITE (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
4569 : #endif
4570 0 : END SUBROUTINE mp_file_write_at_${nametype1}$v
4571 :
4572 : ! **************************************************************************************************
4573 : !> \brief ...
4574 : !> \param fh ...
4575 : !> \param offset ...
4576 : !> \param msg ...
4577 : ! **************************************************************************************************
4578 0 : SUBROUTINE mp_file_write_at_${nametype1}$ (fh, offset, msg)
4579 : ${type1}$, INTENT(IN) :: msg
4580 : CLASS(mp_file_type), INTENT(IN) :: fh
4581 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4582 :
4583 : #if defined(__parallel)
4584 : INTEGER :: ierr
4585 :
4586 : ierr = 0
4587 0 : CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4588 0 : IF (ierr .NE. 0) &
4589 0 : CPABORT("mpi_file_write_at_${nametype1}$ @ mp_file_write_at_${nametype1}$")
4590 : #else
4591 : WRITE (UNIT=fh%handle, POS=offset + 1) msg
4592 : #endif
4593 0 : END SUBROUTINE mp_file_write_at_${nametype1}$
4594 :
4595 : ! **************************************************************************************************
4596 : !> \brief (parallel) Blocking collective file write using explicit offsets
4597 : !> (serial) Unformatted stream write
4598 : !> \param fh ...
4599 : !> \param offset ...
4600 : !> \param msg ...
4601 : !> \param msglen ...
4602 : !> \par MPI-I/O mapping mpi_file_write_at_all
4603 : !> \par STREAM-I/O mapping WRITE
4604 : ! **************************************************************************************************
4605 0 : SUBROUTINE mp_file_write_at_all_${nametype1}$v(fh, offset, msg, msglen)
4606 : ${type1}$, CONTIGUOUS, INTENT(IN) :: msg(:)
4607 : CLASS(mp_file_type), INTENT(IN) :: fh
4608 : INTEGER, INTENT(IN), OPTIONAL :: msglen
4609 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4610 :
4611 : INTEGER :: msg_len
4612 : #if defined(__parallel)
4613 : INTEGER :: ierr
4614 : #endif
4615 :
4616 0 : msg_len = SIZE(msg)
4617 0 : IF (PRESENT(msglen)) msg_len = msglen
4618 : #if defined(__parallel)
4619 0 : CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4620 0 : IF (ierr .NE. 0) &
4621 0 : CPABORT("mpi_file_write_at_all_${nametype1}$v @ mp_file_write_at_all_${nametype1}$v")
4622 : #else
4623 : WRITE (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
4624 : #endif
4625 0 : END SUBROUTINE mp_file_write_at_all_${nametype1}$v
4626 :
4627 : ! **************************************************************************************************
4628 : !> \brief ...
4629 : !> \param fh ...
4630 : !> \param offset ...
4631 : !> \param msg ...
4632 : ! **************************************************************************************************
4633 0 : SUBROUTINE mp_file_write_at_all_${nametype1}$ (fh, offset, msg)
4634 : ${type1}$, INTENT(IN) :: msg
4635 : CLASS(mp_file_type), INTENT(IN) :: fh
4636 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4637 :
4638 : #if defined(__parallel)
4639 : INTEGER :: ierr
4640 :
4641 : ierr = 0
4642 0 : CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4643 0 : IF (ierr .NE. 0) &
4644 0 : CPABORT("mpi_file_write_at_all_${nametype1}$ @ mp_file_write_at_all_${nametype1}$")
4645 : #else
4646 : WRITE (UNIT=fh%handle, POS=offset + 1) msg
4647 : #endif
4648 0 : END SUBROUTINE mp_file_write_at_all_${nametype1}$
4649 :
4650 : ! **************************************************************************************************
4651 : !> \brief (parallel) Blocking individual file read using explicit offsets
4652 : !> (serial) Unformatted stream read
4653 : !> \param[in] fh file handle (file storage unit)
4654 : !> \param[in] offset file offset (position)
4655 : !> \param[out] msg data to be read from the file
4656 : !> \param msglen ...
4657 : !> \par MPI-I/O mapping mpi_file_read_at
4658 : !> \par STREAM-I/O mapping READ
4659 : !> \param[in](optional) msglen number of elements of data
4660 : ! **************************************************************************************************
4661 0 : SUBROUTINE mp_file_read_at_${nametype1}$v(fh, offset, msg, msglen)
4662 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msg(:)
4663 : CLASS(mp_file_type), INTENT(IN) :: fh
4664 : INTEGER, INTENT(IN), OPTIONAL :: msglen
4665 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4666 :
4667 : INTEGER :: msg_len
4668 : #if defined(__parallel)
4669 : INTEGER :: ierr
4670 : #endif
4671 :
4672 0 : msg_len = SIZE(msg)
4673 0 : IF (PRESENT(msglen)) msg_len = msglen
4674 : #if defined(__parallel)
4675 0 : CALL MPI_FILE_READ_AT(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4676 0 : IF (ierr .NE. 0) &
4677 0 : CPABORT("mpi_file_read_at_${nametype1}$v @ mp_file_read_at_${nametype1}$v")
4678 : #else
4679 : READ (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
4680 : #endif
4681 0 : END SUBROUTINE mp_file_read_at_${nametype1}$v
4682 :
4683 : ! **************************************************************************************************
4684 : !> \brief ...
4685 : !> \param fh ...
4686 : !> \param offset ...
4687 : !> \param msg ...
4688 : ! **************************************************************************************************
4689 0 : SUBROUTINE mp_file_read_at_${nametype1}$ (fh, offset, msg)
4690 : ${type1}$, INTENT(OUT) :: msg
4691 : CLASS(mp_file_type), INTENT(IN) :: fh
4692 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4693 :
4694 : #if defined(__parallel)
4695 : INTEGER :: ierr
4696 :
4697 : ierr = 0
4698 0 : CALL MPI_FILE_READ_AT(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4699 0 : IF (ierr .NE. 0) &
4700 0 : CPABORT("mpi_file_read_at_${nametype1}$ @ mp_file_read_at_${nametype1}$")
4701 : #else
4702 : READ (UNIT=fh%handle, POS=offset + 1) msg
4703 : #endif
4704 0 : END SUBROUTINE mp_file_read_at_${nametype1}$
4705 :
4706 : ! **************************************************************************************************
4707 : !> \brief (parallel) Blocking collective file read using explicit offsets
4708 : !> (serial) Unformatted stream read
4709 : !> \param fh ...
4710 : !> \param offset ...
4711 : !> \param msg ...
4712 : !> \param msglen ...
4713 : !> \par MPI-I/O mapping mpi_file_read_at_all
4714 : !> \par STREAM-I/O mapping READ
4715 : ! **************************************************************************************************
4716 0 : SUBROUTINE mp_file_read_at_all_${nametype1}$v(fh, offset, msg, msglen)
4717 : ${type1}$, INTENT(OUT), CONTIGUOUS :: msg(:)
4718 : CLASS(mp_file_type), INTENT(IN) :: fh
4719 : INTEGER, INTENT(IN), OPTIONAL :: msglen
4720 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4721 :
4722 : INTEGER :: msg_len
4723 : #if defined(__parallel)
4724 : INTEGER :: ierr
4725 : #endif
4726 :
4727 0 : msg_len = SIZE(msg)
4728 0 : IF (PRESENT(msglen)) msg_len = msglen
4729 : #if defined(__parallel)
4730 0 : CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4731 0 : IF (ierr .NE. 0) &
4732 0 : CPABORT("mpi_file_read_at_all_${nametype1}$v @ mp_file_read_at_all_${nametype1}$v")
4733 : #else
4734 : READ (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
4735 : #endif
4736 0 : END SUBROUTINE mp_file_read_at_all_${nametype1}$v
4737 :
4738 : ! **************************************************************************************************
4739 : !> \brief ...
4740 : !> \param fh ...
4741 : !> \param offset ...
4742 : !> \param msg ...
4743 : ! **************************************************************************************************
4744 0 : SUBROUTINE mp_file_read_at_all_${nametype1}$ (fh, offset, msg)
4745 : ${type1}$, INTENT(OUT) :: msg
4746 : CLASS(mp_file_type), INTENT(IN) :: fh
4747 : INTEGER(kind=file_offset), INTENT(IN) :: offset
4748 :
4749 : #if defined(__parallel)
4750 : INTEGER :: ierr
4751 :
4752 : ierr = 0
4753 0 : CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
4754 0 : IF (ierr .NE. 0) &
4755 0 : CPABORT("mpi_file_read_at_all_${nametype1}$ @ mp_file_read_at_all_${nametype1}$")
4756 : #else
4757 : READ (UNIT=fh%handle, POS=offset + 1) msg
4758 : #endif
4759 0 : END SUBROUTINE mp_file_read_at_all_${nametype1}$
4760 :
4761 : ! **************************************************************************************************
4762 : !> \brief ...
4763 : !> \param ptr ...
4764 : !> \param vector_descriptor ...
4765 : !> \param index_descriptor ...
4766 : !> \return ...
4767 : ! **************************************************************************************************
4768 0 : FUNCTION mp_type_make_${nametype1}$ (ptr, &
4769 : vector_descriptor, index_descriptor) &
4770 0 : RESULT(type_descriptor)
4771 : ${type1}$, DIMENSION(:), TARGET, ASYNCHRONOUS :: ptr
4772 : INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: vector_descriptor
4773 : TYPE(mp_indexing_meta_type), INTENT(IN), OPTIONAL :: index_descriptor
4774 : TYPE(mp_type_descriptor_type) :: type_descriptor
4775 :
4776 : CHARACTER(len=*), PARAMETER :: routineN = 'mp_type_make_${nametype1}$'
4777 :
4778 : #if defined(__parallel)
4779 : INTEGER :: ierr
4780 : #if defined(__MPI_F08)
4781 : ! Even OpenMPI 5.x misses mpi_get_address in the F08 interface
4782 : EXTERNAL :: mpi_get_address
4783 : #endif
4784 : #endif
4785 :
4786 : NULLIFY (type_descriptor%subtype)
4787 0 : type_descriptor%length = SIZE(ptr)
4788 : #if defined(__parallel)
4789 0 : type_descriptor%type_handle = ${mpi_type1}$
4790 0 : CALL MPI_Get_address(ptr, type_descriptor%base, ierr)
4791 0 : IF (ierr /= 0) &
4792 0 : CPABORT("MPI_Get_address @ "//routineN)
4793 : #else
4794 : type_descriptor%type_handle = ${handle1}$
4795 : #endif
4796 0 : type_descriptor%vector_descriptor(1:2) = 1
4797 0 : type_descriptor%has_indexing = .FALSE.
4798 0 : type_descriptor%data_${nametype1}$ => ptr
4799 0 : IF (PRESENT(vector_descriptor) .OR. PRESENT(index_descriptor)) THEN
4800 0 : CPABORT(routineN//": Vectors and indices NYI")
4801 : END IF
4802 0 : END FUNCTION mp_type_make_${nametype1}$
4803 :
4804 : ! **************************************************************************************************
4805 : !> \brief Allocates an array, using MPI_ALLOC_MEM ... this is hackish
4806 : !> as the Fortran version returns an integer, which we take to be a C_PTR
4807 : !> \param DATA data array to allocate
4808 : !> \param[in] len length (in data elements) of data array allocation
4809 : !> \param[out] stat (optional) allocation status result
4810 : ! **************************************************************************************************
4811 0 : SUBROUTINE mp_alloc_mem_${nametype1}$ (DATA, len, stat)
4812 : ${type1}$, CONTIGUOUS, DIMENSION(:), POINTER :: DATA
4813 : INTEGER, INTENT(IN) :: len
4814 : INTEGER, INTENT(OUT), OPTIONAL :: stat
4815 :
4816 : #if defined(__parallel)
4817 : INTEGER :: size, ierr, length, &
4818 : mp_res
4819 : INTEGER(KIND=MPI_ADDRESS_KIND) :: mp_size
4820 : TYPE(C_PTR) :: mp_baseptr
4821 : MPI_INFO_TYPE :: mp_info
4822 :
4823 0 : length = MAX(len, 1)
4824 0 : CALL MPI_TYPE_SIZE(${mpi_type1}$, size, ierr)
4825 0 : mp_size = INT(length, KIND=MPI_ADDRESS_KIND)*size
4826 0 : IF (mp_size .GT. mp_max_memory_size) THEN
4827 0 : CPABORT("MPI cannot allocate more than 2 GiByte")
4828 : END IF
4829 0 : mp_info = MPI_INFO_NULL
4830 0 : CALL MPI_ALLOC_MEM(mp_size, mp_info, mp_baseptr, mp_res)
4831 0 : CALL C_F_POINTER(mp_baseptr, DATA, (/length/))
4832 0 : IF (PRESENT(stat)) stat = mp_res
4833 : #else
4834 : INTEGER :: length, mystat
4835 : length = MAX(len, 1)
4836 : IF (PRESENT(stat)) THEN
4837 : ALLOCATE (DATA(length), stat=mystat)
4838 : stat = mystat ! show to convention checker that stat is used
4839 : ELSE
4840 : ALLOCATE (DATA(length))
4841 : END IF
4842 : #endif
4843 0 : END SUBROUTINE mp_alloc_mem_${nametype1}$
4844 :
4845 : ! **************************************************************************************************
4846 : !> \brief Deallocates am array, ... this is hackish
4847 : !> as the Fortran version takes an integer, which we hope to get by reference
4848 : !> \param DATA data array to allocate
4849 : !> \param[out] stat (optional) allocation status result
4850 : ! **************************************************************************************************
4851 0 : SUBROUTINE mp_free_mem_${nametype1}$ (DATA, stat)
4852 : ${type1}$, DIMENSION(:), &
4853 : POINTER, ASYNCHRONOUS :: DATA
4854 : INTEGER, INTENT(OUT), OPTIONAL :: stat
4855 :
4856 : #if defined(__parallel)
4857 : INTEGER :: mp_res
4858 0 : CALL MPI_FREE_MEM(DATA, mp_res)
4859 0 : IF (PRESENT(stat)) stat = mp_res
4860 : #else
4861 : DEALLOCATE (DATA)
4862 : IF (PRESENT(stat)) stat = 0
4863 : #endif
4864 0 : END SUBROUTINE mp_free_mem_${nametype1}$
4865 : #:endfor
|
