Merge branch 'master' into reconnection

src/blocks.F90

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

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
@@ -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)

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 \

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

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