Skip to content

Commit ed39ca4

Browse files
hiromatsuihiromatsui
committed
Split module set_sp_rlm_leg_matmul_big and set_sp_rlm_leg_sym_matmul
1 parent 737e17e commit ed39ca4

File tree

7 files changed

+546
-405
lines changed

7 files changed

+546
-405
lines changed

‎src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile.depends‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,10 @@ cal_sp_rlm_by_vecprod.o: $(SPH_COMMDIR)/cal_sp_rlm_by_vecprod.f90 m_precision.o
1010
$(F90) -c $(F90OPTFLAGS) $<
1111
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
1212
$(F90) -c $(F90OPTFLAGS) $<
13+
cal_sp_rlm_sym_matmul.o: $(SPH_COMMDIR)/cal_sp_rlm_sym_matmul.f90 m_precision.o m_constants.o
14+
$(F90) -c $(F90OPTFLAGS) $<
15+
cal_sp_rlm_sym_matmul_big.o: $(SPH_COMMDIR)/cal_sp_rlm_sym_matmul_big.f90 m_precision.o m_constants.o
16+
$(F90) -c $(F90OPTFLAGS) $<
1317
cal_sph_exp_1st_diff.o: $(SPH_COMMDIR)/cal_sph_exp_1st_diff.f90 m_precision.o m_constants.o
1418
$(F90) -c $(F90OPTFLAGS) $<
1519
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
5862
$(F90) -c $(F90OPTFLAGS) $<
5963
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
6064
$(F90) -c $(F90OPTFLAGS) $<
61-
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
65+
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
6266
$(F90) -c $(F90OPTFLAGS) $<
6367
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
6468
$(F90) -c $(F90OPTFLAGS) $<
@@ -74,7 +78,7 @@ legendre_bwd_trans_symmetry.o: $(SPH_COMMDIR)/legendre_bwd_trans_symmetry.f90 m_
7478
$(F90) -c $(F90OPTFLAGS) $<
7579
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
7680
$(F90) -c $(F90OPTFLAGS) $<
77-
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
81+
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
7882
$(F90) -c $(F90OPTFLAGS) $<
7983
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
8084
$(F90) -c $(F90OPTFLAGS) $<

‎src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/cal_sp_rlm_sym_matmul.f90‎

