10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-19 20:42:41 +01:00
quantum_package/plugins/MPI/mpi.irp.f

83 lines
1.6 KiB
Fortran
Raw Normal View History

2017-11-23 12:17:47 +01:00
BEGIN_PROVIDER [ integer, mpi_bit_kind ]
use bitmasks
include 'mpif.h'
implicit none
BEGIN_DOC
! MPI bit kind type
END_DOC
IRP_IF MPI
if (bit_kind == 4) then
mpi_bit_kind = MPI_INTEGER4
else if (bit_kind == 8) then
mpi_bit_kind = MPI_INTEGER8
else
stop 'Wrong bit kind in mpi_bit_kind'
endif
IRP_ELSE
mpi_bit_kind = -1
IRP_ENDIF
END_PROVIDER
2017-11-22 17:07:16 +01:00
BEGIN_PROVIDER [ logical, mpi_initialized ]
implicit none
BEGIN_DOC
! Always true. Initialized MPI
END_DOC
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call mpi_init(ierr)
2017-11-23 18:07:24 +01:00
if (ierr /= MPI_SUCCESS) then
2017-11-22 17:07:16 +01:00
print *, 'ierr = ', ierr
stop 'Unable to initialize MPI'
endif
IRP_ENDIF
mpi_initialized = .True.
END_PROVIDER
BEGIN_PROVIDER [ integer, mpi_rank ]
&BEGIN_PROVIDER [ integer, mpi_size ]
implicit none
BEGIN_DOC
! Rank of MPI process and number of MPI processes
END_DOC
IRP_IF MPI
include 'mpif.h'
PROVIDE mpi_initialized
integer :: ierr
call MPI_COMM_RANK (MPI_COMM_WORLD, mpi_rank, ierr)
2017-11-23 18:07:24 +01:00
if (ierr /= MPI_SUCCESS) then
2017-11-22 17:07:16 +01:00
print *, 'ierr = ', ierr
stop 'Unable to get MPI rank'
endif
2017-11-23 12:17:47 +01:00
call write_int(6,mpi_rank,'MPI rank')
2017-11-22 17:07:16 +01:00
call MPI_COMM_SIZE (MPI_COMM_WORLD, mpi_size, ierr)
2017-11-23 18:07:24 +01:00
if (ierr /= MPI_SUCCESS) then
2017-11-22 17:07:16 +01:00
print *, 'ierr = ', ierr
stop 'Unable to get MPI size'
endif
2017-11-23 12:17:47 +01:00
call write_int(6,mpi_size,'MPI size')
2017-11-22 17:07:16 +01:00
IRP_ELSE
mpi_rank = 0
mpi_size = 1
IRP_ENDIF
ASSERT (mpi_rank >= 0)
ASSERT (mpi_rank < mpi_size)
END_PROVIDER
BEGIN_PROVIDER [ logical, mpi_master ]
implicit none
BEGIN_DOC
! If true, rank is zero
END_DOC
mpi_master = (mpi_rank == 0)
END_PROVIDER