From 2dfe3ac6603791c2ca1e3cb64ddf0b299116e0bc Mon Sep 17 00:00:00 2001 From: Hiroaki Matsui Date: Fri, 20 Dec 2024 14:42:44 -0800 Subject: [PATCH] Remove old radius_1d_rj_r and a_r_1d_rj_r set routines --- .../copy_sph_1d_global_index.f90 | 11 +------ .../SPH_SHELL_src/init_sph_trans.f90 | 2 +- .../parallel_load_data_4_sph.f90 | 7 ++++- .../SPH_SHELL_src/set_params_sph_trans.f90 | 8 ++--- .../SPH_SPECTR_src/copy_sph_rj_mode_4_IO.f90 | 29 +++++++----------- .../SPH_SPECTR_src/m_spheric_constants.f90 | 1 + .../set_radial_grid_sph_shell.f90 | 24 ++++++++++----- .../set_radius_4_sph_dynamo.f90 | 30 +++++++++---------- .../SPH_SPECTR_src/t_spheric_rj_data.f90 | 23 ++++++++++++++ .../Rayleigh_link/t_convert_from_rayleigh.f90 | 13 ++------ 10 files changed, 76 insertions(+), 72 deletions(-) diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/copy_sph_1d_global_index.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/copy_sph_1d_global_index.f90 index 96d6bcdd..6ac429cd 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/copy_sph_1d_global_index.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/copy_sph_1d_global_index.f90 @@ -200,16 +200,7 @@ subroutine copy_sph_1d_gl_idx_rj & sph_rj%radius_1d_rj_r(i) = s3d_radius%radius_1d_gl(j) end do ! -!$omp parallel do private(i) - do i = 1, sph_rj%nidx_rj(1) - sph_rj%a_r_1d_rj_r(i) = one / sph_rj%radius_1d_rj_r(i) - sph_rj%ar_1d_rj(i,1) = sph_rj%a_r_1d_rj_r(i) - sph_rj%ar_1d_rj(i,2) = sph_rj%ar_1d_rj(i,1) & - & * sph_rj%a_r_1d_rj_r(i) - sph_rj%ar_1d_rj(i,3) = sph_rj%ar_1d_rj(i,2) & - & * sph_rj%a_r_1d_rj_r(i) - end do -!$omp end parallel do + call set_sph_one_over_radius_rj(sph_rj) ! end subroutine copy_sph_1d_gl_idx_rj ! diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/init_sph_trans.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/init_sph_trans.f90 index 3dc84962..48b38b00 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/init_sph_trans.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/init_sph_trans.f90 @@ -115,7 +115,7 @@ subroutine initialize_legendre_trans & & (sph%sph_rtm%nidx_rtm, sph%sph_rlm%nidx_rlm, idx_trns) ! call radial_4_sph_trans & - & (sph%sph_rtp, sph%sph_rtm, sph%sph_rlm, sph%sph_rj) + & (sph%sph_rtp, sph%sph_rtm, sph%sph_rlm) call set_mdx_rlm_rtm(sph%sph_params%l_truncation, & & sph%sph_rtm%nidx_rtm, sph%sph_rlm%nidx_rlm, & & sph%sph_rtm%idx_gl_1d_rtm_m, sph%sph_rlm%idx_gl_1d_rlm_j, & diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/parallel_load_data_4_sph.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/parallel_load_data_4_sph.f90 index 608cb378..c9e28c03 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/parallel_load_data_4_sph.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/parallel_load_data_4_sph.f90 @@ -300,6 +300,7 @@ end subroutine sph_rj_index_flags_and_params subroutine set_radius_dat_sph_MHD & & (radial_rj_grp, sph_params, sph_rj) ! + use m_spheric_constants use set_radius_4_sph_dynamo ! type(group_data), intent(in) :: radial_rj_grp @@ -315,9 +316,13 @@ subroutine set_radius_dat_sph_MHD & & (sph_rj%nidx_rj(1), sph_rj%radius_1d_rj_r, radial_rj_grp, & & sph_params%iflag_radial_grid, sph_params%nlayer_ICB, & & sph_params%nlayer_CMB, sph_params%nlayer_2_center, & - & sph_rj%ar_1d_rj, sph_rj%r_ele_rj, sph_rj%ar_ele_rj, & + & sph_rj%r_ele_rj, sph_rj%ar_ele_rj, & & sph_params%radius_ICB, sph_params%radius_CMB, & & sph_params%R_earth) + if(sph_params%iflag_radial_grid .eq. igrid_error) then + call calypso_mpi_abort(ierr_sph, & + & 'Numbedr of radial layers are 0 or negative!') + end if ! end subroutine set_radius_dat_sph_MHD ! diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_params_sph_trans.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_params_sph_trans.f90 index 7d6e42c9..79c76a90 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_params_sph_trans.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_params_sph_trans.f90 @@ -23,11 +23,10 @@ !! & (nidx_rtm, idx_gl_1d_mphi, mn_rlm) !! subroutine set_sin_theta_rtm & !! & (nth_rtm, g_colat_rtm, asin_theta_1d_rtm) -!! subroutine radial_4_sph_trans(sph_rtp, sph_rtm, sph_rlm, sph_rj) +!! subroutine radial_4_sph_trans(sph_rtp, sph_rtm, sph_rlm) !! type(sph_rtp_grid), intent(inout) :: sph_rtp !! type(sph_rtm_grid), intent(inout) :: sph_rtm !! type(sph_rlm_grid), intent(inout) :: sph_rlm -!! type(sph_rj_grid), intent(inout) :: sph_rj !!@endverbatim ! module set_params_sph_trans @@ -245,14 +244,13 @@ end subroutine set_sin_theta_rtp ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine radial_4_sph_trans(sph_rtp, sph_rtm, sph_rlm, sph_rj) + subroutine radial_4_sph_trans(sph_rtp, sph_rtm, sph_rlm) ! use t_spheric_parameter ! type(sph_rtp_grid), intent(inout) :: sph_rtp type(sph_rtm_grid), intent(inout) :: sph_rtm type(sph_rlm_grid), intent(inout) :: sph_rlm - type(sph_rj_grid), intent(inout) :: sph_rj ! ! !$omp parallel workshare @@ -262,8 +260,6 @@ subroutine radial_4_sph_trans(sph_rtp, sph_rtm, sph_rlm, sph_rj) & = one / sph_rtm%radius_1d_rtm_r(1:sph_rtm%nidx_rtm(1)) sph_rlm%a_r_1d_rlm_r(1:sph_rlm%nidx_rlm(1)) & & = one / sph_rlm%radius_1d_rlm_r(1:sph_rlm%nidx_rlm(1)) - sph_rj%a_r_1d_rj_r(1:sph_rj%nidx_rj(1)) & - & = one / sph_rj%radius_1d_rj_r(1:sph_rj%nidx_rj(1)) !$omp end parallel workshare ! end subroutine radial_4_sph_trans diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/copy_sph_rj_mode_4_IO.f90 b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/copy_sph_rj_mode_4_IO.f90 index 1273d3db..1a0532da 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/copy_sph_rj_mode_4_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/copy_sph_rj_mode_4_IO.f90 @@ -66,25 +66,6 @@ subroutine copy_sph_node_4_rj_from_IO(sph_IO, sph_rj, & & = sph_IO%idx_gl_sph(1:sph_rj%nnod_rj,i) end do ! -!$omp parallel workshare - sph_rj%idx_gl_1d_rj_r(1:sph_rj%nidx_rj(1)) & - & = sph_IO%idx_gl_1(1:sph_rj%nidx_rj(1)) -! - sph_rj%radius_1d_rj_r(1:sph_rj%nidx_rj(1)) & - & = sph_IO%r_gl_1(1:sph_rj%nidx_rj(1)) - sph_rj%a_r_1d_rj_r(1:sph_rj%nidx_rj(1)) & - & = one / sph_rj%radius_1d_rj_r(1:sph_rj%nidx_rj(1)) -! - sph_rj%ar_1d_rj(1:sph_rj%nidx_rj(1),1) & - & = sph_rj%a_r_1d_rj_r(1:sph_rj%nidx_rj(1)) - sph_rj%ar_1d_rj(1:sph_rj%nidx_rj(1),2) & - & = sph_rj%ar_1d_rj(1:sph_rj%nidx_rj(1),1) & - & * sph_rj%a_r_1d_rj_r(1:sph_rj%nidx_rj(1)) - sph_rj%ar_1d_rj(1:sph_rj%nidx_rj(1),3) & - & = sph_rj%ar_1d_rj(1:sph_rj%nidx_rj(1),2) & - & * sph_rj%a_r_1d_rj_r(1:sph_rj%nidx_rj(1)) -!$omp end parallel workshare -! !$omp parallel workshare sph_rj%idx_gl_1d_rj_j(1:sph_rj%nidx_rj(2),1) & & = sph_IO%idx_gl_2(1:sph_rj%nidx_rj(2),1) @@ -93,6 +74,16 @@ subroutine copy_sph_node_4_rj_from_IO(sph_IO, sph_rj, & sph_rj%idx_gl_1d_rj_j(1:sph_rj%nidx_rj(2),3) & & = sph_IO%idx_gl_2(1:sph_rj%nidx_rj(2),3) !$omp end parallel workshare +! +!$omp parallel workshare + sph_rj%idx_gl_1d_rj_r(1:sph_rj%nidx_rj(1)) & + & = sph_IO%idx_gl_1(1:sph_rj%nidx_rj(1)) +! + sph_rj%radius_1d_rj_r(1:sph_rj%nidx_rj(1)) & + & = sph_IO%r_gl_1(1:sph_rj%nidx_rj(1)) +!$omp end parallel workshare +! + call set_sph_one_over_radius_rj(sph_rj) ! end subroutine copy_sph_node_4_rj_from_IO ! diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/m_spheric_constants.f90 b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/m_spheric_constants.f90 index 2c41fb8b..fa007db5 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/m_spheric_constants.f90 +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/m_spheric_constants.f90 @@ -21,6 +21,7 @@ module m_spheric_constants ! use m_precision ! + integer(kind = kint), parameter :: igrid_error = -999 integer(kind = kint), parameter :: igrid_half_Chebyshev = 3 integer(kind = kint), parameter :: igrid_Chebyshev = 2 integer(kind = kint), parameter :: igrid_non_equidist = 1 diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radial_grid_sph_shell.f90 b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radial_grid_sph_shell.f90 index 5af87980..18cf568e 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radial_grid_sph_shell.f90 +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radial_grid_sph_shell.f90 @@ -114,24 +114,32 @@ subroutine set_radial_distance_flag(num_layer, nlayer_ICB, & ! real(kind = kreal), allocatable :: r_eq(:), r_ch(:), r_hch(:) ! + if(num_layer .le. 0) then + iflag_rgrid = igrid_error + return + end if ! allocate( r_eq(num_layer) ) allocate( r_ch(num_layer) ) allocate( r_hch(num_layer) ) ! - call set_equi_distance_shell(num_layer, nlayer_ICB, nlayer_CMB, & - & r_ICB, r_CMB, r_eq) + r_eq(1:num_layer) = 0.0d0 + r_ch(1:num_layer) = 0.0d0 + r_hch(1:num_layer) = 0.0d0 +! + call set_equi_distance_shell(num_layer, nlayer_ICB, & + & nlayer_CMB, r_ICB, r_CMB, r_eq) call set_chebyshev_distance_shell(num_layer, nlayer_ICB, & - & nlayer_CMB, r_ICB, r_CMB, r_ch) + & nlayer_CMB, r_ICB, r_CMB, r_ch) call half_chebyshev_distance_shell(num_layer, nlayer_CMB, & - & r_CMB, r_hch) + & r_CMB, r_hch) ! ! - diff_eq_max = abs( r_grid(1) - r_eq(1)) / r_eq(1) - diff_ch_max = abs( r_grid(1) - r_ch(1)) / r_ch(1) - diff_hch_max = abs( r_grid(1) - r_hch(1)) / r_hch(1) + diff_eq_max = 0.0d0 + diff_ch_max = 0.0d0 + diff_hch_max = 0.0d0 ! - do k = 2, num_layer + do k = 1, num_layer diff = abs( r_grid(k) - r_eq(k)) / r_eq(k) diff_eq_max = max(diff_eq_max,diff) ! diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radius_4_sph_dynamo.f90 b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radius_4_sph_dynamo.f90 index d3b0ee27..45947ac5 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radius_4_sph_dynamo.f90 +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/set_radius_4_sph_dynamo.f90 @@ -13,15 +13,19 @@ !! subroutine set_radius_dat_4_sph_dynamo & !! & (nri, radius_1d_rj_r, radial_rj_grp, iflag_radial_grid,& !! & nlayer_ICB, nlayer_CMB, nlayer_2_center, & -!! & ar_1d_rj, r_ele_rj, ar_ele_rj, r_ICB, r_CMB, R_earth) +!! & r_ele_rj, ar_ele_rj, r_ICB, r_CMB, R_earth) !! type(group_data), intent(in) :: radial_rj_grp -!!*********************************************************************** -!!* -!!* ar_1d_rj(k,1) : 1 / r -!!* ar_1d_rj(k,2) : 1 / r**2 -!!* ar_1d_rj(k,3) : 1 / r**3 -!!* -!!*********************************************************************** +!! integer(kind = kint), intent(in) :: nri +!! real(kind = kreal), intent(in) :: radius_1d_rj_r(nri) +!! +!! integer(kind = kint), intent(inout) :: iflag_radial_grid +!! integer(kind = kint), intent(inout) :: nlayer_ICB +!! integer(kind = kint), intent(inout) :: nlayer_CMB +!! integer(kind = kint), intent(inout) :: nlayer_2_center +!! real(kind = kreal), intent(inout) :: r_ele_rj(nri) +!! real(kind = kreal), intent(inout) :: ar_ele_rj(nri,3) +!! real(kind = kreal), intent(inout) :: R_earth(0:2) +!! real(kind = kreal), intent(inout) :: r_ICB, r_CMB !!@endverbatim ! ! @@ -47,7 +51,7 @@ module set_radius_4_sph_dynamo subroutine set_radius_dat_4_sph_dynamo & & (nri, radius_1d_rj_r, radial_rj_grp, iflag_radial_grid, & & nlayer_ICB, nlayer_CMB, nlayer_2_center, & - & ar_1d_rj, r_ele_rj, ar_ele_rj, r_ICB, r_CMB, R_earth) + & r_ele_rj, ar_ele_rj, r_ICB, r_CMB, R_earth) ! use set_radial_grid_sph_shell use skip_comment_f @@ -61,7 +65,6 @@ subroutine set_radius_dat_4_sph_dynamo & integer(kind = kint), intent(inout) :: nlayer_ICB integer(kind = kint), intent(inout) :: nlayer_CMB integer(kind = kint), intent(inout) :: nlayer_2_center - real(kind = kreal), intent(inout) :: ar_1d_rj(nri,3) real(kind = kreal), intent(inout) :: r_ele_rj(nri) real(kind = kreal), intent(inout) :: ar_ele_rj(nri,3) real(kind = kreal), intent(inout) :: R_earth(0:2) @@ -97,13 +100,8 @@ subroutine set_radius_dat_4_sph_dynamo & ! call set_radial_distance_flag(nri, nlayer_ICB, nlayer_CMB, & & r_ICB, r_CMB, radius_1d_rj_r, iflag_radial_grid) + if(iflag_radial_grid .eq. igrid_error) return ! -! - do k = 1, nri - ar_1d_rj(k,1) = one / radius_1d_rj_r(k) - ar_1d_rj(k,2) = ar_1d_rj(k,1)**2 - ar_1d_rj(k,3) = ar_1d_rj(k,1)**3 - end do ! r_ele_rj(1) = half * radius_1d_rj_r(1) do k = 2, nri diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/t_spheric_rj_data.f90 b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/t_spheric_rj_data.f90 index 19dcb652..565281ff 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/t_spheric_rj_data.f90 +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/t_spheric_rj_data.f90 @@ -17,6 +17,8 @@ !! subroutine dealloc_rj_param_smp(sph_rj) !! type(sph_rj_grid), intent(inout) :: sph_rj !! +!! subroutine set_sph_one_over_radius_rj(sph_rj) +!! type(sph_rj_grid), intent(inout) :: sph_rj !! subroutine copy_spheric_rj_data & !! & (ltr_org, rj_org, ltr_new, rj_new) !! type(sph_rj_grid), intent(in) :: rj_org @@ -228,6 +230,27 @@ end subroutine dealloc_rj_param_smp ! ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- +! + subroutine set_sph_one_over_radius_rj(sph_rj) +! + type(sph_rj_grid), intent(inout) :: sph_rj +! + integer(kind = kint) :: i +! +!$omp parallel do private(i) + do i = 1, sph_rj%nidx_rj(1) + sph_rj%a_r_1d_rj_r(i) = one / sph_rj%radius_1d_rj_r(i) + sph_rj%ar_1d_rj(i,1) = sph_rj%a_r_1d_rj_r(i) + sph_rj%ar_1d_rj(i,2) = sph_rj%ar_1d_rj(i,1) & + & * sph_rj%a_r_1d_rj_r(i) + sph_rj%ar_1d_rj(i,3) = sph_rj%ar_1d_rj(i,2) & + & * sph_rj%a_r_1d_rj_r(i) + end do +!$omp end parallel do +! + end subroutine set_sph_one_over_radius_rj +! +! ----------------------------------------------------------------------- ! subroutine copy_spheric_rj_data & & (ltr_org, rj_org, ltr_new, rj_new) diff --git a/src/programs/data_utilities/Rayleigh_link/t_convert_from_rayleigh.f90 b/src/programs/data_utilities/Rayleigh_link/t_convert_from_rayleigh.f90 index 048348ef..7acabfa5 100644 --- a/src/programs/data_utilities/Rayleigh_link/t_convert_from_rayleigh.f90 +++ b/src/programs/data_utilities/Rayleigh_link/t_convert_from_rayleigh.f90 @@ -192,17 +192,8 @@ subroutine copy_rayleigh_radial_data(ra_rst, org_sph) org_sph%sph_rj%radius_1d_rj_r(k) = ra_rst%r_org(kr) end do !$omp end parallel do -!$omp parallel do private(k) - do k = 1, org_sph%sph_rj%nidx_rj(1) - org_sph%sph_rj%a_r_1d_rj_r(k) & - & = one / org_sph%sph_rj%radius_1d_rj_r(k) - org_sph%sph_rj%ar_1d_rj(k,1) = org_sph%sph_rj%a_r_1d_rj_r(k) - org_sph%sph_rj%ar_1d_rj(k,2) = org_sph%sph_rj%ar_1d_rj(k,1) & - & * org_sph%sph_rj%a_r_1d_rj_r(k) - org_sph%sph_rj%ar_1d_rj(k,3) = org_sph%sph_rj%ar_1d_rj(k,2) & - & * org_sph%sph_rj%a_r_1d_rj_r(k) - end do -!$omp end parallel do +! + call set_sph_one_over_radius_rj(sph_rj) ! end subroutine copy_rayleigh_radial_data !