2009-09-11 17:35:23 +02:00
|
|
|
subroutine start_mpi
|
2009-05-15 01:01:27 +02:00
|
|
|
implicit none
|
2009-09-11 17:35:23 +02:00
|
|
|
integer :: ierr
|
|
|
|
|
integer, save :: started = 0
|
2009-05-15 01:01:27 +02:00
|
|
|
|
|
|
|
|
IRP_IF MPI
|
2009-09-11 17:35:23 +02:00
|
|
|
include 'mpif.h'
|
|
|
|
|
if (started == 0) then
|
|
|
|
|
call MPI_INIT(ierr)
|
|
|
|
|
if (ierr /= MPI_SUCCESS) then
|
|
|
|
|
call abrt(irp_here,"Unable to initialize MPI")
|
|
|
|
|
endif
|
|
|
|
|
endif
|
|
|
|
|
started = 1
|
2009-05-15 01:01:27 +02:00
|
|
|
IRP_ENDIF
|
|
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
end
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ integer, mpi_rank ]
|
|
|
|
|
implicit none
|
2009-05-15 01:01:27 +02:00
|
|
|
BEGIN_DOC
|
2009-09-11 17:35:23 +02:00
|
|
|
! Number of the processor
|
2009-05-15 01:01:27 +02:00
|
|
|
END_DOC
|
|
|
|
|
|
|
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
IRP_IF MPI
|
|
|
|
|
include 'mpif.h'
|
|
|
|
|
integer :: ierr
|
|
|
|
|
call start_mpi
|
|
|
|
|
call MPI_COMM_RANK(MPI_COMM_WORLD, mpi_rank, ierr)
|
|
|
|
|
if (ierr /= MPI_SUCCESS) then
|
|
|
|
|
call abrt(irp_here,"Unable to get MPI")
|
|
|
|
|
endif
|
2009-05-15 01:01:27 +02:00
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
IRP_ELSE
|
2009-05-15 01:01:27 +02:00
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
mpi_rank = 0
|
2009-05-15 01:01:27 +02:00
|
|
|
|
|
|
|
|
IRP_ENDIF
|
|
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ integer, mpi_size ]
|
|
|
|
|
implicit none
|
|
|
|
|
BEGIN_DOC
|
|
|
|
|
! Number of processors
|
|
|
|
|
END_DOC
|
|
|
|
|
|
|
|
|
|
IRP_IF MPI
|
|
|
|
|
include 'mpif.h'
|
|
|
|
|
|
|
|
|
|
integer :: ierr
|
|
|
|
|
call start_mpi
|
|
|
|
|
call MPI_COMM_SIZE(MPI_COMM_WORLD, mpi_size, ierr)
|
|
|
|
|
if (ierr /= MPI_SUCCESS) then
|
|
|
|
|
call abrt(irp_here,"Unable to get MPI size")
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
IRP_ELSE
|
|
|
|
|
|
|
|
|
|
mpi_size = 1
|
|
|
|
|
|
|
|
|
|
IRP_ENDIF
|
|
|
|
|
|
|
|
|
|
call iinfo(irp_here,'mpi_size',mpi_size)
|
2009-05-15 01:01:27 +02:00
|
|
|
|
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
|
2009-09-11 17:35:23 +02:00
|
|
|
BEGIN_PROVIDER [ logical, mpi_master ]
|
|
|
|
|
implicit none
|
|
|
|
|
BEGIN_DOC
|
|
|
|
|
! mpi_master : True if the current processor is the master
|
|
|
|
|
END_DOC
|
|
|
|
|
mpi_master = (mpi_rank == 0)
|
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
2009-09-29 13:42:56 +02:00
|
|
|
subroutine barrier()
|
|
|
|
|
IRP_IF MPI
|
|
|
|
|
include 'mpif.h'
|
|
|
|
|
integer :: ierr
|
|
|
|
|
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
|
|
|
|
|
if (ierr /= MPI_SUCCESS) then
|
|
|
|
|
call abrt(irp_here,'Unable to realize MPI barrier')
|
|
|
|
|
endif
|
|
|
|
|
IRP_ENDIF
|
|
|
|
|
end
|
|
|
|
|
|
