Skip to content

Commit

Permalink
Split module set_sp_rlm_leg_matmul_big and set_sp_rlm_leg_sym_matmul
Browse files Browse the repository at this point in the history
  • Loading branch information
@hiromatsui
hiromatsui committed Dec 23, 2024
1 parent 737e17e commit ed39ca4
Show file tree
Hide file tree
Showing 7 changed files with 546 additions and 405 deletions.
8 changes: 6 additions & 2 deletions src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) $<
Expand All @@ -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) $<
Expand Down
252 changes: 252 additions & 0 deletions src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90
View file
Original file line number Diff line number Diff line change
@@ -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
Loading

0 comments on commit ed39ca4

Please sign in to comment.