Merge branch 'master' into binaries
This commit is contained in:
commit
943d292ae2
@ -108,8 +108,9 @@ module boundaries
|
||||
|
||||
! import external procedures and variables
|
||||
!
|
||||
use coordinates , only : periodic
|
||||
#ifdef MPI
|
||||
use mpitools , only : pdims, pcoords, periodic, npmax
|
||||
use mpitools , only : npmax
|
||||
#endif /* MPI */
|
||||
use parameters , only : get_parameter_string
|
||||
|
||||
@ -130,6 +131,10 @@ module boundaries
|
||||
character(len = 32) :: yubndry = "periodic"
|
||||
character(len = 32) :: zlbndry = "periodic"
|
||||
character(len = 32) :: zubndry = "periodic"
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer :: n
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -257,6 +262,13 @@ module boundaries
|
||||
bnd_type(3,2) = bnd_periodic
|
||||
end select
|
||||
|
||||
! set domain periodicity
|
||||
!
|
||||
do n = 1, NDIMS
|
||||
periodic(n) = (bnd_type(n,1) == bnd_periodic) .and. &
|
||||
(bnd_type(n,2) == bnd_periodic)
|
||||
end do
|
||||
|
||||
#ifdef MPI
|
||||
! allocate the exchange arrays
|
||||
!
|
||||
@ -1083,11 +1095,11 @@ module boundaries
|
||||
use blocks , only : ndims, nsides
|
||||
use coordinates , only : im, jm, km
|
||||
use coordinates , only : ax, ay, az
|
||||
use coordinates , only : periodic
|
||||
use equations , only : nv
|
||||
#ifdef MPI
|
||||
use mpitools , only : nproc
|
||||
#endif /* MPI */
|
||||
use mpitools , only : periodic
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
|
||||
@ -94,6 +94,10 @@ module coordinates
|
||||
real(kind=8), save :: yarea = 1.0d+00
|
||||
real(kind=8), save :: zarea = 1.0d+00
|
||||
|
||||
! flags to indicate periodicity of boundaries
|
||||
!
|
||||
logical, dimension(3), save :: periodic = .true.
|
||||
|
||||
! the block coordinates for all levels of refinement
|
||||
!
|
||||
real(kind=8), dimension(:,:), allocatable, save :: ax , ay , az
|
||||
|
||||
@ -143,9 +143,9 @@ module domains
|
||||
use blocks , only : metablock_set_configuration
|
||||
use blocks , only : metablock_set_coordinates, metablock_set_bounds
|
||||
use blocks , only : nsides
|
||||
use boundaries , only : bnd_type, bnd_periodic
|
||||
use coordinates , only : xmin, ymin, zmin, xlen, ylen, zlen
|
||||
use coordinates , only : ir, jr, kr
|
||||
use coordinates , only : periodic
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
@ -344,16 +344,16 @@ module domains
|
||||
|
||||
! check periodicity and reset the edge indices if box is not periodic
|
||||
!
|
||||
if (bnd_type(1,1) /= bnd_periodic .or. bnd_type(1,2) /= bnd_periodic) then
|
||||
if (.not. periodic(1)) then
|
||||
im( 1) = 0
|
||||
ip(ir) = 0
|
||||
end if
|
||||
if (bnd_type(2,1) /= bnd_periodic .or. bnd_type(2,2) /= bnd_periodic) then
|
||||
if (.not. periodic(2)) then
|
||||
jm( 1) = 0
|
||||
jp(jr) = 0
|
||||
end if
|
||||
#if NDIMS == 3
|
||||
if (bnd_type(3,1) /= bnd_periodic .or. bnd_type(3,2) /= bnd_periodic) then
|
||||
if (.not. periodic(3)) then
|
||||
km( 1) = 0
|
||||
kp(kr) = 0
|
||||
end if
|
||||
|
||||
@ -54,7 +54,6 @@ program amun
|
||||
use mesh , only : initialize_mesh, finalize_mesh
|
||||
use mesh , only : generate_mesh, store_mesh_stats
|
||||
use mpitools , only : initialize_mpitools, finalize_mpitools
|
||||
use mpitools , only : setup_mpi
|
||||
#ifdef MPI
|
||||
use mpitools , only : bcast_integer_variable
|
||||
use mpitools , only : reduce_maximum_integer, reduce_sum_real_array
|
||||
@ -85,8 +84,6 @@ program amun
|
||||
|
||||
! default parameters
|
||||
!
|
||||
integer, dimension(3) :: div = 1
|
||||
logical, dimension(3) :: per = .true.
|
||||
integer :: nmax = huge(1), ndat = 1
|
||||
real(kind=8) :: tmax = 0.0d+00, trun = 9.999d+03, tsav = 3.0d+01
|
||||
real(kind=8) :: dtnext = 0.0d+00
|
||||
@ -96,10 +93,6 @@ program amun
|
||||
logical , save :: precise_snapshots = .false.
|
||||
character(len=255) :: prec_snap = "off"
|
||||
|
||||
! temporary variables
|
||||
!
|
||||
character(len=64) :: lbnd, ubnd
|
||||
|
||||
! the termination and status flags
|
||||
!
|
||||
integer :: iterm, iret
|
||||
@ -244,26 +237,6 @@ program amun
|
||||
!
|
||||
iterm = 0
|
||||
|
||||
! check if the domain is periodic
|
||||
!
|
||||
lbnd = "periodic"
|
||||
ubnd = "periodic"
|
||||
call get_parameter_string("xlbndry" , lbnd)
|
||||
call get_parameter_string("xubndry" , ubnd)
|
||||
per(1) = (lbnd == "periodic") .and. (ubnd == "periodic")
|
||||
lbnd = "periodic"
|
||||
ubnd = "periodic"
|
||||
call get_parameter_string("ylbndry" , lbnd)
|
||||
call get_parameter_string("yubndry" , ubnd)
|
||||
per(2) = (lbnd == "periodic") .and. (ubnd == "periodic")
|
||||
#if NDIMS == 3
|
||||
lbnd = "periodic"
|
||||
ubnd = "periodic"
|
||||
call get_parameter_string("zlbndry" , lbnd)
|
||||
call get_parameter_string("zubndry" , ubnd)
|
||||
per(3) = (lbnd == "periodic") .and. (ubnd == "periodic")
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! get the execution termination parameters
|
||||
!
|
||||
call get_parameter_integer("nmax" , nmax)
|
||||
@ -304,10 +277,6 @@ program amun
|
||||
write (*,"(4x,a,1x,i6 )" ) "MPI processes =", nprocs
|
||||
end if
|
||||
|
||||
! set up the MPI geometry
|
||||
!
|
||||
call setup_mpi(div(:), per(:), .false.)
|
||||
|
||||
! initialize the random number generator (passes the number of OpenMP threads
|
||||
! and the current thread number)
|
||||
!
|
||||
|
||||
@ -1273,12 +1273,13 @@ module io
|
||||
use coordinates , only : minlev, maxlev, toplev
|
||||
use coordinates , only : nc, ng, in, jn, kn, ir, jr, kr
|
||||
use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax
|
||||
use coordinates , only : periodic
|
||||
use equations , only : eqsys, eos, gamma, csnd
|
||||
use error , only : print_error
|
||||
use evolution , only : step, time, dt, dtn
|
||||
use hdf5 , only : hid_t
|
||||
use hdf5 , only : h5gcreate_f, h5gclose_f
|
||||
use mpitools , only : nprocs, nproc, periodic
|
||||
use mpitools , only : nprocs, nproc
|
||||
use random , only : nseeds, get_seeds
|
||||
|
||||
! local variables are not implicit by default
|
||||
|
||||
250
src/mpitools.F90
250
src/mpitools.F90
@ -48,11 +48,8 @@ module mpitools
|
||||
|
||||
! MPI global variables
|
||||
!
|
||||
integer(kind=4), save :: comm3d
|
||||
integer(kind=4), save :: comm
|
||||
integer(kind=4), save :: nproc, nprocs, npmax, npairs
|
||||
integer(kind=4), save, dimension(3) :: pdims, pcoords, pparity
|
||||
integer(kind=4), save, dimension(3,2) :: pneighs
|
||||
logical , save, dimension(3) :: periodic
|
||||
logical , save :: master = .true.
|
||||
|
||||
! allocatable array for processor pairs
|
||||
@ -128,11 +125,6 @@ module mpitools
|
||||
nproc = 0
|
||||
nprocs = 1
|
||||
npmax = 0
|
||||
pdims(:) = 1
|
||||
pcoords(:) = 0
|
||||
pparity(:) = 0
|
||||
pneighs(:,:) = -1
|
||||
periodic(:) = .false.
|
||||
|
||||
#ifdef MPI
|
||||
! initialize the MPI interface
|
||||
@ -141,7 +133,7 @@ module mpitools
|
||||
|
||||
! check if the MPI interface was initialized successfully
|
||||
!
|
||||
if (iret .ne. mpi_success) then
|
||||
if (iret /= mpi_success) then
|
||||
write(*,*) 'The MPI interface could not be initializes! Exiting...'
|
||||
write(*,*)
|
||||
stop
|
||||
@ -153,7 +145,7 @@ module mpitools
|
||||
|
||||
! check if the total number of processes could be obtained
|
||||
!
|
||||
if (iret .ne. mpi_success) then
|
||||
if (iret /= mpi_success) then
|
||||
write(*,*) 'The MPI process ID could not be obtained! Exiting...'
|
||||
write(*,*)
|
||||
stop
|
||||
@ -165,7 +157,7 @@ module mpitools
|
||||
|
||||
! check if the process ID was return successfully
|
||||
!
|
||||
if (iret .ne. mpi_success) then
|
||||
if (iret /= mpi_success) then
|
||||
write(*,*) 'The MPI process ID could not be obtained! Exiting...'
|
||||
write(*,*)
|
||||
stop
|
||||
@ -173,7 +165,7 @@ module mpitools
|
||||
|
||||
! set the master flag
|
||||
!
|
||||
master = (nproc .eq. 0)
|
||||
master = nproc == 0
|
||||
|
||||
! calculate the index of the last processor
|
||||
!
|
||||
@ -245,9 +237,9 @@ module mpitools
|
||||
!
|
||||
deallocate(procs)
|
||||
|
||||
! store the MPI pool handles
|
||||
! store the MPI communicator
|
||||
!
|
||||
comm3d = mpi_comm_world
|
||||
comm = mpi_comm_world
|
||||
|
||||
! stop time accounting for the MPI initialization
|
||||
!
|
||||
@ -299,7 +291,7 @@ module mpitools
|
||||
|
||||
! check if the MPI interface was finalizes successfully
|
||||
!
|
||||
if (iret .ne. mpi_success) then
|
||||
if (iret /= mpi_success) then
|
||||
if (master) then
|
||||
write(*,*) 'The MPI interface could not be finalized! Exiting...'
|
||||
write(*,*)
|
||||
@ -319,164 +311,6 @@ module mpitools
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine finalize_mpitools
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine SETUP_MPI:
|
||||
! --------------------
|
||||
!
|
||||
! Subroutine sets the MPI geometry.
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine setup_mpi(div, per, set)
|
||||
|
||||
! include external procedures and variables
|
||||
!
|
||||
#ifdef MPI
|
||||
use mpi, only : mpi_comm_world, mpi_success
|
||||
#endif /* MPI */
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! input arguments
|
||||
!
|
||||
integer, dimension(3), intent(in) :: div
|
||||
logical, dimension(3), intent(in) :: per
|
||||
logical , intent(in) :: set
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer :: iret
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
#ifdef MPI
|
||||
! start time accounting for the MPI initialization
|
||||
!
|
||||
call start_timer(imi)
|
||||
#endif /* MPI */
|
||||
|
||||
! set the periodic flag
|
||||
!
|
||||
periodic(:) = per(:)
|
||||
|
||||
#ifdef MPI
|
||||
! if set = .true. set the MPI domain
|
||||
!
|
||||
if (set) then
|
||||
|
||||
! check if the total number of chunks in division corresponds to the number of
|
||||
! processes, if not try to find the best division
|
||||
!
|
||||
if (nprocs .ne. product(div(:))) then
|
||||
|
||||
if (master) then
|
||||
write(*,*) 'The number of MPI processes does not correspond to' &
|
||||
// ' the number of domain chunks!'
|
||||
write(*,*) 'Looking for the best division...'
|
||||
end if
|
||||
|
||||
! try to find the best division
|
||||
!
|
||||
pdims(:) = 1
|
||||
iret = 0
|
||||
|
||||
do while(product(pdims(:)) .lt. nprocs)
|
||||
#if NDIMS == 3
|
||||
iret = mod(iret, 3) + 1
|
||||
#else /* NDIMS == 3 */
|
||||
iret = mod(iret, 2) + 1
|
||||
#endif /* NDIMS == 3 */
|
||||
pdims(iret) = 2 * pdims(iret)
|
||||
end do
|
||||
|
||||
! check if the best division found
|
||||
!
|
||||
if (product(pdims(:)) .ne. nprocs) then
|
||||
|
||||
if (master) then
|
||||
write(*,*) 'Improssible to find the best domain division! Exiting...'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
call finalize_mpitools()
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
if (master) then
|
||||
write(*,*) 'Found the best division:', pdims(:)
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
! substitute div(:) to pdims(:)
|
||||
!
|
||||
pdims(:) = div(:)
|
||||
|
||||
end if
|
||||
|
||||
! set up the Cartesian geometry
|
||||
!
|
||||
call mpi_cart_create(mpi_comm_world, 3, pdims(:), periodic(:) &
|
||||
, .true., comm3d, iret)
|
||||
|
||||
if (iret .ne. mpi_success) then
|
||||
|
||||
if (master) then
|
||||
write(*,*) 'The MPI could not create the Cartesian geometry! Exiting...'
|
||||
write(*,*)
|
||||
end if
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! assign process coordinate
|
||||
!
|
||||
call mpi_cart_coords(comm3d, nproc, 3, pcoords(:), iret)
|
||||
|
||||
if (iret .ne. mpi_success) then
|
||||
|
||||
if (master) then
|
||||
write(*,*) 'The MPI could not assign process coordinates! Exiting...'
|
||||
write(*,*)
|
||||
end if
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! set the neighbors
|
||||
!
|
||||
if (pdims(1) .gt. 1) then
|
||||
call mpi_cart_shift(comm3d, 0, 1, pneighs(1,1), pneighs(1,2), iret)
|
||||
end if
|
||||
if (pdims(2) .gt. 1) then
|
||||
call mpi_cart_shift(comm3d, 1, 1, pneighs(2,1), pneighs(2,2), iret)
|
||||
end if
|
||||
if (pdims(3) .gt. 1) then
|
||||
call mpi_cart_shift(comm3d, 2, 1, pneighs(3,1), pneighs(3,2), iret)
|
||||
end if
|
||||
|
||||
! set parity flag
|
||||
!
|
||||
pparity(1) = mod(pcoords(1), 2)
|
||||
pparity(2) = mod(pcoords(2), 2)
|
||||
pparity(3) = mod(pcoords(3), 2)
|
||||
|
||||
end if
|
||||
|
||||
! stop time accounting for the MPI initialization
|
||||
!
|
||||
call stop_timer(imi)
|
||||
#endif /* MPI */
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine setup_mpi
|
||||
#ifdef MPI
|
||||
!
|
||||
!===============================================================================
|
||||
@ -516,7 +350,7 @@ module mpitools
|
||||
call start_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_bcast(ibuf, 1, mpi_integer, 0, comm3d, iret)
|
||||
call mpi_bcast(ibuf, 1, mpi_integer, 0, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI broadcast
|
||||
@ -524,7 +358,7 @@ module mpitools
|
||||
call stop_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not broadcast an integer variable!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -574,7 +408,7 @@ module mpitools
|
||||
call start_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_bcast(rbuf, 1, mpi_real8, 0, comm3d, iret)
|
||||
call mpi_bcast(rbuf, 1, mpi_real8, 0, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI broadcast
|
||||
@ -582,7 +416,7 @@ module mpitools
|
||||
call stop_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not broadcast an integer variable!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -632,7 +466,7 @@ module mpitools
|
||||
call start_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_bcast(sbuf, len(sbuf), mpi_character, 0, comm3d, iret)
|
||||
call mpi_bcast(sbuf, len(sbuf), mpi_character, 0, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI broadcast
|
||||
@ -640,7 +474,7 @@ module mpitools
|
||||
call stop_timer(imb)
|
||||
#endif /* PROFILE */
|
||||
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not broadcast a string variable!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -694,7 +528,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_min, comm3d, iret)
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_min, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -708,7 +542,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the minimum value!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -761,7 +595,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_min, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_min, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -775,7 +609,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the minimum value!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -829,7 +663,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_max, comm3d, iret)
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_max, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -843,7 +677,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maximum value!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -896,7 +730,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_max, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_max, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -910,7 +744,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maximum value!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -963,7 +797,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(ibuf, tbuf, 1, mpi_integer, mpi_sum, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -977,7 +811,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maximum value!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1030,7 +864,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, 1, mpi_real8, mpi_sum, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1044,7 +878,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not sum the values from all processes!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1099,7 +933,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_min, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_min, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1113,7 +947,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the minima for all array elements!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1168,7 +1002,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_max, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_max, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1182,7 +1016,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maxima for all array elements!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1237,7 +1071,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(ibuf, tbuf, n, mpi_integer, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(ibuf, tbuf, n, mpi_integer, mpi_sum, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1251,7 +1085,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maxima for all array elements!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1306,7 +1140,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(rbuf, tbuf, n, mpi_real8, mpi_sum, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1320,7 +1154,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maxima for all array elements!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1376,9 +1210,9 @@ module mpitools
|
||||
#endif /* PROFILE */
|
||||
|
||||
tbuf(:) = real(cbuf(:))
|
||||
call mpi_allreduce(tbuf, rbuf, n, mpi_real8, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(tbuf, rbuf, n, mpi_real8, mpi_sum, comm, iret)
|
||||
tbuf(:) = aimag(cbuf(:))
|
||||
call mpi_allreduce(tbuf, ibuf, n, mpi_real8, mpi_sum, comm3d, iret)
|
||||
call mpi_allreduce(tbuf, ibuf, n, mpi_real8, mpi_sum, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI reduce
|
||||
@ -1392,7 +1226,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not find the maxima for all array elements!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1450,7 +1284,7 @@ module mpitools
|
||||
call start_timer(ims)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_send(rbuf, n, mpi_real8, dst, tag, comm3d, iret)
|
||||
call mpi_send(rbuf, n, mpi_real8, dst, tag, comm, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI send
|
||||
@ -1460,7 +1294,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not send the real array to another process!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1522,7 +1356,7 @@ module mpitools
|
||||
call start_timer(imr)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call mpi_recv(rbuf, n, mpi_real8, src, tag, comm3d, status, iret)
|
||||
call mpi_recv(rbuf, n, mpi_real8, src, tag, comm, status, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI receive
|
||||
@ -1532,7 +1366,7 @@ module mpitools
|
||||
|
||||
! check if the operation was successful
|
||||
!
|
||||
if (iret .ne. mpi_success .and. master) then
|
||||
if (iret /= mpi_success .and. master) then
|
||||
write(*,*) 'The MPI could not send the real array to another process!'
|
||||
write(*,*)
|
||||
end if
|
||||
@ -1607,7 +1441,7 @@ module mpitools
|
||||
!
|
||||
call mpi_sendrecv(sbuffer(:), ssize, mpi_real8, sproc, stag &
|
||||
, rbuffer(:), rsize, mpi_real8, rproc, rtag &
|
||||
, comm3d, status, iret)
|
||||
, comm, status, iret)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop time accounting for the MPI buffer exchange
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user