!= MPI 関連ルーチン
!
!= MPI related routines
!
! Authors::   Yoshiyuki O. Takahashi
! Version::   $Id: mpi_wrapper.F90,v 1.5 2011-06-03 16:31:45 sugiyama Exp $
! Tag Name::  $Name: arare5-20110623 $
! Copyright:: Copyright (C) GFD Dennou Club, 2008. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!

module mpi_wrapper
  !
  != MPI 関連ルーチン
  !
  != MPI related routines
  !
  ! <b>Note that Japanese and English are described in parallel.</b>
  !
  ! MPI 関係の変数の管理と MPI 関係ラッパールーチンのモジュール. 
  !
  ! This is a module containing MPI-related variables and wrapper routines. 
  !
  !== Procedures List
  !
  !
  !== NAMELIST
  !
  !

  ! モジュール引用 ; USE statements
  !

  ! 種別型パラメタ
  ! Kind type parameter
  !
  use dc_types, only: DP, &      ! 倍精度実数型. Double precision.
    &                 STRING, &  ! 文字列.       Strings.
    &                 TOKEN      ! キーワード.   Keywords.

#ifdef LIB_MPI
  ! MPI
  !
  use mpi
#endif

  ! 宣言文 ; Declaration statements
  !
  implicit none
  private

  ! 公開手続き
  ! Public procedure
  !
  public :: MPIWrapperInit
  public :: MPIWrapperFinalize
#ifdef LIB_MPI
  public :: MPIWrapperISend
  public :: MPIWrapperIRecv
  public :: MPIWrapperWait
#endif

  ! 公開変数
  ! Public variables
  !
  integer, save, public :: nprocs
                           ! Number of MPI processes
  integer, save, public :: myrank
                           ! My rank
  logical, save, public :: FLAG_LIB_MPI

#ifdef LIB_MPI
  ! 非公開変数
  ! Private variables
  !
  interface MPIWrapperISend
    module procedure &
      MPIWrapperISend_dble_1d, &
      MPIWrapperISend_dble_2d, &
      MPIWrapperISend_dble_3d, &
      MPIWrapperISend_dble_4d
  end interface

  interface MPIWrapperIRecv
    module procedure &
      MPIWrapperIRecv_dble_1d, &
      MPIWrapperIRecv_dble_2d, &
      MPIWrapperIRecv_dble_3d, &
      MPIWrapperIRecv_dble_4d
  end interface

  interface MPIWrapperAbort
    module procedure &
      MPIWrapperStop
  end interface
#endif 

contains

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperInit
    !
    ! MPI の初期化
    !
    ! Initialization of MPI
    !

    ! モジュール引用 ; USE statements
    !


#ifdef LIB_MPI

    ! 作業変数
    ! Work variables
    !
    integer :: ierr

#endif

    FLAG_LIB_MPI = .false.
    nprocs = 1
    myrank = 0

#ifdef LIB_MPI

    FLAG_LIB_MPI = .true.
     call mpi_init( ierr )
    call mpi_comm_size( mpi_comm_world, nprocs, ierr )
    call mpi_comm_rank( mpi_comm_world, myrank, ierr )

#endif

  end subroutine MPIWrapperInit

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperFinalize
    !
    ! MPI の終了処理
    !
    ! Finalization of MPI
    !

    ! モジュール引用 ; USE statements
    !


#ifdef LIB_MPI

    ! 作業変数
    ! Work variables
    !
    integer :: ierr


    call mpi_finalize( ierr )

#endif

  end subroutine MPIWrapperFinalize

  !--------------------------------------------------------------------------------------