Lines changed: 252 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,252 @@
1+
!>@file cal_sp_rlm_sym_matmul.f90
2+
!!@brief module cal_sp_rlm_sym_matmul
3+
!!
4+
!!@author H. Matsui
5+
!!@date Programmed in Aug., 2013
6+
!
7+
!>@brief Set spectrum data for backward Legendre transform
8+
!!
9+
!!@verbatim
10+
!! subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, &
11+
!! & istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm,&
12+
!! & kst, nkr, jst, n_jk_o, n_jk_e, &
13+
!! & pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, &
14+
!! & dtordt_e, dtordp_e, dtordt_o, dtordp_o, &
15+
!! & ncomp, irev_sr_rlm, n_WS, WS)
16+
!! subroutine cal_sp_rlm_scalar_sym_matmul &
17+
!! & (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, &
18+
!! & kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, &
19+
!! & ncomp, nvector, irev_sr_rlm, n_WS, WS)
20+
!! integer(kind = kint), intent(in) :: nnod_rlm
21+
!! integer(kind = kint), intent(in) :: nidx_rlm(2)
22+
!! integer(kind = kint), intent(in) :: istep_rlm(2)
23+
!! integer(kind = kint), intent(in) &
24+
!! & :: idx_gl_1d_rlm_j(nidx_rlm(2),3)
25+
!! real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1))
26+
!! real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17)
27+
!! integer(kind = kint), intent(in) :: kst, nkr
28+
!! integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e
29+
!! real(kind = kreal), intent(inout) :: scl_e(nkr,n_jk_e)
30+
!! real(kind = kreal), intent(inout) :: scl_o(nkr,n_jk_o)
31+
!! real(kind = kreal), intent(inout) :: pol_e(nkr,n_jk_e)
32+
!! real(kind = kreal), intent(inout) :: pol_o(nkr,n_jk_o)
33+
!! real(kind = kreal), intent(inout) :: dpoldt_e(nkr,n_jk_e)
34+
!! real(kind = kreal), intent(inout) :: dpoldp_e(nkr,n_jk_e)
35+
!! real(kind = kreal), intent(inout) :: dpoldt_o(nkr,n_jk_o)
36+
!! real(kind = kreal), intent(inout) :: dpoldp_o(nkr,n_jk_o)
37+
!! real(kind = kreal), intent(inout) :: dtordt_e(nkr,n_jk_e)
38+
!! real(kind = kreal), intent(inout) :: dtordp_e(nkr,n_jk_e)
39+
!! real(kind = kreal), intent(inout) :: dtordt_o(nkr,n_jk_o)
40+
!! real(kind = kreal), intent(inout) :: dtordp_o(nkr,n_jk_o)
41+
!! integer(kind = kint), intent(in) :: ncomp, nvector
42+
!! integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm)
43+
!! integer(kind = kint), intent(in) :: n_WS
44+
!! real (kind=kreal), intent(inout):: WS(n_WS)
45+
!!@endverbatim
46+
!!
47+
module cal_sp_rlm_sym_matmul
48+
!
49+
use m_precision
50+
use m_constants
51+
!
52+
implicit none
53+
!
54+
! -----------------------------------------------------------------------
55+
!
56+
contains
57+
!
58+
! -----------------------------------------------------------------------
59+
!
60+
subroutine cal_sp_rlm_vector_sym_matmul(nnod_rlm, nidx_rlm, &
61+
& istep_rlm, idx_gl_1d_rlm_j, radius_1d_rlm_r, g_sph_rlm, &
62+
& kst, nkr, jst, n_jk_o, n_jk_e, &
63+
& pol_e, pol_o, dpoldt_e, dpoldp_e, dpoldt_o, dpoldp_o, &
64+
& dtordt_e, dtordp_e, dtordt_o, dtordp_o, &
65+
& ncomp, irev_sr_rlm, n_WS, WS)
66+
!
67+
integer(kind = kint), intent(in) :: nnod_rlm
68+
integer(kind = kint), intent(in) :: nidx_rlm(2)
69+
integer(kind = kint), intent(in) :: istep_rlm(2)
70+
integer(kind = kint), intent(in) &
71+
& :: idx_gl_1d_rlm_j(nidx_rlm(2),3)
72+
real(kind = kreal), intent(in) :: radius_1d_rlm_r(nidx_rlm(1))
73+
real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17)
74+
!
75+
integer(kind = kint), intent(in) :: kst, nkr
76+
integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e
77+
!
78+
real(kind = kreal), intent(inout) :: pol_e(nkr,n_jk_e)
79+
real(kind = kreal), intent(inout) :: pol_o(nkr,n_jk_o)
80+
real(kind = kreal), intent(inout) :: dpoldt_e(nkr,n_jk_e)
81+
real(kind = kreal), intent(inout) :: dpoldp_e(nkr,n_jk_e)
82+
real(kind = kreal), intent(inout) :: dpoldt_o(nkr,n_jk_o)
83+
real(kind = kreal), intent(inout) :: dpoldp_o(nkr,n_jk_o)
84+
real(kind = kreal), intent(inout) :: dtordt_e(nkr,n_jk_e)
85+
real(kind = kreal), intent(inout) :: dtordp_e(nkr,n_jk_e)
86+
real(kind = kreal), intent(inout) :: dtordt_o(nkr,n_jk_o)
87+
real(kind = kreal), intent(inout) :: dtordp_o(nkr,n_jk_o)
88+
!
89+
integer(kind = kint), intent(in) :: ncomp
90+
integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm)
91+
integer(kind = kint), intent(in) :: n_WS
92+
real (kind=kreal), intent(inout):: WS(n_WS)
93+
!
94+
integer(kind = kint) :: kr_nd, kk, k_rlm
95+
integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send
96+
integer(kind = kint) :: nd, jj, i_kj
97+
real(kind = kreal) :: g7, gm, r1_1d_rlm_r, r2_1d_rlm_r
98+
!
99+
!
100+
do jj = 1, n_jk_e
101+
g7 = g_sph_rlm(2*jj+jst-1,7)
102+
gm = dble(idx_gl_1d_rlm_j(2*jj+jst-1,3))
103+
do kk = 1, nkr
104+
i_kj = kk + (jj-1) * nkr
105+
k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1))
106+
r1_1d_rlm_r = radius_1d_rlm_r(k_rlm)
107+
r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r
108+
!
109+
pol_e(kk,jj) = pol_e(kk,jj) * r2_1d_rlm_r * g7
110+
dpoldt_e(kk,jj) = dpoldt_e(kk,jj) * r1_1d_rlm_r * g7
111+
dpoldp_e(kk,jj) = dpoldp_e(kk,jj) * r1_1d_rlm_r * g7 * gm
112+
dtordt_e(kk,jj) = dtordt_e(kk,jj) * r1_1d_rlm_r * g7
113+
dtordp_e(kk,jj) = dtordp_e(kk,jj) * r1_1d_rlm_r * g7 * gm
114+
end do
115+
end do
116+
do jj = 1, n_jk_o
117+
g7 = g_sph_rlm(2*jj+jst,7)
118+
gm = dble(idx_gl_1d_rlm_j(2*jj+jst,3))
119+
do kk = 1, nkr
120+
k_rlm = 1 + mod((kk+kst-1),nidx_rlm(1))
121+
r1_1d_rlm_r = radius_1d_rlm_r(k_rlm)
122+
r2_1d_rlm_r = r1_1d_rlm_r * r1_1d_rlm_r
123+
i_kj = kk + (jj-1) * nkr
124+
!
125+
pol_o(kk,jj) = pol_o(kk,jj) * r2_1d_rlm_r * g7
126+
dpoldt_o(kk,jj) = dpoldt_o(kk,jj) * r1_1d_rlm_r * g7
127+
dpoldp_o(kk,jj) = dpoldp_o(kk,jj) * r1_1d_rlm_r * g7 * gm
128+
dtordt_o(kk,jj) = dtordt_o(kk,jj) * r1_1d_rlm_r * g7
129+
dtordp_o(kk,jj) = dtordp_o(kk,jj) * r1_1d_rlm_r * g7 * gm
130+
end do
131+
end do
132+
!
133+
do jj = 1, n_jk_o
134+
do kk = 1, nkr
135+
kr_nd = kk + kst
136+
k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1))
137+
nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1)
138+
!
139+
i_kj = kk + (jj-1) * nkr
140+
ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) &
141+
& + (k_rlm-1) * istep_rlm(1)
142+
io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) &
143+
& + (k_rlm-1) * istep_rlm(1)
144+
ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp
145+
io_send = 3*nd + (irev_sr_rlm(io_rlm) - 1) * ncomp
146+
!
147+
! even l-m
148+
WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj)
149+
WS(ie_send-1) = WS(ie_send-1) &
150+
& - dpoldp_e(kk,jj) + dpoldt_e(kk,jj)
151+
WS(ie_send ) = WS(ie_send ) &
152+
& - dtordp_e(kk,jj) - dtordt_e(kk,jj)
153+
! odd l-m
154+
WS(io_send-2) = WS(io_send-2) + pol_o(kk,jj)
155+
WS(io_send-1) = WS(io_send-1) &
156+
& - dpoldp_o(kk,jj) + dpoldt_o(kk,jj)
157+
WS(io_send ) = WS(io_send ) &
158+
& - dtordp_o(kk,jj) - dtordt_o(kk,jj)
159+
end do
160+
end do
161+
!
162+
do jj = n_jk_o+1, n_jk_e
163+
do kk = 1, nkr
164+
kr_nd = kk + kst
165+
k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1))
166+
nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1)
167+
i_kj = kk + (jj-1) * nkr
168+
ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) &
169+
& + (k_rlm-1) * istep_rlm(1)
170+
ie_send = 3*nd + (irev_sr_rlm(ie_rlm) - 1) * ncomp
171+
!
172+
WS(ie_send-2) = WS(ie_send-2) + pol_e(kk,jj)
173+
WS(ie_send-1) = WS(ie_send-1) &
174+
& - dpoldp_e(kk,jj) + dpoldt_e(kk,jj)
175+
WS(ie_send ) = WS(ie_send ) &
176+
& - dtordp_e(kk,jj) - dtordt_e(kk,jj)
177+
end do
178+
end do
179+
!
180+
end subroutine cal_sp_rlm_vector_sym_matmul
181+
!
182+
! -----------------------------------------------------------------------
183+
!
184+
subroutine cal_sp_rlm_scalar_sym_matmul &
185+
& (nnod_rlm, nidx_rlm, istep_rlm, g_sph_rlm, &
186+
& kst, nkr, jst, n_jk_o, n_jk_e, scl_e, scl_o, &
187+
& ncomp, nvector, irev_sr_rlm, n_WS, WS)
188+
!
189+
integer(kind = kint), intent(in) :: nnod_rlm
190+
integer(kind = kint), intent(in) :: nidx_rlm(2)
191+
integer(kind = kint), intent(in) :: istep_rlm(2)
192+
real(kind = kreal), intent(in) :: g_sph_rlm(nidx_rlm(2),17)
193+
!
194+
integer(kind = kint), intent(in) :: kst, nkr
195+
integer(kind = kint), intent(in) :: jst, n_jk_o, n_jk_e
196+
!
197+
real(kind = kreal), intent(inout) :: scl_e(nkr,n_jk_e)
198+
real(kind = kreal), intent(inout) :: scl_o(nkr,n_jk_o)
199+
!
200+
integer(kind = kint), intent(in) :: ncomp, nvector
201+
integer(kind = kint), intent(in) :: irev_sr_rlm(nnod_rlm)
202+
integer(kind = kint), intent(in) :: n_WS
203+
real (kind=kreal), intent(inout):: WS(n_WS)
204+
!
205+
integer(kind = kint) :: kr_nd, kk, k_rlm
206+
integer(kind = kint) :: ie_rlm, io_rlm, ie_send, io_send
207+
integer(kind = kint) :: nd, jj
208+
real(kind = kreal) :: g6
209+
!
210+
!
211+
do jj = 1, n_jk_e
212+
g6 = g_sph_rlm(2*jj+jst-1,6)
213+
do kk = 1, nkr
214+
scl_e(kk,jj) = scl_e(kk,jj) * g6
215+
end do
216+
end do
217+
do jj = 1, n_jk_o
218+
g6 = g_sph_rlm(2*jj+jst,6)
219+
do kk = 1, nkr
220+
scl_o(kk,jj) = scl_o(kk,jj) * g6
221+
end do
222+
end do
223+
!
224+
do kk = 1, nkr
225+
kr_nd = kk + kst
226+
k_rlm = 1 + mod((kr_nd-1),nidx_rlm(1))
227+
nd = 1 + (kr_nd - k_rlm) / nidx_rlm(1)
228+
do jj = 1, n_jk_o
229+
ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) &
230+
& + (k_rlm-1) * istep_rlm(1)
231+
io_rlm = 1 + (2*jj+jst-1) * istep_rlm(2) &
232+
& + (k_rlm-1) * istep_rlm(1)
233+
ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp
234+
io_send = nd + 3*nvector + (irev_sr_rlm(io_rlm) - 1) * ncomp
235+
!
236+
WS(ie_send) = WS(ie_send) + scl_e(kk,jj)
237+
WS(io_send) = WS(io_send) + scl_o(kk,jj)
238+
end do
239+
!
240+
do jj = n_jk_o+1, n_jk_e
241+
ie_rlm = 1 + (2*jj+jst-2) * istep_rlm(2) &
242+
& + (k_rlm-1) * istep_rlm(1)
243+
ie_send = nd + 3*nvector + (irev_sr_rlm(ie_rlm) - 1) * ncomp
244+
WS(ie_send) = WS(ie_send) + scl_e(kk,jj)
245+
end do
246+
end do
247+
!
248+
end subroutine cal_sp_rlm_scalar_sym_matmul
249+
!
250+
! -----------------------------------------------------------------------
251+
!
252+
end module cal_sp_rlm_sym_matmul

0 commit comments

Comments
 (0)