MODULE Generic_FDFluxInterps
! ---- This module computes the derivative of the
! ---- interpolatedflux vector fxi
! ---- assuming input of interpolated, eg at dx*(j + 1/2 ), values
! ---- stored in fxi(j).
! ---- the resulting directional flux is then added to the existing RHS
INTERFACE AccumulateFluxDiffs
MODULE PROCEDURE OneDDiffFluxInterps
MODULE PROCEDURE TwoDDiffFluxInterps
MODULE PROCEDURE ThreeDDiffFluxInterps
END INTERFACE
CONTAINS
SUBROUTINE OneDDiffFluxInterps(rhs,OneDfluxI,direction)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ----
IMPLICIT NONE
DOUBLE PRECISION, INTENT(INOUT) :: rhs(nvars,1:nx)
DOUBLE PRECISION, INTENT(IN) :: OneDfluxI(ncomps,ixlo:ixhi,1)
DOUBLE PRECISION :: dl
INTEGER, INTENT(IN) :: direction
INTEGER :: slx,shx, i
whichdirection: SELECT CASE (direction)
CASE (1) ! ---- the x direction
dl = dx
slx = 2
shx = nx + 1
END SELECT WHICHDIRECTION
! ----- Difference Fluxes
rhs(1:nvars,1:nx) = rhs(1:nvars,1:nx) - &
(OneDfluxI(1:nvars,slx:shx,direction) &
- OneDfluxI(1:nvars,1:nx,direction))/dl
END SUBROUTINE OneDDiffFluxInterps
SUBROUTINE TwoDDiffFluxInterps(rhs,OneDfluxI,direction)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ----
IMPLICIT NONE
DOUBLE PRECISION, INTENT(INOUT) :: rhs(nvars,1:nx,1:ny)
DOUBLE PRECISION, INTENT(IN) :: OneDfluxI(ncomps,ixlo:ixhi,iylo:iyhi,2)
DOUBLE PRECISION :: dl
INTEGER, INTENT(IN) :: direction
integer :: i, j, ip, jp
INTEGER :: slx,shx
INTEGER :: sly,shy
whichdirection: SELECT CASE (direction)
CASE (1) ! ---- the x direction
dl = dx
ip = 1
jp = 0
CASE (2) ! ---- the y direction
dl = dy
ip = 0
jp = 1
END SELECT WHICHDIRECTION
slx = 1 + ip
shx = nx + ip
sly = 1 + jp
shy = ny + jp
! ----- Difference Fluxes
rhs(1:nvars,1:nx,1:ny) = -( OneDfluxI(1:nvars,slx:shx,sly:shy,direction) &
& -OneDfluxI(1:nvars,1:nx,1:ny,direction))/dl&
& + rhs(1:nvars,1:nx,1:ny)
END SUBROUTINE TwoDDiffFluxInterps
SUBROUTINE ThreeDDiffFluxInterps(rhs,OneDfluxI,direction)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ----
IMPLICIT NONE
DOUBLE PRECISION, INTENT(INOUT) :: rhs(nvars,1:nx,1:ny,1:nz)
DOUBLE PRECISION, INTENT(IN) :: OneDfluxI(ncomps,ixlo:ixhi,iylo:iyhi,izlo:izhi,3)
DOUBLE PRECISION :: dl
INTEGER, INTENT(IN) :: direction
INTEGER :: dir
integer :: i, j, k, ip, jp, kp
INTEGER :: slx,shx
INTEGER :: sly,shy
INTEGER :: slz,shz
call cleslog_log_enter('ThreeDDiffFluxInterps')
dir = direction
whichdirection: SELECT CASE (direction)
CASE (1) ! ---- the x direction
dl = dx
ip = 1
jp = 0
kp = 0
CASE (2) ! ---- the y direction
dl = dy
ip = 0
jp = 1
kp = 0
CASE (3) ! ---- the z direction
dl = dz
ip = 0
jp = 0
kp = 1
END SELECT WHICHDIRECTION
slx = 1 + ip
shx = nx+ ip
sly = 1 + jp
shy = ny + jp
slz = 1 + kp
shz = nz + kp
! ----- Difference Fluxes
rhs(1:nvars,1:nx,1:ny,1:nz) = rhs(1:nvars,1:nx,1:ny,1:nz)&
&-(OneDfluxI(1:nvars,slx:shx,sly:shy,slz:shz,dir) &
& -OneDfluxI(1:nvars,1:nx,1:ny,1:nz,dir))/dl
call cleslog_log_exit('ThreeDDiffFluxInterps')
END SUBROUTINE ThreeDDiffFluxInterps
END MODULE Generic_FDFluxInterps