!----------------------------------------------------------------------
!     Copyright (c) 2009 Shin-ichi Takehiro. All rights reserved.
!----------------------------------------------------------------------
!
!表題  w_module_sjpack テストプログラム :: 微分関数のテスト
!
!履歴  2009/09/22  竹広真一
!
program w_module_sjpack_deriv_test

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

  integer, parameter :: im=2, jm=16, nm=10, m=1

  real(8), dimension(0:im-1,1:jm)  ::  xy_data1              ! 元の関数
  real(8), dimension(0:im-1,1:jm)  ::  xy_ddata              ! 微分の正解
  real(8), dimension(0:im-1,1:jm)  ::  xy_mu                 ! μ=sinφ

  ! 判定誤差設定
  integer, parameter :: check_digits = 11
  integer, parameter :: ignore = -12

  integer :: j

  call MessageNotify('M','w_wave_module_sjpack_deriv_test', &
                         'w_wave_module_sjpack tests of derivative functions') 

  call w_Initial( nm, m, im, jm )

  !============== 微分計算 (φ座標系用) のテスト ==============

  !---- P_1^1 のテスト ----
  xy_data1 = sqrt(3.0D0/2.0D0)*cos(xy_Lat)      ! P_1^1

  xy_ddata = -2*sqrt(3.0D0/2.0D0)*cos(xy_Lat)   ! w_Lapla_w
  call AssertEqual(&
    message='P_1^1 Test of w_Lapla_w',                          &
    answer = xy_ddata,                                          &
    check = xy_w(w_Lapla_w(w_xy(xy_data1))),                    &
    significant_digits = check_digits, ignore_digits = ignore   &
    )

  xy_ddata = -0.5*sqrt(3.0D0/2.0D0)*cos(xy_Lat)      ! w_LaplaInv_l
  call AssertEqual(&
    message='P_1^1 Test of w_LaplaInv_w',                       &
    answer = xy_ddata,                                          &
    check = xy_w(w_LaplaInv_w(w_xy(xy_data1))),                 &
    significant_digits = check_digits, ignore_digits = ignore   &
    )

  do j=1,jm
     xy_ddata(0,j) = - m*sqrt(3.0D0/2.0D0)*cos(y_Lat(j))    ! w_DLon_w
     xy_ddata(1,j) =   m*sqrt(3.0D0/2.0D0)*cos(y_Lat(j))
  enddo
  call AssertEqual(&
    message='P_1^1 Test of w_DLon_w',                           &
    answer = xy_ddata,                                            &
    check = xy_w(w_DLon_w(w_xy(xy_data1))),                   &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do j=1,jm
     xy_ddata(0,j) = -m * sqrt(3.0D0/2.0D0)    ! xy_GradLon_w
     xy_ddata(1,j) =  m * sqrt(3.0D0/2.0D0)
  enddo
  call AssertEqual(&
    message='P_1^1 Test of xy_GradLon_w',                        &
    answer = xy_ddata,                                           &
    check = xy_GradLon_w(w_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore    &
    )

  xy_ddata = -sqrt(3.0D0/2.0D0)*sin(xy_Lat)          ! xy_GradLat_w
  call AssertEqual(&
    message='P_1^1 Test of xy_GradLat_w',                        &
    answer = xy_ddata,                                           &
    check = xy_GradLat_w(w_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore    &
    )

  !---- P_1^1 cosφ のテスト ----
  xy_data1 = sqrt(3.0D0/2.0D0)*cos(xy_Lat)*cos(xy_Lat)         ! P_1^1 cosφ

  do j=1,jm
     xy_ddata(0,j) = -m * sqrt(3.0D0/2.0D0)*cos(y_Lat(j))      ! w_DivLat_xy
     xy_ddata(1,j) =  m * sqrt(3.0D0/2.0D0)*cos(y_Lat(j)) 
  enddo
  call AssertEqual(&
    message='P_1^1 cos(phi) Test of w_DivLon_xy',               &
    answer = xy_ddata,                                          &
    check = xy_w(w_DivLon_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore   &
    )

  xy_ddata = -3*sqrt(3.0D0/2.0D0)*cos(xy_Lat)*sin(xy_Lat)      ! xy_DivLat_xy
  call AssertEqual(&
    message='P_1^1 cos(phi) Test of w_DivLat_xy',               &
    answer = xy_ddata,                                          &
    check = xy_w(w_DivLat_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore   &
    )

  !---- P_2^1 のテスト ----
  xy_data1 = sqrt(5.0D0/6.0D0)*(3*sin(xy_Lat)*cos(xy_Lat))  ! P_2^1

  xy_ddata = -6*xy_data1                                    ! w_Lapla_w
  call AssertEqual(&
    message='P_2^1 Test of w_Lapla_w',                            &
    answer = xy_ddata,                                            &
    check = xy_w(w_Lapla_w(w_xy(xy_data1))),                      &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  xy_ddata = -xy_data1/6.0D0                                ! w_Lapla_w
  call AssertEqual(&
    message='P_2^1 Test of w_LaplaInv_w',                         &
    answer = xy_ddata,                                            &
    check = xy_w(w_LaplaInv_w(w_xy(xy_data1))),                   &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  do j=1,jm
     xy_ddata(0,j) = -m*sqrt(5.0D0/6.0D0)*(3*sin(y_Lat(j))*cos(y_Lat(j))) ! w_DLon_w
     xy_ddata(1,j) =  m*sqrt(5.0D0/6.0D0)*(3*sin(y_Lat(j))*cos(y_Lat(j)))
  enddo
  call AssertEqual(&
    message='P_2^1 Test of w_DLon_w',                           &
    answer = xy_ddata,                                          &
    check = xy_w(w_DLon_w(w_xy(xy_data1))),                     &
    significant_digits = check_digits, ignore_digits = ignore   &
    )

  do j=1,jm
     xy_ddata(0,j) = -m*sqrt(5.0D0/6.0D0)*3*sin(y_Lat(j))    ! xy_GradLon_w
     xy_ddata(1,j) =  m*sqrt(5.0D0/6.0D0)*3*sin(y_Lat(j)) 
  enddo
  call AssertEqual(&
    message='P_2^1 Test of xy_GradLon_w',                        &
    answer = xy_ddata,                                           &
    check = xy_GradLon_w(w_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore    &
    )

  xy_ddata = sqrt(5.0D0/6.0D0)*3.0*cos(2*xy_Lat)           ! xy_GradLat_w
  call AssertEqual(&
    message='P_2^1 Test of xy_GradLat_w',                        &
    answer = xy_ddata,                                           &
    check = xy_GradLat_w(w_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore    &
    )

  !---- P_2^1 cosφ のテスト ----
  xy_data1 = sqrt(5.0D0/6.0D0)*(3*sin(xy_Lat)*cos(xy_Lat))*cos(xy_Lat) !   P_2^1 cosφ

  do j=1,jm
     xy_ddata(0,j) = -m*sqrt(5.0D0/6.0D0)*(3*sin(y_Lat(j))*cos(y_Lat(j)))  ! w_DivLat_xy
     xy_ddata(1,j) =  m*sqrt(5.0D0/6.0D0)*(3*sin(y_Lat(j))*cos(y_Lat(j))) 
  enddo
  call AssertEqual(&
    message='P_2^1 cos(phi) Test of w_DivLon_xy',                &
    answer = xy_ddata,                                            &
    check = xy_w(w_DivLon_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  xy_ddata = sqrt(5.0D0/6.0D0)*(3.0*(cos(xy_Lat)**3-3*sin(xy_Lat)**2*cos(xy_Lat)))
                                                               ! w_DivLat_xy
  call AssertEqual(&
    message='P_2^1 cos(phi) Test of w_DivLat_xy',                  &
    answer = xy_ddata,                                            &
    check = xy_w(w_DivLat_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  !============== 微分計算 (μ座標系用) のテスト ==============
  xy_mu = sin(xy_Lat)

  !----- P_2^1 のテスト -----
  xy_data1 = xy_mu*sqrt(1-xy_mu**2)                       ! P_2^1
  xy_ddata = sqrt(1-xy_mu**2)*(1-2*xy_mu**2)              ! (1-μ^2)∂/∂μ 

  call AssertEqual(&
    message='P_2^1 Test of xy_GradMu_w',                           &
    answer = xy_ddata,                                            &
    check = xy_GradMu_w(w_xy(xy_data1)),                        &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  !----- P_2^1 (1-μ^2) のテスト -----
  xy_data1 = xy_mu*sqrt(1-xy_mu**2)*(1-xy_mu**2)          ! P_2^1 (1-μ^2)
  xy_ddata = (1-4*xy_mu**2)*sqrt(1-xy_mu**2)              ! ∂/∂μ

  call AssertEqual(&
    message='P_2^1 (1-mu^2) Test of xy_DivMu_w',                  &
    answer = xy_ddata,                                            &
    check = xy_w(w_DivMu_xy(xy_data1)),                           &
    significant_digits = check_digits, ignore_digits = ignore     &
    )

  call MessageNotify('M','w_module_sjpack_deriv_test', &
       'w_module_sjpack tests of derivative functions succeeded!') 

end program w_module_sjpack_deriv_test
