gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into reconnection

Browse Source
This commit is contained in:
Grzegorz Kowal 2014-12-22 11:21:08 -02:00
commit fa4da22d53
6 changed files with 1015 additions and 1323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/blocks.F90
View File

@ -277,11 +277,10 @@ module blocks
!
type(block_meta) , pointer :: neigh
! the direction, side and face numbers
! indicating the neighbor block orientation
! with respect to the block
! the direction along which the neighbor
! is located
!
integer(kind=4) :: direction, side, face
integer(kind=4) :: direction
! the corner index determining the position of
! the corner boundary and when direction is

2132
src/boundaries.F90
View File

File diff suppressed because it is too large Load Diff

14
src/io.F90
View File

@ -525,7 +525,7 @@ module io
#ifdef MPI
use mesh , only : redistribute_blocks
#endif /* MPI */
use mpitools , only : nprocs, nproc
use mpitools , only : nprocs, npmax, nproc
! local variables are not implicit by default
!
@ -719,11 +719,11 @@ module io
! switch meta blocks from the read file to belong to the reading process
!
call change_blocks_process(lfile, nprocs - 1)
call change_blocks_process(lfile, npmax)
! read the remaining files by the last process only
!
if (nproc == nprocs - 1) then
if (nproc == npmax) then
! prepare the filename
!
@ -794,7 +794,7 @@ module io
return
end if
end if ! nproc == nprocs - 1
end if ! nproc == npmax
#ifdef MPI
! redistribute blocks between processors
@ -1775,7 +1775,7 @@ module io
! local variables
!
integer(hid_t) :: gid
integer(kind=4) :: i, j, k, l, p, n, ip, lcpu
integer(kind=4) :: i, j, k, l, p, n, ip
integer :: err
integer(hsize_t), dimension(1) :: am
integer(hsize_t), dimension(2) :: dm, pm
@ -1813,10 +1813,6 @@ module io
!
!-------------------------------------------------------------------------------
!
! prepare last cpu index
!
lcpu = nprocs - 1
! open metablock group
!
call h5gopen_f(fid, 'metablocks', gid, err)

2
src/makefile
View File

@ -147,7 +147,7 @@ io.o : io.F90 blocks.o coordinates.o equations.o error.o \
mesh.o : mesh.F90 blocks.o coordinates.o domains.o equations.o \
error.o interpolations.o mpitools.o problems.o refinement.o \
timers.o
mpitools.o : mpitools.F90 timers.o
mpitools.o : mpitools.F90 error.o timers.o
operators.o : operators.F90 timers.o
parameters.o : parameters.F90 mpitools.o
problems.o : problems.F90 blocks.o constants.o coordinates.o equations.o \

12
src/mesh.F90
View File

@ -468,7 +468,7 @@ module mesh
use coordinates , only : minlev, maxlev
use domains , only : setup_domain
use error , only : print_error
use mpitools , only : master, nproc, nprocs
use mpitools , only : master, nproc, nprocs, npmax
use problems , only : setup_problem
use refinement , only : check_refinement_criterion
@ -485,7 +485,7 @@ module mesh
!
integer(kind=4) :: level, lev, idir, iside, iface
integer(kind=4) :: np, nl
integer(kind=4), dimension(0:nprocs-1) :: lb
integer(kind=4), dimension(0:npmax) :: lb
!-------------------------------------------------------------------------------
!
@ -726,7 +726,7 @@ module mesh
! increase the process number
!
np = min(nprocs - 1, np + 1)
np = min(npmax, np + 1)
end if ! nl >= lb(np)
@ -849,7 +849,7 @@ module mesh
use blocks , only : append_datablock, remove_datablock, link_blocks
use coordinates , only : im, jm, km
use equations , only : nv
use mpitools , only : nprocs, nproc
use mpitools , only : nprocs, npmax, nproc
use mpitools , only : send_real_array, receive_real_array
#endif /* MPI */
@ -874,7 +874,7 @@ module mesh
! array for number of data block for autobalancing
!
integer(kind=4), dimension(0:nprocs-1) :: lb
integer(kind=4), dimension(0:npmax) :: lb
! local buffer for data block exchange
!
@ -996,7 +996,7 @@ module mesh
! increase the process number
!
np = min(nprocs - 1, np + 1)
np = min(npmax, np + 1)
end if ! l >= lb(n)

