Octopus
mpi.F90
Go to the documentation of this file.
1!! Copyright (C) 2005-2006 Heiko Appel, Florian Lorenzen
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19#include "global.h"
20
21module mpi_oct_m
22#ifdef HAVE_MPI
23 use mpi_f08
24#else
26#endif
27 use blacs_oct_m
28 use loct_oct_m
30 use iso_c_binding
31 use, intrinsic :: iso_fortran_env
32#ifdef HAVE_OPENMP
33 use omp_lib
34#endif
35
36
37 implicit none
38
39 ! I do not make this module private on purpose, so that the symbols defined either in
40 ! module mpi, or in mpif.h are exported
41
43 type(MPI_Comm), parameter, public :: MPI_COMM_UNDEFINED = mpi_comm(-1)
44
46 integer, parameter, private :: ROOT_PROCESS = 0
47
49 type mpi_grp_t
50 ! Components are public by default
51 type(MPI_Comm) :: comm = mpi_comm_undefined
52 integer :: size = 0
53 integer :: rank = 0
54 contains
55 ! Wrapper functions for common MPI calls
56 ! We do not check the error code in any of those wrappers because the behavior of
57 ! an application is undefined after an MPI error according to the standard. The
58 ! default is to let the application crash in such a case with an error message
59 ! from the MPI runtime.
60 procedure :: barrier => mpi_grp_barrier
61 procedure :: dmpi_grp_scatterv, zmpi_grp_scatterv, impi_grp_scatterv, lmpi_grp_scatterv
62 generic :: scatterv => dmpi_grp_scatterv, zmpi_grp_scatterv, impi_grp_scatterv, lmpi_grp_scatterv
63 procedure :: dmpi_grp_scatterv_i8, zmpi_grp_scatterv_i8, impi_grp_scatterv_i8, lmpi_grp_scatterv_i8
64 generic :: scatterv => dmpi_grp_scatterv_i8, zmpi_grp_scatterv_i8, impi_grp_scatterv_i8, lmpi_grp_scatterv_i8
65 procedure :: dmpi_grp_gatherv, zmpi_grp_gatherv, impi_grp_gatherv, lmpi_grp_gatherv
66 generic :: gatherv => dmpi_grp_gatherv, zmpi_grp_gatherv, impi_grp_gatherv, lmpi_grp_gatherv
67 procedure :: dmpi_grp_gather_0, zmpi_grp_gather_0, impi_grp_gather_0, lmpi_grp_gather_0
68 generic :: gather => dmpi_grp_gather_0, zmpi_grp_gather_0, impi_grp_gather_0, lmpi_grp_gather_0
69 procedure :: dmpi_grp_gatherv_i8, zmpi_grp_gatherv_i8, impi_grp_gatherv_i8, lmpi_grp_gatherv_i8
70 generic :: gatherv => dmpi_grp_gatherv_i8, zmpi_grp_gatherv_i8, impi_grp_gatherv_i8, lmpi_grp_gatherv_i8
71 procedure :: dmpi_grp_alltoallv, zmpi_grp_alltoallv, impi_grp_alltoallv, lmpi_grp_alltoallv
72 generic :: alltoallv => dmpi_grp_alltoallv, zmpi_grp_alltoallv, impi_grp_alltoallv, lmpi_grp_alltoallv
73 procedure :: dmpi_grp_alltoallv_2, zmpi_grp_alltoallv_2, impi_grp_alltoallv_2, lmpi_grp_alltoallv_2
74 generic :: alltoallv => dmpi_grp_alltoallv_2, zmpi_grp_alltoallv_2, impi_grp_alltoallv_2, lmpi_grp_alltoallv_2
75 procedure :: dmpi_grp_alltoallv_3, zmpi_grp_alltoallv_3, impi_grp_alltoallv_3, lmpi_grp_alltoallv_3
76 generic :: alltoallv => dmpi_grp_alltoallv_3, zmpi_grp_alltoallv_3, impi_grp_alltoallv_3, lmpi_grp_alltoallv_3
77 procedure :: dmpi_grp_alltoallv_i8, zmpi_grp_alltoallv_i8, impi_grp_alltoallv_i8, lmpi_grp_alltoallv_i8
78 generic :: alltoallv => dmpi_grp_alltoallv_i8, zmpi_grp_alltoallv_i8, impi_grp_alltoallv_i8, lmpi_grp_alltoallv_i8
79 procedure :: dmpi_grp_alltoall, zmpi_grp_alltoall, impi_grp_alltoall, lmpi_grp_alltoall
80 generic :: alltoall => dmpi_grp_alltoall, zmpi_grp_alltoall, impi_grp_alltoall, lmpi_grp_alltoall
81 procedure :: dmpi_grp_allgatherv, zmpi_grp_allgatherv, impi_grp_allgatherv, lmpi_grp_allgatherv
82 generic :: allgatherv => dmpi_grp_allgatherv, zmpi_grp_allgatherv, impi_grp_allgatherv, lmpi_grp_allgatherv
83 procedure :: dmpi_grp_allgatherv_2, zmpi_grp_allgatherv_2, impi_grp_allgatherv_2, lmpi_grp_allgatherv_2
84 generic :: allgatherv => dmpi_grp_allgatherv_2, zmpi_grp_allgatherv_2, impi_grp_allgatherv_2, lmpi_grp_allgatherv_2
85 procedure :: dmpi_grp_allgatherv_3, zmpi_grp_allgatherv_3, impi_grp_allgatherv_3, lmpi_grp_allgatherv_3
86 generic :: allgatherv => dmpi_grp_allgatherv_3, zmpi_grp_allgatherv_3, impi_grp_allgatherv_3, lmpi_grp_allgatherv_3
87 procedure :: dmpi_grp_allgatherv_3_1, zmpi_grp_allgatherv_3_1, impi_grp_allgatherv_3_1, lmpi_grp_allgatherv_3_1
88 generic :: allgatherv => dmpi_grp_allgatherv_3_1, zmpi_grp_allgatherv_3_1, impi_grp_allgatherv_3_1, lmpi_grp_allgatherv_3_1
89 procedure :: dmpi_grp_allgatherv_i8, zmpi_grp_allgatherv_i8, impi_grp_allgatherv_i8, lmpi_grp_allgatherv_i8
90 generic :: allgatherv => dmpi_grp_allgatherv_i8, zmpi_grp_allgatherv_i8, impi_grp_allgatherv_i8, lmpi_grp_allgatherv_i8
91 procedure :: dmpi_grp_bcast, zmpi_grp_bcast, impi_grp_bcast, lmpi_grp_bcast
92 generic :: bcast => dmpi_grp_bcast, zmpi_grp_bcast, impi_grp_bcast, lmpi_grp_bcast
93 procedure :: dmpi_grp_bcast_0, zmpi_grp_bcast_0, impi_grp_bcast_0, lmpi_grp_bcast_0
94 generic :: bcast => dmpi_grp_bcast_0, zmpi_grp_bcast_0, impi_grp_bcast_0, lmpi_grp_bcast_0
95 procedure :: dmpi_grp_bcast_2, zmpi_grp_bcast_2, impi_grp_bcast_2, lmpi_grp_bcast_2
96 generic :: bcast => dmpi_grp_bcast_2, zmpi_grp_bcast_2, impi_grp_bcast_2, lmpi_grp_bcast_2
97 procedure :: dmpi_grp_bcast_3, zmpi_grp_bcast_3, impi_grp_bcast_3, lmpi_grp_bcast_3
98 generic :: bcast => dmpi_grp_bcast_3, zmpi_grp_bcast_3, impi_grp_bcast_3, lmpi_grp_bcast_3
99 procedure :: chmpi_grp_bcast_0, lompi_grp_bcast_0
100 generic :: bcast => chmpi_grp_bcast_0, lompi_grp_bcast_0
101 procedure :: dmpi_grp_bcast_0_l, zmpi_grp_bcast_0_l, impi_grp_bcast_0_l, lmpi_grp_bcast_0_l
102 generic :: bcast => dmpi_grp_bcast_0_l, zmpi_grp_bcast_0_l, impi_grp_bcast_0_l, lmpi_grp_bcast_0_l
103 procedure :: dmpi_grp_allreduce, zmpi_grp_allreduce, impi_grp_allreduce, lmpi_grp_allreduce
104 generic :: allreduce => dmpi_grp_allreduce, zmpi_grp_allreduce, impi_grp_allreduce, lmpi_grp_allreduce
105 procedure :: dmpi_grp_allreduce_2, zmpi_grp_allreduce_2, impi_grp_allreduce_2, lmpi_grp_allreduce_2
106 generic :: allreduce => dmpi_grp_allreduce_2, zmpi_grp_allreduce_2, impi_grp_allreduce_2, lmpi_grp_allreduce_2
107 procedure :: dmpi_grp_allreduce_3, zmpi_grp_allreduce_3, impi_grp_allreduce_3, lmpi_grp_allreduce_3
108 generic :: allreduce => dmpi_grp_allreduce_3, zmpi_grp_allreduce_3, impi_grp_allreduce_3, lmpi_grp_allreduce_3
109 procedure :: dmpi_grp_allreduce_0, zmpi_grp_allreduce_0, impi_grp_allreduce_0, lmpi_grp_allreduce_0
110 generic :: allreduce => dmpi_grp_allreduce_0, zmpi_grp_allreduce_0, impi_grp_allreduce_0, lmpi_grp_allreduce_0
111 procedure :: lompi_grp_allreduce_0
112 generic :: allreduce => lompi_grp_allreduce_0
113 procedure :: dmpi_grp_allreduce_inplace_0, zmpi_grp_allreduce_inplace_0
114 procedure :: impi_grp_allreduce_inplace_0, lmpi_grp_allreduce_inplace_0
115 procedure :: lompi_grp_allreduce_inplace_0
116 generic :: allreduce_inplace => dmpi_grp_allreduce_inplace_0, zmpi_grp_allreduce_inplace_0
117 generic :: allreduce_inplace => impi_grp_allreduce_inplace_0, lmpi_grp_allreduce_inplace_0
118 generic :: allreduce_inplace => lompi_grp_allreduce_inplace_0
119 procedure :: dmpi_grp_allreduce_inplace_1, zmpi_grp_allreduce_inplace_1, &
120 impi_grp_allreduce_inplace_1, lmpi_grp_allreduce_inplace_1
121 generic :: allreduce_inplace => dmpi_grp_allreduce_inplace_1, zmpi_grp_allreduce_inplace_1, &
122 impi_grp_allreduce_inplace_1, lmpi_grp_allreduce_inplace_1
123 procedure :: dmpi_grp_allreduce_inplace_2, zmpi_grp_allreduce_inplace_2, &
124 impi_grp_allreduce_inplace_2, lmpi_grp_allreduce_inplace_2
125 generic :: allreduce_inplace => dmpi_grp_allreduce_inplace_2, zmpi_grp_allreduce_inplace_2, &
126 impi_grp_allreduce_inplace_2, lmpi_grp_allreduce_inplace_2
127 procedure :: dmpi_grp_allgather, zmpi_grp_allgather, impi_grp_allgather, lmpi_grp_allgather
128 generic :: allgather => dmpi_grp_allgather, zmpi_grp_allgather, impi_grp_allgather, lmpi_grp_allgather
129 procedure :: dmpi_grp_allgather_0, zmpi_grp_allgather_0, impi_grp_allgather_0, lmpi_grp_allgather_0
130 generic :: allgather => dmpi_grp_allgather_0, zmpi_grp_allgather_0, impi_grp_allgather_0, lmpi_grp_allgather_0
131 procedure :: dmpi_grp_recv, zmpi_grp_recv, impi_grp_recv, lmpi_grp_recv
132 generic :: recv => dmpi_grp_recv, zmpi_grp_recv, impi_grp_recv, lmpi_grp_recv
133 procedure :: dmpi_grp_recv_0, zmpi_grp_recv_0, impi_grp_recv_0, lmpi_grp_recv_0
134 generic :: recv => dmpi_grp_recv_0, zmpi_grp_recv_0, impi_grp_recv_0, lmpi_grp_recv_0
135 procedure :: dmpi_grp_recv_2, zmpi_grp_recv_2, impi_grp_recv_2, lmpi_grp_recv_2
136 generic :: recv => dmpi_grp_recv_2, zmpi_grp_recv_2, impi_grp_recv_2, lmpi_grp_recv_2
139 procedure :: lompi_grp_recv_0
140 generic :: recv => lompi_grp_recv_0
143 procedure :: dmpi_grp_send_0, zmpi_grp_send_0, impi_grp_send_0, lmpi_grp_send_0
144 generic :: send => dmpi_grp_send_0, zmpi_grp_send_0, impi_grp_send_0, lmpi_grp_send_0
149 procedure :: lompi_grp_send_0
150 generic :: send => lompi_grp_send_0
172 generic :: wait => mpi_grp_wait, mpi_grp_waitall
173 procedure :: abort => mpi_grp_abort
174 procedure :: is_root => mpi_grp_is_root
175 end type mpi_grp_t
177 type(mpi_grp_t), public :: mpi_world
180 integer, public :: mpi_err
182 private :: not_in_openmp
185contains
192 subroutine mpi_init_comm(comm)
193 type(mpi_comm), intent(out) :: comm
194#if defined(HAVE_MPI)
195#if defined(HAVE_OPENMP)
196 integer :: provided
198 call mpi_init_thread(mpi_thread_funneled, provided, mpi_err)
199#else
200 call mpi_init(mpi_err)
201#endif
202 comm = mpi_comm_world
203#else
204 comm = mpi_comm_undefined
205#endif
207 end subroutine mpi_init_comm
211 subroutine blacs_init()
212#if defined(HAVE_MPI)
213#ifdef HAVE_SCALAPACK
214 integer :: iam, nprocs
215 integer :: blacs_default_system_context
217 ! Determine my process number and the number of processes in machine
218 call blacs_pinfo(iam, nprocs)
219
220 ! If machine needs additional set up, do it now
221 if (nprocs < 1) then
222 call blacs_setup(iam, mpi_world%size)
223 end if
225 ! blacs_gridinit() or blacs_gridmap() must be called, else
226 ! blacs_exit() triggers an error with openmpi:
227 ! *** An error occurred in MPI_Type_free
228 ! *** MPI_ERR_TYPE: invalid datatype
229 call blacs_get(0, 0, blacs_default_system_context)
230 call blacs_gridinit(blacs_default_system_context, 'R', mpi_world%size, 1)
231 call blacs_gridexit(blacs_default_system_context)
232#endif
233#endif
234 end subroutine blacs_init
238 subroutine mpi_mod_end()
240#ifdef HAVE_SCALAPACK
241 if (mpi_world%comm /= mpi_comm_undefined) call blacs_exit(1)
242#endif
244#if defined(HAVE_MPI)
245 ! end MPI, if we started it
246 if (mpi_world%comm /= mpi_comm_undefined) call mpi_finalize(mpi_err)
247#endif
249 end subroutine mpi_mod_end
256 subroutine mpi_grp_init(grp, comm)
257 type(mpi_grp_t), intent(out) :: grp
258 type(mpi_comm), intent(in) :: comm
260 grp%comm = comm
261#if defined(HAVE_MPI)
262 if (grp%comm == mpi_comm_null) grp%comm = mpi_comm_undefined
263#endif
265 if (grp%comm == mpi_comm_undefined) then
266 grp%rank = 0
267 grp%size = 1
268#if defined(HAVE_MPI)
269 else
270 call mpi_comm_rank(grp%comm, grp%rank, mpi_err)
272
273 call mpi_comm_size(grp%comm, grp%size, mpi_err)
275#endif
276 end if
277
278 end subroutine mpi_grp_init
279
280
281 logical &
282#ifndef have_openmp
283 pure &
284#endif
285 function not_in_openmp()
286
287#ifdef HAVE_OPENMP
288 not_in_openmp = .not. omp_in_parallel()
289#else
291#endif
292
293 end function not_in_openmp
294
295
296 !-----------------------------------------------------------
297 subroutine mpi_error_check(error)
298 integer, intent(in) :: error
299
300#if defined(HAVE_MPI)
301 character(len=MPI_MAX_ERROR_STRING) :: message
302 integer :: length, temp
303
304 if (error /= mpi_success ) then
305 call mpi_error_string( error, message, length, temp)
306 print * , message(1:length)
307 call mpi_abort(mpi_comm_world, 1 , temp)
308 end if
309#endif
310 end subroutine mpi_error_check
311
312 ! ---------------------------------------------------------
313 subroutine mpi_grp_copy(mpi_grp_out, mpi_grp_in)
314 type(mpi_grp_t), intent(out) :: mpi_grp_out
315 type(mpi_grp_t), intent(in) :: mpi_grp_in
316
317 mpi_grp_out%comm = mpi_grp_in%comm
318 mpi_grp_out%size = mpi_grp_in%size
319 mpi_grp_out%rank = mpi_grp_in%rank
320 end subroutine mpi_grp_copy
321
322 ! ---------------------------------------------------------
323 subroutine mpi_grp_duplicate(mpi_grp_out, mpi_grp_in)
324 type(mpi_grp_t), intent(out) :: mpi_grp_out
325 type(mpi_grp_t), intent(in) :: mpi_grp_in
326
327#if defined(HAVE_MPI)
328 call mpi_comm_dup(mpi_grp_in%comm, mpi_grp_out%comm, mpi_err)
330 call mpi_comm_rank(mpi_grp_out%comm, mpi_grp_out%rank, mpi_err)
332 call mpi_comm_size(mpi_grp_out%comm, mpi_grp_out%size, mpi_err)
334#else
335 call mpi_grp_copy(mpi_grp_out, mpi_grp_in)
336#endif
337 end subroutine mpi_grp_duplicate
338
340 logical function mpi_grp_is_root(grp)
341 class(mpi_grp_t), intent(in) :: grp
342
343 mpi_grp_is_root = (grp%rank == root_process)
344 end function mpi_grp_is_root
345
346 ! ---------------------------------------------------------
347 subroutine mpi_grp_barrier(mpi_grp)
348 class(mpi_grp_t), intent(in) :: mpi_grp
350 if (mpi_grp%comm == mpi_comm_undefined) return
351#if defined(HAVE_MPI)
352 assert(not_in_openmp())
353
354 call mpi_debug_in(mpi_grp%comm, c_mpi_barrier)
355 call mpi_barrier(mpi_grp%comm, mpi_err)
357 call mpi_debug_out(mpi_grp%comm, c_mpi_barrier)
358#endif
359 end subroutine mpi_grp_barrier
360
361 ! ---------------------------------------------------------
362 subroutine chmpi_grp_bcast_0(mpi_grp, buf, cnt, sendtype, root)
363 class(mpi_grp_t), intent(in) :: mpi_grp
364 character(len=*), intent(inout) :: buf
365 integer, intent(in) :: cnt
366 type(mpi_datatype), intent(in) :: sendtype
367 integer, intent(in) :: root
368
369#if defined(HAVE_MPI)
370 assert(not_in_openmp())
371
372 call mpi_debug_in(mpi_grp%comm, c_mpi_bcast)
373 if (mpi_grp%comm /= mpi_comm_undefined) then
374 call mpi_bcast(buf, cnt, sendtype, root, mpi_grp%comm, mpi_err)
376 end if
377 call mpi_debug_out(mpi_grp%comm, c_mpi_bcast)
378#endif
379 end subroutine chmpi_grp_bcast_0
380
381 ! ---------------------------------------------------------
382 subroutine lompi_grp_bcast_0(mpi_grp, buf, cnt, sendtype, root)
383 class(mpi_grp_t), intent(in) :: mpi_grp
384 logical, intent(inout) :: buf
385 integer, intent(in) :: cnt
386 type(mpi_datatype), intent(in) :: sendtype
387 integer, intent(in) :: root
388
389#if defined(HAVE_MPI)
391
392 call mpi_debug_in(mpi_grp%comm, c_mpi_bcast)
393 if (mpi_grp%comm /= mpi_comm_undefined) then
394 call mpi_bcast(buf, cnt, sendtype, root, mpi_grp%comm, mpi_err)
396 end if
397 call mpi_debug_out(mpi_grp%comm, c_mpi_bcast)
398#endif
399 end subroutine lompi_grp_bcast_0
400
401 ! ---------------------------------------------------------
402 ! copy routine for serial case
403 subroutine lompi_grp_copy_0(sendbuf, recvbuf, count)
404 use iso_c_binding
405 logical, target, intent(in) :: sendbuf
406 logical, target, intent(out) :: recvbuf
407 integer, intent(in) :: count
408 integer :: ii
409 logical, pointer :: send(:), recv(:)
410
411 call c_f_pointer(c_loc(sendbuf), send, [count])
412 call c_f_pointer(c_loc(recvbuf), recv, [count])
413 do ii = 1, count
414 recv(ii) = send(ii)
415 end do
416 end subroutine lompi_grp_copy_0
417
418 ! ---------------------------------------------------------
419 subroutine lompi_grp_allreduce_0(mpi_grp, sendbuf, recvbuf, count, datatype, op)
420 class(mpi_grp_t), intent(in) :: mpi_grp
421 logical, intent(in) :: sendbuf
422 logical, intent(out) :: recvbuf
423 integer, intent(in) :: count
424 type(mpi_datatype), intent(in):: datatype
425 type(mpi_op), intent(in) :: op
426
427#if defined(HAVE_MPI)
428 assert(not_in_openmp())
429
430 call mpi_debug_in(mpi_grp%comm, c_mpi_allreduce)
431 if (mpi_grp%comm /= mpi_comm_undefined) then
432 call mpi_allreduce(sendbuf, recvbuf, count, datatype, op, &
433 mpi_grp%comm, mpi_err)
435 else
436 call lompi_grp_copy_0(sendbuf, recvbuf, count)
437 end if
438 call mpi_debug_out(mpi_grp%comm, c_mpi_allreduce)
439#else
440 call lompi_grp_copy_0(sendbuf, recvbuf, count)
441#endif
442 end subroutine lompi_grp_allreduce_0
443
444 ! ---------------------------------------------------------
445 subroutine lompi_grp_allreduce_inplace_0(mpi_grp, recvbuf, count, datatype, op)
446 class(mpi_grp_t), intent(in) :: mpi_grp
447 logical, intent(inout) :: recvbuf
448 integer, intent(in) :: count
449 type(mpi_datatype), intent(in) :: datatype
450 type(mpi_op), intent(in) :: op
451
452#if defined(HAVE_MPI)
453 assert(not_in_openmp())
454
455 call mpi_debug_in(mpi_grp%comm, c_mpi_allreduce)
456 if (mpi_grp%comm /= mpi_comm_undefined) then
457 call mpi_allreduce(mpi_in_place, recvbuf, count, datatype, op, &
458 mpi_grp%comm, mpi_err)
460 end if
461 call mpi_debug_out(mpi_grp%comm, c_mpi_allreduce)
462#endif
463 end subroutine lompi_grp_allreduce_inplace_0
464
465 ! ---------------------------------------------------------
466 subroutine lompi_grp_recv_0(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
467 class(mpi_grp_t), intent(in) :: mpi_grp
468 logical, intent(out) :: recvbuf
469 integer, intent(in) :: recvcount
470 type(mpi_datatype),intent(in) :: recvtype
471 integer, intent(in) :: source
472 integer, optional, intent(in) :: tag
473
474 integer :: tag_
476 tag_ = 0
477 if (present(tag)) tag_ = tag
478 if (mpi_grp%comm == mpi_comm_undefined) return
479#if defined(HAVE_MPI)
480 assert(not_in_openmp())
481
482 call mpi_recv(recvbuf, recvcount, recvtype, source, tag_, mpi_grp%comm, mpi_status_ignore, mpi_err)
484#endif
485 end subroutine lompi_grp_recv_0
486
487 ! ---------------------------------------------------------
488 subroutine lompi_grp_send_0(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
489 class(mpi_grp_t), intent(in) :: mpi_grp
490 logical, intent(out) :: sendbuf
491 integer, intent(in) :: sendcount
492 type(mpi_datatype),intent(in) :: sendtype
493 integer, intent(in) :: dest
494 integer, optional, intent(in) :: tag
495
496 integer :: tag_
497
498 tag_ = 0
499 if (present(tag)) tag_ = tag
500 if (mpi_grp%comm == mpi_comm_undefined) return
501#if defined(HAVE_MPI)
502 assert(not_in_openmp())
503
504 call mpi_send(sendbuf, sendcount, sendtype, dest, tag_, mpi_grp%comm, mpi_err)
506#endif
507 end subroutine lompi_grp_send_0
508
509 ! ---------------------------------------------------------
510 subroutine mpi_grp_wait(mpi_grp, request)
511 class(mpi_grp_t), intent(in) :: mpi_grp
512 type(mpi_request), intent(inout) :: request
513
514 if (mpi_grp%comm == mpi_comm_undefined) return
515#if defined(HAVE_MPI)
516 assert(not_in_openmp())
517
518 call mpi_wait(request, mpi_status_ignore, mpi_err)
520#endif
521 end subroutine mpi_grp_wait
522
523 ! ---------------------------------------------------------
524 subroutine mpi_grp_waitall(mpi_grp, count, requests)
525 class(mpi_grp_t), intent(in) :: mpi_grp
526 integer, intent(in) :: count
527 type(mpi_request), intent(inout) :: requests(:)
528
529 if (mpi_grp%comm == mpi_comm_undefined) return
530#if defined(HAVE_MPI)
531 assert(not_in_openmp())
532
533 call mpi_waitall(count, requests, mpi_statuses_ignore, mpi_err)
535#endif
536 end subroutine mpi_grp_waitall
537
538 ! ---------------------------------------------------------
539 subroutine mpi_grp_abort(mpi_grp)
540 class(mpi_grp_t), intent(in) :: mpi_grp
541
542 if (mpi_grp%comm /= mpi_comm_undefined) then
543#if defined(HAVE_MPI)
544 assert(not_in_openmp())
545
546 ! Abort with an arbitrary error code
547 call mpi_abort(mpi_grp%comm, 999, mpi_err)
549#endif
550 end if
551
552 end subroutine mpi_grp_abort
553
554 ! ---------------------------------------------------------
556 real(real64) function mpi_get_Wtime() result(now)
557#if defined(HAVE_MPI)
558 now = mpi_wtime()
559#else
560 now = loct_clock()
561#endif
562 end function mpi_get_wtime
563
564#include "undef.F90"
565#include "real.F90"
566#include "mpi_inc.F90"
567
568#include "undef.F90"
569#include "complex.F90"
570#include "mpi_inc.F90"
571
572#include "undef.F90"
573#include "integer.F90"
574#include "mpi_inc.F90"
575
576#include "undef.F90"
577#include "integer8.F90"
578#include "mpi_inc.F90"
579
580end module mpi_oct_m
582
583!! Local Variables:
584!! mode: f90
585!! coding: utf-8
586!! End:
This module contains interfaces for BLACS routines Interfaces are from http:
Definition: blacs.F90:27
integer, parameter, public c_mpi_allreduce
Definition: mpi_debug.F90:137
subroutine, public mpi_debug_in(comm, index)
Definition: mpi_debug.F90:241
integer, parameter, public c_mpi_bcast
Definition: mpi_debug.F90:137
integer, parameter, public c_mpi_barrier
Definition: mpi_debug.F90:137
subroutine, public mpi_debug_out(comm, index)
Definition: mpi_debug.F90:265
subroutine mpi_grp_abort(mpi_grp)
Definition: mpi.F90:633
subroutine impi_grp_irecv(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:4589
subroutine zmpi_grp_isend_0(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:3225
subroutine mpi_grp_duplicate(mpi_grp_out, mpi_grp_in)
Definition: mpi.F90:417
subroutine impi_grp_irecv_0(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:4567
subroutine lmpi_grp_send(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:5934
subroutine lmpi_grp_isend(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:6161
subroutine lompi_grp_copy_0(sendbuf, recvbuf, count)
Definition: mpi.F90:497
subroutine zmpi_grp_irecv_0_int64(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:3087
subroutine zmpi_grp_recv_3(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
Definition: mpi.F90:2977
subroutine blacs_init()
Initialize BLACS to enable use of SCALAPACK.
Definition: mpi.F90:305
subroutine impi_grp_send_3(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:4521
real(real64) function, public mpi_get_wtime()
. Returns an elapsed time on the calling processor.
Definition: mpi.F90:650
subroutine dmpi_grp_irecv_3(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:1723
subroutine zmpi_grp_isend(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:3248
subroutine dmpi_grp_isend_3(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:1838
subroutine zmpi_grp_irecv_3(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:3179
subroutine lompi_grp_bcast_0(mpi_grp, buf, cnt, sendtype, root)
Definition: mpi.F90:476
logical function mpi_grp_is_root(grp)
Is the current MPI process of grpcomm, root.
Definition: mpi.F90:434
subroutine impi_grp_irecv_2(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:4612
subroutine zmpi_grp_irecv(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:3133
subroutine mpi_grp_copy(mpi_grp_out, mpi_grp_in)
Definition: mpi.F90:407
subroutine zmpi_grp_isend_3(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:3294
subroutine impi_grp_isend_2(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:4727
subroutine lmpi_grp_recv_3(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
Definition: mpi.F90:5890
subroutine impi_grp_isend(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:4704
subroutine lompi_grp_allreduce_inplace_0(mpi_grp, recvbuf, count, datatype, op)
Definition: mpi.F90:539
subroutine impi_grp_isend_0_int64(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:4657
subroutine zmpi_grp_irecv_2(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:3156
subroutine dmpi_grp_isend_0(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:1769
subroutine dmpi_grp_irecv(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:1677
subroutine lmpi_grp_irecv_0_int64(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:6000
subroutine dmpi_grp_send_2(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:1587
subroutine impi_grp_irecv_0_int64(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:4543
subroutine lompi_grp_recv_0(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
Definition: mpi.F90:560
subroutine mpi_grp_wait(mpi_grp, request)
Definition: mpi.F90:604
subroutine lmpi_grp_irecv(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:6046
type(mpi_grp_t), public mpi_world
Definition: mpi.F90:270
subroutine impi_grp_isend_0(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:4681
subroutine mpi_mod_end()
Finalize MPI, and optionally BLACS.
Definition: mpi.F90:332
subroutine dmpi_grp_send(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:1565
logical pure function, private not_in_openmp()
Definition: mpi.F90:379
subroutine dmpi_grp_recv_3(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
Definition: mpi.F90:1521
subroutine zmpi_grp_send(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:3021
subroutine lmpi_grp_isend_2(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:6184
subroutine mpi_grp_init(grp, comm)
Initialize MPI group instance.
Definition: mpi.F90:350
subroutine zmpi_grp_send_2(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:3043
subroutine dmpi_grp_irecv_0(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:1655
subroutine impi_grp_irecv_3(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:4635
subroutine impi_grp_isend_3(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:4750
subroutine dmpi_grp_isend(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:1792
subroutine dmpi_grp_isend_2(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:1815
subroutine zmpi_grp_isend_0_int64(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:3201
subroutine lmpi_grp_irecv_3(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:6092
subroutine mpi_grp_barrier(mpi_grp)
Definition: mpi.F90:441
subroutine impi_grp_recv_3(mpi_grp, recvbuf, recvcount, recvtype, source, tag)
Definition: mpi.F90:4433
subroutine zmpi_grp_irecv_0(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:3111
subroutine lmpi_grp_send_2(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:5956
subroutine mpi_init_comm(comm)
Wrapper for MPI_COMM_WORLD initialisation.
Definition: mpi.F90:286
subroutine impi_grp_send_2(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:4499
subroutine dmpi_grp_irecv_2(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:1700
integer, public mpi_err
used to store return values of mpi calls
Definition: mpi.F90:273
subroutine lmpi_grp_isend_0_int64(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:6114
subroutine dmpi_grp_irecv_0_int64(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:1631
subroutine lmpi_grp_isend_0(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:6138
subroutine dmpi_grp_isend_0_int64(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:1745
subroutine dmpi_grp_send_3(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:1609
subroutine zmpi_grp_isend_2(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:3271
subroutine lmpi_grp_send_3(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:5978
subroutine zmpi_grp_send_3(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:3065
subroutine mpi_grp_waitall(mpi_grp, count, requests)
Definition: mpi.F90:618
subroutine lompi_grp_allreduce_0(mpi_grp, sendbuf, recvbuf, count, datatype, op)
Definition: mpi.F90:513
subroutine lmpi_grp_irecv_0(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:6024
subroutine impi_grp_send(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:4477
subroutine lompi_grp_send_0(mpi_grp, sendbuf, sendcount, sendtype, dest, tag)
Definition: mpi.F90:582
subroutine mpi_error_check(error)
Definition: mpi.F90:391
subroutine lmpi_grp_isend_3(mpi_grp, sendbuf, sendcount, sendtype, source, request, tag)
Definition: mpi.F90:6207
subroutine chmpi_grp_bcast_0(mpi_grp, buf, cnt, sendtype, root)
Definition: mpi.F90:456
subroutine lmpi_grp_irecv_2(mpi_grp, recvbuf, recvcount, recvtype, source, request, tag)
Definition: mpi.F90:6069
This is defined even when running serial.
Definition: mpi.F90:142
int true(void)