!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2006. All rights reserved.
!---------------------------------------------------------------------
!
!= 3 次元 (xyz 方向) 不等間隔交互格子 境界条件モジュール
!
!* 履歴
!  * 2007/07/15 (小高正嗣) : 3D deepconv へ移植, dc_types を Use.
!  * 2006/06/07 (小高正嗣) : 新規作成

module setmargin
  != 3 次元 (xyz 方向) 不等間隔交互格子 有限差分モデル用 境界条件モジュール
  !
  !== 概要
  !
  ! setmargin は, 3 次元 (xyz 方向) 不等間隔交互格子を用いた有限差分法に
  ! 基づく数値モデルのための, 境界条件設定 Fortran 90 副プログラムを提供
  ! する.
  !
  ! このモジュールは xyz_module の下位モジュールである. 下請けモジュール
  ! として data_type, xyz_base_module, x_bc_module, y_bc_module, 
  ! z_bc_module モジュールを用いている. 
  !
  !
  !== 手続きの命名法
  !
  ! 境界条件を設定する副プログラムは
  !
  !   Boundary[境界条件を示す文字列][...]_(入力配列の次元情報)
  !
  ! のように命名されている. 境界条件を示す文字列の種類は x_bc_module,
  ! y_bc_module, z_bc_module の場合と同じである.
  ! 
  !
  use dc_types, only : DP
  use gridset,  only : imin, imax, jmin, jmax, kmin, kmax,    &
    &                  xmg, ymg, zmg, nx, ny, nz, ncmax
#ifdef LIB_MPI
  use mpi_wrapper, only : myrank, nprocs, &
    &                     MPIWrapperISend, MPIWrapperIRecv, MPIWrapperWait
#endif

  implicit none

  private

  public :: SetMargin_xyzf 
  public :: SetMargin_xyz
  public :: SetMargin_pyz
  public :: SetMargin_xqz
  public :: SetMargin_xyr

  interface SetMargin_xyz
    module procedure SetMargin_aaz
  end interface

  interface SetMargin_pyz
    module procedure SetMargin_aaz
  end interface

  interface SetMargin_xqz
    module procedure SetMargin_aaz
  end interface
  
contains