95
src/mpitools.F90
View File

@ -43,7 +43,7 @@ module mpitools
!
integer , save :: imi, imc
#ifdef PROFILE
integer , save :: imb, imm, ims, imr
integer , save :: imb, imm, ims, imr, ime
#endif /* PROFILE */
! MPI global variables
@ -115,6 +115,7 @@ module mpitools
call set_timer('mpitools:: reduce' , imm)
call set_timer('mpitools:: send' , ims)
call set_timer('mpitools:: receive' , imr)
call set_timer('mpitools:: exchange' , ime)
#endif /* PROFILE */
! start time accounting for the MPI initialization
@ -178,17 +179,17 @@ module mpitools
!
npmax = nprocs - 1
! roung up the number of processors to even number
! round up the number of processors to even number
!
mprocs = nprocs + mod(nprocs, 2)
! calculate the number of processor pairs for data exchange
!
npairs = nprocs * npmax
npairs = nprocs * npmax / 2
! allocate space for all processor pairs
!
allocate(pairs(npairs, 2))
allocate(pairs(2 * npairs, 2))
! allocate space for the processor order
!
@ -238,7 +239,7 @@ module mpitools
! fill out the remaining pairs (swapped)
!
pairs(npairs/2+1:npairs,1:2) = pairs(1:npairs/2,2:1:-1)
pairs(npairs+1:2*npairs,1:2) = pairs(1:npairs,2:1:-1)
! allocate space for the processor order
!
@ -1545,6 +1546,90 @@ module mpitools
end subroutine receive_real_array
!
!===============================================================================
!
! subroutine EXCHANGE_REAL_ARRAYS:
! -------------------------------
!
! Subroutine exchanges real data buffers between two processes.
!
! Arguments:
!
! sproc - the process number to which send the buffer sbuf;
! stag - the tag identifying the send operation;
! ssize - the size of the send buffer sbuf;
! sbuf - the real array buffer to send;
! rproc - the process number from which receive the buffer rbuf;
! rtag - the tag identifying the receive operation;
! rsize - the size of the receive buffer rbuf;
! rbuf - the real array buffer to receive;
! iret - the result flag identifying if the operation was successful;
!
!===============================================================================
!
subroutine exchange_real_arrays(sproc, stag, ssize, sbuffer &
, rproc, rtag, rsize, rbuffer, iret)
! include external procedures and variables
!
use error, only : print_error
use mpi , only : mpi_real8, mpi_success, mpi_status_size
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
integer , intent(in) :: sproc, rproc
integer , intent(in) :: stag , rtag
integer , intent(in) :: ssize, rsize
real(kind=8), dimension(ssize), intent(in) :: sbuffer
real(kind=8), dimension(rsize), intent(in) :: rbuffer
integer , intent(out) :: iret
! local variables
!
integer :: status(mpi_status_size)
!
!-------------------------------------------------------------------------------
!
! start time accounting for the MPI communication
!
call start_timer(imc)
#ifdef PROFILE
! start time accounting for the MPI buffer exchange
!
call start_timer(ime)
#endif /* PROFILE */
! send sbuf and receive rbuf
!
call mpi_sendrecv(sbuffer(:), ssize, mpi_real8, sproc, stag &
, rbuffer(:), rsize, mpi_real8, rproc, rtag &
, comm3d, status, iret)
#ifdef PROFILE
! stop time accounting for the MPI buffer exchange
!
call stop_timer(ime)
#endif /* PROFILE */
! check if the operation was successful
!
if (iret /= mpi_success) &
call print_error("mpitools::exchange_real_arrays" &
, "Could not exchange real data buffers!")
! stop time accounting for the MPI communication
!
call stop_timer(imc)
!-------------------------------------------------------------------------------
!
end subroutine exchange_real_arrays
!
!===============================================================================
!!
!!*** PRIVATE SUBROUTINES ****************************************************
!!