!----------------------------------------------------------------------
!     Copyright (c) 2020 Shin-ichi Takehiro. All rights reserved.
!----------------------------------------------------------------------
!
!表題  wb_base_mpi_module_sypack テストプログラム :: ベクトル用サブルーチンのテスト
!
!履歴  2020/08/05  竹広真一
!
program ua_base_mpi_module_sypack_vector_test_wb

  use dc_message, only : MessageNotify
  use dc_test, only : AssertEqual
  use ua_mpi_module

  use mpi
  implicit none

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

  real(8), allocatable ::  pva_U(:,:,:)              ! 速度経度成分
  real(8), allocatable ::  pva_V(:,:,:)              ! 速度緯度成分

  real(8), allocatable ::  pva_UCosLat(:,:,:)        ! 速度経度成分
  real(8), allocatable ::  pva_VCosLat(:,:,:)        ! 速度緯度成分

  real(8), allocatable ::  pva_Uans(:,:,:)           ! 速度経度成分
  real(8), allocatable ::  pva_Vans(:,:,:)           ! 速度緯度成分

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

  real(8), allocatable ::  wb_Vor(:,:)               ! 渦度
  real(8), allocatable ::  wb_Div(:,:)               ! 発散

  real(8), allocatable ::  pva_Vorans(:,:,:)         ! 渦度
  real(8), allocatable ::  pva_Divans(:,:,:)         ! 発散


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

  integer :: ip, np, ierr
  integer :: k

  call MessageNotify('M','wb_base_mpi_module_vector_sypack_test', &
                         'wb_base_mpi_module_sypack subroutine 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 ua_mpi_Initial( nm, im, jm, km, npv=2 )

  allocate(pva_U(ic,jc,km))
  allocate(pva_V(ic,jc,km))
  allocate(pva_UCosLat(ic,jc,km))
  allocate(pva_VCosLat(ic,jc,km))
  allocate(pva_Uans(ic,jc,km))
  allocate(pva_Vans(ic,jc,km))
  allocate(pva_Psi(ic,jc,km))
  allocate(pva_Chi(ic,jc,km))
  allocate(pva_Vorans(ic,jc,km))
  allocate(pva_Divans(ic,jc,km))

  allocate(wb_Vor(nc,kc))
  allocate(wb_Div(nc,kc))

  pva_Psi(:,:,1) = cos(pv_Lat)*sin(pv_Lon)       ! Y_1^{-1}
  pva_Chi(:,:,1) = 0.0D0

  pva_Uans(:,:,1) = sin(pv_Lat)*sin(pv_Lon)
  pva_Vans(:,:,1) = cos(pv_Lon)

  pva_Vorans(:,:,1) = -2*cos(pv_Lat)*sin(pv_Lon)
  pva_Divans(:,:,1) = 0.0D0

  pva_Psi(:,:,2) = 0.0D0
  pva_Chi(:,:,2) = cos(pv_Lat)*sin(pv_Lon)       ! Y_1^{-1}

  pva_Uans(:,:,2) = cos(pv_Lon)
  pva_Vans(:,:,2) = - sin(pv_Lat)*sin(pv_Lon)

  pva_Vorans(:,:,2) = 0.0D0
  pva_Divans(:,:,2) = -2*cos(pv_Lat)*sin(pv_Lon)

  pva_Psi(:,:,3) = sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon)       ! Y_2^1
  pva_Chi(:,:,3) = 0.0D0

  pva_Uans(:,:,3) = - cos(2*pv_Lat)*cos(pv_Lon)
  pva_Vans(:,:,3) = - sin(pv_Lat)*sin(pv_Lon)

  pva_Vorans(:,:,3) = -6*sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon) ! Y_2^1
  pva_Divans(:,:,3) = 0.0D0

  pva_Psi(:,:,4) = 0.0D0
  pva_Chi(:,:,4) = sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon)       ! Y_2^1

  pva_Uans(:,:,4) = - sin(pv_Lat)*sin(pv_Lon)
  pva_Vans(:,:,4) =   cos(2*pv_Lat)*cos(pv_Lon)

  pva_Vorans(:,:,4) = 0.0D0
  pva_Divans(:,:,4) = -6*sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon) ! Y_2^1

  pva_Psi(:,:,5) = sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon)       ! Y_2^1
  pva_Chi(:,:,5) = cos(pv_Lat)*sin(pv_Lon)                     ! Y_1^{-1}

  pva_Uans(:,:,5) = - cos(2*pv_Lat)*cos(pv_Lon) + cos(pv_Lon)
  pva_Vans(:,:,5) = - sin(pv_Lat)*sin(pv_Lon) - sin(pv_Lat)*sin(pv_Lon)

  pva_Vorans(:,:,5) = -6*sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon) ! Y_2^1
  pva_Divans(:,:,5) = -2*cos(pv_Lat)*sin(pv_Lon)            ! Y_1^{-1}

  pva_Psi(:,:,6) = cos(pv_Lat)*sin(pv_Lon)                ! Y_1^{-1}
  pva_Chi(:,:,6) = sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon)  ! Y_2^1

  pva_Uans(:,:,6) = 0.0D0
  pva_Vans(:,:,6) = cos(2*pv_Lat)*cos(pv_Lon) + cos(pv_Lon)

  pva_Vorans(:,:,6) = -2*cos(pv_Lat)*sin(pv_Lon)            ! Y_1^{-1}
  pva_Divans(:,:,6) = -6*sin(pv_Lat)*cos(pv_Lat) * cos(pv_Lon) ! Y_2^1

  call wb_StreamPotential2VectorMPI &
       ( wb_pva(pva_Psi), wb_pva(pva_Chi), pva_U, pva_V )

  call AssertEqual(&
    message='Test of wb_StreamPotential2VectorMPI(U)',            &
    answer = pva_Uans,                                            &
    check  = pva_U,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wb_StreamPotential2VectorMPI(V)',            &
    answer = pva_Vans,                                            &
    check  = pva_V,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call wb_Vector2VorDivMPI( pva_U, pva_V, wb_Vor, wb_Div )

  call AssertEqual(&
    message='Test of wb_Vector2VorDivMPI(Vor)',                   &
    answer = pva_Vorans,                                          &
    check  = pva_wb(wb_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wb_Vector2VorDivMPI(Div)',                   &
    answer = pva_Divans,                                          &
    check  = pva_wb(wb_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do k=1,km
     pva_UCosLat(:,:,k) = pva_U(:,:,k) * cos(pv_Lat)
     pva_VCosLat(:,:,k) = pva_V(:,:,k) * cos(pv_Lat)
  enddo

  call wb_VectorCosLat2VorDivMPI( pva_UCosLat, pva_VCosLat, wb_Vor, wb_Div )

  call AssertEqual(&
    message='Test of wb_VectorCosLat2VorDivMPI(Vor)',             &
    answer = pva_Vorans,                                          &
    check  = pva_wb(wb_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wb_VectorCosLat2VorDivMPI(Div)',             &
    answer = pva_Divans,                                          &
    check  = pva_wb(wb_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call MessageNotify('M','wb_base_mpi_module_vector sypack_test', &
                         'wb_base_mpi_module_sypack subroutine tests succeeded!')

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

  call MPI_FINALIZE(IERR)

end program ua_base_mpi_module_sypack_vector_test_wb