!!!-------------------------------------------------------------
#ifdef LIB_MPI
  subroutine SetMargin_xyzf(xyzf_Var)

    implicit none
    real(DP),intent(inout) :: xyzf_Var(imin:imax,jmin:jmax,kmin:kmax,1:ncmax) 
    real(DP)           :: aaa_Var(imin:imax,jmin:jmax,kmin:kmax) 
    integer            :: idest_a, idep_a, idest_b, idep_b
    integer, parameter :: nvars = 1
    real(8)            :: sbuf_a( Xmg, ny, nz )
    real(8)            :: rbuf_a( Xmg, ny, nz )
    real(8)            :: sbuf_b( Xmg, ny, nz )
    real(8)            :: rbuf_b( Xmg, ny, nz )
    integer            :: ireqs_a, ireqr_a, ireqs_b, ireqr_b
    integer            :: ix, jy, kz
    integer            :: i, j, k, s


    ! x 方向に周期境界条件を適用する
    !
    do s = 1, ncmax
      aaa_Var = xyzf_Var(:,:,:,s)
    
      !-------------------------------
      ! 配列の右側を, ノード間で通信する.
      ! 送信する部分配列(sbuf_a)を用意する
      do k = 1, nz
        do j = 1, ny
          do i = 1, Xmg
            sbuf_a( i, j, k ) = aaa_var( nx + 1 - i , j, k ) 
          end do
        end do
      end do
      
      idest_a = mod(( myrank+1 )       , nprocs)   !送信先
      idep_a  = mod(( myrank-1 )+nprocs, nprocs)   !受信元
      
      call MPIWrapperISend( idest_a, xmg, ny, nz, sbuf_a, ireqs_a ) !送信
      call MPIWrapperIRecv( idep_a , xmg, ny, nz, rbuf_a, ireqr_a ) !受信
      
      !-------------------------------
      ! 配列の左側を, ノード間で通信する.
      ! 送信する部分配列(sbuf_b)を用意する
      do k = 1, nz
        do j = 1, ny
          do i = 1, Xmg
            sbuf_b( i, j, k ) = aaa_var( i, j, k ) 
          end do
        end do
      end do
      
      idest_b = mod(( myrank-1 )+nprocs, nprocs)    !送信先
      idep_b  = mod(( myrank+1 )       , nprocs)    !受信元
      
      call MPIWrapperISend( idest_b, xmg, ny, nz, sbuf_b, ireqs_b ) !送信
      call MPIWrapperIRecv( idep_b , xmg, ny, nz, rbuf_b, ireqr_b ) !受信

      !-------------------------------
      ! 配列の右側を, ノード間で通信する.
      ! 受信した部分配列(rbuf_a)を代入する.
      call MPIWrapperWait( ireqs_a )
      call MPIWrapperWait( ireqr_a )
      
      do k = 1, nz
        do j = 1, ny
          do i = 1, Xmg
            aaa_var( 1-i , j, k ) = rbuf_a( i, j, k ) 
          end do
        end do
      end do
      
      !-------------------------------
      ! 配列の左側を, ノード間で通信する.
      ! 受信した部分配列(rbuf_b)を代入する.
      call MPIWrapperWait( ireqs_b )
      call MPIWrapperWait( ireqr_b )
      
      do k = 1, nz
        do j = 1, ny
          do i = 1, Xmg
            aaa_var(nx + i , j, k ) = rbuf_b( i, j, k ) 
          end do
        end do
      end do

      xyzf_Var(:,:,:,s) = aaa_Var
    end do

    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        xyzf_Var(:,1-jy,:,:)  = xyzf_Var(:,ny+1-jy,:,:)
        xyzf_Var(:,ny+jy,:,:) = xyzf_Var(:,jy,:,:)
      end do
    end if
    
    ! z 方向に対称境界条件を適用する
    !
    do kz = 1, zmg
      xyzf_Var(:,:,1-kz,:)  = xyzf_Var(:,:,kz,:)
      xyzf_Var(:,:,nz+kz,:) = xyzf_Var(:,:,nz+1-kz,:)
    end do
    
  end subroutine SetMargin_xyzf


  subroutine SetMargin_aaz(aaz_Var)

    implicit none
    real(DP),intent(inout) :: aaz_Var(imin:imax,jmin:jmax,kmin:kmax) 
    integer            :: idest_a, idep_a, idest_b, idep_b
    integer, parameter :: nvars = 1
    real(8)            :: sbuf_a( Xmg, ny, nz )
    real(8)            :: rbuf_a( Xmg, ny, nz )
    real(8)            :: sbuf_b( Xmg, ny, nz )
    real(8)            :: rbuf_b( Xmg, ny, nz )
    integer            :: ireqs_a, ireqr_a, ireqs_b, ireqr_b
    integer            :: ix, jy, kz
    integer            :: i, j, k

    ! x 方向に周期境界条件を適用する
    !
    !-------------------------------
    ! 配列の右側を, ノード間で通信する.
    ! 送信する部分配列(sbuf_a)を用意する
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          sbuf_a( i, j, k ) = aaz_var( nx + 1 - i , j, k ) 
        end do
      end do
    end do

    idest_a = mod(( myrank+1 )       , nprocs)   !送信先
    idep_a  = mod(( myrank-1 )+nprocs, nprocs)   !受信元

    call MPIWrapperISend( idest_a, xmg, ny, nz, sbuf_a, ireqs_a ) !送信
    call MPIWrapperIRecv( idep_a , xmg, ny, nz, rbuf_a, ireqr_a ) !受信
    
    !-------------------------------
    ! 配列の左側を, ノード間で通信する.
    ! 送信する部分配列(sbuf_b)を用意する
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          sbuf_b( i, j, k ) = aaz_var( i, j, k ) 
        end do
      end do
    end do
    
    idest_b = mod(( myrank-1 )+nprocs, nprocs)    !送信先
    idep_b  = mod(( myrank+1 )       , nprocs)    !受信元

    call MPIWrapperISend( idest_b, xmg, ny, nz, sbuf_b, ireqs_b ) !送信
    call MPIWrapperIRecv( idep_b , xmg, ny, nz, rbuf_b, ireqr_b ) !受信

    !-------------------------------
    ! 配列の右側を, ノード間で通信する.
    ! 受信した部分配列(rbuf_a)を代入する.
    call MPIWrapperWait( ireqs_a )
    call MPIWrapperWait( ireqr_a )
    
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          aaz_var( 1-i , j, k ) = rbuf_a( i, j, k ) 
        end do
      end do
    end do
    
    !-------------------------------
    ! 配列の左側を, ノード間で通信する.
    ! 受信した部分配列(rbuf_b)を代入する.
    call MPIWrapperWait( ireqs_b )
    call MPIWrapperWait( ireqr_b )
    
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          aaz_var(nx + i , j, k ) = rbuf_b( i, j, k ) 
        end do
      end do
    end do
    
    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        aaz_Var(:,1-jy,:)  = aaz_Var(:,ny+1-jy,:)
        aaz_Var(:,ny+jy,:) = aaz_Var(:,jy,:)
      end do
    end if
    
    ! z 方向に対称境界条件を適用する
    !
    do kz = 1, zmg
      aaz_Var(:,:,1-kz)  = aaz_Var(:,:,kz)
      aaz_Var(:,:,nz+kz) = aaz_Var(:,:,nz+1-kz)
    end do
    
  end subroutine SetMargin_aaz
  

  subroutine SetMargin_xyr(xyr_Var)

    implicit none
    real(DP),intent(inout) :: xyr_Var(imin:imax,jmin:jmax,kmin:kmax) 
    integer            :: idest_a, idep_a, idest_b, idep_b
    integer, parameter :: nvars = 1
    real(8)            :: sbuf_a( Xmg, ny, nz )
    real(8)            :: rbuf_a( Xmg, ny, nz )
    real(8)            :: sbuf_b( Xmg, ny, nz )
    real(8)            :: rbuf_b( Xmg, ny, nz )
    integer            :: ireqs_a, ireqr_a, ireqs_b, ireqr_b
    integer            :: ix, jy, kz
    integer            :: i, j, k
    
    !-------------------------------
    ! 配列の右側を, ノード間で通信する.
    ! 送信する部分配列(sbuf_a)を用意する
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          sbuf_a( i, j, k ) = xyr_var( nx + 1 - i , j, k ) 
        end do
      end do
    end do

    idest_a = mod(( myrank+1 )       , nprocs)   !送信先
    idep_a  = mod(( myrank-1 )+nprocs, nprocs)   !受信元

    call MPIWrapperISend( idest_a, xmg, ny, nz, sbuf_a, ireqs_a ) !送信
    call MPIWrapperIRecv( idep_a , xmg, ny, nz, rbuf_a, ireqr_a ) !受信
    
    !-------------------------------
    ! 配列の左側を, ノード間で通信する.
    ! 送信する部分配列(sbuf_b)を用意する
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          sbuf_b( i, j, k ) = xyr_var( i, j, k ) 
        end do
      end do
    end do
    
    idest_b = mod(( myrank-1 )+nprocs, nprocs)    !送信先
    idep_b  = mod(( myrank+1 )       , nprocs)    !受信元

    call MPIWrapperISend( idest_b, xmg, ny, nz, sbuf_b, ireqs_b ) !送信
    call MPIWrapperIRecv( idep_b , xmg, ny, nz, rbuf_b, ireqr_b ) !受信

    !-------------------------------
    ! 配列の右側を, ノード間で通信する.
    ! 受信した部分配列(rbuf_a)を代入する.
    call MPIWrapperWait( ireqs_a )
    call MPIWrapperWait( ireqr_a )
    
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          xyr_var( 1-i , j, k ) = rbuf_a( i, j, k ) 
        end do
      end do
    end do
    
    !-------------------------------
    ! 配列の左側を, ノード間で通信する.
    ! 受信した部分配列(rbuf_b)を代入する.
    call MPIWrapperWait( ireqs_b )
    call MPIWrapperWait( ireqr_b )
    
    do k = 1, nz
      do j = 1, ny
        do i = 1, Xmg
          xyr_var(nx + i , j, k ) = rbuf_b( i, j, k ) 
        end do
      end do
    end do
    
    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        xyr_Var(:,1-jy,:)  = xyr_Var(:,ny+1-jy,:)
        xyr_Var(:,ny+jy,:) = xyr_Var(:,jy,:)
      end do
    end if
    
    ! z 方向に反対称境界条件を適用する
    !
    xyr_Var(:,:,0) = 0.0d0
    xyr_Var(:,:,nz) = 0.0d0
    
    do kz = 1, zmg-1
      xyr_Var(:,:,-kz) = - xyr_Var(:,:,kz)
    end do
    
    do kz = 1, zmg
      xyr_Var(:,:,nz+kz) = - xyr_Var(:,:,nz-kz)
    end do
    
  end subroutine SetMargin_xyr

