From ed39ca48f0122b06d44a7d115366f04f93353a04 Mon Sep 17 00:00:00 2001 From: Hiroaki Matsui Date: Mon, 23 Dec 2024 13:19:38 -0800 Subject: [PATCH] Split module set_sp_rlm_leg_matmul_big and set_sp_rlm_leg_sym_matmul --- .../SPH_SHELL_src/Makefile.depends | 8 +- .../SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90 | 252 ++++++++++++++++++ .../cal_sp_rlm_sym_matmul_big.f90 | 237 ++++++++++++++++ .../leg_f_trans_sym_matmul_big.f90 | 2 +- .../SPH_SHELL_src/legendre_fwd_sym_matmul.f90 | 4 +- .../set_sp_rlm_leg_matmul_big.f90 | 216 ++------------- .../set_sp_rlm_leg_sym_matmul.f90 | 232 ++-------------- 7 files changed, 546 insertions(+), 405 deletions(-) create mode 100644 src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90 create mode 100644 src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul_big.f90 diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends index 109f0a41..88e4f69b 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends @@ -10,6 +10,10 @@ cal_sp_rlm_by_vecprod.o: $(SPH_COMMDIR)/cal_sp_rlm_by_vecprod.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< cal_sp_rlm_sym_mat_tsmp.o: $(SPH_COMMDIR)/cal_sp_rlm_sym_mat_tsmp.f90 m_precision.o m_constants.o m_machine_parameter.o m_elapsed_labels_SPH_TRNS.o m_work_time.o $(F90) -c $(F90OPTFLAGS) $< +cal_sp_rlm_sym_matmul.o: $(SPH_COMMDIR)/cal_sp_rlm_sym_matmul.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< +cal_sp_rlm_sym_matmul_big.o: $(SPH_COMMDIR)/cal_sp_rlm_sym_matmul_big.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< cal_sph_exp_1st_diff.o: $(SPH_COMMDIR)/cal_sph_exp_1st_diff.f90 m_precision.o m_constants.o $(F90) -c $(F90OPTFLAGS) $< cal_sph_zonal_ave_rms_data.o: $(SPH_COMMDIR)/cal_sph_zonal_ave_rms_data.f90 m_precision.o m_constants.o m_machine_parameter.o @@ -58,7 +62,7 @@ leg_bwd_trans_sym_mat_jt.o: $(SPH_COMMDIR)/leg_bwd_trans_sym_mat_jt.f90 m_precis $(F90) -c $(F90OPTFLAGS) $< leg_bwd_trans_sym_mat_tj.o: $(SPH_COMMDIR)/leg_bwd_trans_sym_mat_tj.f90 m_precision.o m_constants.o m_work_time.o calypso_mpi.o m_machine_parameter.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o t_legendre_work_sym_mat_jt.o m_elapsed_labels_SPH_TRNS.o matmul_for_legendre_trans.o set_sp_rlm_sym_mat_tsmp.o cal_vr_rtm_sym_mat_tsmp.o $(F90) -c $(F90OPTFLAGS) $< -leg_f_trans_sym_matmul_big.o: $(SPH_COMMDIR)/leg_f_trans_sym_matmul_big.f90 m_precision.o m_constants.o m_machine_parameter.o m_work_time.o calypso_mpi.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o t_leg_trans_sym_matmul_big.o m_elapsed_labels_SPH_TRNS.o matmul_for_legendre_trans.o set_vr_rtm_leg_matmul_big.o set_sp_rlm_leg_matmul_big.o +leg_f_trans_sym_matmul_big.o: $(SPH_COMMDIR)/leg_f_trans_sym_matmul_big.f90 m_precision.o m_constants.o m_machine_parameter.o m_work_time.o calypso_mpi.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o t_leg_trans_sym_matmul_big.o m_elapsed_labels_SPH_TRNS.o matmul_for_legendre_trans.o set_vr_rtm_leg_matmul_big.o cal_sp_rlm_sym_matmul_big.o $(F90) -c $(F90OPTFLAGS) $< leg_fwd_trans_on_the_fly.o: $(SPH_COMMDIR)/leg_fwd_trans_on_the_fly.f90 m_precision.o m_constants.o m_work_time.o calypso_mpi.o m_machine_parameter.o matmul_for_legendre_trans.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o t_legendre_work_on_the_fly.o m_elapsed_labels_SPH_TRNS.o t_schmidt_poly_on_rtm.o set_vr_rtm_sym_mat_tsmp.o cal_sp_rlm_sym_mat_tsmp.o sum_spectr_over_smp_segment.o t_set_legendre_4_sph_trans.o small_matmul_leg_trans_krin.o $(F90) -c $(F90OPTFLAGS) $< @@ -74,7 +78,7 @@ legendre_bwd_trans_symmetry.o: $(SPH_COMMDIR)/legendre_bwd_trans_symmetry.f90 m_ $(F90) -c $(F90OPTFLAGS) $< legendre_bwd_trans_testloop.o: $(SPH_COMMDIR)/legendre_bwd_trans_testloop.f90 m_precision.o m_constants.o m_work_time.o calypso_mpi.o m_machine_parameter.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o t_legendre_work_testlooop.o m_elapsed_labels_SPH_TRNS.o matmul_for_legendre_trans.o t_schmidt_poly_on_rtm.o set_sp_rlm_sym_mat_tsmp.o cal_vr_rtm_sym_mat_tsmp.o small_matmul_leg_trans_krin.o $(F90) -c $(F90OPTFLAGS) $< -legendre_fwd_sym_matmul.o: $(SPH_COMMDIR)/legendre_fwd_sym_matmul.f90 m_precision.o m_constants.o m_machine_parameter.o m_work_time.o calypso_mpi.o t_legendre_work_sym_matmul.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o matmul_for_legendre_trans.o set_vr_rtm_leg_sym_matmul.o set_sp_rlm_leg_sym_matmul.o +legendre_fwd_sym_matmul.o: $(SPH_COMMDIR)/legendre_fwd_sym_matmul.f90 m_precision.o m_constants.o m_machine_parameter.o m_work_time.o calypso_mpi.o t_legendre_work_sym_matmul.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o matmul_for_legendre_trans.o set_vr_rtm_leg_sym_matmul.o cal_sp_rlm_sym_matmul.o $(F90) -c $(F90OPTFLAGS) $< legendre_fwd_trans_sym_spin.o: $(SPH_COMMDIR)/legendre_fwd_trans_sym_spin.f90 m_precision.o m_machine_parameter.o t_legendre_work_sym_matmul.o t_spheric_rtm_data.o t_spheric_rlm_data.o t_sph_trans_comm_tbl.o t_work_4_sph_trans.o set_vr_rtm_for_leg_vecprod.o cal_sp_rlm_by_vecprod.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90 new file mode 100644 index 00000000..2c24cd3b --- /dev/null +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90 @@ -0,0 +1,252 @@ +!>@file cal_sp_rlm_sym_matmul.f90 +!!@brief module cal_sp_rlm_sym_matmul +!! +!!@author H. Matsui +!!@date Programmed in Aug., 2013 +! +!>@brief Set spectrum data for backward Legendre transform +!! +!!@verbatim +!! subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, & +!! & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm,& +!! & kst, nkr, jst, n_jk_o, n_jk_e, & +!! & pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, & +!! & dtordt_e, dtordp_e, dtordt_o, dtordp_o, & +!! & ncomp, irev_sr_rlm, n_WS, WS) +!! subroutine cal_sp_rlm_scalar_sym_matmul & +!! & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & +!! & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & +!! & ncomp, nvector, irev_sr_rlm, n_WS, WS) +!! integer(kind = kint), intent(in) :: nnod_rlm +!! integer(kind = kint), intent(in) :: nidx_rlm(2) +!! integer(kind = kint), intent(in) :: istep_rlm(2) +!! integer(kind = kint), intent(in) & +!! & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) +!! real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) +!! real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +!! integer(kind = kint), intent(in) :: kst, nkr +!! integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +!! real(kind = kreal), intent(inout) :: scl_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: scl_o(nkr,n_jk_o) +!! real(kind = kreal), intent(inout) :: pol_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: pol_o(nkr,n_jk_o) +!! real(kind = kreal), intent(inout) :: dpoldt_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: dpoldp_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: dpoldt_o(nkr,n_jk_o) +!! real(kind = kreal), intent(inout) :: dpoldp_o(nkr,n_jk_o) +!! real(kind = kreal), intent(inout) :: dtordt_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: dtordp_e(nkr,n_jk_e) +!! real(kind = kreal), intent(inout) :: dtordt_o(nkr,n_jk_o) +!! real(kind = kreal), intent(inout) :: dtordp_o(nkr,n_jk_o) +!! integer(kind = kint), intent(in) :: ncomp, nvector +!! integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) +!! integer(kind = kint), intent(in) :: n_WS +!! real (kind=kreal), intent(inout):: WS(n_WS) +!!@endverbatim +!! + module cal_sp_rlm_sym_matmul +! + use m_precision + use m_constants +! + implicit none +! +! ----------------------------------------------------------------------- +! + contains +! +! ----------------------------------------------------------------------- +! + subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, & + & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm, & + & kst, nkr, jst, n_jk_o, n_jk_e, & + & pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, & + & dtordt_e, dtordp_e, dtordt_o, dtordp_o, & + & ncomp, irev_sr_rlm, n_WS, WS) +! + integer(kind = kint), intent(in) :: nnod_rlm + integer(kind = kint), intent(in) :: nidx_rlm(2) + integer(kind = kint), intent(in) :: istep_rlm(2) + integer(kind = kint), intent(in) & + & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) + real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) + real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +! + integer(kind = kint), intent(in) :: kst, nkr + integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +! + real(kind = kreal), intent(inout) :: pol_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: pol_o(nkr,n_jk_o) + real(kind = kreal), intent(inout) :: dpoldt_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: dpoldp_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: dpoldt_o(nkr,n_jk_o) + real(kind = kreal), intent(inout) :: dpoldp_o(nkr,n_jk_o) + real(kind = kreal), intent(inout) :: dtordt_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: dtordp_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: dtordt_o(nkr,n_jk_o) + real(kind = kreal), intent(inout) :: dtordp_o(nkr,n_jk_o) +! + integer(kind = kint), intent(in) :: ncomp + integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) + integer(kind = kint), intent(in) :: n_WS + real (kind=kreal), intent(inout):: WS(n_WS) +! + integer(kind = kint) :: kr_nd, kk, k_rlm + integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send + integer(kind = kint) :: nd, jj, i_kj + real(kind = kreal) :: g7, gm, r1_1d_rlm_r, r2_1d_rlm_r +! +! + do jj = 1, n_jk_e + g7 = g_sph_rlm(2*jj+jst-1,7) + gm = dble(idx_gl_1d_rlm_j(2*jj+jst-1,3)) + do kk = 1, nkr + i_kj = kk + (jj-1) * nkr + k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1)) + r1_1d_rlm_r = radius_1d_rlm_r(k_rlm) + r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r +! + pol_e(kk,jj) = pol_e(kk,jj) * r2_1d_rlm_r * g7 + dpoldt_e(kk,jj) = dpoldt_e(kk,jj) * r1_1d_rlm_r * g7 + dpoldp_e(kk,jj) = dpoldp_e(kk,jj) * r1_1d_rlm_r * g7 * gm + dtordt_e(kk,jj) = dtordt_e(kk,jj) * r1_1d_rlm_r * g7 + dtordp_e(kk,jj) = dtordp_e(kk,jj) * r1_1d_rlm_r * g7 * gm + end do + end do + do jj = 1, n_jk_o + g7 = g_sph_rlm(2*jj+jst,7) + gm = dble(idx_gl_1d_rlm_j(2*jj+jst,3)) + do kk = 1, nkr + k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1)) + r1_1d_rlm_r = radius_1d_rlm_r(k_rlm) + r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r + i_kj = kk + (jj-1) * nkr +! + pol_o(kk,jj) = pol_o(kk,jj) * r2_1d_rlm_r * g7 + dpoldt_o(kk,jj) = dpoldt_o(kk,jj) * r1_1d_rlm_r * g7 + dpoldp_o(kk,jj) = dpoldp_o(kk,jj) * r1_1d_rlm_r * g7 * gm + dtordt_o(kk,jj) = dtordt_o(kk,jj) * r1_1d_rlm_r * g7 + dtordp_o(kk,jj) = dtordp_o(kk,jj) * r1_1d_rlm_r * g7 * gm + end do + end do +! + do jj = 1, n_jk_o + do kk = 1, nkr + kr_nd = kk + kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) +! + i_kj = kk + (jj-1) * nkr + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp + io_send = 3*nd + (irev_sr_rlm(io_rlm) - 1) * ncomp +! +! even l-m + WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) + WS(ie_send-1) = WS(ie_send-1) & + & - dpoldp_e(kk,jj) + dpoldt_e(kk,jj) + WS(ie_send ) = WS(ie_send ) & + & - dtordp_e(kk,jj) - dtordt_e(kk,jj) +! odd l-m + WS(io_send-2) = WS(io_send-2) + pol_o(kk,jj) + WS(io_send-1) = WS(io_send-1) & + & - dpoldp_o(kk,jj) + dpoldt_o(kk,jj) + WS(io_send ) = WS(io_send ) & + & - dtordp_o(kk,jj) - dtordt_o(kk,jj) + end do + end do +! + do jj = n_jk_o+1, n_jk_e + do kk = 1, nkr + kr_nd = kk + kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) + i_kj = kk + (jj-1) * nkr + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp +! + WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) + WS(ie_send-1) = WS(ie_send-1) & + & - dpoldp_e(kk,jj) + dpoldt_e(kk,jj) + WS(ie_send ) = WS(ie_send ) & + & - dtordp_e(kk,jj) - dtordt_e(kk,jj) + end do + end do +! + end subroutine cal_sp_rlm_vector_sym_matmul +! +! ----------------------------------------------------------------------- +! + subroutine cal_sp_rlm_scalar_sym_matmul & + & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & + & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & + & ncomp, nvector, irev_sr_rlm, n_WS, WS) +! + integer(kind = kint), intent(in) :: nnod_rlm + integer(kind = kint), intent(in) :: nidx_rlm(2) + integer(kind = kint), intent(in) :: istep_rlm(2) + real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +! + integer(kind = kint), intent(in) :: kst, nkr + integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +! + real(kind = kreal), intent(inout) :: scl_e(nkr,n_jk_e) + real(kind = kreal), intent(inout) :: scl_o(nkr,n_jk_o) +! + integer(kind = kint), intent(in) :: ncomp, nvector + integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) + integer(kind = kint), intent(in) :: n_WS + real (kind=kreal), intent(inout):: WS(n_WS) +! + integer(kind = kint) :: kr_nd, kk, k_rlm + integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send + integer(kind = kint) :: nd, jj + real(kind = kreal) :: g6 +! +! + do jj = 1, n_jk_e + g6 = g_sph_rlm(2*jj+jst-1,6) + do kk = 1, nkr + scl_e(kk,jj) = scl_e(kk,jj) * g6 + end do + end do + do jj = 1, n_jk_o + g6 = g_sph_rlm(2*jj+jst,6) + do kk = 1, nkr + scl_o(kk,jj) = scl_o(kk,jj) * g6 + end do + end do +! + do kk = 1, nkr + kr_nd = kk + kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) + do jj = 1, n_jk_o + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp + io_send = nd + 3*nvector + (irev_sr_rlm(io_rlm) - 1) * ncomp +! + WS(ie_send) = WS(ie_send) + scl_e(kk,jj) + WS(io_send) = WS(io_send) + scl_o(kk,jj) + end do +! + do jj = n_jk_o+1, n_jk_e + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp + WS(ie_send) = WS(ie_send) + scl_e(kk,jj) + end do + end do +! + end subroutine cal_sp_rlm_scalar_sym_matmul +! +! ----------------------------------------------------------------------- +! + end module cal_sp_rlm_sym_matmul diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul_big.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul_big.f90 new file mode 100644 index 00000000..ab8b101d --- /dev/null +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul_big.f90 @@ -0,0 +1,237 @@ +!>@file cal_sp_rlm_sym_matmul_big.f90 +!!@brief module cal_sp_rlm_sym_matmul_big +!! +!!@author H. Matsui +!!@date Programmed in Aug., 2013 +! +!>@brief forward Legendre transform using matmulti +!! +!!@verbatim +!! subroutine cal_sp_rlm_vec_sym_matmul_big(nnod_rlm, nidx_rlm, & +!! & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm,& +!! & kst, nkr, jst, n_jk_o, n_jk_e, pol_e, pol_o, & +!! & tor_e, tor_o, ncomp, nvector, irev_sr_rlm, n_WS, WS) +!! subroutine cal_sp_rlm_scl_sym_matmul_big & +!! & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & +!! & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & +!! & ncomp, nvector, nscalar, irev_sr_rlm, n_WS, WS) +!! integer(kind = kint), intent(in) :: nnod_rlm +!! integer(kind = kint), intent(in) :: nidx_rlm(2) +!! integer(kind = kint), intent(in) :: istep_rlm(2) +!! integer(kind = kint), intent(in) & +!! & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) +!! real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) +!! real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +!! integer(kind = kint), intent(in) :: ncomp, nvector, nscalar +!! integer(kind = kint), intent(in) :: kst, nkr +!! integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +!! real(kind = kreal), intent(inout):: scl_e(ncomp*nkr,n_jk_e) +!! real(kind = kreal), intent(inout):: scl_o(ncomp*nkr,n_jk_o) +!! real(kind = kreal), intent(inout):: pol_e(ncomp*nkr,n_jk_e) +!! real(kind = kreal), intent(inout):: pol_o(ncomp*nkr,n_jk_o) +!! real(kind = kreal), intent(inout):: tor_e(2*nvector*nkr,n_jk_e) +!! real(kind = kreal), intent(inout):: tor_o(2*nvector*nkr,n_jk_o) +!! integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) +!! integer(kind = kint), intent(in) :: n_WS +!! real (kind=kreal), intent(inout):: WS(n_WS) +!!@endverbatim +!! +! + module cal_sp_rlm_sym_matmul_big +! + use m_precision + use m_constants +! + implicit none +! +! ----------------------------------------------------------------------- +! + contains +! +! ----------------------------------------------------------------------- +! + subroutine cal_sp_rlm_vec_sym_matmul_big(nnod_rlm, nidx_rlm, & + & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm, & + & kst, nkr, jst, n_jk_o, n_jk_e, pol_e, pol_o, & + & tor_e, tor_o, ncomp, nvector, irev_sr_rlm, n_WS, WS) +! + integer(kind = kint), intent(in) :: nnod_rlm + integer(kind = kint), intent(in) :: nidx_rlm(2) + integer(kind = kint), intent(in) :: istep_rlm(2) + integer(kind = kint), intent(in) & + & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) + real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) + real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +! + integer(kind = kint), intent(in) :: ncomp, nvector + integer(kind = kint), intent(in) :: kst, nkr + integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +! + real(kind = kreal), intent(inout) :: pol_e(ncomp*nkr,n_jk_e) + real(kind = kreal), intent(inout) :: pol_o(ncomp*nkr,n_jk_o) + real(kind = kreal), intent(inout) :: tor_e(2*nvector*nkr,n_jk_e) + real(kind = kreal), intent(inout) :: tor_o(2*nvector*nkr,n_jk_o) +! + integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) + integer(kind = kint), intent(in) :: n_WS + real (kind=kreal), intent(inout):: WS(n_WS) +! + integer(kind = kint) :: kr_nd, kk, k_rlm, nkrv + integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send + integer(kind = kint) :: nd, jj + real(kind = kreal) :: g7, gm, r1, r2 +! +! + nkrv = nkr * nvector + do jj = 1, n_jk_e + g7 = g_sph_rlm(2*jj+jst-1,7) + gm = dble(idx_gl_1d_rlm_j(2*jj+jst-1,3)) + do kk = 1, nkrv + kr_nd = kk + nvector*kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + r1 = radius_1d_rlm_r(k_rlm) + r2 = r1 * r1 +! + pol_e(kk,jj) = pol_e(kk,jj) * r2 * g7 + tor_e(kk+nkrv,jj) = tor_e(kk+nkrv,jj) * r1 * g7 + pol_e(kk+2*nkrv,jj) = pol_e(kk+2*nkrv,jj) * r1 * g7 * gm + tor_e(kk,jj) = tor_e(kk,jj) * r1 * g7 + pol_e(kk+nkrv,jj) = pol_e(kk+nkrv,jj) * r1 * g7 * gm + end do + end do + do jj = 1, n_jk_o + g7 = g_sph_rlm(2*jj+jst,7) + gm = dble(idx_gl_1d_rlm_j(2*jj+jst,3)) + do kk = 1, nkrv + kr_nd = kk + nvector*kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + r1 = radius_1d_rlm_r(k_rlm) + r2 = r1 * r1 +! + pol_o(kk,jj) = pol_o(kk,jj) * r2 * g7 + tor_o(kk+nkrv,jj) = tor_o(kk+nkrv,jj) * r1 * g7 + pol_o(kk+2*nkrv,jj) = pol_o(kk+2*nkrv,jj) * r1 * g7 * gm + tor_o(kk,jj) = tor_o(kk,jj) * r1 * g7 + pol_o(kk+nkrv,jj) = pol_o(kk+nkrv,jj) * r1 * g7 * gm + end do + end do +! + do jj = 1, n_jk_o + do kk = 1, nkrv + kr_nd = kk + nvector*kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) +! + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp + io_send = 3*nd + (irev_sr_rlm(io_rlm) - 1) * ncomp +! +! even l-m + WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) + WS(ie_send-1) = WS(ie_send-1) & + & - pol_e(kk+2*nkrv,jj) + tor_e(kk+nkrv,jj) + WS(ie_send ) = WS(ie_send ) & + & - pol_e(kk+nkrv,jj) - tor_e(kk,jj) +! odd l-m + WS(io_send-2) = WS(io_send-2) + pol_o(kk,jj) + WS(io_send-1) = WS(io_send-1) & + & - pol_o(kk+2*nkrv,jj) + tor_o(kk+nkrv,jj) + WS(io_send ) = WS(io_send ) & + & - pol_o(kk+nkrv,jj) - tor_o(kk,jj) + end do + end do +! + do jj = n_jk_o+1, n_jk_e + do kk = 1, nkrv + kr_nd = kk + nvector*kst + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp +! + WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) + WS(ie_send-1) = WS(ie_send-1) & + & - pol_e(kk+2*nkrv,jj) + tor_e(kk+nkrv,jj) + WS(ie_send ) = WS(ie_send ) & + & - pol_e(kk+nkrv,jj) - tor_e(kk,jj) + end do + end do +! + end subroutine cal_sp_rlm_vec_sym_matmul_big +! +! ----------------------------------------------------------------------- +! + subroutine cal_sp_rlm_scl_sym_matmul_big & + & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & + & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & + & ncomp, nvector, nscalar, irev_sr_rlm, n_WS, WS) +! + integer(kind = kint), intent(in) :: nnod_rlm + integer(kind = kint), intent(in) :: nidx_rlm(2) + integer(kind = kint), intent(in) :: istep_rlm(2) + real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +! + integer(kind = kint), intent(in) :: ncomp, nvector, nscalar + integer(kind = kint), intent(in) :: kst, nkr + integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e +! + real(kind = kreal), intent(inout) :: scl_e(ncomp*nkr,n_jk_e) + real(kind = kreal), intent(inout) :: scl_o(ncomp*nkr,n_jk_o) +! + integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) + integer(kind = kint), intent(in) :: n_WS + real (kind=kreal), intent(inout):: WS(n_WS) +! + integer(kind = kint) :: kr_nd, kk, k_rlm, nkrv + integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send + integer(kind = kint) :: nd, jj + real(kind = kreal) :: g6 +! +! + nkrv = nkr * nvector + do jj = 1, n_jk_e + g6 = g_sph_rlm(2*jj+jst-1,6) + do kk = 1, nkr*nscalar + scl_e(kk+3*nkrv,jj) = scl_e(kk+3*nkrv,jj) * g6 + end do + end do + do jj = 1, n_jk_o + g6 = g_sph_rlm(2*jj+jst,6) + do kk = 1, nkr*nscalar + scl_o(kk+3*nkrv,jj) = scl_o(kk+3*nkrv,jj) * g6 + end do + end do +! + do kk = 1, nkr*nscalar + kr_nd = kk + kst*nscalar + k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) + nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) + do jj = 1, n_jk_o + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp + io_send = nd + 3*nvector + (irev_sr_rlm(io_rlm) - 1) * ncomp +! + WS(ie_send) = WS(ie_send) + scl_e(kk+3*nkrv,jj) + WS(io_send) = WS(io_send) + scl_o(kk+3*nkrv,jj) + end do +! + do jj = n_jk_o+1, n_jk_e + ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & + & + (k_rlm-1) * istep_rlm(1) + ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp + WS(ie_send) = WS(ie_send) + scl_e(kk+3*nkrv,jj) + end do + end do +! + end subroutine cal_sp_rlm_scl_sym_matmul_big +! +! ----------------------------------------------------------------------- +! + end module cal_sp_rlm_sym_matmul_big diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/leg_f_trans_sym_matmul_big.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/leg_f_trans_sym_matmul_big.f90 index 5099fb51..c8447daf 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/leg_f_trans_sym_matmul_big.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/leg_f_trans_sym_matmul_big.f90 @@ -66,7 +66,7 @@ subroutine leg_fwd_trans_sym_matmul_big & & n_WR, n_WS, WR, WS, WK_l_bsm) ! use set_vr_rtm_leg_matmul_big - use set_sp_rlm_leg_matmul_big + use cal_sp_rlm_sym_matmul_big ! integer(kind = kint), intent(in) :: iflag_matmul type(sph_rtm_grid), intent(in) :: sph_rtm diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/legendre_fwd_sym_matmul.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/legendre_fwd_sym_matmul.f90 index 701358cc..d2727491 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/legendre_fwd_sym_matmul.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/legendre_fwd_sym_matmul.f90 @@ -78,7 +78,7 @@ subroutine leg_f_trans_vec_sym_matmul & & n_WR, n_WS, WR, WS, WK_l_sml) ! use set_vr_rtm_leg_sym_matmul - use set_sp_rlm_leg_sym_matmul + use cal_sp_rlm_sym_matmul ! integer(kind = kint), intent(in) :: iflag_matmul type(sph_rtm_grid), intent(in) :: sph_rtm @@ -218,7 +218,7 @@ subroutine leg_f_trans_scl_sym_matmul & & g_sph_rlm, weight_rtm, n_WR, n_WS, WR, WS, WK_l_sml) ! use set_vr_rtm_leg_sym_matmul - use set_sp_rlm_leg_sym_matmul + use cal_sp_rlm_sym_matmul ! integer(kind = kint), intent(in) :: iflag_matmul type(sph_rtm_grid), intent(in) :: sph_rtm diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_matmul_big.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_matmul_big.f90 index 8c2139ed..90684837 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_matmul_big.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_matmul_big.f90 @@ -15,15 +15,25 @@ !! & (nnod_rlm, nidx_rlm, istep_rlm, kst, nkr, jst, & !! & n_jk_e, n_jk_o, ncomp, nvector, nscalar, irev_sr_rlm, & !! & n_WR, WR, scl_e, scl_o) -!! -!! subroutine cal_sp_rlm_vec_sym_matmul_big(nnod_rlm, nidx_rlm, & -!! & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm,& -!! & kst, nkr, jst, n_jk_o, n_jk_e, pol_e, pol_o, & -!! & tor_e, tor_o, ncomp, nvector, irev_sr_rlm, n_WS, WS) -!! subroutine cal_sp_rlm_scl_sym_matmul_big & -!! & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & -!! & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & -!! & ncomp, nvector, nscalar, irev_sr_rlm, n_WS, WS) +!! integer(kind = kint), intent(in) :: nnod_rlm +!! integer(kind = kint), intent(in) :: nidx_rlm(2) +!! integer(kind = kint), intent(in) :: istep_rlm(2) +!! integer(kind = kint), intent(in) & +!! & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) +!! real(kind = kreal), intent(in) :: a_r_1d_rlm_r(nidx_rlm(1)) +!! real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +!! integer(kind = kint), intent(in) :: kst, nkr +!! integer(kind = kint), intent(in) :: jst, n_jk_e, n_jk_o +!! integer(kind = kint), intent(in) :: ncomp, nvector, nscalar +!! integer(kind = kint), intent(in) :: n_WR +!! integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) +!! real(kind = kreal), intent(in) :: WR(n_WR) +!! real(kind = kreal), intent(inout):: pol_e(n_jk_e,ncomp*nkr) +!! real(kind = kreal), intent(inout):: tor_e(n_jk_e,2*nvector*nkr) +!! real(kind = kreal), intent(inout):: pol_o(n_jk_o,ncomp*nkr) +!! real(kind = kreal), intent(inout):: tor_o(n_jk_o,2*nvector*nkr) +!! real(kind = kreal), intent(inout):: scl_e(n_jk_e,ncomp*nkr) +!! real(kind = kreal), intent(inout):: scl_o(n_jk_o,ncomp*nkr) !!@endverbatim !! ! @@ -48,7 +58,8 @@ subroutine set_sp_rlm_vec_sym_matmul_big(nnod_rlm, nidx_rlm, & integer(kind = kint), intent(in) :: nnod_rlm integer(kind = kint), intent(in) :: nidx_rlm(2) integer(kind = kint), intent(in) :: istep_rlm(2) - integer(kind = kint), intent(in) :: idx_gl_1d_rlm_j(nidx_rlm(2),3) + integer(kind = kint), intent(in) & + & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) real(kind = kreal), intent(in) :: a_r_1d_rlm_r(nidx_rlm(1)) real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) ! @@ -160,190 +171,5 @@ subroutine set_sp_rlm_scl_sym_matmul_big & end subroutine set_sp_rlm_scl_sym_matmul_big ! ! ----------------------------------------------------------------------- -! ----------------------------------------------------------------------- -! - subroutine cal_sp_rlm_vec_sym_matmul_big(nnod_rlm, nidx_rlm, & - & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm, & - & kst, nkr, jst, n_jk_o, n_jk_e, pol_e, pol_o, & - & tor_e, tor_o, ncomp, nvector, irev_sr_rlm, n_WS, WS) -! - integer(kind = kint), intent(in) :: nnod_rlm - integer(kind = kint), intent(in) :: nidx_rlm(2) - integer(kind = kint), intent(in) :: istep_rlm(2) - integer(kind = kint), intent(in) & - & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) - real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) - real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) -! - integer(kind = kint), intent(in) :: ncomp, nvector - integer(kind = kint), intent(in) :: kst, nkr - integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e -! - real(kind = kreal), intent(inout) :: pol_e(ncomp*nkr,n_jk_e) - real(kind = kreal), intent(inout) :: pol_o(ncomp*nkr,n_jk_o) - real(kind = kreal), intent(inout) :: tor_e(2*nvector*nkr,n_jk_e) - real(kind = kreal), intent(inout) :: tor_o(2*nvector*nkr,n_jk_o) -! - integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) - integer(kind = kint), intent(in) :: n_WS - real (kind=kreal), intent(inout):: WS(n_WS) -! - integer(kind = kint) :: kr_nd, kk, k_rlm, nkrv - integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send - integer(kind = kint) :: nd, jj - real(kind = kreal) :: g7, gm, r1, r2 -! -! - nkrv = nkr * nvector - do jj = 1, n_jk_e - g7 = g_sph_rlm(2*jj+jst-1,7) - gm = dble(idx_gl_1d_rlm_j(2*jj+jst-1,3)) - do kk = 1, nkrv - kr_nd = kk + nvector*kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - r1 = radius_1d_rlm_r(k_rlm) - r2 = r1 * r1 -! - pol_e(kk,jj) = pol_e(kk,jj) * r2 * g7 - tor_e(kk+nkrv,jj) = tor_e(kk+nkrv,jj) * r1 * g7 - pol_e(kk+2*nkrv,jj) = pol_e(kk+2*nkrv,jj) * r1 * g7 * gm - tor_e(kk,jj) = tor_e(kk,jj) * r1 * g7 - pol_e(kk+nkrv,jj) = pol_e(kk+nkrv,jj) * r1 * g7 * gm - end do - end do - do jj = 1, n_jk_o - g7 = g_sph_rlm(2*jj+jst,7) - gm = dble(idx_gl_1d_rlm_j(2*jj+jst,3)) - do kk = 1, nkrv - kr_nd = kk + nvector*kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - r1 = radius_1d_rlm_r(k_rlm) - r2 = r1 * r1 -! - pol_o(kk,jj) = pol_o(kk,jj) * r2 * g7 - tor_o(kk+nkrv,jj) = tor_o(kk+nkrv,jj) * r1 * g7 - pol_o(kk+2*nkrv,jj) = pol_o(kk+2*nkrv,jj) * r1 * g7 * gm - tor_o(kk,jj) = tor_o(kk,jj) * r1 * g7 - pol_o(kk+nkrv,jj) = pol_o(kk+nkrv,jj) * r1 * g7 * gm - end do - end do -! - do jj = 1, n_jk_o - do kk = 1, nkrv - kr_nd = kk + nvector*kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) -! - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp - io_send = 3*nd + (irev_sr_rlm(io_rlm) - 1) * ncomp -! -! even l-m - WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) - WS(ie_send-1) = WS(ie_send-1) & - & - pol_e(kk+2*nkrv,jj) + tor_e(kk+nkrv,jj) - WS(ie_send ) = WS(ie_send ) & - & - pol_e(kk+nkrv,jj) - tor_e(kk,jj) -! odd l-m - WS(io_send-2) = WS(io_send-2) + pol_o(kk,jj) - WS(io_send-1) = WS(io_send-1) & - & - pol_o(kk+2*nkrv,jj) + tor_o(kk+nkrv,jj) - WS(io_send ) = WS(io_send ) & - & - pol_o(kk+nkrv,jj) - tor_o(kk,jj) - end do - end do -! - do jj = n_jk_o+1, n_jk_e - do kk = 1, nkrv - kr_nd = kk + nvector*kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp -! - WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) - WS(ie_send-1) = WS(ie_send-1) & - & - pol_e(kk+2*nkrv,jj) + tor_e(kk+nkrv,jj) - WS(ie_send ) = WS(ie_send ) & - & - pol_e(kk+nkrv,jj) - tor_e(kk,jj) - end do - end do -! - end subroutine cal_sp_rlm_vec_sym_matmul_big -! -! ----------------------------------------------------------------------- -! - subroutine cal_sp_rlm_scl_sym_matmul_big & - & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & - & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & - & ncomp, nvector, nscalar, irev_sr_rlm, n_WS, WS) -! - integer(kind = kint), intent(in) :: nnod_rlm - integer(kind = kint), intent(in) :: nidx_rlm(2) - integer(kind = kint), intent(in) :: istep_rlm(2) - real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) -! - integer(kind = kint), intent(in) :: ncomp, nvector, nscalar - integer(kind = kint), intent(in) :: kst, nkr - integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e -! - real(kind = kreal), intent(inout) :: scl_e(ncomp*nkr,n_jk_e) - real(kind = kreal), intent(inout) :: scl_o(ncomp*nkr,n_jk_o) -! - integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) - integer(kind = kint), intent(in) :: n_WS - real (kind=kreal), intent(inout):: WS(n_WS) -! - integer(kind = kint) :: kr_nd, kk, k_rlm, nkrv - integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send - integer(kind = kint) :: nd, jj - real(kind = kreal) :: g6 -! -! - nkrv = nkr * nvector - do jj = 1, n_jk_e - g6 = g_sph_rlm(2*jj+jst-1,6) - do kk = 1, nkr*nscalar - scl_e(kk+3*nkrv,jj) = scl_e(kk+3*nkrv,jj) * g6 - end do - end do - do jj = 1, n_jk_o - g6 = g_sph_rlm(2*jj+jst,6) - do kk = 1, nkr*nscalar - scl_o(kk+3*nkrv,jj) = scl_o(kk+3*nkrv,jj) * g6 - end do - end do -! - do kk = 1, nkr*nscalar - kr_nd = kk + kst*nscalar - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) - do jj = 1, n_jk_o - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp - io_send = nd + 3*nvector + (irev_sr_rlm(io_rlm) - 1) * ncomp -! - WS(ie_send) = WS(ie_send) + scl_e(kk+3*nkrv,jj) - WS(io_send) = WS(io_send) + scl_o(kk+3*nkrv,jj) - end do -! - do jj = n_jk_o+1, n_jk_e - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp - WS(ie_send) = WS(ie_send) + scl_e(kk+3*nkrv,jj) - end do - end do -! - end subroutine cal_sp_rlm_scl_sym_matmul_big -! -! ----------------------------------------------------------------------- ! end module set_sp_rlm_leg_matmul_big diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_sym_matmul.f90 b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_sym_matmul.f90 index 99597029..89abec27 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_sym_matmul.f90 +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/set_sp_rlm_leg_sym_matmul.f90 @@ -17,17 +17,31 @@ !! & (nnod_rlm, nidx_rlm, istep_rlm, & !! & kst, nkr, jst, n_jk_e, n_jk_o, & !! & ncomp, nvector, irev_sr_rlm, n_WR, WR, scl_e, scl_o) -!! -!! subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, & -!! & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm,& -!! & kst, nkr, jst, n_jk_o, n_jk_e, & -!! & pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, & -!! & dtordt_e, dtordp_e, dtordt_o, dtordp_o, & -!! & ncomp, irev_sr_rlm, n_WS, WS) -!! subroutine cal_sp_rlm_scalar_sym_matmul & -!! & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & -!! & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & -!! & ncomp, nvector, irev_sr_rlm, n_WS, WS) +!! integer(kind = kint), intent(in) :: nnod_rlm +!! integer(kind = kint), intent(in) :: nidx_rlm(2) +!! integer(kind = kint), intent(in) :: istep_rlm(2) +!! integer(kind = kint), intent(in) & +!! & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) +!! real(kind = kreal), intent(in) :: a_r_1d_rlm_r(nidx_rlm(1)) +!! real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) +!! integer(kind = kint), intent(in) :: kst, nkr +!! integer(kind = kint), intent(in) :: jst, n_jk_e, n_jk_o +!! integer(kind = kint), intent(in) :: ncomp, nvector +!! integer(kind = kint), intent(in) :: n_WR +!! integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) +!! real(kind = kreal), intent(in) :: WR(n_WR) +!! real(kind = kreal), intent(inout) :: pol_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: dpoldt_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: dpoldp_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: dtordt_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: dtordp_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: pol_o(n_jk_o,nkr) +!! real(kind = kreal), intent(inout) :: dpoldt_o(n_jk_o,nkr) +!! real(kind = kreal), intent(inout) :: dpoldp_o(n_jk_o,nkr) +!! real(kind = kreal), intent(inout) :: dtordt_o(n_jk_o,nkr) +!! real(kind = kreal), intent(inout) :: dtordp_o(n_jk_o,nkr) +!! real(kind = kreal), intent(inout) :: scl_e(n_jk_e,nkr) +!! real(kind = kreal), intent(inout) :: scl_o(n_jk_o,nkr) !!@endverbatim !! module set_sp_rlm_leg_sym_matmul @@ -53,7 +67,8 @@ subroutine set_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, & integer(kind = kint), intent(in) :: nnod_rlm integer(kind = kint), intent(in) :: nidx_rlm(2) integer(kind = kint), intent(in) :: istep_rlm(2) - integer(kind = kint), intent(in) :: idx_gl_1d_rlm_j(nidx_rlm(2),3) + integer(kind = kint), intent(in) & + & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) real(kind = kreal), intent(in) :: a_r_1d_rlm_r(nidx_rlm(1)) real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) ! @@ -169,198 +184,5 @@ subroutine set_sp_rlm_scalar_sym_matmul & end subroutine set_sp_rlm_scalar_sym_matmul ! ! ----------------------------------------------------------------------- -! ----------------------------------------------------------------------- -! - subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, & - & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm, & - & kst, nkr, jst, n_jk_o, n_jk_e, & - & pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, & - & dtordt_e, dtordp_e, dtordt_o, dtordp_o, & - & ncomp, irev_sr_rlm, n_WS, WS) -! - integer(kind = kint), intent(in) :: nnod_rlm - integer(kind = kint), intent(in) :: nidx_rlm(2) - integer(kind = kint), intent(in) :: istep_rlm(2) - integer(kind = kint), intent(in) & - & :: idx_gl_1d_rlm_j(nidx_rlm(2),3) - real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1)) - real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) -! - integer(kind = kint), intent(in) :: kst, nkr - integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e -! - real(kind = kreal), intent(inout) :: pol_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: pol_o(nkr,n_jk_o) - real(kind = kreal), intent(inout) :: dpoldt_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: dpoldp_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: dpoldt_o(nkr,n_jk_o) - real(kind = kreal), intent(inout) :: dpoldp_o(nkr,n_jk_o) - real(kind = kreal), intent(inout) :: dtordt_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: dtordp_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: dtordt_o(nkr,n_jk_o) - real(kind = kreal), intent(inout) :: dtordp_o(nkr,n_jk_o) -! - integer(kind = kint), intent(in) :: ncomp - integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) - integer(kind = kint), intent(in) :: n_WS - real (kind=kreal), intent(inout):: WS(n_WS) -! - integer(kind = kint) :: kr_nd, kk, k_rlm - integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send - integer(kind = kint) :: nd, jj, i_kj - real(kind = kreal) :: g7, gm, r1_1d_rlm_r, r2_1d_rlm_r -! -! - do jj = 1, n_jk_e - g7 = g_sph_rlm(2*jj+jst-1,7) - gm = dble(idx_gl_1d_rlm_j(2*jj+jst-1,3)) - do kk = 1, nkr - i_kj = kk + (jj-1) * nkr - k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1)) - r1_1d_rlm_r = radius_1d_rlm_r(k_rlm) - r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r -! - pol_e(kk,jj) = pol_e(kk,jj) * r2_1d_rlm_r * g7 - dpoldt_e(kk,jj) = dpoldt_e(kk,jj) * r1_1d_rlm_r * g7 - dpoldp_e(kk,jj) = dpoldp_e(kk,jj) * r1_1d_rlm_r * g7 * gm - dtordt_e(kk,jj) = dtordt_e(kk,jj) * r1_1d_rlm_r * g7 - dtordp_e(kk,jj) = dtordp_e(kk,jj) * r1_1d_rlm_r * g7 * gm - end do - end do - do jj = 1, n_jk_o - g7 = g_sph_rlm(2*jj+jst,7) - gm = dble(idx_gl_1d_rlm_j(2*jj+jst,3)) - do kk = 1, nkr - k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1)) - r1_1d_rlm_r = radius_1d_rlm_r(k_rlm) - r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r - i_kj = kk + (jj-1) * nkr -! - pol_o(kk,jj) = pol_o(kk,jj) * r2_1d_rlm_r * g7 - dpoldt_o(kk,jj) = dpoldt_o(kk,jj) * r1_1d_rlm_r * g7 - dpoldp_o(kk,jj) = dpoldp_o(kk,jj) * r1_1d_rlm_r * g7 * gm - dtordt_o(kk,jj) = dtordt_o(kk,jj) * r1_1d_rlm_r * g7 - dtordp_o(kk,jj) = dtordp_o(kk,jj) * r1_1d_rlm_r * g7 * gm - end do - end do -! - do jj = 1, n_jk_o - do kk = 1, nkr - kr_nd = kk + kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) -! - i_kj = kk + (jj-1) * nkr - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp - io_send = 3*nd + (irev_sr_rlm(io_rlm) - 1) * ncomp -! -! even l-m - WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) - WS(ie_send-1) = WS(ie_send-1) & - & - dpoldp_e(kk,jj) + dpoldt_e(kk,jj) - WS(ie_send ) = WS(ie_send ) & - & - dtordp_e(kk,jj) - dtordt_e(kk,jj) -! odd l-m - WS(io_send-2) = WS(io_send-2) + pol_o(kk,jj) - WS(io_send-1) = WS(io_send-1) & - & - dpoldp_o(kk,jj) + dpoldt_o(kk,jj) - WS(io_send ) = WS(io_send ) & - & - dtordp_o(kk,jj) - dtordt_o(kk,jj) - end do - end do -! - do jj = n_jk_o+1, n_jk_e - do kk = 1, nkr - kr_nd = kk + kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) - i_kj = kk + (jj-1) * nkr - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp -! - WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj) - WS(ie_send-1) = WS(ie_send-1) & - & - dpoldp_e(kk,jj) + dpoldt_e(kk,jj) - WS(ie_send ) = WS(ie_send ) & - & - dtordp_e(kk,jj) - dtordt_e(kk,jj) - end do - end do -! - end subroutine cal_sp_rlm_vector_sym_matmul -! -! ----------------------------------------------------------------------- -! - subroutine cal_sp_rlm_scalar_sym_matmul & - & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, & - & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, & - & ncomp, nvector, irev_sr_rlm, n_WS, WS) -! - integer(kind = kint), intent(in) :: nnod_rlm - integer(kind = kint), intent(in) :: nidx_rlm(2) - integer(kind = kint), intent(in) :: istep_rlm(2) - real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17) -! - integer(kind = kint), intent(in) :: kst, nkr - integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e -! - real(kind = kreal), intent(inout) :: scl_e(nkr,n_jk_e) - real(kind = kreal), intent(inout) :: scl_o(nkr,n_jk_o) -! - integer(kind = kint), intent(in) :: ncomp, nvector - integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm) - integer(kind = kint), intent(in) :: n_WS - real (kind=kreal), intent(inout):: WS(n_WS) -! - integer(kind = kint) :: kr_nd, kk, k_rlm - integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send - integer(kind = kint) :: nd, jj - real(kind = kreal) :: g6 -! -! - do jj = 1, n_jk_e - g6 = g_sph_rlm(2*jj+jst-1,6) - do kk = 1, nkr - scl_e(kk,jj) = scl_e(kk,jj) * g6 - end do - end do - do jj = 1, n_jk_o - g6 = g_sph_rlm(2*jj+jst,6) - do kk = 1, nkr - scl_o(kk,jj) = scl_o(kk,jj) * g6 - end do - end do -! - do kk = 1, nkr - kr_nd = kk + kst - k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1)) - nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1) - do jj = 1, n_jk_o - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp - io_send = nd + 3*nvector + (irev_sr_rlm(io_rlm) - 1) * ncomp -! - WS(ie_send) = WS(ie_send) + scl_e(kk,jj) - WS(io_send) = WS(io_send) + scl_o(kk,jj) - end do -! - do jj = n_jk_o+1, n_jk_e - ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) & - & + (k_rlm-1) * istep_rlm(1) - ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp - WS(ie_send) = WS(ie_send) + scl_e(kk,jj) - end do - end do -! - end subroutine cal_sp_rlm_scalar_sym_matmul -! -! ----------------------------------------------------------------------- ! end module set_sp_rlm_leg_sym_matmul