MODULE Generic_CellWallFlux
! ---- Computes the inviscid fluxes at the cell walls
INTERFACE CellWallFlux
MODULE PROCEDURE OneDWallFlux
MODULE PROCEDURE TwoDWallFlux
MODULE PROCEDURE ThreeDWallFlux
END INTERFACE
CONTAINS
SUBROUTINE OneDWallFlux(ux,vx,fx,fxi,dcflag,direction,ifilter)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ---- Shared Procedures
USE Generic_FDInterpFlux
USE Generic_CaptureDc
USE Generic_FDFluxInterps
IMPLICIT NONE
include 'cles.i'
DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi)
DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi)
DOUBLE PRECISION, INTENT(IN) :: fx(nvars,ixlo:ixhi)
DOUBLE PRECISION, INTENT(INOUT) :: fxi(ncomps,ixlo:ixhi,1)
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1)
INTEGER, INTENT(IN) :: direction, ifilter
! ---- initialize flux interpolates and mask
fxi(:,:,direction) = 0.0D0
IF (method.eq.CLES_METHOD_HYBRID) THEN
! ---- Use the TCD
! ---- Everywhere:-----
! ---- compute fluxes at cell walls by finite difference
! ---- of the flux vector
CALL FDInterpFluxSkew(ux, vx, fx, fxi, direction)
ENDIF
! ---- At The shock and other discons:----
! ---- compute flux (overwrite) by WENO
! ---- at the effective discountinities
! ---- where 'dcflag' indicates
CALL CaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter)
END SUBROUTINE OneDWallFlux
SUBROUTINE TwoDWallFlux(ux,vx,fx,fxi,dcflag,direction,ifilter)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ---- Shared Procedures
USE Generic_FDInterpFlux
USE Generic_CaptureDc
USE Generic_FDFluxInterps
IMPLICIT NONE
include 'cles.i'
DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi,iylo:iyhi)
DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi,iylo:iyhi)
DOUBLE PRECISION, INTENT(IN) :: fx(nvars,ixlo:ixhi,iylo:iyhi)
DOUBLE PRECISION, INTENT(INOUT) :: fxi(ncomps,ixlo:ixhi,iylo:iyhi,2)
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1:ny+1,2)
INTEGER, INTENT(IN) :: direction, ifilter
! ---- initialize flux interpolates and mask
fxi(:,:,:,direction) = 0.0D0
IF (method.eq.CLES_METHOD_HYBRID) THEN
! ---- Use the TCD
! ---- Everywhere:-----
! ---- compute fluxes at cell walls by finite difference
! ---- of the flux vector
CALL FDInterpFluxSkew(ux, vx, fx, fxi, direction)
END IF
! ---- At The shock and other discons:----
! ---- compute flux (overwrite) by WENO
! ---- at the effective discountinities
! ---- where 'dcflag' indicates
CALL CaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter)
END SUBROUTINE TwoDWallFlux
SUBROUTINE ThreeDWallFlux(ux,vx,fx,fxi,dcflag,direction,ifilter)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ---- Shared Procedures
USE Generic_GetFlux
USE Generic_FDInterpFlux
USE Generic_CaptureDc
USE Generic_FDFluxInterps
IMPLICIT NONE
include 'cles.i'
DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi,iylo:iyhi,izlo:izhi)
DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi,iylo:iyhi,izlo:izhi)
DOUBLE PRECISION, INTENT(INOUT) :: fx(nvars,ixlo:ixhi,iylo:iyhi,izlo:izhi)
DOUBLE PRECISION, INTENT(INOUT) :: fxi(ncomps,ixlo:ixhi,iylo:iyhi,izlo:izhi,3)
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1:ny+1,1:nz+1,3)
INTEGER, INTENT(IN) :: direction,ifilter
INTEGER :: ipar(12), nnf, nnu, nnv, ierr, has_hooks, cles_hook_exist
EXTERNAL cles_hook_exist, cles_hook4
call cleslog_log_enter('ThreeDWallFlux')
has_hooks = cles_hook_exist(CLES_HOOK_CONVECTIVE)
! ---- initialize flux interpolates and mask
fxi(:,:,:,:,direction) = 0.0D0
IF (method.eq.CLES_METHOD_HYBRID) THEN
! ---- Use the TCD
! ---- Everywhere:-----
! ---- compute fluxes at cell walls by finite difference
! ---- of the flux vector
CALL FDInterpFluxSkew(ux, vx, fx, fxi, direction)
ENDIF
! ---- At The shock and other discons:----
! ---- compute flux (overwrite) by WENO
! ---- at the effective discountinities
! ---- where 'dcflag' indicates
CALL CaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter)
if ( has_hooks .eq. CLES_TRUE ) then
ipar(1) = nx
ipar(2) = ny
ipar(3) = nz
ipar(4) = ixlo
ipar(5) = ixhi
ipar(6) = iylo
ipar(7) = iyhi
ipar(8) = izlo
ipar(9) = izhi
ipar(10) = ncomps
ipar(11) = nvars
ipar(12) = direction
nnu = ncomps*mx*my*mz
nnf = nnu*3
nnv = nvars*mx*my*mz
call cles_hook4(CLES_HOOK_CONVECTIVE, ipar, 12, fxi, nnf, &
ux, nnu, vx, nnv, ierr)
endif
call cleslog_log_exit('ThreeDWallFlux')
END SUBROUTINE ThreeDWallFlux
END MODULE Generic_CellWallFlux