!C
!C***
!C*** hpcmw_eps_fvm_barrier
!C***
!C
subroutine hpcmw_eps_fvm_barrier
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: ierr
call MPI_BARRIER (MPI_COMM_WORLD, ierr)
end subroutine hpcmw_eps_fvm_barrier
!C
!C***
!C*** hpcmw_eps_fvm_allREDUCE_R
!C***
!C
subroutine hpcmw_eps_fvm_allreduce_R ( VAL, ntag)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, ntag, ierr
real(kind=kreal):: VAL, VALM
if (ntag .eq. hpcmw_sum) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_max) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_min) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_DOUBLE_PRECISION, MPI_MIN, &
& MPI_COMM_WORLD, ierr)
endif
VAL= VALM
end subroutine hpcmw_eps_fvm_allreduce_R
!C
!C***
!C*** hpcmw_eps_fvm_allREDUCE_I
!C***
!C
subroutine hpcmw_eps_fvm_allreduce_I ( VAL, ntag)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, ntag, ierr
integer:: VAL, VALM
if (ntag .eq. hpcmw_sum) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_INTEGER, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_max) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_INTEGER, MPI_MAX, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_min) then
call MPI_allREDUCE &
& (VAL, VALM, 1, MPI_INTEGER, MPI_MIN, &
& MPI_COMM_WORLD, ierr)
endif
VAL= VALM
end subroutine hpcmw_eps_fvm_allreduce_I
!C
!C***
!C*** hpcmw_eps_fvm_bcast_R
!C***
!C
subroutine hpcmw_eps_fvm_bcast_R ( VAL, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nbase, ierr
real(kind=kreal):: VAL
call MPI_BCAST (VAL, 1, MPI_DOUBLE_PRECISION, nbase, &
& MPI_COMM_WORLD, ierr)
end subroutine hpcmw_eps_fvm_bcast_R
!C
!C***
!C*** hpcmw_eps_fvm_bcast_I
!C***
!C
subroutine hpcmw_eps_fvm_bcast_I ( VAL, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: nbase, ierr
integer :: VAL
call MPI_BCAST (VAL, 1, MPI_INTEGER, nbase, MPI_COMM_WORLD, ierr)
end subroutine hpcmw_eps_fvm_bcast_I
!C
!C***
!C*** hpcmw_eps_fvm_bcast_C
!C***
!C
subroutine hpcmw_eps_fvm_bcast_C ( VAL, n, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nbase, ierr
character(len=n) :: VAL
call MPI_BCAST (VAL, n, MPI_CHARACTER, nbase, MPI_COMM_WORLD, &
& ierr)
end subroutine hpcmw_eps_fvm_bcast_C
!C
!C***
!C*** hpcmw_eps_fvm_allREDUCE_RV
!C***
!C
subroutine hpcmw_eps_fvm_allreduce_RV ( VAL, n, ntag)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, ntag, ierr
real(kind=kreal), dimension(n) :: VAL
real(kind=kreal), dimension(:), allocatable :: VALM
allocate (VALM(n))
VALM= 0.d0
if (ntag .eq. hpcmw_sum) then
call MPI_allREDUCE &
& (VAL, VALM, n, MPI_DOUBLE_PRECISION, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_max) then
call MPI_allREDUCE &
& (VAL, VALM, n, MPI_DOUBLE_PRECISION, MPI_MAX, &
& MPI_COMM_WORLD, ierr)
endif
if (ntag .eq. hpcmw_min) then
call MPI_allREDUCE &
& (VAL, VALM, n, MPI_DOUBLE_PRECISION, MPI_MIN, &
& MPI_COMM_WORLD, ierr)
endif
VAL= VALM
deallocate (VALM)
end subroutine hpcmw_eps_fvm_allreduce_RV
!C
!C***
!C*** hpcmw_eps_fvm_allREDUCE_IV
!C***
!C
subroutine hpcmw_eps_fvm_allreduce_IV ( VAL, n, ntag)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, ntag, ierr
integer, dimension(n) :: VAL
integer, dimension(:), allocatable :: VALM
allocate (VALM(n))
VALM= 0
if (ntag .eq. hpcmw_sum) then
call MPI_allREDUCE &
& (VAL, VALM, n, MPI_INTEGER, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
endif
VAL= VALM
deallocate (VALM)
end subroutine hpcmw_eps_fvm_allreduce_IV
!C
!C***
!C*** hpcmw_eps_fvm_bcast_RV
!C***
!C
subroutine hpcmw_eps_fvm_bcast_RV ( VAL, n, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nbase, ierr
real(kind=kreal), dimension(n) :: VAL
call MPI_BCAST (VAL, n, MPI_DOUBLE_PRECISION, nbase, &
& MPI_COMM_WORLD, ierr)
end subroutine hpcmw_eps_fvm_bcast_RV
!C
!C***
!C*** hpcmw_eps_fvm_bcast_IV
!C***
!C
subroutine hpcmw_eps_fvm_bcast_IV ( VAL, n, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nbase, ierr
integer, dimension(n) :: VAL
call MPI_BCAST (VAL, n, MPI_INTEGER, nbase, MPI_COMM_WORLD, ierr)
end subroutine hpcmw_eps_fvm_bcast_IV
!C
!C***
!C*** hpcmw_eps_fvm_bcast_CV
!C***
!C
subroutine hpcmw_eps_fvm_bcast_CV ( VAL, n, nn, nbase)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nn, nbase, ierr
character(len=n) :: VAL(nn)
call MPI_BCAST (VAL, n*nn, MPI_CHARACTER, nbase, MPI_COMM_WORLD, &
& ierr)
end subroutine hpcmw_eps_fvm_bcast_CV
!C
!C***
!C*** hpcmw_eps_fvm_update_1_R
!C***
!C
!C 1-DOF, REAL
!C
subroutine hpcmw_eps_fvm_update_1_R (X, n)
use hpcmw_eps_fvm_util
implicit REAL*8 (A-H,O-Z)
integer :: n, nn, ierr
real(kind=kreal), dimension(n) :: X
real(kind=kreal), dimension(:), allocatable :: WS, WR
integer(kind=kint ), dimension(:,:), allocatable :: sta1
integer(kind=kint ), dimension(:,:), allocatable :: sta2
integer(kind=kint ), dimension(: ), allocatable :: req1
integer(kind=kint ), dimension(: ), allocatable :: req2
nn= max (n, import_index(n_neighbor_pe), &
& export_index(n_neighbor_pe))
allocate (WS(nn), WR(nn))
!C
!C-- INIT.
allocate (sta1(MPI_STATUS_SIZE,n_neighbor_pe))
allocate (sta2(MPI_STATUS_SIZE,n_neighbor_pe))
allocate (req1(n_neighbor_pe))
allocate (req2(n_neighbor_pe))
!C
!C-- SEND
do neib= 1, n_neighbor_pe
istart= export_index(neib-1)
inum = export_index(neib ) - istart
do k= istart+1, istart+inum
WS(k)= X(export_item(k))
enddo
call MPI_ISEND (WS(istart+1), inum, MPI_DOUBLE_PRECISION, &
& neighbor_pe(neib), 0, MPI_COMM_WORLD, &
& req1(neib), ierr)
enddo
!C
!C-- RECEIVE
do neib= 1, n_neighbor_pe
istart= import_index(neib-1)
inum = import_index(neib ) - istart
call MPI_IRECV (WR(istart+1), inum, MPI_DOUBLE_PRECISION, &
& neighbor_pe(neib), 0, MPI_COMM_WORLD, &
& req2(neib), ierr)
enddo
call MPI_WAITALL (n_neighbor_pe, req2, sta2, ierr)
do neib= 1, n_neighbor_pe
istart= import_index(neib-1)
inum = import_index(neib ) - istart
do k= istart+1, istart+inum
X(import_item(k))= WR(k)
enddo
enddo
call MPI_WAITALL (n_neighbor_pe, req1, sta1, ierr)
deallocate (sta1, sta2, req1, req2, WS, WR)
end subroutine hpcmw_eps_fvm_update_1_R