Skip to content

Commit ecb7d10

Browse files
hiromatsuihiromatsui
committed
Merge branch 'refs/heads/Ver.2.0_alpha' into Ver.2.0_w_PVR
2 parents 7290575 + a9ae165 commit ecb7d10

20 files changed

+3510
-29
lines changed

‎src/Fortran_libraries/MHD_src/radial_FDM/cal_sph_FDM3e_hdiv_viscous.f90‎

Lines changed: 320 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,320 @@
1+
!>@file cal_sph_FDM3e_hdiv_viscous.f90
2+
!!@brief module cal_sph_FDM3e_hdiv_viscous
3+
!!
4+
!!@author H. Matsui
5+
!!@date programmed by H.Matsui in Oct., 2009
6+
!
7+
!>@brief Set FDM matrix and explicit horizontal diffusivity
8+
!! for Valuable density
9+
!!
10+
!!@verbatim
11+
!! subroutine set_sph_FDM_fix_hdiv_vscs_mat(kr, n_in, n_out, &
12+
!! & jmax, a2r_ele_rj, a3r_ele_rj, g_sph_rj, &
13+
!! & nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d3_mat, &
14+
!! & hdiv_visous_mat)
15+
!! subroutine add_sph_hdiv_viscous_rho_depend &
16+
!! & (kr, n_in, n_out, jmax, &
17+
!! & a1r_ele_rj, a2r_ele_rj, g_sph_rj, h_rho, h_drhodr, &
18+
!! & nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
19+
!! & hdiv_visous_mat)
20+
!! subroutine add_sph_hdiv_viscous_nu_depend(kr, n_in, n_out, jmax,&
21+
!! & a1r_ele_rj, a2r_ele_rj, g_sph_rj, relative_d, h_nu, &
22+
!! & nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
23+
!! & hdiv_visous_mat)
24+
!! integer(kind = kint), intent(in) :: n_in, n_out
25+
!! integer(kind = kint), intent(in) :: kr, nri_fdm
26+
!! integer(kind = kint), intent(in) :: jmax
27+
!! real(kind = kreal), intent(in) :: a1r_ele_rj
28+
!! real(kind = kreal), intent(in) :: a2r_ele_rj
29+
!! real(kind = kreal), intent(in) :: a3r_ele_rj
30+
!! real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
31+
!! real(kind = kreal), intent(in) :: h_rho, h_drhodr
32+
!! real(kind = kreal), intent(in) :: relative_d, h_nu
33+
!! real(kind = kreal), intent(in) &
34+
!! & :: fdm3e_d0_mat(nri_fdm,n_in:n_out)
35+
!! real(kind = kreal), intent(in) &
36+
!! & :: fdm3e_d1_mat(nri_fdm,n_in:n_out)
37+
!! real(kind = kreal), intent(in) &
38+
!! & :: fdm3e_d2_mat(nri_fdm,n_in:n_out)
39+
!! real(kind = kreal), intent(in) &
40+
!! & :: fdm3e_d3_mat(nri_fdm,n_in:n_out)
41+
!! real(kind = kreal), intent(inout) &
42+
!! & :: hdiv_visous_mat(jmax,n_in:n_out)
43+
!!
44+
!! subroutine each_sph_FDM_fix_hdiv_vscs_mat(n_in, n_out, jmax, &
45+
!! & a2r_ele_rj, a3r_ele_rj, g_sph_rj, &
46+
!! & fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d3_mat, &
47+
!! & hdiv_visous_mat)
48+
!! subroutine each_sph_hdiv_vscs_rho_depend(n_in, n_out, jmax, &
49+
!! & a1r_ele_rj, a2r_ele_rj, g_sph_rj, h_rho, h_drhodr, &
50+
!! & fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
51+
!! & hdiv_visous_mat)
52+
!! subroutine each_sph_hdiv_vscs_nu_depend(n_in, n_out, jmax, &
53+
!! & a1r_ele_rj, a2r_ele_rj, g_sph_rj, relative_d, h_nu, &
54+
!! & fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
55+
!! & hdiv_visous_mat)
56+
!! integer(kind = kint), intent(in) :: n_in, n_out
57+
!! integer(kind = kint), intent(in) :: jmax
58+
!! real(kind = kreal), intent(in) :: a1r_ele_rj
59+
!! real(kind = kreal), intent(in) :: a2r_ele_rj
60+
!! real(kind = kreal), intent(in) :: a3r_ele_rj
61+
!! real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
62+
!! real(kind = kreal), intent(in) :: h_rho, h_drhodr
63+
!! real(kind = kreal), intent(in) :: relative_d, h_nu
64+
!! real(kind = kreal), intent(in) :: fdm3e_d0_mat(n_in:n_out)
65+
!! real(kind = kreal), intent(in) :: fdm3e_d1_mat(n_in:n_out)
66+
!! real(kind = kreal), intent(in) :: fdm3e_d2_mat(n_in:n_out)
67+
!! real(kind = kreal), intent(in) :: fdm3e_d3_mat(n_in:n_out)
68+
!! real(kind = kreal), intent(inout) &
69+
!! & :: hdiv_visous_mat(jmax,n_in:n_out)
70+
!!@endverbatim
71+
!
72+
module cal_sph_FDM3e_hdiv_viscous
73+
!
74+
use m_precision
75+
use m_constants
76+
!
77+
implicit none
78+
!
79+
! -----------------------------------------------------------------------
80+
!
81+
contains
82+
!
83+
! -----------------------------------------------------------------------
84+
!
85+
subroutine set_sph_FDM_fix_hdiv_vscs_mat(kr, n_in, n_out, &
86+
& jmax, a2r_ele_rj, a3r_ele_rj, g_sph_rj, &
87+
& nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d3_mat, &
88+
& hdiv_visous_mat)
89+
!
90+
integer(kind = kint), intent(in) :: n_in, n_out
91+
integer(kind = kint), intent(in) :: kr, nri_fdm
92+
integer(kind = kint), intent(in) :: jmax
93+
real(kind = kreal), intent(in) :: a2r_ele_rj
94+
real(kind = kreal), intent(in) :: a3r_ele_rj
95+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
96+
real(kind = kreal), intent(in) &
97+
& :: fdm3e_d0_mat(nri_fdm,n_in:n_out)
98+
real(kind = kreal), intent(in) &
99+
& :: fdm3e_d1_mat(nri_fdm,n_in:n_out)
100+
real(kind = kreal), intent(in) &
101+
& :: fdm3e_d3_mat(nri_fdm,n_in:n_out)
102+
!
103+
real(kind = kreal), intent(inout) &
104+
& :: hdiv_visous_mat(jmax,n_in:n_out)
105+
!
106+
integer(kind = kint) :: i_next
107+
!
108+
!
109+
do i_next = n_in, n_out
110+
hdiv_visous_mat(1:jmax,i_next) = - fdm3e_d3_mat(kr,i_next) &
111+
& + g_sph_rj(1:jmax,3)*a2r_ele_rj * fdm3e_d1_mat(kr,i_next) &
112+
& - two*g_sph_rj(1:jmax,3)*a3r_ele_rj * fdm3e_d0_mat(kr,i_next)
113+
end do
114+
!
115+
end subroutine set_sph_FDM_fix_hdiv_vscs_mat
116+
!
117+
! -----------------------------------------------------------------------
118+
!
119+
subroutine each_sph_FDM_fix_hdiv_vscs_mat(n_in, n_out, jmax, &
120+
& a2r_ele_rj, a3r_ele_rj, g_sph_rj, &
121+
& fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d3_mat, &
122+
& hdiv_visous_mat)
123+
!
124+
integer(kind = kint), intent(in) :: n_in, n_out
125+
integer(kind = kint), intent(in) :: jmax
126+
real(kind = kreal), intent(in) :: a2r_ele_rj
127+
real(kind = kreal), intent(in) :: a3r_ele_rj
128+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
129+
real(kind = kreal), intent(in) :: fdm3e_d0_mat(n_in:n_out)
130+
real(kind = kreal), intent(in) :: fdm3e_d1_mat(n_in:n_out)
131+
real(kind = kreal), intent(in) :: fdm3e_d3_mat(n_in:n_out)
132+
!
133+
real(kind = kreal), intent(inout) &
134+
& :: hdiv_visous_mat(jmax,n_in:n_out)
135+
!
136+
integer(kind = kint) :: i_next
137+
!
138+
!
139+
!$omp parallel
140+
do i_next = n_in, n_out
141+
!$omp workshare
142+
hdiv_visous_mat(1:jmax,i_next) = - fdm3e_d3_mat(i_next) &
143+
& + g_sph_rj(1:jmax,3)*a2r_ele_rj * fdm3e_d1_mat(i_next) &
144+
& - two*g_sph_rj(1:jmax,3)*a3r_ele_rj * fdm3e_d0_mat(i_next)
145+
!$omp end workshare
146+
end do
147+
!$omp end parallel
148+
!
149+
end subroutine each_sph_FDM_fix_hdiv_vscs_mat
150+
!
151+
! -----------------------------------------------------------------------
152+
! -----------------------------------------------------------------------
153+
!
154+
subroutine add_sph_hdiv_viscous_rho_depend &
155+
& (kr, n_in, n_out, jmax, &
156+
& a1r_ele_rj, a2r_ele_rj, g_sph_rj, h_rho, h_drhodr, &
157+
& nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
158+
& hdiv_visous_mat)
159+
!
160+
integer(kind = kint), intent(in) :: n_in, n_out
161+
integer(kind = kint), intent(in) :: kr, nri_fdm
162+
integer(kind = kint), intent(in) :: jmax
163+
real(kind = kreal), intent(in) :: a1r_ele_rj
164+
real(kind = kreal), intent(in) :: a2r_ele_rj
165+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
166+
real(kind = kreal), intent(in) :: h_rho, h_drhodr
167+
real(kind = kreal), intent(in) &
168+
& :: fdm3e_d0_mat(nri_fdm,n_in:n_out)
169+
real(kind = kreal), intent(in) &
170+
& :: fdm3e_d1_mat(nri_fdm,n_in:n_out)
171+
real(kind = kreal), intent(in) &
172+
& :: fdm3e_d2_mat(nri_fdm,n_in:n_out)
173+
!
174+
real(kind = kreal), intent(inout) &
175+
& :: hdiv_visous_mat(jmax,n_in:n_out)
176+
!
177+
integer(kind = kint) :: i_next
178+
real(kind = kreal) :: c_d1
179+
!
180+
!
181+
c_d1 = two * a1r_ele_rj * h_rho + h_drhodr
182+
do i_next = n_in, n_out
183+
hdiv_visous_mat(1:jmax,i_next) = hdiv_visous_mat(1:jmax,i_next) &
184+
& + h_rho * fdm3e_d2_mat(kr,i_next) &
185+
& + c_d1 * fdm3e_d1_mat(kr,i_next) &
186+
& - (g_sph_rj(1:jmax,3)*a2r_ele_rj &
187+
& * h_rho * two / three) &
188+
& * fdm3e_d0_mat(kr,i_next)
189+
end do
190+
!
191+
end subroutine add_sph_hdiv_viscous_rho_depend
192+
!
193+
! -----------------------------------------------------------------------
194+
!
195+
subroutine each_sph_hdiv_vscs_rho_depend(n_in, n_out, jmax, &
196+
& a1r_ele_rj, a2r_ele_rj, g_sph_rj, h_rho, h_drhodr, &
197+
& fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
198+
& hdiv_visous_mat)
199+
!
200+
integer(kind = kint), intent(in) :: n_in, n_out
201+
integer(kind = kint), intent(in) :: jmax
202+
real(kind = kreal), intent(in) :: a1r_ele_rj
203+
real(kind = kreal), intent(in) :: a2r_ele_rj
204+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
205+
real(kind = kreal), intent(in) :: h_rho, h_drhodr
206+
real(kind = kreal), intent(in) :: fdm3e_d0_mat(n_in:n_out)
207+
real(kind = kreal), intent(in) :: fdm3e_d1_mat(n_in:n_out)
208+
real(kind = kreal), intent(in) :: fdm3e_d2_mat(n_in:n_out)
209+
!
210+
real(kind = kreal), intent(inout) &
211+
& :: hdiv_visous_mat(jmax,n_in:n_out)
212+
!
213+
integer(kind = kint) :: i_next
214+
real(kind = kreal) :: c_d1
215+
!
216+
!
217+
c_d1 = two * a1r_ele_rj * h_rho + h_drhodr
218+
!$omp parallel
219+
do i_next = n_in, n_out
220+
!$omp workshare
221+
hdiv_visous_mat(1:jmax,i_next) = hdiv_visous_mat(1:jmax,i_next) &
222+
& + h_rho * fdm3e_d2_mat(i_next) &
223+
& + c_d1 * fdm3e_d1_mat(i_next) &
224+
& - (g_sph_rj(1:jmax,3)*a2r_ele_rj &
225+
& * h_rho * two / three) &
226+
& * fdm3e_d0_mat(i_next)
227+
!$omp end workshare
228+
end do
229+
!$omp end parallel
230+
!
231+
end subroutine each_sph_hdiv_vscs_rho_depend
232+
!
233+
! -----------------------------------------------------------------------
234+
! -----------------------------------------------------------------------
235+
!
236+
subroutine add_sph_hdiv_viscous_nu_depend(kr, n_in, n_out, jmax, &
237+
& a1r_ele_rj, a2r_ele_rj, g_sph_rj, relative_d, h_nu, &
238+
& nri_fdm, fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
239+
& hdiv_visous_mat)
240+
!
241+
integer(kind = kint), intent(in) :: n_in, n_out
242+
integer(kind = kint), intent(in) :: kr, nri_fdm
243+
integer(kind = kint), intent(in) :: jmax
244+
real(kind = kreal), intent(in) :: a1r_ele_rj
245+
real(kind = kreal), intent(in) :: a2r_ele_rj
246+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
247+
real(kind = kreal), intent(in) :: relative_d, h_nu
248+
real(kind = kreal), intent(in) &
249+
& :: fdm3e_d0_mat(nri_fdm,n_in:n_out)
250+
real(kind = kreal), intent(in) &
251+
& :: fdm3e_d1_mat(nri_fdm,n_in:n_out)
252+
real(kind = kreal), intent(in) &
253+
& :: fdm3e_d2_mat(nri_fdm,n_in:n_out)
254+
!
255+
real(kind = kreal), intent(inout) &
256+
& :: hdiv_visous_mat(jmax,n_in:n_out)
257+
!
258+
integer(kind = kint) :: i_next
259+
real(kind = kreal) :: c_d2, c_d1
260+
!
261+
!
262+
do i_next = n_in, n_out
263+
c_d2 = - h_nu
264+
c_d1 = two * a1r_ele_rj * h_nu
265+
hdiv_visous_mat(1:jmax,i_next) = hdiv_visous_mat(1:jmax,i_next) &
266+
& + c_d2 * fdm3e_d2_mat(kr,i_next) &
267+
& + c_d1 * fdm3e_d1_mat(kr,i_next) &
268+
& - g_sph_rj(1:jmax,3) * a2r_ele_rj * h_nu &
269+
& * fdm3e_d0_mat(kr,i_next)
270+
hdiv_visous_mat(1:jmax,i_next) = relative_d &
271+
& * hdiv_visous_mat(1:jmax,i_next)
272+
end do
273+
!
274+
end subroutine add_sph_hdiv_viscous_nu_depend
275+
!
276+
! -----------------------------------------------------------------------
277+
!
278+
subroutine each_sph_hdiv_vscs_nu_depend(n_in, n_out, jmax, &
279+
& a1r_ele_rj, a2r_ele_rj, g_sph_rj, relative_d, h_nu, &
280+
& fdm3e_d0_mat, fdm3e_d1_mat, fdm3e_d2_mat, &
281+
& hdiv_visous_mat)
282+
!
283+
integer(kind = kint), intent(in) :: n_in, n_out
284+
integer(kind = kint), intent(in) :: jmax
285+
real(kind = kreal), intent(in) :: a1r_ele_rj
286+
real(kind = kreal), intent(in) :: a2r_ele_rj
287+
real(kind = kreal), intent(in) :: g_sph_rj(jmax,17)
288+
real(kind = kreal), intent(in) :: relative_d, h_nu
289+
real(kind = kreal), intent(in) :: fdm3e_d0_mat(n_in:n_out)
290+
real(kind = kreal), intent(in) :: fdm3e_d1_mat(n_in:n_out)
291+
real(kind = kreal), intent(in) :: fdm3e_d2_mat(n_in:n_out)
292+
!
293+
real(kind = kreal), intent(inout) &
294+
& :: hdiv_visous_mat(jmax,n_in:n_out)
295+
!
296+
integer(kind = kint) :: i_next
297+
real(kind = kreal) :: c_d2, c_d1
298+
!
299+
!
300+
!$omp parallel
301+
do i_next = n_in, n_out
302+
c_d2 = - h_nu
303+
c_d1 = two * a1r_ele_rj * h_nu
304+
!$omp workshare
305+
hdiv_visous_mat(1:jmax,i_next) = hdiv_visous_mat(1:jmax,i_next) &
306+
& + c_d2 * fdm3e_d2_mat(i_next) &
307+
& + c_d1 * fdm3e_d1_mat(i_next) &
308+
& - g_sph_rj(1:jmax,3) * a2r_ele_rj * h_nu &
309+
& * fdm3e_d0_mat(i_next)
310+
hdiv_visous_mat(1:jmax,i_next) = relative_d &
311+
& * hdiv_visous_mat(1:jmax,i_next)
312+
!$omp end workshare
313+
end do
314+
!$omp end parallel
315+
!
316+
end subroutine each_sph_hdiv_vscs_nu_depend
317+
!
318+
! -----------------------------------------------------------------------
319+
!
320+
end module cal_sph_FDM3e_hdiv_viscous

0 commit comments

Comments
 (0)