MPITOOLS: Rewrite MPI support using Fortran 2008 interface.

Use procedure interfaces, remove unused variables, etc.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2020-08-14 19:40:10 -03:00
parent 701bb6618b
commit c15378bddd
7 changed files with 330 additions and 1072 deletions

View File

@ -565,7 +565,7 @@ module boundaries
use equations , only : nf use equations , only : nf
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -595,7 +595,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -962,8 +962,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -1363,7 +1362,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -1392,7 +1391,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -1617,8 +1616,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -1726,7 +1724,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -1753,7 +1751,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -1966,8 +1964,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -2078,7 +2075,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -2107,7 +2104,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -2359,8 +2356,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -2502,7 +2498,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -2532,7 +2528,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -2818,8 +2814,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -2949,7 +2944,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -2979,7 +2974,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -3243,8 +3238,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -3379,7 +3373,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -3409,7 +3403,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -3722,8 +3716,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -3888,7 +3881,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -3914,7 +3907,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -4167,8 +4160,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -4281,7 +4273,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -4307,7 +4299,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -4537,8 +4529,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!
@ -4651,7 +4642,7 @@ module boundaries
use equations , only : nv use equations , only : nv
#ifdef MPI #ifdef MPI
use mpitools , only : nproc, npairs, pairs use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_real_arrays use mpitools , only : exchange_arrays
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -4677,7 +4668,7 @@ module boundaries
#ifdef MPI #ifdef MPI
integer :: sproc = 0, rproc = 0 integer :: sproc = 0, rproc = 0
integer :: scount, rcount integer :: scount, rcount
integer :: l, p, iret integer :: l, p
! local arrays ! local arrays
! !
@ -4907,8 +4898,7 @@ module boundaries
!! !!
! exchange data ! exchange data
! !
call exchange_real_arrays(rproc, p, size(sbuf), sbuf & call exchange_arrays(rproc, p, sbuf, rbuf)
, size(rbuf), rbuf, iret)
!! PROCESS RECEIVED BLOCKS !! PROCESS RECEIVED BLOCKS
!! !!

View File

@ -67,7 +67,7 @@ program amun
use mesh , only : generate_mesh, store_mesh_stats use mesh , only : generate_mesh, store_mesh_stats
use mpitools , only : initialize_mpitools, finalize_mpitools use mpitools , only : initialize_mpitools, finalize_mpitools
#ifdef MPI #ifdef MPI
use mpitools , only : bcast_integer_variable, reduce_sum_real_array use mpitools , only : reduce_sum
#endif /* MPI */ #endif /* MPI */
use mpitools , only : master, nprocs, nproc, check_status use mpitools , only : master, nprocs, nproc, check_status
use operators , only : initialize_operators, finalize_operators use operators , only : initialize_operators, finalize_operators
@ -898,7 +898,7 @@ program amun
#ifdef MPI #ifdef MPI
! sum up timers from all processes ! sum up timers from all processes
! !
call reduce_sum_real_array(ntimers, tm(:), status) call reduce_sum(tm(1:ntimers))
#endif /* MPI */ #endif /* MPI */
! print timings only on master processor ! print timings only on master processor

View File

@ -509,7 +509,7 @@ module evolution
! !
use equations , only : maxspeed, cmax, cmax2 use equations , only : maxspeed, cmax, cmax2
#ifdef MPI #ifdef MPI
use mpitools , only : reduce_maximum_real, reduce_maximum_integer use mpitools , only : reduce_maximum
#endif /* MPI */ #endif /* MPI */
! include external variables ! include external variables
@ -535,7 +535,7 @@ module evolution
! local variables ! local variables
! !
integer :: iret, mlev integer :: mlev
real(kind=8) :: cm, dx_min real(kind=8) :: cm, dx_min
! local parameters ! local parameters
@ -585,8 +585,8 @@ module evolution
#ifdef MPI #ifdef MPI
! reduce maximum speed and level over all processors ! reduce maximum speed and level over all processors
! !
call reduce_maximum_real (cmax, iret) call reduce_maximum(cmax)
call reduce_maximum_integer(mlev, iret) call reduce_maximum(mlev)
#endif /* MPI */ #endif /* MPI */
! calculate the squared cmax ! calculate the squared cmax

View File

@ -1654,17 +1654,13 @@ module forcing
! !
use blocks , only : block_data, list_data use blocks , only : block_data, list_data
#ifdef MPI #ifdef MPI
use mpitools, only : reduce_sum_complex_array use mpitools, only : reduce_sum
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
! !
implicit none implicit none
! local variables
!
integer :: status
! local pointers ! local pointers
! !
type(block_data), pointer :: pdata type(block_data), pointer :: pdata
@ -1696,7 +1692,7 @@ module forcing
#ifdef MPI #ifdef MPI
! reduce velocity coefficients over all processes ! reduce velocity coefficients over all processes
! !
call reduce_sum_complex_array(size(vcoefs), vcoefs, status) call reduce_sum(vcoefs)
#endif /* MPI */ #endif /* MPI */
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------

View File

