diff --git a/src/boundaries.F90 b/src/boundaries.F90 index 8aab3c5..32986d2 100644 --- a/src/boundaries.F90 +++ b/src/boundaries.F90 @@ -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 ! diff --git a/src/coordinates.F90 b/src/coordinates.F90 index d3a3768..1218a8b 100644 --- a/src/coordinates.F90 +++ b/src/coordinates.F90 @@ -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 diff --git a/src/domains.F90 b/src/domains.F90 index cea746a..ff777d7 100644 --- a/src/domains.F90 +++ b/src/domains.F90 @@ -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 diff --git a/src/driver.F90 b/src/driver.F90 index ee37f85..53d5850 100644 --- a/src/driver.F90 +++ b/src/driver.F90 @@ -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) ! diff --git a/src/io.F90 b/src/io.F90 index 7b90c4b..7f47baf 100644 --- a/src/io.F90 +++ b/src/io.F90 @@ -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 diff --git a/src/mpitools.F90 b/src/mpitools.F90 index 8cd9e7d..fb2ec8a 100644 --- a/src/mpitools.F90 +++ b/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