!------------------------------------------------------------------------
! Copyright (c) 2023 SPMODEL Development Group. All rights reserved.
!------------------------------------------------------------------------
!
!表題  et_mpi_module テストプログラム (微分計算)
!
!履歴  2023/08/08  竹広真一
!
program et_mpi_module_derivative_test

  use dc_message, only : MessageNotify
  use dc_test, only : AssertEqual
  use et_mpi_module
  use mpi
  implicit none

  !---- 空間解像度設定 ----
  integer, parameter :: im=64, jm=64            ! 格子点の設定(X,Y)
  integer, parameter :: km=21, lm=42              ! 切断波数の設定(X,Y)

  !---- 変数 ----
  real(8), allocatable :: vx_Data(:,:)    ! 格子データ
  real(8), allocatable :: vx_Deriv(:,:)   ! 格子データ

  integer            :: k=2, l=3
  integer            :: np, ip, ierr

  !---- 座標変数など ----
  real(8), parameter :: xmin = -1.0d0, xmax=1.0d0
  real(8), parameter :: ymin = -1.0d0, ymax=1.0d0

  ! 判定誤差設定
  integer, parameter :: check_digits = 8
  integer, parameter :: ignore = -9

  real(8), parameter :: pi=3.1415926535897932385D0

  call MessageNotify('M','et_mpi_module_derivative_test', &
       'et_mpi_module derivative function tests')

  !---------------- MPI スタート ---------------------
  call MPI_INIT(IERR)
  call MPI_COMM_RANK(MPI_COMM_WORLD,IP,IERR)
  call MPI_COMM_SIZE(MPI_COMM_WORLD,NP,IERR)

  !---------------- 座標値の設定 ---------------------
  call et_mpi_initial(im,jm,km,lm,xmin,xmax,ymin,ymax)    ! スペクトル初期化

  allocate(vx_Data(jc(ip),0:im-1))    ! 格子データ
  allocate(vx_Deriv(jc(ip),0:im-1))   ! 格子データ

  !------------------- 初期値設定 ----------------------

  ! sin sin
  vx_Data = sin(k*pi*vx_X) * sin(l*pi*vx_Y)  
  vx_Deriv = k*pi*cos(k*pi*vx_X) * sin(l*pi*vx_Y)
  !vx_Data = sin(k*pi*vx_X) * (vx_Y-ymin)*(vx_Y-ymax)
  !vx_Deriv = k*pi*cos(k*pi*vx_X) * (vx_Y-ymin)*(vx_Y-ymax)

  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(sin(k*pi*X)*sin(l*pi*Y))')

  vx_Deriv = l*pi*sin(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(sin(k*pi*X)*sin(l*pi*Y))')

  vx_Deriv = -((k*pi)**2 + (l*pi)**2) * sin(k*pi*vx_X) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(sin(k*pi*X)*sin(l*pi*Y))')

!!$  vx_Deriv = -1.0/((k*pi)**2 + (l*pi)**2) * sin(k*pi*vx_X) * sin(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(sin(k*pi*X)*sin(l*pi*Y))')

  ! cos cos
  vx_Data = cos(k*pi*vx_X) * cos(l*pi*vx_Y)

  vx_Deriv = -k*pi*sin(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(cos(k*pi*X)*cos(l*pi*Y))')

  vx_Deriv = -l*pi*cos(k*pi*vx_X) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))),&
    vx_Deriv, 'Dy(cos(k*pi*X)*cos(l*pi*Y))')

  vx_Deriv = -((k*pi)**2 + (l*pi)**2) * cos(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(cos(k*pi*X)*cos(l*pi*Y))')

!!$  vx_Deriv = -1.0/((k*pi)**2 + (l*pi)**2) * cos(k*pi*vx_X) * cos(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(cos(k*pi*X)*cos(l*pi*Y))')

  ! sin cos
  vx_Data = sin(k*pi*vx_X) * cos(l*pi*vx_Y)

  vx_Deriv = k*pi*cos(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(sin(k*pi*X)*cos(l*pi*Y))')

  vx_Deriv = -l*pi*sin(k*pi*vx_X) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(sin(k*pi*X)*cos(l*pi*Y))')

  vx_Deriv = -((k*pi)**2 + (l*pi)**2) * sin(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(sin(k*pi*X)*cos(l*pi*Y))')

!!$  vx_Deriv = -1.0/((k*pi)**2 + (l*pi)**2) * sin(k*pi*vx_X) * cos(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(sin(k*pi*X)*cos(l*pi*Y))')

  ! cos sin
  vx_Data = cos(k*pi*vx_X) * sin(l*pi*vx_Y)

  vx_Deriv = -k*pi*sin(k*pi*vx_X) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(cos(k*pi*X)*sin(l*pi*Y))')

  vx_Deriv = l*pi*cos(k*pi*vx_X) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(cos(k*pi*X)*sin(l*pi*Y))')

  vx_Deriv = -((k*pi)**2 + (l*pi)**2) * cos(k*pi*vx_X) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(cos(k*pi*X)*sin(l*pi*Y))')

!!$  vx_Deriv = -1.0/((k*pi)**2 + (l*pi)**2) * cos(k*pi*vx_X) * sin(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(cos(k*pi*X)*sin(l*pi*Y))')

  ! l=0
  vx_Data = cos(k*pi*vx_X)

  vx_Deriv = -k*pi*sin(k*pi*vx_X)
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(cos(k*pi*X))')

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(cos(k*pi*X))')

  vx_Deriv = -((k*pi)**2) * cos(k*pi*vx_X)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(cos(k*pi*X))')

!!$  vx_Deriv = -1.0/((k*pi)**2) * cos(k*pi*vx_X)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(cos(k*pi*X))')

  vx_Data = sin(k*pi*vx_X)

  vx_Deriv = k*pi*cos(k*pi*vx_X)
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(sin(k*pi*X))')

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(sin(k*pi*X))')

  vx_Deriv = -((k*pi)**2) * sin(k*pi*vx_X)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(sin(k*pi*X))')

!!$  vx_Deriv = -1.0/((k*pi)**2) * sin(k*pi*vx_X)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(sin(k*pi*X))')

  ! k=0
  vx_Data = cos(l*pi*vx_Y)

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(cos(l*pi*Y))')

  vx_Deriv = -l*pi*sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(cos(l*pi*Y))')

  vx_Deriv = -((l*pi)**2) * cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(cos(l*pi*Y))')

!!$  vx_Deriv = -1.0/((l*pi)**2) * cos(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(cos(l*pi*Y))')

  vx_Data = sin(l*pi*vx_Y)

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(sin(l*pi*Y))')

  vx_Deriv = l*pi*cos(l*pi*vx_Y)
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(sin(l*pi*Y))')

  vx_Deriv = -((l*pi)**2) * sin(l*pi*vx_Y)
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(sin(l*pi*Y))')

!!$  vx_Deriv = -1.0/((l*pi)**2) * sin(l*pi*vx_Y)
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(sin(l*pi*Y))')

  ! k=l=0
  vx_Data = 1.0D0

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dx_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dx(1.0)')

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Dy_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Dy(1.0)')

  vx_Deriv = 0.0D0
  call check2d(vx_ft(ft_Lapla_ft(ft_vx(vx_Data))), &
    vx_Deriv, 'Lapla(1.0)')

!!$  vx_Deriv = 0.0D0
!!$  call check2d(vx_ft(ft_LaplaInv_ft(ft_vx(vx_Data))), &
!!$    vx_Deriv, 'LaplaInv(1.0)')
  
  call MPI_FINALIZE(IERR)
  
  call MessageNotify('M','et_mpi_module_derivative_test', &
       'et_mpi_module derivative function tests succeeded!')

contains

  subroutine check2d(var,sol,funcname)
    real(8) :: var(:,:)                ! 判定する配列
    real(8) :: sol(:,:)                ! 解析解
    character(len=*) :: funcname       ! 関数名

    call AssertEqual(     &
      message = funcname, &
      answer = sol,       &
      check = var,        &
      significant_digits = check_digits, ignore_digits = ignore     )

  end subroutine check2d

end program et_mpi_module_derivative_test