#ifdef LIB_MPI

  subroutine MPIWrapperStop
    !
    ! MPI の異常終了処理
    !
    ! Abort of MPI
    !

    ! モジュール引用 ; USE statements
    !

    ! 作業変数
    ! Work variables
    !
    integer :: errorcode = 9
    integer :: ierr

    call mpi_abort( mpi_comm_world, errorcode, ierr )
    call MPIWrapperFinalize
    stop

  end subroutine MPIWrapperstop

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperWait( ireq )
    !
    ! MPI 通信終了まで待機
    !
    ! Wait finishing MPI transfer
    !

    ! モジュール引用 ; USE statements
    !

    integer, intent(inout) :: ireq
                               ! request number

    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: istatus( MPI_STATUS_SIZE )


    call mpi_wait( ireq, istatus, ierr )

  end subroutine MPIWrapperWait

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperISend_dble_1d( &
    & idest, im,                      & ! (in)
    & buf,                            & ! (in)
    & ireq                            & ! (out)
    & )
    !
    ! 1D 倍精度配列の非ブロッキング通信(送信)
    !
    ! Non-blocking transfer (send) of real(8) 1D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idest
                              ! Process number of destination
    integer , intent(in ) :: im
                              ! Size of 1st dimension of sent data
    real(DP), intent(in ) :: buf( im )
                              ! Array to be sent
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_isend( buf, isize, &
      mpi_double_precision, idest, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperISend_dble_1d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperIRecv_dble_1d( &
    & idep, im,                       & ! (in)
    & buf,                            & ! (out)
    & ireq                            & ! (out)
    & )
    !
    ! 1D 倍精度配列の非ブロッキング通信(受信)
    !
    ! Non-blocking transfer (receive) of real(8) 1D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idep
                              ! Process number of departure
    integer , intent(in ) :: im
                              ! Size of 1st dimension of received data
    real(DP), intent(out) :: buf( im )
                              ! Array to be received
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_irecv( buf, isize, &
      mpi_double_precision, idep, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperIRecv_dble_1d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperISend_dble_2d( &
    & idest, im, jm,                  & ! (in)
    & buf,                            & ! (in)
    & ireq                            & ! (out)
    & )
    !
    ! 2D 倍精度配列の非ブロッキング通信(送信)
    !
    ! Non-blocking transfer (send) of real(8) 2D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idest
                              ! Process number of destination
    integer , intent(in ) :: im
                              ! Size of 1st dimension of sent data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of sent data
    real(DP), intent(in ) :: buf( im, jm )
                              ! Array to be sent
    integer , intent(out) :: ireq
                              ! Request number

    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_isend( buf, isize, &
      mpi_double_precision, idest, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperISend_dble_2d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperIRecv_dble_2d( &
    & idep, im, jm,                   & ! (in)
    & buf,                            & ! (out)
    & ireq                            & ! (out)
    & )
    !
    ! 2D 倍精度配列の非ブロッキング通信(受信)
    !
    ! Non-blocking transfer (receive) of real(8) 2D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idep
                              ! Process number of destination
    integer , intent(in ) :: im
                              ! Size of 1st dimension of received data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of received data
    real(DP), intent(out) :: buf( im, jm )
                              ! Array to be received
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_irecv( buf, isize, &
      mpi_double_precision, idep, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperIRecv_dble_2d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperISend_dble_3d( &
    & idest, im, jm, km,              & ! (in)
    & buf,                            & ! (in)
    & ireq                            & ! (out)
    & )
    !
    ! 3D 倍精度配列の非ブロッキング通信(送信)
    !
    ! Non-blocking transfer (send) of real(8) 3D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idest
                              ! Process number of destination
    integer , intent(in ) :: im
                              ! Size of 1st dimension of sent data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of sent data
    integer , intent(in ) :: km
                              ! Size of 3rd dimension of sent data
    real(DP), intent(in ) :: buf( im, jm, km )
                              ! Array to be sent
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_isend( buf, isize, &
      mpi_double_precision, idest, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperISend_dble_3d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperIRecv_dble_3d( &
    & idep, im, jm, km,               & ! (in)
    & buf,                            & ! (out)
    & ireq                            & ! (out)
    & )
    !
    ! 3D 倍精度配列の非ブロッキング通信(受信)
    !
    ! Non-blocking transfer (receive) of real(8) 3D array
    !

    ! モジュール引用 ; USE statements
    !

    integer , intent(in ) :: idep
                              ! Process number of departure
    integer , intent(in ) :: im
                              ! Size of 1st dimension of received data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of received data
    integer , intent(in ) :: km
                              ! Size of 3rd dimension of received data
    real(DP), intent(out) :: buf( im, jm, km )
                              ! Array to be received
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_irecv( buf, isize, &
      mpi_double_precision, idep, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperIRecv_dble_3d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperISend_dble_4d( &
    & idest, im, jm, km, lm,          & ! (in)
    & buf,                            & ! (in)
    & ireq                            & ! (out)
    & )
    !
    ! 4D 倍精度配列の非ブロッキング通信(送信)
    !
    ! Non-blocking transfer (send) of real(8) 4D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idest
                              ! Process number of destination
    integer , intent(in ) :: im
                              ! Size of 1st dimension of sent data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of sent data
    integer , intent(in ) :: km
                              ! Size of 3rd dimension of sent data
    integer , intent(in ) :: lm
                              ! Size of 4th dimension of sent data
    real(DP), intent(in ) :: buf( im, jm, km, lm )
                              ! Array to be sent
    integer , intent(out) :: ireq
                              ! Request number

    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_isend( buf, isize, &
      mpi_double_precision, idest, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperISend_dble_4d

  !--------------------------------------------------------------------------------------

  subroutine MPIWrapperIRecv_dble_4d( &
    & idep, im, jm, km, lm,           & ! (in)
    & buf,                            & ! (out)
    & ireq                            & ! (out)
    & )
    !
    ! 4D 倍精度配列の非ブロッキング通信(受信)
    !
    ! Non-blocking transfer (receive) of real(8) 4D array
    !

    ! モジュール引用 ; USE statements
    !


    integer , intent(in ) :: idep
                              ! Process number of departure
    integer , intent(in ) :: im
                              ! Size of 1st dimension of received data
    integer , intent(in ) :: jm
                              ! Size of 2nd dimension of received data
    integer , intent(in ) :: km
                              ! Size of 3rd dimension of received data
    integer , intent(in ) :: lm
                              ! Size of 4th dimension of received data
    real(DP), intent(out) :: buf( im, jm, km, lm )
                              ! Array to be received
    integer , intent(out) :: ireq
                              ! Request number


    ! 作業変数
    ! Work variables
    !
    integer :: ierr
    integer :: isize


    isize = size( buf )

    call mpi_irecv( buf, isize, &
      mpi_double_precision, idep, 1, mpi_comm_world, &
      ireq, ierr )

  end subroutine MPIWrapperIRecv_dble_4d

  !--------------------------------------------------------------------------------------
#endif 

end module mpi_wrapper
