@@ -135,6 +135,7 @@ contains
135135
136136        real (wp) ::  pres_IP, coeff
137137        real (wp), dimension (3 ) ::  vel_IP, vel_norm_IP
138+         real (wp) ::  c_IP
138139        real (wp), dimension (num_fluids) ::  alpha_rho_IP, alpha_IP
139140        real (wp), dimension (nb) ::  r_IP, v_IP, pb_IP, mv_IP
140141        real (wp), dimension (nb* nmom) ::  nmom_IP
@@ -170,19 +171,19 @@ contains
170171            !Interpolate primitive variables at image point associated w/  GP
171172            if  (bubbles_euler .and.  .not.  qbmm) then 
172173                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,  &
174175                                               r_IP, v_IP, pb_IP, mv_IP)
175176            else  if  (qbmm .and.  polytropic) then 
176177                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,  &
178179                                               r_IP, v_IP, pb_IP, mv_IP, nmom_IP)
179180            else  if  (qbmm .and.  .not.  polytropic) then 
180181                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,  &
182183                                               r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP)
183184            else 
184185                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 )
186187            end if 
187188
188189            dyn_pres =  0._wp 
@@ -194,6 +195,10 @@ contains
194195                q_prim_vf(advxb +  q -  1 )%sf(j, k, l) =  alpha_IP(q)
195196            end do 
196197
198+             if  (surface_tension) then 
199+                 q_prim_vf(c_idx)%sf(j, k, l) =  c_IP
200+             end if 
201+ 
197202            if  (model_eqns /=  4 ) then 
198203                ! If  in  simulation, use acc mixture subroutines
199204                if  (elasticity) then 
@@ -234,6 +239,11 @@ contains
234239                q_cons_vf(advxb +  q -  1 )%sf(j, k, l) =  alpha_IP(q)
235240            end do 
236241
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+ 
237247            ! Set Energy
238248            if  (bubbles_euler) then 
239249                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
309319                q_prim_vf(advxb +  q -  1 )%sf(j, k, l) =  alpha_IP(q)
310320            end do 
311321
322+             if  (surface_tension) then 
323+                 q_prim_vf(c_idx)%sf(j, k, l) =  c_IP
324+             end if 
325+ 
312326            call  s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, &
313327                                                            alpha_rho_IP, Re_K, j, k, l)
314328
@@ -725,16 +739,18 @@ contains
725739
726740    !> Function that uses the interpolation coefficients and the current state
727741    !! 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 )
729743        !$acc routine seq
730744        type(scalar_field), &
731745            dimension (sys_size), &
732746            intent (IN ) ::  q_prim_vf !< Primitive Variables
747+ 
733748        real (wp), optional, dimension (idwbuff(1 )%beg:, idwbuff(2 )%beg:, idwbuff(3 )%beg:, 1 :, 1 :), intent (INOUT ) ::  pb, mv
734749
735750        type(ghost_point), intent (IN ) ::  gp
736751        real (wp), intent (INOUT ) ::  pres_IP
737752        real (wp), dimension (3 ), intent (INOUT ) ::  vel_IP
753+         real (wp), intent (INOUT ) ::  c_IP
738754        real (wp), dimension (num_fluids), intent (INOUT ) ::  alpha_IP, alpha_rho_IP
739755        real (wp), optional, dimension (:), intent (INOUT ) ::  r_IP, v_IP, pb_IP, mv_IP
740756        real (wp), optional, dimension (:), intent (INOUT ) ::  nmom_IP
@@ -758,6 +774,8 @@ contains
758774        pres_IP =  0._wp 
759775        vel_IP =  0._wp 
760776
777+         if  (surface_tension) c_IP =  0._wp 
778+ 
761779        if  (bubbles_euler) then 
762780            r_IP =  0._wp 
763781            v_IP =  0._wp 
@@ -801,6 +819,10 @@ contains
801819                                      q_prim_vf(advxb +  l -  1 )%sf(i, j, k)
802820                    end do 
803821
822+                     if  (surface_tension) then 
823+                         c_IP =  c_IP +  coeff* q_prim_vf(c_idx)%sf(i, j, k)
824+                     end if 
825+ 
804826                    if  (bubbles_euler .and.  .not.  qbmm) then 
805827                        !$acc loop seq
806828                        do  l =  1 , nb
0 commit comments