!----------------------------------------------------------------------
!  Copyright (c) 2021 SPMODEL Development Group.  All rights reserved.
!----------------------------------------------------------------------
!
!表題  wa_base_mpi_module_sjpack テストプログラム :: ベクトル用サブルーチンのテスト
!
!履歴  2013/02/15  竹広真一
!      2021/10/07  佐々木洋平 rename
!
program wa_mpi_module_sjpack_base_vector_test

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

  integer, parameter :: im=128, jm=64, nm=42, km=6

  real(8), allocatable ::  xva_U(:,:,:)              ! 速度経度成分
  real(8), allocatable ::  xva_V(:,:,:)              ! 速度緯度成分

  real(8), allocatable ::  xva_UCosLat(:,:,:)        ! 速度経度成分
  real(8), allocatable ::  xva_VCosLat(:,:,:)        ! 速度緯度成分

  real(8), allocatable ::  xva_Uans(:,:,:)           ! 速度経度成分
  real(8), allocatable ::  xva_Vans(:,:,:)           ! 速度緯度成分

  real(8), allocatable ::  xva_Psi(:,:,:)            ! 流線関数
  real(8), allocatable ::  xva_Chi(:,:,:)            ! 速度ポテンシャル

  real(8), allocatable ::  wa_Vor(:,:)               ! 渦度
  real(8), allocatable ::  wa_Div(:,:)               ! 発散

  real(8), allocatable ::  xva_Vorans(:,:,:)         ! 渦度
  real(8), allocatable ::  xva_Divans(:,:,:)         ! 発散


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

  integer :: iproc, np, ierr
  integer :: k

  call MessageNotify('M','wa_base_mpi_module_vector_sjpack_test', &
                         'wa_base_mpi_module_sjpack subroutine tests')

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

  call wa_mpi_Initial( nm, im, jm, km )

  allocate(xva_U(0:im-1,jc,km))
  allocate(xva_V(0:im-1,jc,km))
  allocate(xva_UCosLat(0:im-1,jc,km))
  allocate(xva_VCosLat(0:im-1,jc,km))
  allocate(xva_Uans(0:im-1,jc,km))
  allocate(xva_Vans(0:im-1,jc,km))
  allocate(xva_Psi(0:im-1,jc,km))
  allocate(xva_Chi(0:im-1,jc,km))
  allocate(xva_Vorans(0:im-1,jc,km))
  allocate(xva_Divans(0:im-1,jc,km))

  allocate(wa_Vor((nm+1)**2,km))
  allocate(wa_Div((nm+1)**2,km))

  xva_Psi(:,:,1) = cos(xv_Lat)*sin(xv_Lon)       ! Y_1^{-1}
  xva_Chi(:,:,1) = 0.0D0

  xva_Uans(:,:,1) = sin(xv_Lat)*sin(xv_Lon)
  xva_Vans(:,:,1) = cos(xv_Lon)

  xva_Vorans(:,:,1) = -2*cos(xv_Lat)*sin(xv_Lon)
  xva_Divans(:,:,1) = 0.0D0

  xva_Psi(:,:,2) = 0.0D0
  xva_Chi(:,:,2) = cos(xv_Lat)*sin(xv_Lon)       ! Y_1^{-1}

  xva_Uans(:,:,2) = cos(xv_Lon)
  xva_Vans(:,:,2) = - sin(xv_Lat)*sin(xv_Lon)

  xva_Vorans(:,:,2) = 0.0D0
  xva_Divans(:,:,2) = -2*cos(xv_Lat)*sin(xv_Lon)

  xva_Psi(:,:,3) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1
  xva_Chi(:,:,3) = 0.0D0

  xva_Uans(:,:,3) = - cos(2*xv_Lat)*cos(xv_Lon)
  xva_Vans(:,:,3) = - sin(xv_Lat)*sin(xv_Lon)

  xva_Vorans(:,:,3) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1
  xva_Divans(:,:,3) = 0.0D0

  xva_Psi(:,:,4) = 0.0D0
  xva_Chi(:,:,4) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1

  xva_Uans(:,:,4) = - sin(xv_Lat)*sin(xv_Lon)
  xva_Vans(:,:,4) =   cos(2*xv_Lat)*cos(xv_Lon)

  xva_Vorans(:,:,4) = 0.0D0
  xva_Divans(:,:,4) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1

  xva_Psi(:,:,5) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1
  xva_Chi(:,:,5) = cos(xv_Lat)*sin(xv_Lon)                     ! Y_1^{-1}

  xva_Uans(:,:,5) = - cos(2*xv_Lat)*cos(xv_Lon) + cos(xv_Lon)
  xva_Vans(:,:,5) = - sin(xv_Lat)*sin(xv_Lon) - sin(xv_Lat)*sin(xv_Lon)

  xva_Vorans(:,:,5) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1
  xva_Divans(:,:,5) = -2*cos(xv_Lat)*sin(xv_Lon)                     ! Y_1^{-1}

  xva_Psi(:,:,6) = cos(xv_Lat)*sin(xv_Lon)                     ! Y_1^{-1}
  xva_Chi(:,:,6) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1

  xva_Uans(:,:,6) = 0.0D0
  xva_Vans(:,:,6) = cos(2*xv_Lat)*cos(xv_Lon) + cos(xv_Lon)

  xva_Vorans(:,:,6) = -2*cos(xv_Lat)*sin(xv_Lon)                     ! Y_1^{-1}
  xva_Divans(:,:,6) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon)       ! Y_2^1

  call wa_StreamPotential2VectorMPI &
       ( wa_xva(xva_Psi), wa_xva(xva_Chi), xva_U, xva_V )

  call AssertEqual(&
    message='Test of wa_StreamPotential2VectorMPI(U)',            &
    answer = xva_Uans,                                            &
    check  = xva_U,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wa_StreamPotential2VectorMPI(V)',            &
    answer = xva_Vans,                                            &
    check  = xva_V,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call wa_Vector2VorDivMPI( xva_U, xva_V, wa_Vor, wa_Div )

  call AssertEqual(&
    message='Test of wa_Vector2VorDivMPI(Vor)',                   &
    answer = xva_Vorans,                                          &
    check  = xva_wa(wa_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wa_Vector2VorDivMPI(Div)',                   &
    answer = xva_Divans,                                          &
    check  = xva_wa(wa_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do k=1,km
     xva_UCosLat(:,:,k) = xva_U(:,:,k) * cos(xv_Lat)
     xva_VCosLat(:,:,k) = xva_V(:,:,k) * cos(xv_Lat)
  enddo

  call wa_VectorCosLat2VorDivMPI( xva_UCosLat, xva_VCosLat, wa_Vor, wa_Div )

  call AssertEqual(&
    message='Test of wa_VectorCosLat2VorDivMPI(Vor)',             &
    answer = xva_Vorans,                                          &
    check  = xva_wa(wa_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wa_VectorCosLat2VorDivMPI(Div)',             &
    answer = xva_Divans,                                          &
    check  = xva_wa(wa_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call MessageNotify('M','wa_base_mpi_module_vector sjpack_test', &
                         'wa_base_mpi_module_sjpack subroutine tests succeeded!')

 !------ MPIの終了 ------

  call MPI_FINALIZE(IERR)

end program wa_mpi_module_sjpack_base_vector_test
