From 3f537aa93f883cecdb0ee21aaf040c7d7b06094d Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Wed, 3 Dec 2014 21:47:41 -0200
Subject: [PATCH 01/29] MPITOOLS: Add exchange_real_arrays().
The new subroutine exchanges two buffers between two processes at the
same time.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/makefile | 2 +-
src/mpitools.F90 | 87 +++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 87 insertions(+), 2 deletions(-)
diff --git a/src/makefile b/src/makefile
index e7a1cb0..781e779 100644
--- a/src/makefile
+++ b/src/makefile
@@ -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 \
diff --git a/src/mpitools.F90 b/src/mpitools.F90
index 85f286b..31d7857 100644
--- a/src/mpitools.F90
+++ b/src/mpitools.F90
@@ -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
@@ -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 ****************************************************
!!
From 51497fe60d0285741f170cad0a6b4c98b813f4a2 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:14:08 -0200
Subject: [PATCH 02/29] BOUNDARIES: Add subroutine to handle exchange block
arrays.
Two new arrays barray and bcount are allocated during the module
initialization and deallocated during the module finalization.
Those two arrays are used to store information about neighbors which
lay on different processes and need some boundary data to exchange.
Subroutines prepare_exchange_array() and release_exchange_array() are
responsinble for initialization of barray and bcount and for
deallocation all array elements, respectively.
Subroutine append_exchange_block() helps to append a new block pairs to
the exchange array.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 245 ++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 243 insertions(+), 2 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 1ae5807..897ce0f 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -29,9 +29,12 @@
!
module boundaries
-#ifdef PROFILE
! import external subroutines
!
+#ifdef MPI
+ use blocks, only : pointer_info
+#endif /* MPI */
+#ifdef PROFILE
use timers, only : set_timer, start_timer, stop_timer
#endif /* PROFILE */
@@ -56,6 +59,14 @@ module boundaries
!
integer, dimension(3,2), save :: bnd_type = bnd_periodic
+#ifdef MPI
+! arrays to store information about blocks which need to be exchange between
+! processes
+!
+ type(pointer_info), dimension(:,:), allocatable, save :: barray
+ integer , dimension(:,:), allocatable, save :: bcount
+#endif /* MPI */
+
! by default everything is private
!
private
@@ -95,7 +106,7 @@ module boundaries
! import external procedures and variables
!
#ifdef MPI
- use mpitools , only : pdims, pcoords, periodic
+ use mpitools , only : pdims, pcoords, periodic, npmax
#endif /* MPI */
use parameters , only : get_parameter_string
@@ -212,6 +223,16 @@ module boundaries
bnd_type(3,2) = bnd_periodic
end select
+#ifdef MPI
+! allocate the exchange arrays
+!
+ allocate(barray(0:npmax,0:npmax), bcount(0:npmax,0:npmax))
+
+! prepare the exchange arrays
+!
+ call prepare_exchange_array()
+#endif /* MPI */
+
! print information about the boundary conditions
!
if (verbose) then
@@ -268,6 +289,16 @@ module boundaries
call start_timer(imi)
#endif /* PROFILE */
+#ifdef MPI
+! release the exchange arrays
+!
+ call release_exchange_array()
+
+! deallocate the exchange arrays
+!
+ deallocate(barray, bcount)
+#endif /* MPI */
+
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@@ -8157,6 +8188,216 @@ module boundaries
!-------------------------------------------------------------------------------
!
end subroutine update_ghost_cells
+#ifdef MPI
+!
+!===============================================================================
+!
+! subroutine PREPARE_EXCHANGE_ARRAY:
+! ---------------------------------
+!
+! Subroutine prepares the arrays for block exchange lists and their counters.
+!
+!
+!===============================================================================
+!
+ subroutine prepare_exchange_array()
+
+! include external variables
+!
+ use mpitools , only : npmax
+
+! local variables are not implicit by default
+!
+ implicit none
+
+! local variables
+!
+ integer :: icol, irow
+!
+!-------------------------------------------------------------------------------
+!
+! iterate over all elements of the block exchange array
+!
+ do irow = 0, npmax
+ do icol = 0, npmax
+
+! nullify the array element pointer
+!
+ nullify(barray(irow,icol)%ptr)
+
+! reset the corresponding counter
+!
+ bcount(irow,icol) = 0
+
+ end do ! icol = 0, npmax
+ end do ! irow = 0, npmax
+
+!-------------------------------------------------------------------------------
+!
+ end subroutine prepare_exchange_array
+!
+!===============================================================================
+!
+! subroutine RELEASE_EXCHANGE_ARRAY:
+! ---------------------------------
+!
+! Subroutine releases objects on the array of block exchange lists.
+!
+!
+!===============================================================================
+!
+ subroutine release_exchange_array()
+
+! include external variables
+!
+ use blocks , only : block_info, pointer_info
+ use mpitools , only : npmax
+
+! local variables are not implicit by default
+!
+ implicit none
+
+! local variables
+!
+ integer :: icol, irow
+
+! local pointers
+!
+ type(block_info), pointer :: pinfo
+!
+!-------------------------------------------------------------------------------
+!
+! iterate over all elements of the block exchange array
+!
+ do irow = 0, npmax
+ do icol = 0, npmax
+
+! associate pinfo with the first block in the exchange list
+!
+ pinfo => barray(irow,icol)%ptr
+
+! scan all elements on the exchange list
+!
+ do while(associated(pinfo))
+
+! associate the exchange list pointer
+!
+ barray(irow,icol)%ptr => pinfo%prev
+
+! nullify pointer fields
+!
+ nullify(pinfo%prev)
+ nullify(pinfo%next)
+ nullify(pinfo%block)
+ nullify(pinfo%neigh)
+
+! deallocate info block
+!
+ deallocate(pinfo)
+
+! associate pinfo with the next block
+!
+ pinfo => barray(irow,icol)%ptr
+
+ end do ! %ptr blocks
+
+ end do ! icol = 0, npmax
+ end do ! irow = 0, npmax
+
+!-------------------------------------------------------------------------------
+!
+ end subroutine release_exchange_array
+!
+!===============================================================================
+!
+! subroutine APPEND_EXCHANGE_BLOCK:
+! ---------------------------------
+!
+! Subroutine appends an info block to the element of array of block
+! exchange lists. The element is determined by the processes of the meta
+! and neighbor blocks.
+!
+! Arguments:
+!
+! pmeta - the pointer to meta block;
+! pneigh - the pointer to the neighbor of pmeta;
+! n, i, j, k - the location of the neighbor;
+!
+!===============================================================================
+!
+ subroutine append_exchange_block(pmeta, pneigh, n, i, j, k)
+
+! include external variables
+!
+ use blocks , only : block_info, block_meta
+
+! local variables are not implicit by default
+!
+ implicit none
+
+! subroutine arguments
+!
+ type(block_meta), pointer, intent(inout) :: pmeta, pneigh
+ integer , intent(in) :: n, i, j, k
+
+! local variables
+!
+ integer :: icol, irow
+
+! local pointers
+!
+ type(block_info), pointer :: pinfo
+!
+!-------------------------------------------------------------------------------
+!
+! get the column and row indices
+!
+ irow = pneigh%process
+ icol = pmeta%process
+
+! increase the counter for the number of blocks to exchange
+!
+ bcount(irow,icol) = bcount(irow,icol) + 1
+
+! allocate a new info object
+!
+ allocate(pinfo)
+
+! fill out its fields
+!
+ pinfo%block => pmeta
+ pinfo%neigh => pneigh
+ pinfo%direction = n
+ pinfo%corner(1) = i
+ pinfo%corner(2) = j
+#if NDIMS == 3
+ pinfo%corner(3) = k
+#endif /* NDIMS == 3 */
+ pinfo%level_difference = pmeta%level - pneigh%level
+
+! nullify pointer fields
+!
+ nullify(pinfo%prev)
+ nullify(pinfo%next)
+
+! check if the list is empty
+!
+ if (associated(barray(irow,icol)%ptr)) then
+
+! if it is, associate the newly created block with it
+!
+ pinfo%prev => barray(irow,icol)%ptr
+
+ end if ! %ptr associated
+
+! point the list to the newly created block
+!
+ barray(irow,icol)%ptr => pinfo
+
+!-------------------------------------------------------------------------------
+!
+ end subroutine append_exchange_block
+#endif /* MPI */
!===============================================================================
!
From 25d6251dba8345c2257ffa5dea6c527705fd7e93 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:19:21 -0200
Subject: [PATCH 03/29] BOUNDARIES: Use new exchange arrays in
boundary_fluxes().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 102 ++++++---------------------------------------
1 file changed, 13 insertions(+), 89 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 897ce0f..ea18254 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -473,13 +473,8 @@ module boundaries
integer :: irecv, isend, nblocks, itag, iret
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:nprocs-1,0:nprocs-1) :: block_array
-
! local arrays
!
- integer , dimension(0:nprocs-1,0:nprocs-1) :: block_counter
real(kind=8), dimension(:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
@@ -511,17 +506,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the block counter
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify pointers to blocks which need to be exchanged between processes
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do ! isend
- end do ! irecv
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE THE FLUX BOUNDARIES BETWEEN LOCAL BLOCKS
@@ -691,47 +678,9 @@ module boundaries
!
else
-! increase the counter for the number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out its fields
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = n
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
- pinfo%level_difference = pmeta%level - pneigh%level
-
-! nullify pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! check if the list is empty
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) then
-
-! if it is, associate the newly created block with it
-!
- pinfo%prev => &
- block_array(pneigh%process,pmeta%process)%ptr
-
- end if ! %ptr associated
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, n, i, j, k)
end if ! pmeta and pneigh on local process
#endif /* MPI */
@@ -767,11 +716,11 @@ module boundaries
! process only pairs which have anything to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -791,7 +740,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan all blocks on the list
!
@@ -897,7 +846,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan all blocks on the list
!
@@ -1027,38 +976,13 @@ module boundaries
!
deallocate(rbuf)
-! associate pinfo with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan all blocks on the exchange list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate info block
-!
- deallocate(pinfo)
-
-! associate pinfo with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr blocks
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 3f97569869b21fa6ba0dab1fe8f69578930efae7 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:25:50 -0200
Subject: [PATCH 04/29] BOUNDARIES: Use new exchange arrays in
boundary_face_copy().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 94 +++++++---------------------------------------
1 file changed, 13 insertions(+), 81 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index ea18254..e79bee2 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -1229,13 +1229,8 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
#endif /* MPI */
!
@@ -1256,17 +1251,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE FACE BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME
@@ -1400,39 +1387,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
- pinfo%corner(3) = k
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -1469,11 +1426,11 @@ module boundaries
! process only pairs which have anything to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -1500,7 +1457,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -1565,7 +1522,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -1675,38 +1632,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate pinfo with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer with the previous block on the list
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the current pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate pinfo with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 969accd19f62e95c7795b6cf0296c6aefb0469a4 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:32:07 -0200
Subject: [PATCH 05/29] BOUNDARIES: Use new exchange arrays in
boundary_face_restrict().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 96 +++++++---------------------------------------
1 file changed, 14 insertions(+), 82 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index e79bee2..a04b7c0 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -1714,14 +1714,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -1741,17 +1736,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE FACE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT
@@ -1885,39 +1872,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
- pinfo%corner(3) = k
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -1954,11 +1911,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -1985,7 +1942,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -2050,7 +2007,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -2160,38 +2117,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate pinfo with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer with the previous block
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate pinfo with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 8243edb33d065d99b4af24d1c2799b8fb949b860 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:32:50 -0200
Subject: [PATCH 06/29] BOUNDARIES: Use new exchange arrays in
boundary_face_prolong().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 96 +++++++---------------------------------------
1 file changed, 14 insertions(+), 82 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index a04b7c0..e82b7ff 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -2200,14 +2200,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -2227,17 +2222,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE FACE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT
@@ -2383,39 +2370,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
- pinfo%corner(3) = k
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -2452,11 +2409,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -2483,7 +2440,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -2555,7 +2512,7 @@ module boundaries
! associate pinfo with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -2665,38 +2622,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate pinfo with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate pinfo with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 738ef159f89f622693317c15982cfe010637501d Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:39:22 -0200
Subject: [PATCH 07/29] BOUNDARIES: Use new exchange arrays in
boundary_edge_copy().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 98 +++++++---------------------------------------
1 file changed, 14 insertions(+), 84 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index e82b7ff..5844e47 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -2711,14 +2711,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -2740,17 +2735,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE EDGE BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME
@@ -2881,41 +2868,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -2954,11 +2909,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -2993,7 +2948,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -3076,7 +3031,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -3186,38 +3141,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From c6bd74170763cd20addecdff575943fdd728a61c Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:42:20 -0200
Subject: [PATCH 08/29] BOUNDARIES: Use new exchange arrays in
boundary_edge_restrict().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 98 +++++++---------------------------------------
1 file changed, 14 insertions(+), 84 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 5844e47..f962659 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -3223,14 +3223,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -3252,17 +3247,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE EDGE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT
@@ -3393,41 +3380,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -3466,11 +3421,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -3505,7 +3460,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -3588,7 +3543,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -3698,38 +3653,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 25daf4165aa4997d40a79b705ec78bdd368989f0 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 12:46:20 -0200
Subject: [PATCH 09/29] BOUNDARIES: Use new exchange arrays in
boundary_edge_prolong().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 98 +++++++---------------------------------------
1 file changed, 14 insertions(+), 84 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index f962659..349c32e 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -3736,14 +3736,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -3765,17 +3760,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE EDGE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT
@@ -3912,41 +3899,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%direction = idir
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, idir, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -3985,11 +3940,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -4024,7 +3979,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -4111,7 +4066,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -4221,38 +4176,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 7eef97ae6b6e7e0e07d7f0745e9c60bdbee3f5f2 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 13:01:44 -0200
Subject: [PATCH 10/29] BOUNDARIES: Use new exchange arrays in
boundary_corner_copy().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 +++++++---------------------------------------
1 file changed, 14 insertions(+), 83 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 349c32e..5fbbbef 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -4253,14 +4253,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -4274,17 +4269,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE CORNER BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME
@@ -4387,40 +4374,9 @@ module boundaries
else ! block and neighbor belong to different processes
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, -1, i, j, k)
end if ! block and neighbor belong to different processes
#endif /* MPI */
@@ -4459,11 +4415,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -4488,7 +4444,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -4551,7 +4507,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -4621,38 +4577,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 69e206731dc16e60e5800c458528e20723bd653a Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 13:04:10 -0200
Subject: [PATCH 11/29] BOUNDARIES: Use new exchange arrays in
boundary_corner_restrict().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 +++++++---------------------------------------
1 file changed, 14 insertions(+), 83 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 5fbbbef..40e6eb2 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -4648,14 +4648,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -4669,17 +4664,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE CORNER BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME
@@ -4782,40 +4769,9 @@ module boundaries
else ! block and neighbor on different processors
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, -1, i, j, k)
end if ! block and neighbor on different processors
#endif /* MPI */
@@ -4853,11 +4809,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -4882,7 +4838,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -4945,7 +4901,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -5015,38 +4971,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 852ee2d1a4a184f1ab6ed3f1eaf4c8416dc053df Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 13:06:07 -0200
Subject: [PATCH 12/29] BOUNDARIES: Use new exchange arrays in
boundary_corner_prolong().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 +++++++---------------------------------------
1 file changed, 14 insertions(+), 83 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 40e6eb2..7572779 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -5042,14 +5042,9 @@ module boundaries
integer :: isend, irecv, nblocks, itag
integer :: l, p
-! local pointer arrays
-!
- type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
-
! local arrays
!
- integer , dimension(0:npmax,0:npmax) :: block_counter
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -5063,17 +5058,9 @@ module boundaries
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
-! reset the exchange block counters
+! prepare the array of exchange block lists and its counters
!
- block_counter(:,:) = 0
-
-! nullify the info pointers
-!
- do irecv = 0, npmax
- do isend = 0, npmax
- nullify(block_array(isend,irecv)%ptr)
- end do
- end do
+ call prepare_exchange_array()
#endif /* MPI */
!! 2. UPDATE VARIABLE CORNER BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME
@@ -5176,40 +5163,9 @@ module boundaries
else ! block and neighbor on different processors
-! increase the counter for number of blocks to exchange
+! append the block to the exchange list
!
- block_counter(pneigh%process,pmeta%process) = &
- block_counter(pneigh%process,pmeta%process) + 1
-
-! allocate a new info object
-!
- allocate(pinfo)
-
-! fill out only fields which are used
-!
- pinfo%block => pmeta
- pinfo%neigh => pneigh
- pinfo%corner(1) = i
- pinfo%corner(2) = j
-#if NDIMS == 3
- pinfo%corner(3) = k
-#endif /* NDIMS == 3 */
-
-! nullify pointer fields of the object
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
-
-! if the list is not empty append the newly created block to it
-!
- if (associated(block_array(pneigh%process &
- ,pmeta%process)%ptr)) &
- pinfo%prev => block_array(pneigh%process &
- ,pmeta%process)%ptr
-
-! point the list to the newly created block
-!
- block_array(pneigh%process,pmeta%process)%ptr => pinfo
+ call append_exchange_block(pmeta, pneigh, -1, i, j, k)
end if ! block and neighbor on different processors
#endif /* MPI */
@@ -5247,11 +5203,11 @@ module boundaries
! process only pairs which have something to exchange
!
- if (block_counter(isend,irecv) > 0) then
+ if (bcount(isend,irecv) > 0) then
! obtain the number of blocks to exchange
!
- nblocks = block_counter(isend,irecv)
+ nblocks = bcount(isend,irecv)
! prepare the tag for communication
!
@@ -5276,7 +5232,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! scan over all blocks on the block exchange list
!
@@ -5339,7 +5295,7 @@ module boundaries
! associate the pointer with the first block in the exchange list
!
- pinfo => block_array(isend,irecv)%ptr
+ pinfo => barray(isend,irecv)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -5409,38 +5365,13 @@ module boundaries
!
if (allocated(rbuf)) deallocate(rbuf)
-! associate the pointer with the first block in the exchange list
-!
- pinfo => block_array(isend,irecv)%ptr
-
-! scan over all blocks on the exchange block list
-!
- do while(associated(pinfo))
-
-! associate the exchange list pointer
-!
- block_array(isend,irecv)%ptr => pinfo%prev
-
-! nullify the pointer fields
-!
- nullify(pinfo%prev)
- nullify(pinfo%next)
- nullify(pinfo%block)
- nullify(pinfo%neigh)
-
-! deallocate the object
-!
- deallocate(pinfo)
-
-! associate the pointer with the next block
-!
- pinfo => block_array(isend,irecv)%ptr
-
- end do ! %ptr block list
-
- end if ! if block_count > 0
+ end if ! if bcount > 0
end do ! p = 1, npairs
+
+! release the memory used by the array of exchange block lists
+!
+ call release_exchange_array()
#endif /* MPI */
#ifdef PROFILE
From 7fa2f4ecae0df15ba6c3e170ab107483dcb7ca71 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 13:08:49 -0200
Subject: [PATCH 13/29] BLOCKS: Remove unused fields of block_info structure.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/blocks.F90 | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/src/blocks.F90 b/src/blocks.F90
index bf97a29..c4bd216 100644
--- a/src/blocks.F90
+++ b/src/blocks.F90
@@ -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
From fc80be02d428de12959989e95f033956a02d92a3 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 13:23:16 -0200
Subject: [PATCH 14/29] MPITOOLS: npairs represents the exact number of
processes.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 20 ++++++++++----------
src/mpitools.F90 | 8 ++++----
2 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 7572779..6a73873 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -707,7 +707,7 @@ module boundaries
#ifdef MPI
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -1417,7 +1417,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -1902,7 +1902,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -2400,7 +2400,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -2900,7 +2900,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -3412,7 +3412,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -3931,7 +3931,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -4406,7 +4406,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -4800,7 +4800,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
@@ -5194,7 +5194,7 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, npairs
+ do p = 1, 2 * npairs
! get sending and receiving process identifiers
!
diff --git a/src/mpitools.F90 b/src/mpitools.F90
index 31d7857..027efc8 100644
--- a/src/mpitools.F90
+++ b/src/mpitools.F90
@@ -179,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
!
@@ -239,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
!
From ac3b2ce520bbc785f9143d53700d3253da349466 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 14:49:07 -0200
Subject: [PATCH 15/29] BOUNDARIES: Rewrite MPI part in boundary_fluxes().
Now, instead of separate calls to receive or send data, we process pairs
and exchange data between them directly using exchage_read_arrays().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 94 ++++++++++++++++++++++++----------------------
1 file changed, 49 insertions(+), 45 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 6a73873..5df8a2b 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -447,9 +447,8 @@ module boundaries
use coordinates , only : kb, ke, kbl
use equations , only : nv
#ifdef MPI
- use mpitools , only : nprocs, nproc, npmax
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -470,12 +469,13 @@ module boundaries
integer :: j, js, jt, jl, ju, jh
integer :: k, ks, kt, kl, ku, kh
#ifdef MPI
- integer :: irecv, isend, nblocks, itag, iret
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -707,40 +707,51 @@ module boundaries
#ifdef MPI
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
+
+! get sending and receiving process identifiers (depending on pair member)
+!
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ 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 (bcount(isend,irecv) > 0) then
-
-! obtain the number of blocks to exchange
-!
- nblocks = bcount(isend,irecv)
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 1
+ stag = 16 * (rproc * nprocs + sproc) + 1
+ rtag = 16 * (sproc * nprocs + rproc) + 1
-! allocate the buffer for variable exchange
+! allocate buffers for variable exchange
!
- allocate(rbuf(nblocks,nv,ih,kh))
-
-! if isend == nproc we are sending data
-!
- if (isend == nproc) then
+ allocate(sbuf(scount,nv,ih,kh))
+ allocate(rbuf(rcount,nv,ih,kh))
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate pinfo with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan all blocks on the list
!
@@ -780,7 +791,7 @@ module boundaries
!
call block_update_flux(i, j, k, n &
, pneigh%data%f(n,1:nv,is,jb:je,kb:ke) &
- , rbuf(l,1:nv,1:jh,1:kh))
+ , sbuf(l,1:nv,1:jh,1:kh))
case(2)
@@ -796,7 +807,7 @@ module boundaries
!
call block_update_flux(i, j, k, n &
, pneigh%data%f(n,1:nv,ib:ie,js,kb:ke) &
- , rbuf(l,1:nv,1:ih,1:kh))
+ , sbuf(l,1:nv,1:ih,1:kh))
#if NDIMS == 3
case(3)
@@ -813,7 +824,7 @@ module boundaries
!
call block_update_flux(i, j, k, n &
, pneigh%data%f(n,1:nv,ib:ie,jb:je,ks) &
- , rbuf(l,1:nv,1:ih,1:jh))
+ , sbuf(l,1:nv,1:ih,1:jh))
#endif /* NDIMS == 3 */
end select
@@ -824,29 +835,22 @@ module boundaries
end do ! %ptr blocks
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf(:,:,:,:)), irecv, itag &
- , rbuf(:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate pinfo with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! scan all blocks on the list
!
@@ -970,13 +974,13 @@ module boundaries
end do ! %ptr blocks
- end if ! irecv = nproc
-
! deallocate data buffer
!
- deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From dd3ee8c57d0e73d1dcb62d291363ee663c2fc223 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 18:16:36 -0200
Subject: [PATCH 16/29] BOUNDARIES: Rewrite MPI part in boundaries_edge_copy().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 122 ++++++++++++++++++++++++---------------------
1 file changed, 65 insertions(+), 57 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 5df8a2b..a73eb94 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -2683,10 +2683,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -2710,14 +2709,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -2904,55 +2903,70 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 5
+ stag = 16 * (rproc * nprocs + sproc) + 5
+ rtag = 16 * (sproc * nprocs + rproc) + 5
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
- select case(idir)
+ select case(idir)
#if NDIMS == 2
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,km))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,km))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,km))
+ allocate(rbuf(rcount,nv,ih,ng,km))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,km))
+ allocate(rbuf(rcount,nv,ng,jh,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,ng))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,ng))
- case(3)
- allocate(rbuf(nblocks,nv,ng,ng,kh))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,ng))
+ allocate(rbuf(rcount,nv,ih,ng,ng))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,ng))
+ allocate(rbuf(rcount,nv,ng,jh,ng))
+ case(3)
+ allocate(sbuf(scount,nv,ng,ng,kh))
+ allocate(rbuf(rcount,nv,ng,ng,kh))
#endif /* NDIMS == 3 */
- end select
-
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -2982,29 +2996,29 @@ module boundaries
#if NDIMS == 2
call block_edge_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:km))
+ , sbuf(l,1:nv,1:ih,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:ng))
+ , sbuf(l,1:nv,1:ih,1:ng,1:ng))
#endif /* NDIMS == 3 */
case(2)
#if NDIMS == 2
call block_edge_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:km))
+ , sbuf(l,1:nv,1:ng,1:jh,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ng,1:jh,1:ng))
#endif /* NDIMS == 3 */
#if NDIMS == 3
case(3)
call block_edge_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ng,1:ng,1:kh))
#endif /* NDIMS == 3 */
end select
@@ -3014,28 +3028,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -3139,13 +3147,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From 33375fce41042eafe56aa1e8d61a4366f466a18d Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 18:25:04 -0200
Subject: [PATCH 17/29] BOUNDARIES: Rewrite MPI part in
boundaries_edge_restrict().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 122 ++++++++++++++++++++++++---------------------
1 file changed, 65 insertions(+), 57 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index a73eb94..47880d7 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -3203,10 +3203,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -3230,14 +3229,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -3424,55 +3423,70 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 6
+ stag = 16 * (rproc * nprocs + sproc) + 6
+ rtag = 16 * (sproc * nprocs + rproc) + 6
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
- select case(idir)
+ select case(idir)
#if NDIMS == 2
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,km))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,km))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,km))
+ allocate(rbuf(rcount,nv,ih,ng,km))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,km))
+ allocate(rbuf(rcount,nv,ng,jh,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,ng))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,ng))
- case(3)
- allocate(rbuf(nblocks,nv,ng,ng,kh))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,ng))
+ allocate(rbuf(rcount,nv,ih,ng,ng))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,ng))
+ allocate(rbuf(rcount,nv,ng,jh,ng))
+ case(3)
+ allocate(sbuf(scount,nv,ng,ng,kh))
+ allocate(rbuf(rcount,nv,ng,ng,kh))
#endif /* NDIMS == 3 */
- end select
-
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -3502,29 +3516,29 @@ module boundaries
#if NDIMS == 2
call block_edge_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:km))
+ , sbuf(l,1:nv,1:ih,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:ng))
+ , sbuf(l,1:nv,1:ih,1:ng,1:ng))
#endif /* NDIMS == 3 */
case(2)
#if NDIMS == 2
call block_edge_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:km))
+ , sbuf(l,1:nv,1:ng,1:jh,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ng,1:jh,1:ng))
#endif /* NDIMS == 3 */
#if NDIMS == 3
case(3)
call block_edge_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ng,1:ng,1:kh))
#endif /* NDIMS == 3 */
end select
@@ -3534,28 +3548,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -3659,13 +3667,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From bdecf835021e92956b83101cbcf755b208922ce2 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 18:30:54 -0200
Subject: [PATCH 18/29] BOUNDARIES: Rewrite MPI part in
boundaries_edge_prolong().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 125 ++++++++++++++++++++++++---------------------
1 file changed, 66 insertions(+), 59 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 47880d7..3a14025 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -3723,10 +3723,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -3751,14 +3750,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -3951,55 +3950,70 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 7
+ stag = 16 * (rproc * nprocs + sproc) + 7
+ rtag = 16 * (sproc * nprocs + rproc) + 7
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
- select case(idir)
+ select case(idir)
#if NDIMS == 2
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,km))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,km))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,km))
+ allocate(rbuf(rcount,nv,ih,ng,km))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,km))
+ allocate(rbuf(rcount,nv,ng,jh,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- case(1)
- allocate(rbuf(nblocks,nv,ih,ng,ng))
- case(2)
- allocate(rbuf(nblocks,nv,ng,jh,ng))
- case(3)
- allocate(rbuf(nblocks,nv,ng,ng,kh))
+ case(1)
+ allocate(sbuf(scount,nv,ih,ng,ng))
+ allocate(rbuf(rcount,nv,ih,ng,ng))
+ case(2)
+ allocate(sbuf(scount,nv,ng,jh,ng))
+ allocate(rbuf(rcount,nv,ng,jh,ng))
+ case(3)
+ allocate(sbuf(scount,nv,ng,ng,kh))
+ allocate(rbuf(rcount,nv,ng,ng,kh))
#endif /* NDIMS == 3 */
- end select
-
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -4009,9 +4023,8 @@ module boundaries
!
l = l + 1
-! assign pmeta and pneigh to the associated blocks
+! assign pneigh to the associated neighbor block
!
- pmeta => pinfo%block
pneigh => pinfo%neigh
! get the corner coordinates
@@ -4031,31 +4044,31 @@ module boundaries
#if NDIMS == 2
call block_edge_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:km))
+ , sbuf(l,1:nv,1:ih,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:ng))
+ , sbuf(l,1:nv,1:ih,1:ng,1:ng))
#endif /* NDIMS == 3 */
case(2)
j = pmeta%pos(2)
#if NDIMS == 2
call block_edge_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:km))
+ , sbuf(l,1:nv,1:ng,1:jh,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_edge_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ng,1:jh,1:ng))
#endif /* NDIMS == 3 */
#if NDIMS == 3
case(3)
k = pmeta%pos(3)
call block_edge_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ng,1:ng,1:kh))
#endif /* NDIMS == 3 */
end select
@@ -4065,28 +4078,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -4190,13 +4197,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From 7d0969a280cd40906c13cbfb191dbe3b74cb8c64 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 18:48:53 -0200
Subject: [PATCH 19/29] BOUNDARIES: Add pmeta initialization in
boundaries_edge_prolong().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 3a14025..0da782b 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -4023,8 +4023,9 @@ module boundaries
!
l = l + 1
-! assign pneigh to the associated neighbor block
+! assign pmeta and pneigh to the associated blocks
!
+ pmeta => pinfo%block
pneigh => pinfo%neigh
! get the corner coordinates
From 594564899ac8036fb331b092f447ff556bce8216 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:06:14 -0200
Subject: [PATCH 20/29] BOUNDARIES: Rewrite MPI part in
boundaries_corner_copy().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 ++++++++++++++++++++++++----------------------
1 file changed, 51 insertions(+), 46 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 0da782b..cc19da1 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -4254,10 +4254,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -4276,14 +4275,14 @@ module boundaries
integer :: i , j , k
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -4434,45 +4433,57 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 8
+ stag = 16 * (rproc * nprocs + sproc) + 8
+ rtag = 16 * (sproc * nprocs + rproc) + 8
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
#if NDIMS == 2
- allocate(rbuf(nblocks,nv,ng,ng,km))
+ allocate(sbuf(scount,nv,ng,ng,km))
+ allocate(rbuf(rcount,nv,ng,ng,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- allocate(rbuf(nblocks,nv,ng,ng,ng))
+ allocate(sbuf(scount,nv,ng,ng,ng))
+ allocate(rbuf(rcount,nv,ng,ng,ng))
#endif /* NDIMS == 3 */
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
-
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -4499,13 +4510,13 @@ module boundaries
!
#if NDIMS == 2
call block_corner_copy(i, j, k &
- , pneigh%data%q(1:nv, 1:im, 1:jm, 1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:km))
+ , pneigh%data%q(1:nv,1:im,1:jm,1:km) &
+ , sbuf(l,1:nv,1:ng,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_corner_copy(i, j, k &
- , pneigh%data%q(1:nv, 1:im, 1:jm, 1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:ng))
+ , pneigh%data%q(1:nv,1:im,1:jm,1:km) &
+ , sbuf(l,1:nv,1:ng,1:ng,1:ng))
#endif /* NDIMS == 3 */
! associate the pointer with the next block
@@ -4514,28 +4525,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -4599,13 +4604,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From d71c749353bbd51f086c6a308c40988d3daae570 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:16:15 -0200
Subject: [PATCH 21/29] BOUNDARIES: Rewrite MPI part in
boundaries_corner_restrict().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 ++++++++++++++++++++++++----------------------
1 file changed, 51 insertions(+), 46 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index cc19da1..170b713 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -4654,10 +4654,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -4676,14 +4675,14 @@ module boundaries
integer :: i , j , k
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -4833,45 +4832,57 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 9
+ stag = 16 * (rproc * nprocs + sproc) + 9
+ rtag = 16 * (sproc * nprocs + rproc) + 9
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
#if NDIMS == 2
- allocate(rbuf(nblocks,nv,ng,ng,km))
+ allocate(sbuf(scount,nv,ng,ng,km))
+ allocate(rbuf(rcount,nv,ng,ng,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- allocate(rbuf(nblocks,nv,ng,ng,ng))
+ allocate(sbuf(scount,nv,ng,ng,ng))
+ allocate(rbuf(rcount,nv,ng,ng,ng))
#endif /* NDIMS == 3 */
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
-
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -4898,13 +4909,13 @@ module boundaries
!
#if NDIMS == 2
call block_corner_restrict(i, j, k &
- , pneigh%data%q(1:nv, 1:im, 1:jm, 1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:km))
+ , pneigh%data%q(1:nv,1:im,1:jm,1:km) &
+ , sbuf(l,1:nv,1:ng,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_corner_restrict(i, j, k &
- , pneigh%data%q(1:nv, 1:im, 1:jm, 1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:ng))
+ , pneigh%data%q(1:nv,1:im,1:jm,1:km) &
+ , sbuf(l,1:nv,1:ng,1:ng,1:ng))
#endif /* NDIMS == 3 */
! associate the pointer with the next block
@@ -4913,28 +4924,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -4998,13 +5003,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From d4f43f2ebe9fd9d0f4cd2f75db3d1f62b98efbc9 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:21:37 -0200
Subject: [PATCH 22/29] BOUNDARIES: Rewrite MPI part in
boundaries_corner_prolong().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 97 ++++++++++++++++++++++++----------------------
1 file changed, 51 insertions(+), 46 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index 170b713..be761fa 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -5053,10 +5053,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -5075,14 +5074,14 @@ module boundaries
integer :: i , j , k
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -5232,45 +5231,57 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 10
+ stag = 16 * (rproc * nprocs + sproc) + 10
+ rtag = 16 * (sproc * nprocs + rproc) + 10
-! allocate data buffer for variables to exchange
+! allocate buffers for variable exchange
!
#if NDIMS == 2
- allocate(rbuf(nblocks,nv,ng,ng,km))
+ allocate(sbuf(scount,nv,ng,ng,km))
+ allocate(rbuf(rcount,nv,ng,ng,km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
- allocate(rbuf(nblocks,nv,ng,ng,ng))
+ allocate(sbuf(scount,nv,ng,ng,ng))
+ allocate(rbuf(rcount,nv,ng,ng,ng))
#endif /* NDIMS == 3 */
-! if isend == nproc we are sending data from the neighbor block
-!
- if (isend == nproc) then
-
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -5292,18 +5303,18 @@ module boundaries
k = pinfo%corner(3)
#endif /* NDIMS == 3 */
-! restrict and extract the corresponding corner region from the neighbor and
-! insert it to the buffer
+! prolong the corresponding corner region from the neighbor and insert it in
+! the buffer
!
#if NDIMS == 2
call block_corner_prolong(i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:km))
+ , sbuf(l,1:nv,1:ng,1:ng,1:km))
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_corner_prolong(i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:ng,1:ng))
+ , sbuf(l,1:nv,1:ng,1:ng,1:ng))
#endif /* NDIMS == 3 */
! associate the pointer with the next block
@@ -5312,28 +5323,22 @@ module boundaries
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data from the neighbor block
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -5397,13 +5402,13 @@ module boundaries
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From 233fe1d520db3012a85b464c36899b39bb07b6fb Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:31:09 -0200
Subject: [PATCH 23/29] BOUNDARIES: Rewrite MPI part in boundaries_face_copy().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 129 +++++++++++++++++++++++----------------------
1 file changed, 66 insertions(+), 63 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index be761fa..ac80ca4 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -1201,10 +1201,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -1228,14 +1227,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:) , allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -1421,47 +1420,60 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
+
+! get sending and receiving process identifiers (depending on pair member)
+!
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ 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 (bcount(isend,irecv) > 0) then
-
-! obtain the number of blocks to exchange
-!
- nblocks = bcount(isend,irecv)
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 2
+ stag = 16 * (rproc * nprocs + sproc) + 2
+ rtag = 16 * (sproc * nprocs + rproc) + 2
! allocate data buffer for variables to exchange
!
- select case(idir)
- case(1)
- allocate(rbuf(nblocks,nv,ng,jh,kh))
- case(2)
- allocate(rbuf(nblocks,nv,ih,ng,kh))
- case(3)
- allocate(rbuf(nblocks,nv,ih,jh,ng))
- end select
-
-! if isend == nproc we are sending data
-!
- if (isend == nproc) then
+ select case(idir)
+ case(1)
+ allocate(sbuf(scount,nv,ng,jh,kh))
+ allocate(rbuf(rcount,nv,ng,jh,kh))
+ case(2)
+ allocate(sbuf(scount,nv,ih,ng,kh))
+ allocate(rbuf(rcount,nv,ih,ng,kh))
+ case(3)
+ allocate(sbuf(scount,nv,ih,jh,ng))
+ allocate(rbuf(rcount,nv,ih,jh,ng))
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -1471,7 +1483,7 @@ module boundaries
!
l = l + 1
-! associate pneigh with pinfo%neigh
+! assign pneigh to the associated neighbor block
!
pneigh => pinfo%neigh
@@ -1488,45 +1500,39 @@ module boundaries
case(1)
call block_face_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:kh))
+ , sbuf(l,1:nv,1:ng,1:jh,1:kh))
case(2)
call block_face_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ih,1:ng,1:kh))
case(3)
call block_face_copy(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ih,1:jh,1:ng))
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -1537,7 +1543,7 @@ module boundaries
!
l = l + 1
-! associate pmeta with pinfo%block
+! assign a pointer to the associated data block
!
pmeta => pinfo%block
@@ -1572,8 +1578,7 @@ module boundaries
kl = ke - kh + 1
ku = ke
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ng,1:jh,1:kh)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:jh,1:kh)
case(2)
if (i == 1) then
il = ib
@@ -1596,8 +1601,7 @@ module boundaries
kl = ke - kh + 1
ku = ke
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ih,1:ng,1:kh)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ih,1:ng,1:kh)
case(3)
if (i == 1) then
il = ib
@@ -1620,23 +1624,22 @@ module boundaries
kl = keu
ku = km
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ih,1:jh,1:ng)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ih,1:jh,1:ng)
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From a9349d967beae8fd1ce5371bf2309a54d2dc3f24 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:36:00 -0200
Subject: [PATCH 24/29] BOUNDARIES: Rewrite MPI part in
boundaries_face_restrict().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 120 ++++++++++++++++++++++++---------------------
1 file changed, 63 insertions(+), 57 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index ac80ca4..bc4dd7f 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -1689,10 +1689,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -1716,14 +1715,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -1909,47 +1908,60 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 3
+ stag = 16 * (rproc * nprocs + sproc) + 3
+ rtag = 16 * (sproc * nprocs + rproc) + 3
! allocate data buffer for variables to exchange
!
- select case(idir)
- case(1)
- allocate(rbuf(nblocks,nv,ng,jh,kh))
- case(2)
- allocate(rbuf(nblocks,nv,ih,ng,kh))
- case(3)
- allocate(rbuf(nblocks,nv,ih,jh,ng))
- end select
-
-! if isend == nproc we are sending data
-!
- if (isend == nproc) then
+ select case(idir)
+ case(1)
+ allocate(sbuf(scount,nv,ng,jh,kh))
+ allocate(rbuf(rcount,nv,ng,jh,kh))
+ case(2)
+ allocate(sbuf(scount,nv,ih,ng,kh))
+ allocate(rbuf(rcount,nv,ih,ng,kh))
+ case(3)
+ allocate(sbuf(scount,nv,ih,jh,ng))
+ allocate(rbuf(rcount,nv,ih,jh,ng))
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -1959,7 +1971,7 @@ module boundaries
!
l = l + 1
-! associate pneigh with pinfo%neigh
+! assign pneigh to the associated neighbor block
!
pneigh => pinfo%neigh
@@ -1969,52 +1981,46 @@ module boundaries
j = pinfo%corner(2)
k = pinfo%corner(3)
-! extract the corresponding face region from the neighbor and insert it
+! restrict the corresponding face region from the neighbor and insert it
! to the buffer
!
select case(idir)
case(1)
call block_face_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:kh))
+ , sbuf(l,1:nv,1:ng,1:jh,1:kh))
case(2)
call block_face_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ih,1:ng,1:kh))
case(3)
call block_face_restrict(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ih,1:jh,1:ng))
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -2025,7 +2031,7 @@ module boundaries
!
l = l + 1
-! associate pmeta with pinfo%block
+! assign a pointer to the associated data block
!
pmeta => pinfo%block
@@ -2112,19 +2118,19 @@ module boundaries
rbuf(l,1:nv,1:ih,1:jh,1:ng)
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From bd913cb04dba548959f6b79c4f4554f6f43109be Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 11 Dec 2014 19:42:06 -0200
Subject: [PATCH 25/29] BOUNDARIES: Rewrite MPI part in
boundaries_face_prolong().
We use exchange_real_arrays() now.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 127 +++++++++++++++++++++++----------------------
1 file changed, 65 insertions(+), 62 deletions(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index bc4dd7f..c729c22 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -2180,10 +2180,9 @@ module boundaries
use coordinates , only : ibl, jbl, kbl
use coordinates , only : ieu, jeu, keu
use equations , only : nv
- use mpitools , only : nproc, nprocs, npmax
#ifdef MPI
- use mpitools , only : npairs, pairs
- use mpitools , only : send_real_array, receive_real_array
+ use mpitools , only : nproc, nprocs, npairs, pairs
+ use mpitools , only : exchange_real_arrays
#endif /* MPI */
! local variables are not implicit by default
@@ -2208,14 +2207,14 @@ module boundaries
integer :: ih, jh, kh
integer :: il, jl, kl
integer :: iu, ju, ku
- integer :: iret
#ifdef MPI
- integer :: isend, irecv, nblocks, itag
- integer :: l, p
+ integer :: sproc, scount, stag
+ integer :: rproc, rcount, rtag
+ integer :: l, p, iret
! local arrays
!
- real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
+ real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
!-------------------------------------------------------------------------------
@@ -2413,47 +2412,60 @@ module boundaries
!!
! iterate over all process pairs
!
- do p = 1, 2 * npairs
+ do p = 1, npairs
-! get sending and receiving process identifiers
+! process only pairs related to this process
!
- isend = pairs(p,1)
- irecv = pairs(p,2)
+ if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
-! process only pairs which have something to exchange
+! get sending and receiving process identifiers (depending on pair member)
!
- if (bcount(isend,irecv) > 0) then
+ if (pairs(p,1) == nproc) then
+ sproc = pairs(p,1)
+ rproc = pairs(p,2)
+ end if
+ if (pairs(p,2) == nproc) then
+ sproc = pairs(p,2)
+ rproc = pairs(p,1)
+ end if
-! obtain the number of blocks to exchange
+! get the number of blocks to exchange
!
- nblocks = bcount(isend,irecv)
+ scount = bcount(sproc,rproc)
+ rcount = bcount(rproc,sproc)
+
+! process only pairs which have anything to exchange
+!
+ if ((scount + rcount) > 0) then
! prepare the tag for communication
!
- itag = 16 * (irecv * nprocs + isend) + 4
+ stag = 16 * (rproc * nprocs + sproc) + 4
+ rtag = 16 * (sproc * nprocs + rproc) + 4
! allocate data buffer for variables to exchange
!
- select case(idir)
- case(1)
- allocate(rbuf(nblocks,nv,ng,jh,kh))
- case(2)
- allocate(rbuf(nblocks,nv,ih,ng,kh))
- case(3)
- allocate(rbuf(nblocks,nv,ih,jh,ng))
- end select
-
-! if isend == nproc we are sending data
-!
- if (isend == nproc) then
+ select case(idir)
+ case(1)
+ allocate(sbuf(scount,nv,ng,jh,kh))
+ allocate(rbuf(rcount,nv,ng,jh,kh))
+ case(2)
+ allocate(sbuf(scount,nv,ih,ng,kh))
+ allocate(rbuf(rcount,nv,ih,ng,kh))
+ case(3)
+ allocate(sbuf(scount,nv,ih,jh,ng))
+ allocate(rbuf(rcount,nv,ih,jh,ng))
+ end select
+!! PREPARE BLOCKS FOR SENDING
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(sproc,rproc)%ptr
! scan over all blocks on the block exchange list
!
@@ -2463,7 +2475,7 @@ module boundaries
!
l = l + 1
-! prepare pointer for updated meta block and its neighbor
+! assign pmeta and pneigh to the right blocks
!
pmeta => pinfo%block
pneigh => pinfo%neigh
@@ -2483,49 +2495,43 @@ module boundaries
k = pmeta%pos(3)
call block_face_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ng,1:jh,1:kh))
+ , sbuf(l,1:nv,1:ng,1:jh,1:kh))
case(2)
i = pmeta%pos(1)
k = pmeta%pos(3)
call block_face_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:ng,1:kh))
+ , sbuf(l,1:nv,1:ih,1:ng,1:kh))
case(3)
i = pmeta%pos(1)
j = pmeta%pos(2)
call block_face_prolong(idir, i, j, k &
, pneigh%data%q(1:nv,1:im,1:jm,1:km) &
- , rbuf(l,1:nv,1:ih,1:jh,1:ng))
+ , sbuf(l,1:nv,1:ih,1:jh,1:ng))
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
-! send the data buffer to another process
+!! SEND PREPARED BLOCKS AND RECEIVCE NEW ONES
+!!
+! exchange data
!
- call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
-
- end if ! isend = nproc
-
-! if irecv == nproc we are receiving data
-!
- if (irecv == nproc) then
-
-! receive the data buffer
-!
- call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
- , rbuf(:,:,:,:,:), iret)
+ call exchange_real_arrays(rproc, stag, size(sbuf), sbuf &
+ , rproc, rtag, size(rbuf), rbuf, iret)
+!! PROCESS RECEIVED BLOCKS
+!!
! reset the block counter
!
l = 0
-! associate pinfo with the first block in the exchange list
+! associate the pointer with the first block in the exchange list
!
- pinfo => barray(isend,irecv)%ptr
+ pinfo => barray(rproc,sproc)%ptr
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
@@ -2536,7 +2542,7 @@ module boundaries
!
l = l + 1
-! prepare the pointer to updated block
+! assign a pointer to the associated data block
!
pmeta => pinfo%block
@@ -2571,8 +2577,7 @@ module boundaries
kl = 1
ku = ke
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ng,1:jh,1:kh)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:jh,1:kh)
case(2)
if (j == 1) then
jl = 1
@@ -2595,8 +2600,7 @@ module boundaries
kl = 1
ku = ke
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ih,1:ng,1:kh)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ih,1:ng,1:kh)
case(3)
if (k == 1) then
kl = 1
@@ -2619,23 +2623,22 @@ module boundaries
jl = 1
ju = je
end if
- pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = &
- rbuf(l,1:nv,1:ih,1:jh,1:ng)
+ pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ih,1:jh,1:ng)
end select
-! associate pinfo with the next block
+! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
- end if ! irecv = nproc
-
! deallocate data buffer
!
- if (allocated(rbuf)) deallocate(rbuf)
+ deallocate(sbuf, rbuf)
- end if ! if bcount > 0
+ end if ! (scount + rcount) > 0
+
+ end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end do ! p = 1, npairs
From 50302b0705d2d42c83e83e8452d218f98e4fdb14 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Fri, 19 Dec 2014 14:08:37 -0200
Subject: [PATCH 26/29] MESH: Use npmax instead of (nprocs - 1).
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/mesh.F90 | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/src/mesh.F90 b/src/mesh.F90
index 8ba8cb6..0e8bd09 100644
--- a/src/mesh.F90
+++ b/src/mesh.F90
@@ -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
@@ -483,9 +483,9 @@ module mesh
! local variables
!
- integer(kind=4) :: level, lev, idir, iside, iface
- integer(kind=4) :: np, nl
- integer(kind=4), dimension(0:nprocs-1) :: lb
+ integer(kind=4) :: level, lev, idir, iside, iface
+ integer(kind=4) :: np, nl
+ 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)
From 1ff1ce50d17d4956f577c72de9b7f3a3830f9525 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Fri, 19 Dec 2014 14:09:32 -0200
Subject: [PATCH 27/29] IO: Remove unused variable lcpu.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/io.F90 | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/src/io.F90 b/src/io.F90
index 7ccdeed..319b635 100644
--- a/src/io.F90
+++ b/src/io.F90
@@ -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)
From 80236693d52ddaca1bccc837d284e9884f1a6a10 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Fri, 19 Dec 2014 14:11:40 -0200
Subject: [PATCH 28/29] IO: Use npmax instead of (nprocs - 1).
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/io.F90 | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/src/io.F90 b/src/io.F90
index 319b635..0ce757e 100644
--- a/src/io.F90
+++ b/src/io.F90
@@ -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
From a7a7afa81a85c0fc152ef4000627a1a24ccaef87 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Mon, 22 Dec 2014 10:56:11 -0200
Subject: [PATCH 29/29] BOUNDARIES: Add timer to update_ghost_cells().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
src/boundaries.F90 | 15 ++++++++++++++-
1 file changed, 14 insertions(+), 1 deletion(-)
diff --git a/src/boundaries.F90 b/src/boundaries.F90
index ec9c4c8..ea750f0 100644
--- a/src/boundaries.F90
+++ b/src/boundaries.F90
@@ -45,7 +45,7 @@ module boundaries
#ifdef PROFILE
! timer indices
!
- integer , save :: imi, imv, imf, ims, imc, imr, imp
+ integer , save :: imi, imv, imf, ims, imc, imr, imp, imu
#endif /* PROFILE */
! parameters corresponding to the boundary type
@@ -140,6 +140,7 @@ module boundaries
call set_timer('boundaries:: copy' , imc)
call set_timer('boundaries:: restrict' , imr)
call set_timer('boundaries:: prolong' , imp)
+ call set_timer('boundaries:: update ghosts' , imu)
! start accounting time for module initialization/finalization
!
@@ -7485,6 +7486,12 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
+#ifdef PROFILE
+! start accounting time subroutine
+!
+ call start_timer(imu)
+#endif /* PROFILE */
+
! assign the pointer to the first block on the list
!
pdata => list_data
@@ -7549,6 +7556,12 @@ module boundaries
end do ! data blocks
+#ifdef PROFILE
+! stop accounting time subroutine
+!
+ call stop_timer(imu)
+#endif /* PROFILE */
+
!-------------------------------------------------------------------------------
!
end subroutine update_ghost_cells