@@ -23,8 +23,7 @@ module m_muscl
2323
2424 private; public :: s_initialize_muscl_module, &
2525 s_muscl, &
26- s_finalize_muscl_module, &
27- s_interface_compression
26+ s_finalize_muscl_module
2827
2928 integer :: v_size
3029 $:GPU_DECLARE(create= ' [v_size]'
@@ -225,92 +224,8 @@ contains
225224 #:endfor
226225 end if
227226
228- if (int_comp) then
229- call s_interface_compression(vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z, &
230- vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z, &
231- muscl_dir, is1_muscl_d, is2_muscl_d, is3_muscl_d)
232- end if
233-
234227 end subroutine s_muscl
235228
236- !> @brief Applies THINC interface- compression to sharpen volume- fraction reconstructions at material interfaces.
237- subroutine s_interface_compression (vL_rs_vf_x , vL_rs_vf_y , vL_rs_vf_z , vR_rs_vf_x , vR_rs_vf_y , vR_rs_vf_z , &
238- muscl_dir , &
239- is1_muscl_d , is2_muscl_d , is3_muscl_d )
240-
241- real (wp), dimension (idwbuff(1 )%beg:, idwbuff(2 )%beg:, idwbuff(3 )%beg:, 1 :), intent (inout ) :: &
242- vL_rs_vf_x, vL_rs_vf_y, &
243- vL_rs_vf_z, vR_rs_vf_x, &
244- vR_rs_vf_y, vR_rs_vf_z
245- integer , intent (in ) :: muscl_dir
246- type(int_bounds_info), intent (in ) :: is1_muscl_d, is2_muscl_d, is3_muscl_d
247-
248- integer :: j, k, l
249-
250- real (wp) :: aCL, aCR, aC, aTHINC, qmin, qmax, A, B, C, sign, moncon
251-
252- #:for MUSCL_DIR, XYZ in [(1 , ' x' 2 , ' y' 3 , ' z'
253- if (muscl_dir == ${MUSCL_DIR}$) then
254-
255- $:GPU_PARALLEL_LOOP(collapse= 3 ,private= ' [j,k,l,aCL,aC,aCR,aTHINC,moncon,sign,qmin,qmax]'
256- do l = is3_muscl%beg, is3_muscl%end
257- do k = is2_muscl%beg, is2_muscl%end
258- do j = is1_muscl%beg, is1_muscl%end
259-
260- aCL = v_rs_ws_${XYZ}$_muscl(j - 1 , k, l, advxb)
261- aC = v_rs_ws_${XYZ}$_muscl(j, k, l, advxb)
262- aCR = v_rs_ws_${XYZ}$_muscl(j + 1 , k, l, advxb)
263-
264- moncon = (aCR - aC)* (aC - aCL)
265-
266- if (aC >= ic_eps .and. aC <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
267-
268- if (aCR - aCL > 0._wp ) then
269- sign = 1._wp
270- else
271- sign = - 1._wp
272- end if
273-
274- qmin = min (aCR, aCL)
275- qmax = max (aCR, aCL) - qmin
276-
277- C = (aC - qmin + sgm_eps)/ (qmax + sgm_eps)
278- B = exp (sign* ic_beta* (2._wp * C - 1._wp ))
279- A = (B/ cosh (ic_beta) - 1._wp )/ tanh (ic_beta)
280-
281- ! Left reconstruction
282- aTHINC = qmin + 5e-1_wp * qmax* (1._wp + sign* A)
283- if (aTHINC < ic_eps) aTHINC = ic_eps
284- if (aTHINC > 1 - ic_eps) aTHINC = 1 - ic_eps
285- vL_rs_vf_${XYZ}$ (j, k, l, contxb) = vL_rs_vf_${XYZ}$ (j, k, l, contxb)/ &
286- vL_rs_vf_${XYZ}$ (j, k, l, advxb)* aTHINC
287- vL_rs_vf_${XYZ}$ (j, k, l, contxe) = vL_rs_vf_${XYZ}$ (j, k, l, contxe)/ &
288- (1._wp - vL_rs_vf_${XYZ}$ (j, k, l, advxb))* (1._wp - aTHINC)
289- vL_rs_vf_${XYZ}$ (j, k, l, advxb) = aTHINC
290- vL_rs_vf_${XYZ}$ (j, k, l, advxe) = 1 - aTHINC
291-
292- ! Right reconstruction
293- aTHINC = qmin + 5e-1_wp * qmax* (1._wp + sign* (tanh (ic_beta) + A)/ (1._wp + A* tanh (ic_beta)))
294- if (aTHINC < ic_eps) aTHINC = ic_eps
295- if (aTHINC > 1 - ic_eps) aTHINC = 1 - ic_eps
296- vR_rs_vf_${XYZ}$ (j, k, l, contxb) = vL_rs_vf_${XYZ}$ (j, k, l, contxb)/ &
297- vL_rs_vf_${XYZ}$ (j, k, l, advxb)* aTHINC
298- vR_rs_vf_${XYZ}$ (j, k, l, contxe) = vL_rs_vf_${XYZ}$ (j, k, l, contxe)/ &
299- (1._wp - vL_rs_vf_${XYZ}$ (j, k, l, advxb))* (1._wp - aTHINC)
300- vR_rs_vf_${XYZ}$ (j, k, l, advxb) = aTHINC
301- vR_rs_vf_${XYZ}$ (j, k, l, advxe) = 1 - aTHINC
302-
303- end if
304-
305- end do
306- end do
307- end do
308- $:END_GPU_PARALLEL_LOOP()
309- end if
310- #:endfor
311-
312- end subroutine s_interface_compression
313-
314229 !> @brief Reshapes cell- averaged variable data into direction- local work arrays for MUSCL reconstruction.
315230 subroutine s_initialize_muscl (v_vf , muscl_dir )
316231
0 commit comments