!---------------------------------------------------------------------- ! Copyright (c) 2013 Shin-ichi Takehiro. All rights reserved. !---------------------------------------------------------------------- ! !表題 wa_base_mpi_module テストプログラム :: ベクトル用サブルーチンのテスト ! !履歴 2013/02/15 竹広真一 ! program wa_base_mpi_module_vector_test use dc_message, only : MessageNotify use dc_test, only : AssertEqual use wa_mpi_module use mpi implicit none integer, parameter :: im=128, jm=64, nm=42, km=6 real(8), allocatable :: xva_U(:,:,:) ! 速度経度成分 real(8), allocatable :: xva_V(:,:,:) ! 速度緯度成分 real(8), allocatable :: xva_UCosLat(:,:,:) ! 速度経度成分 real(8), allocatable :: xva_VCosLat(:,:,:) ! 速度緯度成分 real(8), allocatable :: xva_Uans(:,:,:) ! 速度経度成分 real(8), allocatable :: xva_Vans(:,:,:) ! 速度緯度成分 real(8), allocatable :: xva_Psi(:,:,:) ! 流線関数 real(8), allocatable :: xva_Chi(:,:,:) ! 速度ポテンシャル real(8), allocatable :: wa_Vor(:,:) ! 渦度 real(8), allocatable :: wa_Div(:,:) ! 発散 real(8), allocatable :: xva_Vorans(:,:,:) ! 渦度 real(8), allocatable :: xva_Divans(:,:,:) ! 発散 ! 判定誤差設定 integer, parameter :: check_digits = 9 integer, parameter :: ignore = -10 integer :: iproc, np, ierr integer :: k call MessageNotify('M','wa_base_mpi_module_vector_test', & 'wa_base_mpi_module 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 wa_mpi_Initial( nm, im, jm, km ) allocate(xva_U(0:im-1,jc,km)) allocate(xva_V(0:im-1,jc,km)) allocate(xva_UCosLat(0:im-1,jc,km)) allocate(xva_VCosLat(0:im-1,jc,km)) allocate(xva_Uans(0:im-1,jc,km)) allocate(xva_Vans(0:im-1,jc,km)) allocate(xva_Psi(0:im-1,jc,km)) allocate(xva_Chi(0:im-1,jc,km)) allocate(xva_Vorans(0:im-1,jc,km)) allocate(xva_Divans(0:im-1,jc,km)) allocate(wa_Vor((nm+1)**2,km)) allocate(wa_Div((nm+1)**2,km)) xva_Psi(:,:,1) = cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Chi(:,:,1) = 0.0D0 xva_Uans(:,:,1) = sin(xv_Lat)*sin(xv_Lon) xva_Vans(:,:,1) = cos(xv_Lon) xva_Vorans(:,:,1) = -2*cos(xv_Lat)*sin(xv_Lon) xva_Divans(:,:,1) = 0.0D0 xva_Psi(:,:,2) = 0.0D0 xva_Chi(:,:,2) = cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Uans(:,:,2) = cos(xv_Lon) xva_Vans(:,:,2) = - sin(xv_Lat)*sin(xv_Lon) xva_Vorans(:,:,2) = 0.0D0 xva_Divans(:,:,2) = -2*cos(xv_Lat)*sin(xv_Lon) xva_Psi(:,:,3) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Chi(:,:,3) = 0.0D0 xva_Uans(:,:,3) = - cos(2*xv_Lat)*cos(xv_Lon) xva_Vans(:,:,3) = - sin(xv_Lat)*sin(xv_Lon) xva_Vorans(:,:,3) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Divans(:,:,3) = 0.0D0 xva_Psi(:,:,4) = 0.0D0 xva_Chi(:,:,4) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Uans(:,:,4) = - sin(xv_Lat)*sin(xv_Lon) xva_Vans(:,:,4) = cos(2*xv_Lat)*cos(xv_Lon) xva_Vorans(:,:,4) = 0.0D0 xva_Divans(:,:,4) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Psi(:,:,5) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Chi(:,:,5) = cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Uans(:,:,5) = - cos(2*xv_Lat)*cos(xv_Lon) + cos(xv_Lon) xva_Vans(:,:,5) = - sin(xv_Lat)*sin(xv_Lon) - sin(xv_Lat)*sin(xv_Lon) xva_Vorans(:,:,5) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Divans(:,:,5) = -2*cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Psi(:,:,6) = cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Chi(:,:,6) = sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 xva_Uans(:,:,6) = 0.0D0 xva_Vans(:,:,6) = cos(2*xv_Lat)*cos(xv_Lon) + cos(xv_Lon) xva_Vorans(:,:,6) = -2*cos(xv_Lat)*sin(xv_Lon) ! Y_1^{-1} xva_Divans(:,:,6) = -6*sin(xv_Lat)*cos(xv_Lat) * cos(xv_Lon) ! Y_2^1 call wa_StreamPotential2VectorMPI & ( wa_xva(xva_Psi), wa_xva(xva_Chi), xva_U, xva_V ) call AssertEqual(& message='Test of wa_StreamPotential2VectorMPI(U)', & answer = xva_Uans, & check = xva_U, & significant_digits = check_digits, ignore_digits = ignore & ) call AssertEqual(& message='Test of wa_StreamPotential2VectorMPI(V)', & answer = xva_Vans, & check = xva_V, & significant_digits = check_digits, ignore_digits = ignore & ) call wa_Vector2VorDivMPI( xva_U, xva_V, wa_Vor, wa_Div ) call AssertEqual(& message='Test of wa_Vector2VorDivMPI(Vor)', & answer = xva_Vorans, & check = xva_wa(wa_Vor), & significant_digits = check_digits, ignore_digits = ignore & ) call AssertEqual(& message='Test of wa_Vector2VorDivMPI(Div)', & answer = xva_Divans, & check = xva_wa(wa_Div), & significant_digits = check_digits, ignore_digits = ignore & ) do k=1,km xva_UCosLat(:,:,k) = xva_U(:,:,k) * cos(xv_Lat) xva_VCosLat(:,:,k) = xva_V(:,:,k) * cos(xv_Lat) enddo call wa_VectorCosLat2VorDivMPI( xva_UCosLat, xva_VCosLat, wa_Vor, wa_Div ) call AssertEqual(& message='Test of wa_VectorCosLat2VorDivMPI(Vor)', & answer = xva_Vorans, & check = xva_wa(wa_Vor), & significant_digits = check_digits, ignore_digits = ignore & ) call AssertEqual(& message='Test of wa_VectorCosLat2VorDivMPI(Div)', & answer = xva_Divans, & check = xva_wa(wa_Div), & significant_digits = check_digits, ignore_digits = ignore & ) call MessageNotify('M','wa_base_mpi_module_vector sjpack_test', & 'wa_base_mpi_module subroutine tests succeeded!') !------ MPIの終了 ------ call MPI_FINALIZE(IERR) end program wa_base_mpi_module_vector_test