!!!---------------------------------------------
#else
!!!---------------------------------------------
  subroutine SetMargin_xyzf(xyzf_Var)

    implicit none
    real(DP),intent(inout) :: xyzf_Var(imin:imax,jmin:jmax,kmin:kmax,1:ncmax) 
    integer :: ix, jy, kz

    ! x 方向に周期境界条件を適用する
    !
    do ix = 1, xmg
      xyzf_Var(1-ix,:,:,:)  = xyzf_Var(nx+1-ix,:,:,:)
      xyzf_Var(nx+ix,:,:,:) = xyzf_Var(ix,:,:,:)
    end do
    
    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        xyzf_Var(:,1-jy,:,:)  = xyzf_Var(:,ny+1-jy,:,:)
        xyzf_Var(:,ny+jy,:,:) = xyzf_Var(:,jy,:,:)
      end do
    end if
    
    ! z 方向に対称境界条件を適用する
    !
    do kz = 1, zmg
      xyzf_Var(:,:,1-kz,:)  = xyzf_Var(:,:,kz,:)
      xyzf_Var(:,:,nz+kz,:) = xyzf_Var(:,:,nz+1-kz,:)
    end do
    
  end subroutine SetMargin_xyzf


  subroutine SetMargin_aaz(aaz_Var)

    implicit none
    real(DP),intent(inout) :: aaz_Var(imin:imax,jmin:jmax,kmin:kmax) 
    integer :: ix, jy, kz

    ! x 方向に周期境界条件を適用する
    !
    do ix = 1, xmg
      aaz_Var(1-ix,:,1:nz)  = aaz_Var(nx+1-ix,:,1:nz)
      aaz_Var(nx+ix,:,1:nz) = aaz_Var(ix,:,1:nz)
    end do
    
    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        aaz_Var(:,1-jy,1:nz)  = aaz_Var(:,ny+1-jy,1:nz)
        aaz_Var(:,ny+jy,1:nz) = aaz_Var(:,jy,1:nz)
      end do
    end if
    
    ! z 方向に対称境界条件を適用する
    !
    do kz = 1, zmg
      aaz_Var(:,:,1-kz)  = aaz_Var(:,:,kz)
      aaz_Var(:,:,nz+kz) = aaz_Var(:,:,nz+1-kz)
    end do
    
  end subroutine SetMargin_aaz
  
