!---------------------------------------------------------------------- ! Copyright (c) 2019-2020 Shin-ichi Takehiro. All rights reserved. !---------------------------------------------------------------------- ! !表題 ua_deriv_mpi_module テストプログラム :: 微分関数のテスト ! !履歴 2019/08/04 竹広真一 ! 2020/11/10 竹広真一 セクター計算オプション導入 ! program ua_mpi_module_deriv_mint_test use dc_message, only : MessageNotify use dc_test, only : AssertEqual use ua_mpi_module_mint use mpi implicit none !!$ integer, parameter :: im=64, jm=32, nm=21, km=2, npv=2, mint=1 integer, parameter :: im=32, jm=32, nm=21, km=2, npv=2, mint=2 real(8), allocatable :: pva_data1(:,:,:) ! 元の関数 real(8), allocatable :: pva_data2(:,:,:) ! 元の関数 real(8), allocatable :: pva_ddata(:,:,:) ! 微分の正解 real(8), allocatable :: pv_data1(:,:) ! 元の関数 real(8), allocatable :: pv_data2(:,:) ! 元の関数 real(8), allocatable :: pv_ddata(:,:) ! 微分の正解 real(8), allocatable :: pv_mu(:,:) ! μ=sinφ ! 判定誤差設定 integer, parameter :: check_digits = 10 integer, parameter :: ignore = -11 integer :: ip, np, ierr !---------------- MPI スタート --------------------- call MPI_INIT(IERR) call MPI_COMM_RANK(MPI_COMM_WORLD,IP,IERR) call MPI_COMM_SIZE(MPI_COMM_WORLD,NP,IERR) call MessageNotify('M','ua_deriv_mpi_module_mint_test', & 'ua_mpi_module_mint function deriv tests') call ua_mpi_Initial( nm, im, jm, km, npv=npv, mint=mint ) allocate(pva_data1(0:ic-1,jc,km)) allocate(pva_data2(0:ic-1,jc,km)) allocate(pva_ddata(0:ic-1,jc,km)) allocate(pv_data1(0:ic-1,jc)) allocate(pv_data2(0:ic-1,jc)) allocate(pv_ddata(0:ic-1,jc)) allocate(pv_mu(0:ic-1,jc)) !============== 微分計算 (lon,lat座標系用) のテスト ============== !---- Y_1^0 Y_2^2 のテスト ---- pva_data1(:,:,1) = sin(pv_Lat) ! Y_1^0 pva_data1(:,:,2) = cos(pv_Lat)**2*cos(2*pv_Lon) ! Y_2^2 pva_ddata(:,:,1) = -2*sin(pv_Lat) ! ua_Lapla_ua pva_ddata(:,:,2) = -6*cos(pv_Lat)**2*cos(2*pv_Lon) ! ua_Lapla_ua call AssertEqual(& message='ua_Lapla_ua with Y_1^0 and Y^2_2', & answer = pva_ua(ua_Lapla_ua(ua_pva(pva_data1))), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = -1.0/2.0*sin(pv_Lat) ! ua_LaplaInv_ua pva_ddata(:,:,2) = -1.0D0/6.0D0*cos(pv_Lat)**2*cos(2*pv_Lon) call AssertEqual(& message='ua_LaplaInv_ua with Y_1^0 and Y^2_2', & answer = pva_ua(ua_LaplaInv_ua(ua_pva(pva_data1))), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = 0.0D0 ! ua_DLon_ua pva_ddata(:,:,2) = cos(pv_Lat)**2*(-2)*sin(2*pv_Lon) call AssertEqual(& message='ua_DLon_ua with Y_1^0 and Y^2_2', & answer = pva_ua(ua_DLon_ua(ua_pva(pva_data1))), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = 0.0D0 ! pva_GradLon_ua pva_ddata(:,:,2) = cos(pv_Lat)*(-2)*sin(2*pv_Lon) call AssertEqual(& message='pva_GradLon_ua with Y_1^0 and Y^2_2', & answer = pva_GradLon_ua(ua_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = cos(pv_Lat) ! pva_GradLat_ua pva_ddata(:,:,2) = (-2)*cos(pv_Lat)*sin(pv_Lat)*cos(2*pv_Lon) call AssertEqual(& message='pva_GradLat_ua with Y_1^0 and Y^2_2', & answer = pva_GradLat_ua(ua_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = sin(pv_Lat) ! Y_1^0 pv_ddata = -2*sin(pv_Lat) ! u_Lapla_u call AssertEqual(& message='u_Lapla_u with Y_1^0', & answer = pv_u(u_Lapla_u(u_pv(pv_data1))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = -1.0/2.0*sin(pv_Lat) ! u_LaplaInv_u call AssertEqual(& message='u_LaplaInv_u with Y_1^0', & answer = pv_u(u_LaplaInv_u(u_pv(pv_data1))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = cos(pv_Lat) ! pv_GradLat_u call AssertEqual(& message='pv_GradLat_u with Y_1^0', & answer = pv_GradLat_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = cos(pv_Lat)**2*cos(2*pv_Lon) ! Y_2^2 pv_ddata = -6*cos(pv_Lat)**2*cos(2*pv_Lon) ! a_Lapla_u call AssertEqual(& message='u_Lapla_u with Y_2^2', & answer = pv_u(u_Lapla_u(u_pv(pv_data1))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = -1.0D0/6.0D0*cos(pv_Lat)**2*cos(2*pv_Lon) ! u_LaplaInv_u call AssertEqual(& message='u_LaplaInv_u with Y_2^2', & answer = pv_u(u_LaplaInv_u(u_pv(pv_data1))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = (-2)*cos(pv_Lat)*sin(pv_Lat)*cos(2*pv_Lon) ! pv_GradLat_u call AssertEqual(& message='pv_GradLat_u with Y_2^2', & answer = pv_GradLat_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) !---- Y_1^0 cosφ, Y_2^2 cosφ のテスト ---- pva_data1(:,:,1) = sin(pv_Lat)*cos(pv_Lat) ! Y_1^0 cosφ pva_data1(:,:,2) = cos(pv_Lat)**3*cos(2*pv_Lon) ! Y_2^2 cosφ pva_ddata(:,:,1) = 0.0D0 ! ua_DivLon_pv pva_ddata(:,:,2) = cos(pv_Lat)**2*(-2)*sin(2*pv_Lon) ! ua_DivLon_pv call AssertEqual(& message='ua_DivLon_pva with Y_1^0 cosφ and Y^2_2 cosφ', & answer = pva_ua(ua_DivLon_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = cos(pv_Lat)**2 - 2*sin(pv_Lat)**2 !ua_DivLat_ua pva_ddata(:,:,2) = (-4)*cos(pv_Lat)**2*sin(pv_Lat)*cos(2*pv_Lon) !ua_DivLat_ua call AssertEqual(& message='ua_DivLat_pva with Y_1^0 cosφ and Y^2_2 cosφ', & answer = pva_ua(ua_DivLat_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = sin(pv_Lat)*cos(pv_Lat) ! Y_1^0 cosφ pv_ddata = 0.0D0 ! u_DivLon_pv call Assertequal(& message='u_DivLon_pv with Y_1^0 cosφ', & answer = pv_u(u_DivLon_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = cos(pv_Lat)**2 - 2*sin(pv_Lat)**2 !u_DivLat_u call Assertequal(& message='u_DivLat_pv with Y_1^0 cosφ', & answer = pv_u(u_DivLat_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = cos(pv_Lat)**3*cos(2*pv_Lon) ! Y_2^2 cosφ pv_ddata = cos(pv_Lat)**2*(-2)*sin(2*pv_Lon) ! u_DivLon_pv call Assertequal(& message='u_DivLon_pv with Y^2_2 cosφ', & answer = pv_u(u_DivLon_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = (-4)*cos(pv_Lat)**2*sin(pv_Lat)*cos(2*pv_Lon) !u_DivLat_u call Assertequal(& message='u_DivLat_pv with Y^2_2 cosφ', & answer = pv_u(u_DivLat_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) !---- Jacobian のテスト ---- pva_data1(:,:,1) = sin(pv_Lat) ! Y_1^0 pva_data1(:,:,2) = sin(pv_Lat) ! Y_1^0 pva_data2(:,:,1) = 3.0D0/2.0D0*sin(pv_Lat)**2-1.0D0/2.0D0 ! Y_2^0 pva_data2(:,:,2) = cos(pv_Lat)**2 * cos(2*pv_Lon) ! Y_2^2 pva_ddata(:,:,1) = 0.0 pva_ddata(:,:,2) = -cos(pv_Lat)**2*(-2)*sin(2*pv_Lon) call AssertEqual(& message='ua_JacobianMPI_ua_ua Y_1^0 and Y^2_*', & answer = pva_ua(ua_JacobianMPI_ua_ua(ua_pva(pva_data1),ua_pva(pva_data2))), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = cos(pv_Lat)**2 * cos(2*pv_Lon) ! Y_2^2 pv_data2 = cos(pv_Lat)**2 * cos(2*pv_Lon) ! Y_2^2 pv_ddata = 0.0D0 call AssertEqual(& message='u_JacobianMPI_u_u with Y^2_2', & answer = pv_u(u_JacobianMPI_u_u(u_pv(pv_data1),u_pv(pv_data2))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = sin(pv_Lat) ! Y_1^0 pv_data2 = cos(pv_Lat)**2*sin(2*pv_Lon) ! Y_2^-2 pv_ddata = -cos(pv_Lat)**2*2*cos(2*pv_Lon) call AssertEqual(& message='u_JacobianMPI_u_u with Y_1^0 and Y_2^-2', & answer = pv_u(u_JacobianMPI_u_u(u_pv(pv_data1),u_pv(pv_data2))), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) !============== 微分計算 (λ,μ座標系用) のテスト ============== pv_mu = sin(pv_Lat) !----- Y_2^0, Y_1^1 のテスト ----- pva_data1(:,:,1) = 3*pv_mu**2-1 ! Y_2^0 pva_data1(:,:,2) = -(1-pv_mu**2)*sin(2*pv_Lon) ! Y_2^-2 pva_ddata(:,:,1) = 0.0D0 pva_ddata(:,:,2) = -(1-pv_mu**2)*2*cos(2*pv_Lon) call AssertEqual(& message='pva_GradLambda_ua with Y_2^0 and Y^2_-2', & answer = pva_GradLambda_ua(ua_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = 6*pv_mu*(1-pv_mu**2) pva_ddata(:,:,2) = 2*pv_mu*(1-pv_mu**2)*sin(2*pv_Lon) call AssertEqual(& message='pva_GradMu_ua with Y_2^0 and Y^2_-2', & answer = pva_GradMu_ua(ua_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = 3*pv_mu**2-1 ! Y_2^0 pv_ddata = 0.0 call AssertEqual(& message='pv_GradLambda_u with Y_2^0', & answer = pv_GradLambda_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = 6*pv_mu*(1-pv_mu**2) call AssertEqual(& message='pv_GradMu_u with Y_2^0', & answer = pv_GradMu_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = (1-pv_mu**2)*cos(2*pv_Lon) ! Y_2^2 pv_ddata = -(1-pv_mu**2)*2*sin(2*pv_Lon) call AssertEqual(& message='pv_GradLambda_u with Y^2_2', & answer = pv_GradLambda_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = -2*pv_mu*(1-pv_mu**2)*cos(2*pv_Lon) call AssertEqual(& message='pv_GradMu_u with Y_2^2', & answer = pv_GradMu_u(u_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) !----- Y_2^0(1-μ^2), Y_1^1 (1-μ^2) のテスト ----- pva_data1(:,:,1) = (3*pv_mu**2-1)*(1-pv_mu**2) ! Y_2^0 (1-μ^2) pva_data1(:,:,2) = (1-pv_mu**2)**2*sin(2*pv_Lon) ! Y_2^-2 (1-μ^2) pva_ddata(:,:,1) = 0.0 pva_ddata(:,:,2) = (1-pv_mu**2)*2*cos(2*pv_Lon) call AssertEqual(& message='ua_DivLambda_pva with Y_2^0 (1-μ^2) and Y^2_-2 (1-μ^2)',& answer = pva_ua(ua_DivLambda_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pva_ddata(:,:,1) = (2-3*pv_mu**2)*4*pv_mu pva_ddata(:,:,2) = 2*(1-pv_mu**2)*(-2)*pv_mu*sin(2*pv_Lon) call AssertEqual(& message='ua_DivMu_pva with Y_2^0 (1-μ^2) and Y^2_-2(1-μ^2)', & answer = pva_ua(ua_DivMu_pva(pva_data1)), & check = pva_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = (3*pv_mu**2-1)*(1-pv_mu**2) ! Y_2^0 (1-μ^2) pv_ddata = 0.0 call AssertEqual(& message='u_DivLambda_pv with Y_2^0 (1-μ^2)', & answer = pv_u(u_DivLambda_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = (2-3*pv_mu**2)*4*pv_mu call AssertEqual(& message='u_DivMu_pv with Y_2^0 (1-μ^2)', & answer = pv_u(u_DivMu_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_data1 = (1-pv_mu**2)**2*cos(2*pv_Lon) ! Y_2^2 (1-μ^2) pv_ddata = (1-pv_mu**2)*(-2)*sin(2*pv_Lon) call AssertEqual(& message='u_DivLambda_pv with Y^2_2 (1-μ^2)', & answer = pv_u(u_DivLambda_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) pv_ddata = 2*(1-pv_mu**2)*(-2)*pv_mu*cos(2*pv_Lon) call AssertEqual(& message='u_DivMu_pv with Y^2_2 (1-μ^2)', & answer = pv_u(u_DivMu_pv(pv_data1)), & check = pv_ddata, & significant_digits = check_digits, ignore_digits = ignore & ) call MessageNotify('M','ua_mpi_module_deriv_test', & 'ua_mpi_module_mint deriv function tests succeeded!') !------ MPIの終了 ------ call MPI_FINALIZE(IERR) end program ua_mpi_module_deriv_mint_test