Merge branch 'master' into reconnection
This commit is contained in:
commit
c3ec26fb00
@ -20,7 +20,7 @@ endif()
|
||||
|
||||
if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU")
|
||||
add_compile_options("$<$<CONFIG:RELEASE>:-march=native;-pipe;-fno-tree-vectorize;-fno-unsafe-math-optimizations;-frounding-math;-fsignaling-nans;-finline-limit=10000;-fdiagnostics-color=always>")
|
||||
add_compile_options("$<$<CONFIG:DEBUG>:-Og;-pedantic;-W;-Wall;-Wno-unused-dummy-argument>")
|
||||
add_compile_options("$<$<CONFIG:DEBUG>:-Og;-pedantic;-fcheck=all;-W;-Wall;-Wno-unused-dummy-argument>")
|
||||
endif()
|
||||
|
||||
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
|
||||
|
||||
@ -23,7 +23,7 @@ LD = $(FC)
|
||||
# compiler and linker flags
|
||||
#
|
||||
ifeq ($(DEBUG),Y)
|
||||
FFLAGS = -Og -g -DDEBUG
|
||||
FFLAGS = -Og -g -DDEBUG -fcheck=all
|
||||
else
|
||||
FFLAGS = -O2 -march=native -pipe
|
||||
endif
|
||||
@ -37,6 +37,38 @@ endif
|
||||
|
||||
endif
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
#
|
||||
# NVIDIA Fortran compiler
|
||||
#
|
||||
ifeq ($(COMPILER), NVIDIA)
|
||||
|
||||
# compiler and linker setup
|
||||
#
|
||||
ifeq ($(MPI),Y)
|
||||
FC = mpifort
|
||||
else
|
||||
FC = nvfortran
|
||||
endif
|
||||
LD = $(FC)
|
||||
|
||||
# compiler and linker flags
|
||||
#
|
||||
ifeq ($(DEBUG),Y)
|
||||
FFLAGS = -O0 -g -Mbounds -Mchkptr -Mcache_align -Mnovintr -Mchkstk -DDEBUG
|
||||
else
|
||||
FFLAGS = -fast -O3
|
||||
endif
|
||||
ifeq ($(PROFILE),Y)
|
||||
FFLAGS += -Mprof=dwarf
|
||||
endif
|
||||
LDFLAGS = $(FFLAGS)
|
||||
ifeq ($(STATIC),Y)
|
||||
LDFLAGS += -Bstatic
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
#
|
||||
# PGI Fortran compiler
|
||||
@ -78,7 +110,7 @@ ifeq ($(COMPILER), INTEL)
|
||||
# compiler and linker setup
|
||||
#
|
||||
ifeq ($(MPI),Y)
|
||||
FC = mpifort
|
||||
FC = mpiifort
|
||||
else
|
||||
FC = ifort
|
||||
endif
|
||||
|
||||
@ -286,7 +286,7 @@ module blocks
|
||||
|
||||
! a pointer to the associated meta block
|
||||
!
|
||||
type(block_meta) , pointer :: block
|
||||
type(block_meta) , pointer :: meta
|
||||
|
||||
! a pointer to the associated neighbor block
|
||||
!
|
||||
|
||||
@ -1183,7 +1183,7 @@ module boundaries
|
||||
|
||||
! associate meta and data block pointers
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
pdata => pmeta%data
|
||||
|
||||
! get neighbor direction and corner indices
|
||||
@ -1698,12 +1698,12 @@ module boundaries
|
||||
integer :: it, jt, kt
|
||||
#ifdef MPI
|
||||
integer :: sproc = 0, rproc = 0
|
||||
integer :: scount, rcount
|
||||
integer :: ecount
|
||||
integer :: l, p
|
||||
|
||||
! local arrays
|
||||
!
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: buf
|
||||
#endif /* MPI */
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -1828,38 +1828,33 @@ module boundaries
|
||||
!
|
||||
if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
|
||||
|
||||
! get sending and receiving process identifiers (depending on pair member)
|
||||
! get sending and receiving process identifiers (depending on pair member),
|
||||
! and the number of blocks to exchange
|
||||
!
|
||||
if (pairs(p,1) == nproc) then
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
ecount = bcount(sproc,rproc)
|
||||
end if
|
||||
if (pairs(p,2) == nproc) then
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
ecount = bcount(rproc,sproc)
|
||||
end if
|
||||
|
||||
! get the number of blocks to exchange
|
||||
!
|
||||
scount = bcount(sproc,rproc)
|
||||
rcount = bcount(rproc,sproc)
|
||||
|
||||
! process only pairs which have anything to exchange
|
||||
!
|
||||
if ((scount + rcount) > 0) then
|
||||
if (ecount > 0) then
|
||||
|
||||
! allocate data buffer for variables to exchange
|
||||
!
|
||||
select case(idir)
|
||||
case(1)
|
||||
allocate(sbuf(scount,nv,ng,nh,nh))
|
||||
allocate(rbuf(rcount,nv,ng,nh,nh))
|
||||
allocate(buf(ecount,nv,ng,nh,nh))
|
||||
case(2)
|
||||
allocate(sbuf(scount,nv,nh,ng,nh))
|
||||
allocate(rbuf(rcount,nv,nh,ng,nh))
|
||||
allocate(buf(ecount,nv,nh,ng,nh))
|
||||
case(3)
|
||||
allocate(sbuf(scount,nv,nh,nh,ng))
|
||||
allocate(rbuf(rcount,nv,nh,nh,ng))
|
||||
allocate(buf(ecount,nv,nh,nh,ng))
|
||||
end select
|
||||
|
||||
!! PREPARE BLOCKS FOR SENDING
|
||||
@ -1904,14 +1899,11 @@ module boundaries
|
||||
!
|
||||
select case(idir)
|
||||
case(1)
|
||||
sbuf(l,1:nv,1:ng,1:nh,1:nh) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:ng,1:nh,1:nh) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
case(2)
|
||||
sbuf(l,1:nv,1:nh,1:ng,1:nh) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:nh,1:ng,1:nh) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
case(3)
|
||||
sbuf(l,1:nv,1:nh,1:nh,1:ng) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:nh,1:nh,1:ng) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
end select
|
||||
|
||||
! associate the pointer with the next block
|
||||
@ -1924,7 +1916,7 @@ module boundaries
|
||||
!!
|
||||
! exchange data
|
||||
!
|
||||
call exchange_arrays(rproc, p, sbuf, rbuf)
|
||||
call exchange_arrays(rproc, p, buf)
|
||||
|
||||
!! PROCESS RECEIVED BLOCKS
|
||||
!!
|
||||
@ -1947,7 +1939,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -1968,11 +1960,11 @@ module boundaries
|
||||
!
|
||||
select case(idir)
|
||||
case(1)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:nh,1:nh)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:ng,1:nh,1:nh)
|
||||
case(2)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:nh,1:ng,1:nh)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:nh,1:ng,1:nh)
|
||||
case(3)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:nh,1:nh,1:ng)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:nh,1:nh,1:ng)
|
||||
end select
|
||||
|
||||
! associate the pointer with the next block
|
||||
@ -1983,9 +1975,9 @@ module boundaries
|
||||
|
||||
! deallocate data buffer
|
||||
!
|
||||
deallocate(sbuf, rbuf)
|
||||
deallocate(buf)
|
||||
|
||||
end if ! (scount + rcount) > 0
|
||||
end if ! ecount > 0
|
||||
|
||||
end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
|
||||
|
||||
@ -2295,7 +2287,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -2621,7 +2613,7 @@ module boundaries
|
||||
|
||||
! assign pmeta and pneigh to the right blocks
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
pneigh => pinfo%neigh
|
||||
|
||||
! get the corner coordinates
|
||||
@ -2687,7 +2679,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -2835,12 +2827,12 @@ module boundaries
|
||||
#endif /* NDIMS == 3 */
|
||||
#ifdef MPI
|
||||
integer :: sproc = 0, rproc = 0
|
||||
integer :: scount, rcount
|
||||
integer :: ecount
|
||||
integer :: l, p
|
||||
|
||||
! local arrays
|
||||
!
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: buf
|
||||
#endif /* MPI */
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -2992,47 +2984,40 @@ module boundaries
|
||||
!
|
||||
if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
|
||||
|
||||
! get sending and receiving process identifiers (depending on pair member)
|
||||
! get sending and receiving process identifiers (depending on pair member),
|
||||
! and the number of blocks to exchange
|
||||
!
|
||||
if (pairs(p,1) == nproc) then
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
ecount = bcount(sproc,rproc)
|
||||
end if
|
||||
if (pairs(p,2) == nproc) then
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
ecount = bcount(rproc,sproc)
|
||||
end if
|
||||
|
||||
! get the number of blocks to exchange
|
||||
!
|
||||
scount = bcount(sproc,rproc)
|
||||
rcount = bcount(rproc,sproc)
|
||||
|
||||
! process only pairs which have anything to exchange
|
||||
!
|
||||
if ((scount + rcount) > 0) then
|
||||
if (ecount > 0) then
|
||||
|
||||
! allocate buffers for variable exchange
|
||||
!
|
||||
select case(idir)
|
||||
#if NDIMS == 2
|
||||
case(1)
|
||||
allocate(sbuf(scount,nv,nh,ng, 1))
|
||||
allocate(rbuf(rcount,nv,nh,ng, 1))
|
||||
allocate(buf(ecount,nv,nh,ng, 1))
|
||||
case(2)
|
||||
allocate(sbuf(scount,nv,ng,nh, 1))
|
||||
allocate(rbuf(rcount,nv,ng,nh, 1))
|
||||
allocate(buf(ecount,nv,ng,nh, 1))
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
case(1)
|
||||
allocate(sbuf(scount,nv,nh,ng,ng))
|
||||
allocate(rbuf(rcount,nv,nh,ng,ng))
|
||||
allocate(buf(ecount,nv,nh,ng,ng))
|
||||
case(2)
|
||||
allocate(sbuf(scount,nv,ng,nh,ng))
|
||||
allocate(rbuf(rcount,nv,ng,nh,ng))
|
||||
allocate(buf(ecount,nv,ng,nh,ng))
|
||||
case(3)
|
||||
allocate(sbuf(scount,nv,ng,ng,nh))
|
||||
allocate(rbuf(rcount,nv,ng,ng,nh))
|
||||
allocate(buf(ecount,nv,ng,ng,nh))
|
||||
#endif /* NDIMS == 3 */
|
||||
end select
|
||||
|
||||
@ -3089,26 +3074,21 @@ module boundaries
|
||||
select case(idir)
|
||||
case(1)
|
||||
#if NDIMS == 2
|
||||
sbuf(l,1:nv,1:nh,1:ng, : ) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
buf(l,1:nv,1:nh,1:ng, : ) = pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
sbuf(l,1:nv,1:nh,1:ng,1:ng) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:nh,1:ng,1:ng) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
#endif /* NDIMS == 3 */
|
||||
case(2)
|
||||
#if NDIMS == 2
|
||||
sbuf(l,1:nv,1:ng,1:nh, : ) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
buf(l,1:nv,1:ng,1:nh, : ) = pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
sbuf(l,1:nv,1:ng,1:nh,1:ng) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:ng,1:nh,1:ng) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
#endif /* NDIMS == 3 */
|
||||
#if NDIMS == 3
|
||||
case(3)
|
||||
sbuf(l,1:nv,1:ng,1:ng,1:nh) = &
|
||||
pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:ng,1:ng,1:nh) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
#endif /* NDIMS == 3 */
|
||||
end select
|
||||
|
||||
@ -3122,7 +3102,7 @@ module boundaries
|
||||
!!
|
||||
! exchange data
|
||||
!
|
||||
call exchange_arrays(rproc, p, sbuf, rbuf)
|
||||
call exchange_arrays(rproc, p, buf)
|
||||
|
||||
!! PROCESS RECEIVED BLOCKS
|
||||
!!
|
||||
@ -3145,7 +3125,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -3177,21 +3157,21 @@ module boundaries
|
||||
select case(idir)
|
||||
case(1)
|
||||
#if NDIMS == 2
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = rbuf(l,1:nv,1:nh,1:ng, : )
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = buf(l,1:nv,1:nh,1:ng, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:nh,1:ng,1:ng)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:nh,1:ng,1:ng)
|
||||
#endif /* NDIMS == 3 */
|
||||
case(2)
|
||||
#if NDIMS == 2
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = rbuf(l,1:nv,1:ng,1:nh, : )
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = buf(l,1:nv,1:ng,1:nh, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:nh,1:ng)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:ng,1:nh,1:ng)
|
||||
#endif /* NDIMS == 3 */
|
||||
#if NDIMS == 3
|
||||
case(3)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:ng,1:nh)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:ng,1:ng,1:nh)
|
||||
#endif /* NDIMS == 3 */
|
||||
end select
|
||||
|
||||
@ -3203,9 +3183,9 @@ module boundaries
|
||||
|
||||
! deallocate data buffer
|
||||
!
|
||||
deallocate(sbuf, rbuf)
|
||||
deallocate(buf)
|
||||
|
||||
end if ! (scount + rcount) > 0
|
||||
end if ! ecount > 0
|
||||
|
||||
end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
|
||||
|
||||
@ -3569,7 +3549,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -3966,7 +3946,7 @@ module boundaries
|
||||
|
||||
! assign pmeta and pneigh to the associated blocks
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
pneigh => pinfo%neigh
|
||||
|
||||
! get the corner coordinates
|
||||
@ -4047,7 +4027,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -4214,12 +4194,12 @@ module boundaries
|
||||
#endif /* NDIMS == 3 */
|
||||
#ifdef MPI
|
||||
integer :: sproc = 0, rproc = 0
|
||||
integer :: scount, rcount
|
||||
integer :: ecount
|
||||
integer :: l, p
|
||||
|
||||
! local arrays
|
||||
!
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
|
||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: buf
|
||||
#endif /* MPI */
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -4371,35 +4351,31 @@ module boundaries
|
||||
!
|
||||
if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
|
||||
|
||||
! get sending and receiving process identifiers (depending on pair member)
|
||||
! get sending and receiving process identifiers (depending on pair member),
|
||||
! and the number of blocks to exchange
|
||||
!
|
||||
if (pairs(p,1) == nproc) then
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
sproc = pairs(p,1)
|
||||
rproc = pairs(p,2)
|
||||
ecount = bcount(sproc,rproc)
|
||||
end if
|
||||
if (pairs(p,2) == nproc) then
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
sproc = pairs(p,2)
|
||||
rproc = pairs(p,1)
|
||||
ecount = bcount(rproc,sproc)
|
||||
end if
|
||||
|
||||
! get the number of blocks to exchange
|
||||
!
|
||||
scount = bcount(sproc,rproc)
|
||||
rcount = bcount(rproc,sproc)
|
||||
|
||||
! process only pairs which have anything to exchange
|
||||
!
|
||||
if ((scount + rcount) > 0) then
|
||||
if (ecount > 0) then
|
||||
|
||||
! allocate buffers for variable exchange
|
||||
!
|
||||
#if NDIMS == 2
|
||||
allocate(sbuf(scount,nv,ng,ng, 1))
|
||||
allocate(rbuf(rcount,nv,ng,ng, 1))
|
||||
allocate(buf(ecount,nv,ng,ng, 1))
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
allocate(sbuf(scount,nv,ng,ng,ng))
|
||||
allocate(rbuf(rcount,nv,ng,ng,ng))
|
||||
allocate(buf(ecount,nv,ng,ng,ng))
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
!! PREPARE BLOCKS FOR SENDING
|
||||
@ -4452,10 +4428,10 @@ module boundaries
|
||||
! copy the corresponding corner region from the neighbor to the buffer
|
||||
!
|
||||
#if NDIMS == 2
|
||||
sbuf(l,1:nv,1:ng,1:ng, : ) = pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
buf(l,1:nv,1:ng,1:ng, : ) = pneigh%data%q(1:nv,is:it,js:jt, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
sbuf(l,1:nv,1:ng,1:ng,1:ng) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
buf(l,1:nv,1:ng,1:ng,1:ng) = pneigh%data%q(1:nv,is:it,js:jt,ks:kt)
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! associate the pointer with the next block
|
||||
@ -4468,7 +4444,7 @@ module boundaries
|
||||
!!
|
||||
! exchange data
|
||||
!
|
||||
call exchange_arrays(rproc, p, sbuf, rbuf)
|
||||
call exchange_arrays(rproc, p, buf)
|
||||
|
||||
!! PROCESS RECEIVED BLOCKS
|
||||
!!
|
||||
@ -4491,7 +4467,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -4521,10 +4497,10 @@ module boundaries
|
||||
! update the corresponding corner region of the current block
|
||||
!
|
||||
#if NDIMS == 2
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = rbuf(l,1:nv,1:ng,1:ng, : )
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = buf(l,1:nv,1:ng,1:ng, : )
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:ng,1:ng)
|
||||
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = buf(l,1:nv,1:ng,1:ng,1:ng)
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! associate the pointer with the next block
|
||||
@ -4535,9 +4511,9 @@ module boundaries
|
||||
|
||||
! deallocate data buffer
|
||||
!
|
||||
deallocate(sbuf, rbuf)
|
||||
deallocate(buf)
|
||||
|
||||
end if ! (scount + rcount) > 0
|
||||
end if ! ecount > 0
|
||||
|
||||
end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
|
||||
|
||||
@ -4860,7 +4836,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -5229,7 +5205,7 @@ module boundaries
|
||||
|
||||
! assign a pointer to the associated data block
|
||||
!
|
||||
pmeta => pinfo%block
|
||||
pmeta => pinfo%meta
|
||||
|
||||
! get the corner coordinates
|
||||
!
|
||||
@ -6911,7 +6887,7 @@ module boundaries
|
||||
!
|
||||
nullify(pinfo%prev)
|
||||
nullify(pinfo%next)
|
||||
nullify(pinfo%block)
|
||||
nullify(pinfo%meta)
|
||||
nullify(pinfo%neigh)
|
||||
|
||||
! deallocate info block
|
||||
@ -6990,7 +6966,7 @@ module boundaries
|
||||
|
||||
! fill out its fields
|
||||
!
|
||||
pinfo%block => pmeta
|
||||
pinfo%meta => pmeta
|
||||
pinfo%neigh => pneigh
|
||||
pinfo%direction = dir
|
||||
pinfo%corner(1:NDIMS) = pos(1:NDIMS)
|
||||
|
||||
@ -5528,7 +5528,6 @@ module equations
|
||||
, "N = ", nr
|
||||
write(error_unit,"('[',a,']: ',a,4(1es24.16))") trim(loc) &
|
||||
, "X = ", x(1:4)
|
||||
iret = 300
|
||||
end if
|
||||
#endif /* DEBUG */
|
||||
|
||||
@ -5549,7 +5548,6 @@ module equations
|
||||
, "N = ", nr
|
||||
write(error_unit,"('[',a,']: ',a,4(1es24.16))") trim(loc) &
|
||||
, "X = ", x(1:4)
|
||||
iret = 300
|
||||
#endif /* DEBUG */
|
||||
|
||||
end if
|
||||
|
||||
@ -506,7 +506,7 @@ module mesh
|
||||
type(block_meta), pointer :: pmeta
|
||||
type(block_data), pointer :: pdata
|
||||
|
||||
logical :: refine
|
||||
logical :: refine, flag
|
||||
integer(kind=4) :: level, lev
|
||||
integer(kind=4) :: nc, nr, np, nl
|
||||
|
||||
@ -739,13 +739,17 @@ module mesh
|
||||
nr = 1
|
||||
nc = nc + 1
|
||||
end if
|
||||
do while(lb(nr,nc) == 0 .and. nc <= nodes)
|
||||
flag = nc <= nodes
|
||||
if (flag) flag = lb(nr,nc) == 0
|
||||
do while(flag)
|
||||
np = min(npmax, np + 1)
|
||||
nr = nr + 1
|
||||
if (nr > lprocs) then
|
||||
nr = 1
|
||||
nc = nc + 1
|
||||
end if
|
||||
flag = nc <= nodes
|
||||
if (flag) flag = lb(nr,nc) == 0
|
||||
end do
|
||||
|
||||
end if ! nl >= lb(nr,np)
|
||||
@ -912,17 +916,18 @@ module mesh
|
||||
#ifdef MPI
|
||||
! local variables
|
||||
!
|
||||
integer :: status
|
||||
integer(kind=4) :: np, nl, nc, nr
|
||||
logical :: flag
|
||||
integer :: status
|
||||
integer(kind=4) :: np, nl, nc, nr
|
||||
|
||||
! local pointers
|
||||
!
|
||||
type(block_meta), pointer :: pmeta
|
||||
type(block_data), pointer :: pdata
|
||||
type(block_meta), pointer :: pmeta
|
||||
type(block_data), pointer :: pdata
|
||||
|
||||
! tag for the MPI data exchange
|
||||
!
|
||||
integer(kind=4) :: itag
|
||||
integer(kind=4) :: itag
|
||||
|
||||
! array for number of data block for autobalancing
|
||||
!
|
||||
@ -1063,13 +1068,17 @@ module mesh
|
||||
nr = 1
|
||||
nc = nc + 1
|
||||
end if
|
||||
do while(lb(nr,nc) == 0 .and. nc <= nodes)
|
||||
flag = nc <= nodes
|
||||
if (flag) flag = lb(nr,nc) == 0
|
||||
do while(flag)
|
||||
np = min(npmax, np + 1)
|
||||
nr = nr + 1
|
||||
if (nr > lprocs) then
|
||||
nr = 1
|
||||
nc = nc + 1
|
||||
end if
|
||||
flag = nc <= nodes
|
||||
if (flag) flag = lb(nr,nc) == 0
|
||||
end do
|
||||
|
||||
end if ! nl >= lb(nr,np)
|
||||
|
||||
@ -50,7 +50,9 @@ module mpitools
|
||||
end interface
|
||||
interface reduce_maximum
|
||||
module procedure reduce_maximum_integer
|
||||
#ifndef __NVCOMPILER
|
||||
module procedure reduce_maximum_double
|
||||
#endif /* __NVCOMPILER */
|
||||
module procedure reduce_maximum_double_array
|
||||
end interface
|
||||
interface reduce_sum
|
||||
@ -58,6 +60,10 @@ module mpitools
|
||||
module procedure reduce_sum_double_array
|
||||
module procedure reduce_sum_complex_array
|
||||
end interface
|
||||
interface exchange_arrays
|
||||
module procedure exchange_arrays_diff
|
||||
module procedure exchange_arrays_same
|
||||
end interface
|
||||
#endif /* MPI */
|
||||
|
||||
! timer indices
|
||||
@ -357,65 +363,51 @@ module mpitools
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! ibuf - the logical buffer;
|
||||
! flag - the input logical flag;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
logical function check_status(ibuf) result(obuf)
|
||||
logical function check_status(flag)
|
||||
|
||||
! include external procedures and variables
|
||||
!
|
||||
use iso_fortran_env, only : error_unit
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
logical, intent(in) :: ibuf
|
||||
|
||||
logical, intent(in) :: flag
|
||||
#ifdef MPI
|
||||
! local variables
|
||||
!
|
||||
|
||||
integer :: ierror
|
||||
|
||||
! local parameters
|
||||
!
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::check_status()'
|
||||
#endif /* MPI */
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
#ifdef MPI
|
||||
call start_timer(imc)
|
||||
#ifdef PROFILE
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(ibuf, obuf, 1, &
|
||||
check_status = flag
|
||||
|
||||
#ifdef MPI
|
||||
call MPI_Allreduce(MPI_IN_PLACE, check_status, 1, &
|
||||
MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierror)
|
||||
|
||||
if (ierror /= MPI_SUCCESS) then
|
||||
write(error_unit,"('[', a, ']: ', a)") trim(loc), &
|
||||
"MPI_Allreduce of logical buffer failed!"
|
||||
end if
|
||||
#endif /* MPI */
|
||||
|
||||
#ifdef PROFILE
|
||||
call stop_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call stop_timer(imc)
|
||||
#else /* MPI */
|
||||
! no MPI, so just copy the input to output
|
||||
!
|
||||
obuf = ibuf
|
||||
#endif /* MPI */
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end function check_status
|
||||
!
|
||||
#ifdef MPI
|
||||
!
|
||||
!===============================================================================
|
||||
@ -439,8 +431,8 @@ module mpitools
|
||||
|
||||
implicit none
|
||||
|
||||
integer , intent(in) :: dst, tag
|
||||
real(kind=8), dimension(..), intent(in) :: buf
|
||||
integer , intent(in) :: dst, tag
|
||||
real(kind=8), dimension(..), intent(in) :: buf
|
||||
|
||||
integer :: ierror
|
||||
|
||||
@ -525,10 +517,11 @@ module mpitools
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine EXCHANGE_ARRAYS:
|
||||
! --------------------------
|
||||
! subroutine EXCHANGE_ARRAYS_DIFF:
|
||||
! -------------------------------
|
||||
!
|
||||
! Subroutine exchanges real data buffers between two processes.
|
||||
! Subroutine exchanges real data buffers (of different sizes) between
|
||||
! two processes.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
@ -540,7 +533,7 @@ module mpitools
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine exchange_arrays(proc, tag, sbuf, rbuf)
|
||||
subroutine exchange_arrays_diff(proc, tag, sbuf, rbuf)
|
||||
|
||||
use iso_fortran_env, only : error_unit
|
||||
|
||||
@ -548,11 +541,12 @@ module mpitools
|
||||
|
||||
integer , intent(in) :: proc, tag
|
||||
real(kind=8), dimension(..), intent(in) :: sbuf
|
||||
real(kind=8), dimension(..), intent(in) :: rbuf
|
||||
real(kind=8), dimension(..), intent(out) :: rbuf
|
||||
|
||||
integer :: ssize, rsize
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::exchange_arrays()'
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::exchange_arrays_diff()'
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -561,9 +555,22 @@ module mpitools
|
||||
call start_timer(ime)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Sendrecv(sbuf, size(sbuf), MPI_REAL8, proc, tag, &
|
||||
rbuf, size(rbuf), MPI_REAL8, proc, tag, &
|
||||
MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror)
|
||||
ssize = size(sbuf)
|
||||
rsize = size(rbuf)
|
||||
|
||||
if (ssize > 0 .and. rsize > 0) then
|
||||
call MPI_Sendrecv(sbuf, ssize, MPI_REAL8, proc, tag, &
|
||||
rbuf, rsize, MPI_REAL8, proc, tag, &
|
||||
MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror)
|
||||
else
|
||||
if (ssize > 0) then
|
||||
call MPI_Send(sbuf, ssize, MPI_REAL8, proc, tag, MPI_COMM_WORLD, &
|
||||
ierror)
|
||||
else
|
||||
call MPI_Recv(rbuf, rsize, MPI_REAL8, proc, tag, MPI_COMM_WORLD, &
|
||||
MPI_STATUS_IGNORE, ierror)
|
||||
end if
|
||||
end if
|
||||
|
||||
#ifdef PROFILE
|
||||
call stop_timer(ime)
|
||||
@ -579,7 +586,62 @@ module mpitools
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine exchange_arrays
|
||||
end subroutine exchange_arrays_diff
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine EXCHANGE_ARRAYS_SAME:
|
||||
! -------------------------------
|
||||
!
|
||||
! Subroutine exchanges a real data buffer between two processes.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! proc - the remote process number to which send the buffer sbuf,
|
||||
! and from which receive the buffer rbuf;
|
||||
! tag - the tag identifying the send operation;
|
||||
! buf - the real array buffer to exchange;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine exchange_arrays_same(proc, tag, buf)
|
||||
|
||||
use iso_fortran_env, only : error_unit
|
||||
|
||||
implicit none
|
||||
|
||||
integer , intent(in) :: proc, tag
|
||||
real(kind=8), dimension(..), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::exchange_arrays_same()'
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
call start_timer(imc)
|
||||
#ifdef PROFILE
|
||||
call start_timer(ime)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Sendrecv_replace(buf, size(buf), MPI_REAL8, proc, tag, proc, tag, &
|
||||
MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
call stop_timer(ime)
|
||||
#endif /* PROFILE */
|
||||
|
||||
if (ierror /= MPI_SUCCESS) then
|
||||
write(error_unit,"('[', a, ']: ', 2(a, i9),'.')") trim(loc) &
|
||||
, "Could not exchange real data buffer between " &
|
||||
, proc, "and", nproc
|
||||
end if
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine exchange_arrays_same
|
||||
!
|
||||
!===============================================================================
|
||||
!!
|
||||
@ -609,8 +671,7 @@ module mpitools
|
||||
|
||||
real(kind=8), dimension(:), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
real(kind=8), dimension(size(buf)) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_minimum_double_array()'
|
||||
!
|
||||
@ -621,7 +682,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, size(buf), &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), &
|
||||
MPI_REAL8, MPI_MIN, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -633,8 +694,6 @@ module mpitools
|
||||
"MPI_Allreduce of a real array failed!"
|
||||
end if
|
||||
|
||||
buf(:) = tmp(:)
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -664,7 +723,6 @@ module mpitools
|
||||
integer, intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
integer :: tmp
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_integer()'
|
||||
!
|
||||
@ -675,7 +733,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, 1, &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, 1, &
|
||||
MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -687,13 +745,12 @@ module mpitools
|
||||
"MPI_Allreduce of an integer value failed!"
|
||||
end if
|
||||
|
||||
buf = tmp
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine reduce_maximum_integer
|
||||
#ifndef __NVCOMPILER
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
@ -717,8 +774,7 @@ module mpitools
|
||||
|
||||
real(kind=8), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
real(kind=8) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double()'
|
||||
!
|
||||
@ -729,7 +785,8 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, 1, MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror)
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, 1, &
|
||||
MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
call stop_timer(imm)
|
||||
@ -740,13 +797,12 @@ module mpitools
|
||||
"MPI_Allreduce of a real value failed!"
|
||||
end if
|
||||
|
||||
buf = tmp
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine reduce_maximum_double
|
||||
#endif /* __NVCOMPILER */
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
@ -770,8 +826,7 @@ module mpitools
|
||||
|
||||
real(kind=8), dimension(:), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
real(kind=8), dimension(size(buf)) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double_array()'
|
||||
!
|
||||
@ -782,7 +837,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, size(buf), &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), &
|
||||
MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -794,8 +849,6 @@ module mpitools
|
||||
"MPI_Allreduce of a real array failed!"
|
||||
end if
|
||||
|
||||
buf(:) = tmp(:)
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -824,8 +877,7 @@ module mpitools
|
||||
|
||||
integer, dimension(:), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
integer, dimension(size(buf)) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_integer_array()'
|
||||
!
|
||||
@ -836,7 +888,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, size(buf), &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), &
|
||||
MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -848,8 +900,6 @@ module mpitools
|
||||
"MPI_Allreduce of an integer array failed!"
|
||||
end if
|
||||
|
||||
buf(:) = tmp(:)
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -878,8 +928,7 @@ module mpitools
|
||||
|
||||
real(kind=8), dimension(:), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
real(kind=8), dimension(size(buf)) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_double_array()'
|
||||
!
|
||||
@ -890,7 +939,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, size(buf), &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), &
|
||||
MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -902,8 +951,6 @@ module mpitools
|
||||
"MPI_Allreduce of a real array failed!"
|
||||
end if
|
||||
|
||||
buf(:) = tmp(:)
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -932,8 +979,7 @@ module mpitools
|
||||
|
||||
complex(kind=8), dimension(:,:), intent(inout) :: buf
|
||||
|
||||
integer :: ierror
|
||||
complex(kind=8), dimension(size(buf,1),size(buf,2)) :: tmp
|
||||
integer :: ierror
|
||||
|
||||
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_complex_array()'
|
||||
!
|
||||
@ -944,7 +990,7 @@ module mpitools
|
||||
call start_timer(imm)
|
||||
#endif /* PROFILE */
|
||||
|
||||
call MPI_Allreduce(buf, tmp, size(buf), &
|
||||
call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), &
|
||||
MPI_DOUBLE_COMPLEX, MPI_SUM, MPI_COMM_WORLD, ierror)
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -956,8 +1002,6 @@ module mpitools
|
||||
"MPI_Allreduce of a complex array failed!"
|
||||
end if
|
||||
|
||||
buf(:,:) = tmp(:,:)
|
||||
|
||||
call stop_timer(imc)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user