@@ -135,6 +135,7 @@ contains
135
135
136
136
real (wp) :: pres_IP, coeff
137
137
real (wp), dimension (3 ) :: vel_IP, vel_norm_IP
138
+ real (wp) :: c_IP
138
139
real (wp), dimension (num_fluids) :: alpha_rho_IP, alpha_IP
139
140
real (wp), dimension (nb) :: r_IP, v_IP, pb_IP, mv_IP
140
141
real (wp), dimension (nb* nmom) :: nmom_IP
@@ -170,19 +171,19 @@ contains
170
171
!Interpolate primitive variables at image point associated w/ GP
171
172
if (bubbles_euler .and. .not. qbmm) then
172
173
call s_interpolate_image_point(q_prim_vf, gp, &
173
- alpha_rho_IP, alpha_IP, pres_IP, vel_IP, &
174
+ alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, &
174
175
r_IP, v_IP, pb_IP, mv_IP)
175
176
else if (qbmm .and. polytropic) then
176
177
call s_interpolate_image_point(q_prim_vf, gp, &
177
- alpha_rho_IP, alpha_IP, pres_IP, vel_IP, &
178
+ alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, &
178
179
r_IP, v_IP, pb_IP, mv_IP, nmom_IP)
179
180
else if (qbmm .and. .not. polytropic) then
180
181
call s_interpolate_image_point(q_prim_vf, gp, &
181
- alpha_rho_IP, alpha_IP, pres_IP, vel_IP, &
182
+ alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, &
182
183
r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP)
183
184
else
184
185
call s_interpolate_image_point(q_prim_vf, gp, &
185
- alpha_rho_IP, alpha_IP, pres_IP, vel_IP)
186
+ alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP )
186
187
end if
187
188
188
189
dyn_pres = 0._wp
@@ -194,6 +195,10 @@ contains
194
195
q_prim_vf(advxb + q - 1 )%sf(j, k, l) = alpha_IP(q)
195
196
end do
196
197
198
+ if (surface_tension) then
199
+ q_prim_vf(c_idx)%sf(j, k, l) = c_IP
200
+ end if
201
+
197
202
if (model_eqns /= 4 ) then
198
203
! If in simulation, use acc mixture subroutines
199
204
if (elasticity) then
@@ -234,6 +239,11 @@ contains
234
239
q_cons_vf(advxb + q - 1 )%sf(j, k, l) = alpha_IP(q)
235
240
end do
236
241
242
+ ! Set color function
243
+ if (surface_tension) then
244
+ q_cons_vf(c_idx)%sf(j, k, l) = c_IP
245
+ end if
246
+
237
247
! Set Energy
238
248
if (bubbles_euler) then
239
249
q_cons_vf(E_idx)%sf(j, k, l) = (1 - alpha_IP(1 ))* (gamma* pres_IP + pi_inf + dyn_pres)
@@ -309,6 +319,10 @@ contains
309
319
q_prim_vf(advxb + q - 1 )%sf(j, k, l) = alpha_IP(q)
310
320
end do
311
321
322
+ if (surface_tension) then
323
+ q_prim_vf(c_idx)%sf(j, k, l) = c_IP
324
+ end if
325
+
312
326
call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, &
313
327
alpha_rho_IP, Re_K, j, k, l)
314
328
@@ -725,16 +739,18 @@ contains
725
739
726
740
!> Function that uses the interpolation coefficients and the current state
727
741
!! at the cell centers in order to estimate the state at the image point
728
- subroutine s_interpolate_image_point (q_prim_vf , gp , alpha_rho_IP , alpha_IP , pres_IP , vel_IP , r_IP , v_IP , pb_IP , mv_IP , nmom_IP , pb , mv , presb_IP , massv_IP )
742
+ subroutine s_interpolate_image_point (q_prim_vf , gp , alpha_rho_IP , alpha_IP , pres_IP , vel_IP , c_IP , r_IP , v_IP , pb_IP , mv_IP , nmom_IP , pb , mv , presb_IP , massv_IP )
729
743
!$acc routine seq
730
744
type(scalar_field), &
731
745
dimension (sys_size), &
732
746
intent (IN ) :: q_prim_vf !< Primitive Variables
747
+
733
748
real (wp), optional, dimension (idwbuff(1 )%beg:, idwbuff(2 )%beg:, idwbuff(3 )%beg:, 1 :, 1 :), intent (INOUT ) :: pb, mv
734
749
735
750
type(ghost_point), intent (IN ) :: gp
736
751
real (wp), intent (INOUT ) :: pres_IP
737
752
real (wp), dimension (3 ), intent (INOUT ) :: vel_IP
753
+ real (wp), intent (INOUT ) :: c_IP
738
754
real (wp), dimension (num_fluids), intent (INOUT ) :: alpha_IP, alpha_rho_IP
739
755
real (wp), optional, dimension (:), intent (INOUT ) :: r_IP, v_IP, pb_IP, mv_IP
740
756
real (wp), optional, dimension (:), intent (INOUT ) :: nmom_IP
@@ -758,6 +774,8 @@ contains
758
774
pres_IP = 0._wp
759
775
vel_IP = 0._wp
760
776
777
+ if (surface_tension) c_IP = 0._wp
778
+
761
779
if (bubbles_euler) then
762
780
r_IP = 0._wp
763
781
v_IP = 0._wp
@@ -801,6 +819,10 @@ contains
801
819
q_prim_vf(advxb + l - 1 )%sf(i, j, k)
802
820
end do
803
821
822
+ if (surface_tension) then
823
+ c_IP = c_IP + coeff* q_prim_vf(c_idx)%sf(i, j, k)
824
+ end if
825
+
804
826
if (bubbles_euler .and. .not. qbmm) then
805
827
!$acc loop seq
806
828
do l = 1 , nb
0 commit comments