9 SUBROUTINE three_level_mass(comm_one_d, time, level_set_LA_P1, level_set_LA_P2, list_mode, &
10 mesh_p1, mesh_p2, chmp_vit_p2, max_vel, level_set_per, density_m2, density_m1, density, &
11 level_set_m1, level_set, visc_entro_level)
18 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
24 REAL(KIND=8),
DIMENSION(:,:,:),
INTENT(IN) :: chmp_vit_p2
25 REAL(KIND=8),
DIMENSION(:,:,:),
INTENT(INOUT) :: density, density_m1, density_m2
26 REAL(KIND=8),
DIMENSION(:,:,:,:),
INTENT(INOUT) :: level_set, level_set_m1
27 REAL(KIND=8),
INTENT(INOUT) :: max_vel
28 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: visc_entro_level
29 REAL(KIND=8),
DIMENSION(mesh_P1%np,6,SIZE(list_mode)) :: chmp_vit_p1
31 #include "petsc/finclude/petsc.h"
32 mpi_comm,
DIMENSION(:),
POINTER :: comm_one_d
34 IF (inputs%if_level_set)
THEN
36 IF (inputs%if_level_set_P2)
THEN
37 DO n = 1, inputs%nb_fluid-1
39 mesh_p2, level_set_m1(n,:,:,:), level_set(n,:,:,:), chmp_vit_p2, max_vel, &
40 inputs%my_par_level_set, inputs%level_set_list_dirichlet_sides, level_set_per, n, &
44 DO i = 1,
SIZE(list_mode)
46 CALL
project_p2_p1(mesh_p2%jj, mesh_p1%jj, chmp_vit_p2(:,k,i), chmp_vit_p1(:,k,i))
50 DO n = 1, inputs%nb_fluid-1
52 mesh_p1, level_set_m1(n,:,:,:), level_set(n,:,:,:), chmp_vit_p1, max_vel, &
53 inputs%my_par_level_set, inputs%level_set_list_dirichlet_sides, level_set_per, n, &
59 density_m2 = density_m1
62 inputs%density_fluid, density)
76 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
79 REAL(KIND=8),
DIMENSION(:,:,:,:),
INTENT(IN) :: level_set
80 REAL(KIND=8),
DIMENSION(:),
INTENT(IN) :: values
81 REAL(KIND=8),
DIMENSION(:,:,:),
INTENT(INOUT) :: variable
82 LOGICAL,
SAVE :: once = .true.
83 INTEGER,
SAVE :: m_max_c
84 INTEGER,
SAVE :: m_max_pad
85 INTEGER,
SAVE :: bloc_size
86 INTEGER,
SAVE :: nb_procs
87 INTEGER :: i, code, k, nb_inter
88 REAL(KIND=8),
DIMENSION(mesh_P2%np,2,SIZE(list_mode)) :: rho_phi
89 REAL(KIND=8),
DIMENSION(inputs%nb_fluid-1,mesh_P2%np,2,SIZE(list_mode)) :: level_set_p2
91 #include "petsc/finclude/petsc.h"
92 mpi_comm,
DIMENSION(:),
POINTER :: comm_one_d
98 m_max_c =
SIZE(list_mode)
100 CALL mpi_comm_size(comm_one_d(2), nb_procs, code)
101 bloc_size = mesh_p2%np/nb_procs+1
102 m_max_pad = 3*m_max_c*nb_procs/2
105 IF (.NOT.inputs%if_level_set)
THEN
109 IF (inputs%if_level_set_P2)
THEN
110 level_set_p2=level_set
112 DO nb_inter = 1, inputs%nb_fluid-1
113 DO i = 1,
SIZE(list_mode)
115 CALL
inject_p1_p2(mesh_p1%jj, mesh_p2%jj, level_set(nb_inter,:,k,i), level_set_p2(nb_inter,:,k,i))
120 IF (maxval(abs(values(1)-values(:))) .LE. 1.d-6)
THEN
123 IF (list_mode(i)==0)
THEN
124 variable(:,1,i) = values(1)
127 ELSE IF (inputs%level_set_reconstruction_type ==
'lin')
THEN
128 IF (inputs%if_kill_overshoot)
THEN
129 IF (nb_procs==1.AND.
SIZE(list_mode)==1.AND.list_mode(1)==0)
THEN
130 level_set_p2 = min(1.d0, level_set_p2)
131 level_set_p2 = max(0.d0, level_set_p2)
133 DO k = 1, inputs%nb_fluid-1
135 nb_procs, bloc_size, m_max_pad)
141 IF (list_mode(i)==0)
THEN
142 variable(:,1,i) = values(1)
145 variable = variable + (values(2)-values(1))*level_set_p2(1,:,:,:)
146 IF (inputs%nb_fluid.GE.3)
THEN
147 DO i = 1, inputs%nb_fluid-2
148 CALL
fft_par_prod_dcl(comm_one_d(2), variable, level_set_p2(i+1,:,:,:), rho_phi, &
149 nb_procs, bloc_size, m_max_pad)
150 variable = variable -rho_phi + values(i+2)*level_set_p2(i+1,:,:,:)
155 nb_procs, bloc_size, m_max_pad, inputs%level_set_tanh_coeff_reconstruction)
157 IF (list_mode(i)==0)
THEN
158 variable(:,2,i) = 0.d0
165 SUBROUTINE total_mass(comm_one_d, list_mode, mass_mesh, level_set, mass_tot)
171 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
173 REAL(KIND=8),
DIMENSION(:,:,:,:),
INTENT(IN) :: level_set
174 REAL(KIND=8),
INTENT(OUT) ::
mass_tot
175 REAL(KIND=8),
DIMENSION(SIZE(level_set,2),SIZE(level_set,3), &
SIZE(level_set,4)) :: density_loc
176 INTEGER :: m_max_pad, bloc_size, nb_procs
177 INTEGER :: i, code, my_petscworld_rank, m, l
178 REAL(KIND=8) :: mass_loc, mass_f, ray
179 REAL(KIND=8),
DIMENSION(mass_mesh%np,2,SIZE(list_mode)) :: rho_phi
180 INTEGER,
DIMENSION(mass_mesh%gauss%n_w) :: j_loc
181 REAL(KIND=8) :: pi= 3.14159265358979323846d0
183 #include "petsc/finclude/petsc.h"
184 mpi_comm,
DIMENSION(:),
POINTER :: comm_one_d
187 CALL mpi_comm_rank(petsc_comm_world,my_petscworld_rank,code)
188 CALL mpi_comm_size(comm_one_d(2), nb_procs, code)
190 IF(.NOT.inputs%if_level_set)
THEN
191 CALL
error_petsc(
'BUG in sub_mass : you should not compute any mass')
193 IF (inputs%level_set_reconstruction_type ==
'lin')
THEN
195 DO i = 1,
SIZE(list_mode)
196 IF (list_mode(i)==0)
THEN
197 density_loc(:,1,i) = inputs%density_fluid(1)
200 density_loc = density_loc + (inputs%density_fluid(2)-inputs%density_fluid(1))*level_set(i,:,:,:)
202 bloc_size =
SIZE(level_set,2)/nb_procs+1
203 m_max_pad = 3*
SIZE(list_mode)*nb_procs/2
204 IF (inputs%nb_fluid.GE.3)
THEN
205 DO i = 1, inputs%nb_fluid-2
206 CALL
fft_par_prod_dcl(comm_one_d(2), density_loc, level_set(i+1,:,:,:), rho_phi, &
207 nb_procs, bloc_size, m_max_pad)
208 density_loc = density_loc -rho_phi + inputs%density_fluid(i+2)*level_set(i+1,:,:,:)
212 bloc_size =
SIZE(level_set,2)/nb_procs+1
213 m_max_pad = 3*
SIZE(list_mode)*nb_procs/2
215 density_loc, nb_procs, bloc_size, m_max_pad, inputs%level_set_tanh_coeff_reconstruction)
219 DO i = 1,
SIZE(list_mode)
220 IF (list_mode(i)==0)
THEN
221 DO m = 1, mass_mesh%me
222 j_loc = mass_mesh%jj(:,m)
223 DO l = 1, mass_mesh%gauss%l_G
225 ray = sum(mass_mesh%rr(1,j_loc)*mass_mesh%gauss%ww(:,l))
226 mass_loc = mass_loc + sum(density_loc(j_loc,1,i)* &
227 mass_mesh%gauss%ww(:,l))*ray*mass_mesh%gauss%rj(l,m)
232 mass_loc = mass_loc*2*pi
233 CALL mpi_allreduce(mass_loc, mass_f, 1, mpi_double_precision, mpi_sum, &
235 CALL mpi_allreduce(mass_f,
mass_tot, 1, mpi_double_precision, mpi_sum, &
244 INTEGER,
DIMENSION(:,:),
INTENT(IN) :: jj_c, jj_f
245 REAL(KIND=8),
DIMENSION(:),
INTENT(IN) :: pp_c
246 REAL(KIND=8),
DIMENSION(:),
INTENT(OUT) :: pp_f
247 REAL(KIND=8) :: half = 0.5
249 IF (
SIZE(jj_c,1)==3)
THEN
250 DO m = 1,
SIZE(jj_f,2)
251 pp_f(jj_f(1:3,m)) = pp_c(jj_c(:,m))
252 pp_f(jj_f(4,m)) = (pp_c(jj_c(2,m)) + pp_c(jj_c(3,m)))*half
253 pp_f(jj_f(5,m)) = (pp_c(jj_c(3,m)) + pp_c(jj_c(1,m)))*half
254 pp_f(jj_f(6,m)) = (pp_c(jj_c(1,m)) + pp_c(jj_c(2,m)))*half
257 CALL
error_petsc(
'BUG in inject_P1_P2: finite element not yet programmed')
265 INTEGER,
DIMENSION(:,:),
INTENT(IN) :: jj_p2, jj_p1
266 REAL(KIND=8),
DIMENSION(:),
INTENT(IN) :: pp_p2
267 REAL(KIND=8),
DIMENSION(:),
INTENT(OUT) :: pp_p1
270 IF (
SIZE(jj_p1,1)==3)
THEN
271 DO m = 1,
SIZE(jj_p1,2)
272 pp_p1(jj_p1(:,m)) = pp_p2(jj_p2(1:3,m))
275 CALL
error_petsc(
'BUG in inject_P2_P1: finite element not yet programmed')
281 subroutine, public reconstruct_variable(comm_one_d, list_mode, mesh_P1, mesh_P2, level_set, values, variable)
subroutine, public total_mass(comm_one_d, list_mode, mass_mesh, level_set, mass_tot)
subroutine, public fft_par_prod_dcl(communicator, c1_in, c2_in, c_out, nb_procs, bloc_size, m_max_pad, temps)
subroutine, public three_level_level_set(comm_one_d, time, cc_1_LA, dt, list_mode, cc_mesh, cn_m1, cn, chmp_vit, max_vel, my_par_cc, cc_list_dirichlet_sides, cc_per, nb_inter, visc_entro_level)
subroutine, public inject_p1_p2(jj_c, jj_f, pp_c, pp_f)
subroutine, public fft_no_overshoot_level_set(communicator, c1_inout, nb_procs, bloc_size, m_max_pad, temps)
subroutine, public fft_heaviside_dcl(communicator, V1_in, values, V_out, nb_procs, bloc_size, m_max_pad, coeff_tanh, temps)
subroutine mass_tot(communicator, mesh, tempn, RESLT)
subroutine, public project_p2_p1(jj_P2, jj_P1, pp_P2, pp_P1)
subroutine error_petsc(string)
subroutine, public three_level_mass(comm_one_d, time, level_set_LA_P1, level_set_LA_P2, list_mode, mesh_P1, mesh_P2, chmp_vit_P2, max_vel, level_set_per, density_m2, density_m1, density, level_set_m1, level_set, visc_entro_level)