!= 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-20111010 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! module mpi_wrapper ! != MPI 関連ルーチン ! != MPI related routines ! ! Note that Japanese and English are described in parallel. ! ! 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