!----------------------------------------------------------------------
!     Copyright (c) 2013 Shin-ichi Takehiro. All rights reserved.
!----------------------------------------------------------------------
!
!表題  wa_base_module テストプログラム :: ベクトル用サブルーチンのテスト
!
!履歴  2013/02/14  竹広真一
!      2013/02/18  佐々木洋平 check_digit を一桁緩和
!
program wa_base_module_vector_test

  use dc_message, only : MessageNotify
  use dc_test, only : AssertEqual
  use wa_module
  implicit none

  integer, parameter :: im=128, jm=64, km=6, nm=42
!!$  integer, parameter :: im=32, jm=16, km=6, nm=10

  real(8), dimension(0:im-1,1:jm,km)  ::  xya_U              ! 速度経度成分
  real(8), dimension(0:im-1,1:jm,km)  ::  xya_V              ! 速度緯度成分

  real(8), dimension(0:im-1,1:jm,km)  ::  xya_UCosLat        ! 速度経度成分
  real(8), dimension(0:im-1,1:jm,km)  ::  xya_VCosLat        ! 速度緯度成分

  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Uans           ! 速度経度成分
  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Vans           ! 速度緯度成分

  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Psi            ! 流線関数
  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Chi            ! 速度ポテンシャル

  real(8), dimension((nm+1)**2,km)    ::  wa_Vor             ! 渦度
  real(8), dimension((nm+1)**2,km)    ::  wa_Div             ! 発散

  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Vorans         ! 渦度
  real(8), dimension(0:im-1,1:jm,km)  ::  xya_Divans         ! 発散


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

  integer :: k

  call MessageNotify('M','wa_base_module_vector_test', &
                         'wa_base_module subroutine tests') 

  call wa_Initial( nm, im, jm, km )

  xya_Psi(:,:,1) = cos(xy_Lat)*sin(xy_Lon)       ! Y_1^{-1}
  xya_Chi(:,:,1) = 0.0D0

  xya_Uans(:,:,1) = sin(xy_Lat)*sin(xy_Lon)
  xya_Vans(:,:,1) = cos(xy_Lon)

  xya_Vorans(:,:,1) = -2*cos(xy_Lat)*sin(xy_Lon)
  xya_Divans(:,:,1) = 0.0D0

  xya_Psi(:,:,2) = 0.0D0
  xya_Chi(:,:,2) = cos(xy_Lat)*sin(xy_Lon)       ! Y_1^{-1}

  xya_Uans(:,:,2) = cos(xy_Lon)
  xya_Vans(:,:,2) = - sin(xy_Lat)*sin(xy_Lon)

  xya_Vorans(:,:,2) = 0.0D0
  xya_Divans(:,:,2) = -2*cos(xy_Lat)*sin(xy_Lon)

  xya_Psi(:,:,3) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
  xya_Chi(:,:,3) = 0.0D0

  xya_Uans(:,:,3) = - cos(2*xy_Lat)*cos(xy_Lon)
  xya_Vans(:,:,3) = - sin(xy_Lat)*sin(xy_Lon)

  xya_Vorans(:,:,3) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
  xya_Divans(:,:,3) = 0.0D0

  xya_Psi(:,:,4) = 0.0D0
  xya_Chi(:,:,4) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1

  xya_Uans(:,:,4) = - sin(xy_Lat)*sin(xy_Lon)
  xya_Vans(:,:,4) =   cos(2*xy_Lat)*cos(xy_Lon)

  xya_Vorans(:,:,4) = 0.0D0
  xya_Divans(:,:,4) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1

  xya_Psi(:,:,5) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
  xya_Chi(:,:,5) = cos(xy_Lat)*sin(xy_Lon)                     ! Y_1^{-1}

  xya_Uans(:,:,5) = - cos(2*xy_Lat)*cos(xy_Lon) + cos(xy_Lon)
  xya_Vans(:,:,5) = - sin(xy_Lat)*sin(xy_Lon) - sin(xy_Lat)*sin(xy_Lon)

  xya_Vorans(:,:,5) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1
  xya_Divans(:,:,5) = -2*cos(xy_Lat)*sin(xy_Lon)                     ! Y_1^{-1}

  xya_Psi(:,:,6) = cos(xy_Lat)*sin(xy_Lon)                     ! Y_1^{-1}
  xya_Chi(:,:,6) = sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1

  xya_Uans(:,:,6) = 0.0D0
  xya_Vans(:,:,6) = cos(2*xy_Lat)*cos(xy_Lon) + cos(xy_Lon)

  xya_Vorans(:,:,6) = -2*cos(xy_Lat)*sin(xy_Lon)                     ! Y_1^{-1}
  xya_Divans(:,:,6) = -6*sin(xy_Lat)*cos(xy_Lat) * cos(xy_Lon)       ! Y_2^1

  call wa_StreamPotential2Vector &
       ( wa_xya(xya_Psi), wa_xya(xya_Chi), xya_U, xya_V )

  call AssertEqual(&
    message='Test of wa_StreamPotential2Vector(U)',   &
    answer = xya_Uans,                                             &
    check  = xya_U,                                                &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of wa_StreamPotential2Vector(V)',               &
    answer = xya_Vans,                                            &
    check  = xya_V,                                               &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call wa_Vector2VorDiv( xya_U, xya_V, wa_Vor, wa_Div )

  call AssertEqual(&
    message='Test of w_Vector2VorDiv(Vor)',                       &
    answer = xya_Vorans,                                          &
    check  = xya_wa(wa_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of w_Vector2VorDiv(Div)',                       &
    answer = xya_Divans,                                          &
    check  = xya_wa(wa_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do k=1,km
     xya_UCosLat(:,:,k) = xya_U(:,:,k)*cos(xy_Lat)
     xya_VCosLat(:,:,k) = xya_V(:,:,k)*cos(xy_Lat)
  enddo

  call wa_VectorCosLat2VorDiv( xya_UCosLat, xya_VCosLat, wa_Vor, wa_Div )

  call AssertEqual(&
    message='Test of w_VectorCosLat2VorDiv(Vor)',                 &
    answer = xya_Vorans,                                          &
    check  = xya_wa(wa_Vor),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )
  call AssertEqual(&
    message='Test of w_VectorCosLat2VorDiv(Div)',                 &
    answer = xya_Divans,                                          &
    check  = xya_wa(wa_Div),                                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )


  call MessageNotify('M','wa_base_module_vector_test', &
                         'wa_base_module subroutine tests succeeded!') 

end program wa_base_module_vector_test