hecmw_adapt_stack_sr.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
module hecmw_adapt_stack_sr
contains
  !C
  !C***
  !C*** hecmw_adapt_STACK_SEND_RECV
  !C***
  !C
  !C    exchange IMPORT/EXPORT item NUMBER information
  !C
  subroutine  hecmw_adapt_stack_send_recv                           &
      &              ( neibpetot, neibpe, stack_import, stack_export,    &
      &                solver_comm,my_rank)
 
    use hecmw_util
    implicit real*8 (a-h,o-z)
 
    integer(kind=kint ), intent(in) :: NEIBPETOT
    integer(kind=kint ), pointer    :: NEIBPE      (:)
    integer(kind=kint ), pointer    :: STACK_IMPORT(:)
    integer(kind=kint ), pointer    :: STACK_EXPORT(:)
    integer(kind=kint )             :: SOLVER_COMM, my_rank
 
    integer(kind=kint ), dimension(:,:), save, allocatable :: sta1
    integer(kind=kint ), dimension(:,:), save, allocatable :: sta2
    integer(kind=kint ), dimension(:  ), save, allocatable :: req1
    integer(kind=kint ), dimension(:  ), save, allocatable :: req2
 
    integer(kind=kint ), save :: NFLAG
    data nflag/0/
 
    !C
    !C-- INIT.
    if (nflag.eq.0) then
      allocate (sta1(mpi_status_size,neibpetot))
      allocate (sta2(mpi_status_size,neibpetot))
      allocate (req1(neibpetot))
      allocate (req2(neibpetot))
      nflag= 1
    endif
 
    !C
    !C-- SEND
    do neib= 1, neibpetot
      num= stack_import(neib)
      call mpi_isend (num, 1, mpi_integer, neibpe(neib), 0,           &
        &                  solver_comm, req1(neib), ierr)
    enddo
 
    !C
    !C-- RECEIVE
    do neib= 1, neibpetot
      call mpi_irecv (stack_export(neib), 1, mpi_integer,             &
        &                  neibpe(neib), 0, solver_comm, req2(neib), ierr)
    enddo
 
    call mpi_waitall (neibpetot, req2, sta2, ierr)
    call mpi_waitall (neibpetot, req1, sta1, ierr)
 
  end subroutine hecmw_adapt_stack_send_recv
end module     hecmw_adapt_stack_sr