@ -327,9 +327,7 @@ module integrals
use evolution , only : step, time, dtn use evolution , only : step, time, dtn
use forcing , only : einj, rinj, arms use forcing , only : einj, rinj, arms
#ifdef MPI #ifdef MPI
use mpitools , only : reduce_sum_real_array use mpitools , only : reduce_minimum, reduce_maximum, reduce_sum
use mpitools , only : reduce_minimum_real_array
use mpitools , only : reduce_maximum_real_array
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -338,8 +336,7 @@ module integrals
! local variables ! local variables
! !
integer :: iret real(kind=8) :: dvol, dvolh
real(kind=8) :: dvol, dvolh
! local pointers ! local pointers
! !
@ -567,13 +564,13 @@ module integrals
#ifdef MPI #ifdef MPI
! sum the integral array from all processes ! sum the integral array from all processes
! !
call reduce_sum_real_array(narr, inarr(:), iret) call reduce_sum(inarr(1:narr))
! reduce average, minimum and maximum values ! reduce average, minimum and maximum values
! !
call reduce_sum_real_array(narr, avarr(:), iret) call reduce_sum(avarr(1:narr))
call reduce_minimum_real_array(narr, mnarr(:), iret) call reduce_minimum(mnarr(1:narr))
call reduce_maximum_real_array(narr, mxarr(:), iret) call reduce_maximum(mxarr(1:narr))
#endif /* MPI */ #endif /* MPI */
! calculate the internal energy ! calculate the internal energy

View File

@ -903,7 +903,7 @@ module mesh
use coordinates , only : nn => bcells use coordinates , only : nn => bcells
use equations , only : nv use equations , only : nv
use mpitools , only : nprocs, npmax, nproc use mpitools , only : nprocs, npmax, nproc
use mpitools , only : send_real_array, receive_real_array use mpitools , only : send_array, receive_array
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -914,7 +914,6 @@ module mesh
! local variables ! local variables
! !
integer :: status integer :: status
integer :: iret
integer(kind=4) :: np, nl integer(kind=4) :: np, nl
! local pointers ! local pointers
@ -995,7 +994,7 @@ module mesh
! send data ! send data
! !
call send_real_array(size(rbuf), np, itag, rbuf, iret) call send_array(np, itag, rbuf)
! remove data block from the current process ! remove data block from the current process
! !
@ -1016,7 +1015,7 @@ module mesh
! receive the data ! receive the data
! !
call receive_real_array(size(rbuf), pmeta%process, itag, rbuf, iret) call receive_array(pmeta%process, itag, rbuf)
! coppy the buffer to data block ! coppy the buffer to data block
! !
@ -1535,7 +1534,7 @@ module mesh
#ifdef DEBUG #ifdef DEBUG
use mpitools , only : nproc use mpitools , only : nproc
#endif /* DEBUG */ #endif /* DEBUG */
use mpitools , only : reduce_sum_integer_array use mpitools , only : reduce_sum
#endif /* MPI */ #endif /* MPI */
use refinement , only : check_refinement_criterion use refinement , only : check_refinement_criterion
@ -1556,7 +1555,6 @@ module mesh
! local variables ! local variables
! !
integer(kind=4) :: nl, l integer(kind=4) :: nl, l
integer :: iret
! array for storing the refinement flags ! array for storing the refinement flags
! !
@ -1677,7 +1675,7 @@ module mesh
! update refinement flags across all processes ! update refinement flags across all processes
! !
call reduce_sum_integer_array(nl, ibuf(1:nl), iret) call reduce_sum(ibuf(1:nl))
! reset the leaf block counter ! reset the leaf block counter
! !
@ -1844,7 +1842,7 @@ module mesh
use iso_fortran_env, only : error_unit use iso_fortran_env, only : error_unit
#ifdef MPI #ifdef MPI
use mpitools , only : nprocs, nproc use mpitools , only : nprocs, nproc
use mpitools , only : send_real_array, receive_real_array use mpitools , only : send_array, receive_array
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default ! local variables are not implicit by default
@ -1871,7 +1869,6 @@ module mesh
! tag for the MPI data exchange ! tag for the MPI data exchange
! !
integer(kind=4) :: itag integer(kind=4) :: itag
integer :: iret
! local buffer for data block exchange ! local buffer for data block exchange
! !
@ -2070,8 +2067,7 @@ module mesh
! send data ! send data
! !
call send_real_array(size(rbuf), pmeta%process & call send_array(pmeta%process, itag, rbuf)
, itag, rbuf(:,:,:,:), iret)
! deallocate the associated data block (it has to be pchild%data, and not pdata, ! deallocate the associated data block (it has to be pchild%data, and not pdata,
! otherwise, pchild%data won't be nullified) ! otherwise, pchild%data won't be nullified)
@ -2093,8 +2089,7 @@ module mesh
! receive the data ! receive the data
! !
call receive_real_array(size(rbuf) & call receive_array(pchild%process, itag, rbuf(:,:,:,:))
, pchild%process, itag, rbuf(:,:,:,:), iret)
! allocate data block for the current child ! allocate data block for the current child
! !

File diff suppressed because it is too large Load Diff