!---------------------------------------------------------------------- ! 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