Skip to content

Commit

Permalink
Remove radial_4_sph_trans
Browse files Browse the repository at this point in the history
  • Loading branch information
@hiromatsui
hiromatsui committed Dec 23, 2024
1 parent 06ceb96 commit 466668f
Show file tree
Hide file tree
Showing 6 changed files with 112 additions and 104 deletions.
2 changes: 1 addition & 1 deletion src/Fortran_libraries/MHD_src/sph_MHD/cal_energy_flux_rtp.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -214,7 +214,7 @@ subroutine cal_magnetic_fluxes_rtp &
if(fe_trns_frc%i_mag_stretch .gt. 0) then
call cal_rtp_magnetic_streach &
& (sph_rtp%nnod_rtp, sph_rtp%nidx_rtp(1), sph_rtp%nidx_rtp(2), &
& sph_rtp%a_r_1d_rtp_r, sph_rtp%cot_theta_1d_rtp, &
& sph_rtp%ar_1d_rtp, sph_rtp%cot_theta_1d_rtp, &
& trns_b_snap%fld_rtp(1,bs_trns_base%i_magne), &
& trns_b_snap%fld_rtp(1,bs_trns_base%i_velo), &
& trns_b_difv%fld_rtp(1,bs_trns_diff_v%i_grad_vx), &
Expand Down
1 change: 1 addition & 0 deletions src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/copy_sph_1d_global_index.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,6 +73,7 @@ subroutine copy_sph_1d_gl_idx_rtp &
j = sph_rtp%idx_gl_1d_rtp_r(i)
sph_rtp%radius_1d_rtp_r(i) = s3d_radius%radius_1d_gl(j)
end do
call set_sph_one_over_radius_rtp(sph_rtp)
!
do i = 1, sph_rtp%nidx_rtp(2)
j = i - 1 + sph_rtp%ist_rtp(2)
Expand Down
1 change: 0 additions & 1 deletion src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/init_sph_trans.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,6 @@ subroutine initialize_legendre_trans &
call alloc_work_4_sph_trans &
& (sph%sph_rtm%nidx_rtm, sph%sph_rlm%nidx_rlm, idx_trns)
!
call radial_4_sph_trans(sph%sph_rtp)
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, &
Expand Down
20 changes: 0 additions & 20 deletions src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_params_sph_trans.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,6 @@
!! & (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)
!! type(sph_rtp_grid), intent(inout) :: sph_rtp
!! type(sph_rtm_grid), intent(inout) :: sph_rtm
!!@endverbatim
!
module set_params_sph_trans
Expand Down Expand Up @@ -241,22 +238,5 @@ subroutine set_sin_theta_rtp &
end subroutine set_sin_theta_rtp
!
! -----------------------------------------------------------------------
! -----------------------------------------------------------------------
!
subroutine radial_4_sph_trans(sph_rtp)
!
use t_spheric_parameter
!
type(sph_rtp_grid), intent(inout) :: sph_rtp
!
!
!$omp parallel workshare
sph_rtp%a_r_1d_rtp_r(1:sph_rtp%nidx_rtp(1)) &
& = one / sph_rtp%radius_1d_rtp_r(1:sph_rtp%nidx_rtp(1))
!$omp end parallel workshare
!
end subroutine radial_4_sph_trans
!
! -----------------------------------------------------------------------
!
end module set_params_sph_trans
165 changes: 88 additions & 77 deletions src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/copy_sph_rtp_node_4_IO.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,18 +7,20 @@
!>@brief Copy sphectr indices structure between IO buffer
!!
!!@verbatim
!! subroutine copy_sph_node_4_rtp_from_IO(sph_IO, rtp, l_truncation)
!! subroutine copy_sph_node_4_rtp_from_IO(sph_IO, sph_rtp, &
!! & l_truncation)
!! integer(kind = kint), intent(inout) :: l_truncation
!! type(sph_rtp_grid), intent(inout) :: rtp
!! type(sph_rtp_grid), intent(inout) :: sph_rtp
!! type(sph_IO_data), intent(in) :: sph_IO
!! subroutine copy_sph_node_4_rtp_to_IO(l_truncation, rtp, sph_IO)
!! subroutine copy_sph_node_4_rtp_to_IO(l_truncation, sph_rtp, &
!! & sph_IO)
!! integer(kind = kint), intent(in) :: l_truncation
!! type(sph_rtp_grid), intent(in) :: rtp
!! type(sph_rtp_grid), intent(in) :: sph_rtp
!! type(sph_IO_data), intent(inout) :: sph_IO
!!
!! integer(kind = kint) function compare_sph_rtp_node_with_IO &
!! & (l_truncation, rtp, sph_IO)
!! type(sph_rtp_grid), intent(in) :: rtp
!! & (l_truncation, sph_rtp, sph_IO)
!! type(sph_rtp_grid), intent(in) :: sph_rtp
!! type(sph_IO_data), intent(in) :: sph_IO
!!@endverbatim
!
Expand All @@ -38,119 +40,122 @@ module copy_sph_rtp_node_4_IO
!
! ----------------------------------------------------------------------
!
subroutine copy_sph_node_4_rtp_from_IO(sph_IO, rtp, l_truncation)
subroutine copy_sph_node_4_rtp_from_IO(sph_IO, sph_rtp, &
& l_truncation)
!
integer(kind = kint), intent(inout) :: l_truncation
type(sph_rtp_grid), intent(inout) :: rtp
type(sph_rtp_grid), intent(inout) :: sph_rtp
type(sph_IO_data), intent(in) :: sph_IO
!
integer(kind = kint) :: i
!
rtp%irank_sph_rtp(1:ithree) = sph_IO%sph_rank(1:ithree)
sph_rtp%irank_sph_rtp(1:ithree) = sph_IO%sph_rank(1:ithree)
!
rtp%nidx_global_rtp(1:ithree) = sph_IO%nidx_gl_sph(1:ithree)
sph_rtp%nidx_global_rtp(1:ithree) = sph_IO%nidx_gl_sph(1:ithree)
l_truncation = sph_IO%ltr_gl
!
rtp%nnod_rtp = sph_IO%numnod_sph
rtp%nidx_rtp(1:ithree) = sph_IO%nidx_sph(1:ithree)
rtp%ist_rtp(1:ithree) = sph_IO%ist_sph(1:ithree)
rtp%ied_rtp(1:ithree) = sph_IO%ied_sph(1:ithree)
rtp%nnod_med = sph_IO%nidx_sph(1)*sph_IO%nidx_sph(2)
sph_rtp%nnod_rtp = sph_IO%numnod_sph
sph_rtp%nidx_rtp(1:ithree) = sph_IO%nidx_sph(1:ithree)
sph_rtp%ist_rtp(1:ithree) = sph_IO%ist_sph(1:ithree)
sph_rtp%ied_rtp(1:ithree) = sph_IO%ied_sph(1:ithree)
sph_rtp%nnod_med = sph_IO%nidx_sph(1)*sph_IO%nidx_sph(2)
!
call alloc_spheric_param_rtp(rtp)
call alloc_sph_1d_index_rtp(rtp)
call alloc_spheric_param_rtp(sph_rtp)
call alloc_sph_1d_index_rtp(sph_rtp)
!
do i = 1, ithree
rtp%idx_global_rtp(1:rtp%nnod_rtp,i) &
& = sph_IO%idx_gl_sph(1:rtp%nnod_rtp,i)
sph_rtp%idx_global_rtp(1:sph_rtp%nnod_rtp,i) &
& = sph_IO%idx_gl_sph(1:sph_rtp%nnod_rtp,i)
end do
!
!$omp parallel workshare
rtp%radius_1d_rtp_r(1:rtp%nidx_rtp(1)) &
& = sph_IO%r_gl_1(1:rtp%nidx_rtp(1))
rtp%idx_gl_1d_rtp_r(1:rtp%nidx_rtp(1)) &
& = sph_IO%idx_gl_1(1:rtp%nidx_rtp(1))
sph_rtp%radius_1d_rtp_r(1:sph_rtp%nidx_rtp(1)) &
& = sph_IO%r_gl_1(1:sph_rtp%nidx_rtp(1))
sph_rtp%idx_gl_1d_rtp_r(1:sph_rtp%nidx_rtp(1)) &
& = sph_IO%idx_gl_1(1:sph_rtp%nidx_rtp(1))
!$omp end parallel workshare
call set_sph_one_over_radius_rtp(sph_rtp)
!
!$omp parallel workshare
rtp%idx_gl_1d_rtp_t(1:rtp%nidx_rtp(2)) &
& = sph_IO%idx_gl_2(1:rtp%nidx_rtp(2),1)
sph_rtp%idx_gl_1d_rtp_t(1:sph_rtp%nidx_rtp(2)) &
& = sph_IO%idx_gl_2(1:sph_rtp%nidx_rtp(2),1)
!$omp end parallel workshare
!
!$omp parallel workshare
rtp%idx_gl_1d_rtp_p(1:rtp%nidx_rtp(3),1) &
& = sph_IO%idx_gl_3(1:rtp%nidx_rtp(3),1)
rtp%idx_gl_1d_rtp_p(1:rtp%nidx_rtp(3),2) &
& = sph_IO%idx_gl_3(1:rtp%nidx_rtp(3),2)
sph_rtp%idx_gl_1d_rtp_p(1:sph_rtp%nidx_rtp(3),1) &
& = sph_IO%idx_gl_3(1:sph_rtp%nidx_rtp(3),1)
sph_rtp%idx_gl_1d_rtp_p(1:sph_rtp%nidx_rtp(3),2) &
& = sph_IO%idx_gl_3(1:sph_rtp%nidx_rtp(3),2)
!$omp end parallel workshare
!
end subroutine copy_sph_node_4_rtp_from_IO
!
! ----------------------------------------------------------------------
!
subroutine copy_sph_node_4_rtp_to_IO(l_truncation, rtp, sph_IO)
subroutine copy_sph_node_4_rtp_to_IO(l_truncation, sph_rtp, &
& sph_IO)
!
integer(kind = kint), intent(in) :: l_truncation
type(sph_rtp_grid), intent(in) :: rtp
type(sph_rtp_grid), intent(in) :: sph_rtp
type(sph_IO_data), intent(inout) :: sph_IO
!
integer(kind = kint) :: i
integer(kind = kint_gl) :: nr_8, nrt8
!
!
sph_IO%numdir_sph = ithree
sph_IO%sph_rank(1:ithree) = rtp%irank_sph_rtp(1:ithree)
sph_IO%sph_rank(1:ithree) = sph_rtp%irank_sph_rtp(1:ithree)
!
sph_IO%ncomp_table_1d(1) = ione
sph_IO%ncomp_table_1d(2) = ione
sph_IO%ncomp_table_1d(3) = itwo
!
sph_IO%nidx_gl_sph(1:ithree) = rtp%nidx_global_rtp(1:ithree)
sph_IO%nidx_gl_sph(1:ithree) = sph_rtp%nidx_global_rtp(1:ithree)
sph_IO%ltr_gl = l_truncation
!
sph_IO%numnod_sph = rtp%nnod_rtp
sph_IO%numnod_sph = sph_rtp%nnod_rtp
!
call alloc_num_idx_sph_IO(sph_IO)
!
sph_IO%nidx_sph(1:ithree) = rtp%nidx_rtp(1:ithree)
sph_IO%ist_sph(1:ithree) = rtp%ist_rtp(1:ithree)
sph_IO%ied_sph(1:ithree) = rtp%ied_rtp(1:ithree)
sph_IO%nidx_sph(1:ithree) = sph_rtp%nidx_rtp(1:ithree)
sph_IO%ist_sph(1:ithree) = sph_rtp%ist_rtp(1:ithree)
sph_IO%ied_sph(1:ithree) = sph_rtp%ied_rtp(1:ithree)
!
call alloc_nod_id_sph_IO(sph_IO)
call alloc_idx_sph_1d1_IO(sph_IO)
call alloc_idx_sph_1d2_IO(sph_IO)
call alloc_idx_sph_1d3_IO(sph_IO)
!
!$omp parallel do private(i,nr_8,nrt8)
do i = 1, rtp%nnod_rtp
nr_8 = rtp%nidx_global_rtp(1)
nrt8 = rtp%nidx_global_rtp(1)*rtp%nidx_global_rtp(2)
sph_IO%idx_gl_sph(i,1) = rtp%idx_global_rtp(i,1)
sph_IO%idx_gl_sph(i,2) = rtp%idx_global_rtp(i,2)
sph_IO%idx_gl_sph(i,3) = rtp%idx_global_rtp(i,3)
sph_IO%inod_gl_sph(i) = rtp%idx_global_rtp(i,1) &
& + (rtp%idx_global_rtp(i,2) - 1) * nr_8 &
& + (rtp%idx_global_rtp(i,3) - 1) * nrt8
do i = 1, sph_rtp%nnod_rtp
nr_8 = sph_rtp%nidx_global_rtp(1)
nrt8 = sph_rtp%nidx_global_rtp(1)*sph_rtp%nidx_global_rtp(2)
sph_IO%idx_gl_sph(i,1) = sph_rtp%idx_global_rtp(i,1)
sph_IO%idx_gl_sph(i,2) = sph_rtp%idx_global_rtp(i,2)
sph_IO%idx_gl_sph(i,3) = sph_rtp%idx_global_rtp(i,3)
sph_IO%inod_gl_sph(i) = sph_rtp%idx_global_rtp(i,1) &
& + (sph_rtp%idx_global_rtp(i,2) - 1) * nr_8 &
& + (sph_rtp%idx_global_rtp(i,3) - 1) * nrt8
end do
!$omp end parallel do
!
!$omp parallel workshare
sph_IO%r_gl_1(1:rtp%nidx_rtp(1)) &
& = rtp%radius_1d_rtp_r(1:rtp%nidx_rtp(1))
sph_IO%idx_gl_1(1:rtp%nidx_rtp(1)) &
& = rtp%idx_gl_1d_rtp_r(1:rtp%nidx_rtp(1))
sph_IO%r_gl_1(1:sph_rtp%nidx_rtp(1)) &
& = sph_rtp%radius_1d_rtp_r(1:sph_rtp%nidx_rtp(1))
sph_IO%idx_gl_1(1:sph_rtp%nidx_rtp(1)) &
& = sph_rtp%idx_gl_1d_rtp_r(1:sph_rtp%nidx_rtp(1))
!$omp end parallel workshare
!
!$omp parallel workshare
sph_IO%idx_gl_2(1:rtp%nidx_rtp(2),1) &
& = rtp%idx_gl_1d_rtp_t(1:rtp%nidx_rtp(2))
sph_IO%idx_gl_2(1:sph_rtp%nidx_rtp(2),1) &
& = sph_rtp%idx_gl_1d_rtp_t(1:sph_rtp%nidx_rtp(2))
!$omp end parallel workshare
!
!$omp parallel workshare
sph_IO%idx_gl_3(1:rtp%nidx_rtp(3),1) &
& = rtp%idx_gl_1d_rtp_p(1:rtp%nidx_rtp(3),1)
sph_IO%idx_gl_3(1:rtp%nidx_rtp(3),2) &
& = rtp%idx_gl_1d_rtp_p(1:rtp%nidx_rtp(3),2)
sph_IO%idx_gl_3(1:sph_rtp%nidx_rtp(3),1) &
& = sph_rtp%idx_gl_1d_rtp_p(1:sph_rtp%nidx_rtp(3),1)
sph_IO%idx_gl_3(1:sph_rtp%nidx_rtp(3),2) &
& = sph_rtp%idx_gl_1d_rtp_p(1:sph_rtp%nidx_rtp(3),2)
!$omp end parallel workshare
!
end subroutine copy_sph_node_4_rtp_to_IO
Expand All @@ -159,55 +164,61 @@ end subroutine copy_sph_node_4_rtp_to_IO
! ----------------------------------------------------------------------
!
integer(kind = kint) function compare_sph_rtp_node_with_IO &
& (l_truncation, rtp, sph_IO)
& (l_truncation, sph_rtp, sph_IO)
!
integer(kind = kint), intent(in) :: l_truncation
type(sph_rtp_grid), intent(in) :: rtp
type(sph_rtp_grid), intent(in) :: sph_rtp
type(sph_IO_data), intent(in) :: sph_IO
!
integer(kind = kint) :: i
!
!
compare_sph_rtp_node_with_IO = 1
do i = 1, ithree
if(sph_IO%sph_rank(i) .ne. rtp%irank_sph_rtp(i)) return
if(sph_IO%sph_rank(i) .ne. sph_rtp%irank_sph_rtp(i)) return
end do
!
do i = 1, ithree
if(sph_IO%nidx_gl_sph(i) .ne. rtp%nidx_global_rtp(i)) return
if(sph_IO%nidx_gl_sph(i) &
& .ne. sph_rtp%nidx_global_rtp(i)) return
end do
if(sph_IO%ltr_gl .ne. l_truncation) return
!
if(sph_IO%numnod_sph .ne. rtp%nnod_rtp) return
if(sph_IO%numnod_sph .ne. sph_rtp%nnod_rtp) return
!
!
do i = 1, ithree
if(sph_IO%nidx_sph(i) .ne. rtp%nidx_rtp(i)) return
if(sph_IO%ist_sph(i) .ne. rtp%ist_rtp(i)) return
if(sph_IO%ied_sph(i) .ne. rtp%ied_rtp(i)) return
if(sph_IO%nidx_sph(i) .ne. sph_rtp%nidx_rtp(i)) return
if(sph_IO%ist_sph(i) .ne. sph_rtp%ist_rtp(i)) return
if(sph_IO%ied_sph(i) .ne. sph_rtp%ied_rtp(i)) return
end do
!
do i = 1, rtp%nnod_rtp
if(sph_IO%idx_gl_sph(i,1) .ne. rtp%idx_global_rtp(i,1)) return
if(sph_IO%idx_gl_sph(i,2) .ne. rtp%idx_global_rtp(i,2)) return
if(sph_IO%idx_gl_sph(i,3) .ne. rtp%idx_global_rtp(i,3)) return
do i = 1, sph_rtp%nnod_rtp
if(sph_IO%idx_gl_sph(i,1) &
& .ne. sph_rtp%idx_global_rtp(i,1)) return
if(sph_IO%idx_gl_sph(i,2) &
& .ne. sph_rtp%idx_global_rtp(i,2)) return
if(sph_IO%idx_gl_sph(i,3) &
& .ne. sph_rtp%idx_global_rtp(i,3)) return
end do
!
do i = 1, rtp%nidx_rtp(1)
if(sph_IO%r_gl_1(i) .ne. rtp%radius_1d_rtp_r(i)) then
if(abs(sph_IO%r_gl_1(i) - rtp%radius_1d_rtp_r(i)) &
do i = 1, sph_rtp%nidx_rtp(1)
if(sph_IO%r_gl_1(i) .ne. sph_rtp%radius_1d_rtp_r(i)) then
if(abs(sph_IO%r_gl_1(i) - sph_rtp%radius_1d_rtp_r(i)) &
& .gt. 1.0d-10) return
end if
if(sph_IO%idx_gl_1(i) .ne. rtp%idx_gl_1d_rtp_r(i)) return
if(sph_IO%idx_gl_1(i) .ne. sph_rtp%idx_gl_1d_rtp_r(i)) return
end do
!
do i = 1, rtp%nidx_rtp(2)
if(sph_IO%idx_gl_2(i,1) .ne. rtp%idx_gl_1d_rtp_t(i)) return
do i = 1, sph_rtp%nidx_rtp(2)
if(sph_IO%idx_gl_2(i,1) .ne. sph_rtp%idx_gl_1d_rtp_t(i)) return
end do
!
do i = 1, rtp%nidx_rtp(3)
if(sph_IO%idx_gl_3(i,1) .ne. rtp%idx_gl_1d_rtp_p(i,1)) return
if(sph_IO%idx_gl_3(i,2) .ne. rtp%idx_gl_1d_rtp_p(i,2)) return
do i = 1, sph_rtp%nidx_rtp(3)
if(sph_IO%idx_gl_3(i,1) &
& .ne. sph_rtp%idx_gl_1d_rtp_p(i,1)) return
if(sph_IO%idx_gl_3(i,2) &
& .ne. sph_rtp%idx_gl_1d_rtp_p(i,2)) return
end do
compare_sph_rtp_node_with_IO = 0
!
Expand Down
Loading

0 comments on commit 466668f

Please sign in to comment.