!!!-------------------------------------------------------------
  subroutine SetMargin_xyr(xyr_Var)

    implicit none
    real(DP),intent(inout) :: xyr_Var(imin:imax,jmin:jmax,kmin:kmax) 
    integer :: ix, jy, kz

    ! x 方向に周期境界条件を適用する
    !
    do ix = 1, xmg
      xyr_Var(1-ix,:,:)  = xyr_Var(nx+1-ix,:,:)
      xyr_Var(nx+ix,:,:) = xyr_Var(ix,:,:)
    end do
    
    ! y 方向に周期境界条件を適用する
    !
    if (ymg /= 0) then 
      do jy = 1, ymg
        xyr_Var(:,1-jy,:)  = xyr_Var(:,ny+1-jy,:)
        xyr_Var(:,ny+jy,:) = xyr_Var(:,jy,:)
      end do
    end if
    
    ! z 方向に反対称境界条件を適用する
    !
    xyr_Var(:,:,0) = 0.0d0
    xyr_Var(:,:,nz) = 0.0d0
    
    do kz = 1, zmg-1
      xyr_Var(:,:,-kz) = - xyr_Var(:,:,kz)
    end do
    
    do kz = 1, zmg
      xyr_Var(:,:,nz+kz) = - xyr_Var(:,:,nz-kz)
    end do
    
  end subroutine SetMargin_xyr

#endif

end module setmargin
