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

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

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

  real(8), allocatable ::  xyb_U(:,:,:)              ! 速度経度成分
  real(8), allocatable ::  xyb_V(:,:,:)              ! 速度緯度成分

  real(8), allocatable ::  xyb_UCosLat(:,:,:)        ! 速度経度成分
  real(8), allocatable ::  xyb_VCosLat(:,:,:)        ! 速度緯度成分

  real(8), allocatable ::  xyb_Uans(:,:,:)           ! 速度経度成分
  real(8), allocatable ::  xyb_Vans(:,:,:)           ! 速度緯度成分

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

  real(8), allocatable ::  ua_Vor(:,:)               ! 渦度
  real(8), allocatable ::  ua_Div(:,:)               ! 発散

  real(8), allocatable ::  xyb_Vorans(:,:,:)         ! 渦度
  real(8), allocatable ::  xyb_Divans(:,:,:)         ! 発散


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

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

  call MessageNotify('M','ua_base_mpi_module_vector_svpack_test', &
                         'ua_base_mpi_module_svpack 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 ua_mpi_Initial( nm, im, jm, km )
  
  allocate(xyb_U(0:im-1,jm,kc))
  allocate(xyb_V(0:im-1,jm,kc))
  allocate(xyb_UCosLat(0:im-1,jm,kc))
  allocate(xyb_VCosLat(0:im-1,jm,kc))
  allocate(xyb_Uans(0:im-1,jm,kc))
  allocate(xyb_Vans(0:im-1,jm,kc))
  allocate(xyb_Psi(0:im-1,jm,kc))
  allocate(xyb_Chi(0:im-1,jm,kc))
  allocate(xyb_Vorans(0:im-1,jm,kc))
  allocate(xyb_Divans(0:im-1,jm,kc))

  allocate(ua_Vor(nc,km))
  allocate(ua_Div(nc,km))

  if ( kp_kl(1) /= 0 ) then
     xyb_Psi(:,:,kp_kl(1)) = cos(xy_Lat)*sin(xy_Lon)       ! Y_1^{-1}
     xyb_Chi(:,:,kp_kl(1)) = 0.0D0
  
     xyb_Uans(:,:,kp_kl(1)) = sin(xy_Lat)*sin(xy_Lon)
     xyb_Vans(:,:,kp_kl(1)) = cos(xy_Lon)

     xyb_Vorans(:,:,kp_kl(1)) = -2*cos(xy_Lat)*sin(xy_Lon)
     xyb_Divans(:,:,kp_kl(1)) = 0.0D0
  endif
     
  if ( kp_kl(2) /= 0 ) then
     xyb_Psi(:,:,kp_kl(2)) = 0.0D0
     xyb_Chi(:,:,kp_kl(2)) = cos(xy_Lat)*sin(xy_Lon)       ! Y_1^{-1}

     xyb_Uans(:,:,kp_kl(2)) = cos(xy_Lon)
     xyb_Vans(:,:,kp_kl(2)) = - sin(xy_Lat)*sin(xy_Lon)

     xyb_Vorans(:,:,kp_kl(2)) = 0.0D0
     xyb_Divans(:,:,kp_kl(2)) = -2*cos(xy_Lat)*sin(xy_Lon)
  endif
     
  if ( kp_kl(3) /= 0 ) then
     xyb_Psi(:,:,kp_kl(3)) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
     xyb_Chi(:,:,kp_kl(3)) = 0.0D0

     xyb_Uans(:,:,kp_kl(3)) = - cos(2*xy_Lat)*cos(xy_Lon)
     xyb_Vans(:,:,kp_kl(3)) = - sin(xy_Lat)*sin(xy_Lon)

     xyb_Vorans(:,:,kp_kl(3)) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon) ! Y_2^1
     xyb_Divans(:,:,kp_kl(3)) = 0.0D0
  endif
     
  if ( kp_kl(4) /= 0 ) then
     xyb_Psi(:,:,kp_kl(4)) = 0.0D0
     xyb_Chi(:,:,kp_kl(4)) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1

     xyb_Uans(:,:,kp_kl(4)) = - sin(xy_Lat)*sin(xy_Lon)
     xyb_Vans(:,:,kp_kl(4)) =   cos(2*xy_Lat)*cos(xy_Lon)
  
     xyb_Vorans(:,:,kp_kl(4)) = 0.0D0
     xyb_Divans(:,:,kp_kl(4)) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon) ! Y_2^1
  endif

  if ( kp_kl(5) /= 0 ) then
     xyb_Psi(:,:,kp_kl(5)) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
     xyb_Chi(:,:,kp_kl(5)) = cos(xy_Lat)*sin(xy_Lon)                     ! Y_1^{-1}

     xyb_Uans(:,:,kp_kl(5)) = - cos(2*xy_Lat)*cos(xy_Lon) + cos(xy_Lon)
     xyb_Vans(:,:,kp_kl(5)) = - sin(xy_Lat)*sin(xy_Lon) - sin(xy_Lat)*sin(xy_Lon)

     xyb_Vorans(:,:,kp_kl(5)) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon) ! Y_2^1
     xyb_Divans(:,:,kp_kl(5)) = -2*cos(xy_Lat)*sin(xy_Lon)            ! Y_1^{-1}
  endif
     
  if ( kp_kl(6) /= 0 ) then
     xyb_Psi(:,:,kp_kl(6)) = cos(xy_Lat)*sin(xy_Lon)                ! Y_1^{-1}
     xyb_Chi(:,:,kp_kl(6)) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)  ! Y_2^1

     xyb_Uans(:,:,kp_kl(6)) = 0.0D0
     xyb_Vans(:,:,kp_kl(6)) = cos(2*xy_Lat)*cos(xy_Lon) + cos(xy_Lon)

     xyb_Vorans(:,:,kp_kl(6)) = -2*cos(xy_Lat)*sin(xy_Lon)            ! Y_1^{-1}
     xyb_Divans(:,:,kp_kl(6)) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon) ! Y_2^1
  endif

  call ua_StreamPotential2VectorMPI &
       ( ua_xyb(xyb_Psi), ua_xyb(xyb_Chi), xyb_U, xyb_V )

  call AssertEqual(&
    message='Test of ua_StreamPotential2VectorMPI(U)',            &
    answer = xyb_Uans,                                            &
    check  = xyb_U,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of ua_StreamPotential2VectorMPI(V)',            &
    answer = xyb_Vans,                                            &
    check  = xyb_V,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call ua_Vector2VorDivMPI( xyb_U, xyb_V, ua_Vor, ua_Div )

  call AssertEqual(&
    message='Test of ua_Vector2VorDivMPI(Vor)',                   &
    answer = xyb_Vorans,                                          &
    check  = xyb_ua(ua_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of ua_Vector2VorDivMPI(Div)',                   &
    answer = xyb_Divans,                                          &
    check  = xyb_ua(ua_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do k=1,kc
     xyb_UCosLat(:,:,k) = xyb_U(:,:,k) * cos(xy_Lat)
     xyb_VCosLat(:,:,k) = xyb_V(:,:,k) * cos(xy_Lat)
  enddo

  call ua_VectorCosLat2VorDivMPI( xyb_UCosLat, xyb_VCosLat, ua_Vor, ua_Div )

  call AssertEqual(&
    message='Test of ua_VectorCosLat2VorDivMPI(Vor)',             &
    answer = xyb_Vorans,                                          &
    check  = xyb_ua(ua_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of ua_VectorCosLat2VorDivMPI(Div)',             &
    answer = xyb_Divans,                                          &
    check  = xyb_ua(ua_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call MessageNotify('M','ua_base_mpi_module_vector svpack_test', &
                         'ua_base_mpi_module_svpack subroutine tests succeeded!') 

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

  call MPI_FINALIZE(IERR)

end program ua_base_mpi_module_svpack_vector_test
