SUBROUTINE OneDSetArrayBounds(ix,lbc,ubc,dix,bnd,mb,per)
! ---- This subroutine establishs the array bounds.
! ---- Shared Variables
USE mesh ! --- shares: nx,ny,nz,xl,xr...,dx,dy,dz
USE array_bounds ! --- shares: ixlo, ixhi...
USE method_parms ! --- shares: nghost, enoOrder...
USE Interp_coeffs
USE Generic_EstablishBoundaryType
use Generic_FDInterp
! ----
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(IN) :: ix(1), mb, per(1)
DOUBLE PRECISION, INTENT(IN) :: lbc(1), ubc(1), dix(1), bnd(mb,2,1)
INTEGER :: nc
! ---- values to the true variables
nx = ix(1)
xl = lbc(1)
xr = ubc(1)
dx = dix(1)
xlg = bnd(1,1,1)
xrg = bnd(1,2,1)
xper = per(1)
! ---- Set the Low (lo) and High (hi) array bounds
! ---- for the domain including ghost-cells
! ---- nghost is defined in method_parms as
! ---- nghost = enoOrder, but could be expanded for LES
ixlo = 1 - nghost
ixhi = nx + nghost
mx = ixhi-ixlo+1
! ---- Does this patch see a boundary, if so is it periodic
CALL OneDSetLocalBoundary()
call FDInterpolateTest(ixlo, ixhi, nx, bc_ixlow, bc_ixup)
useExOutput = CLES_TRUE
END SUBROUTINE OneDSetArrayBounds
SUBROUTINE TwoDSetArrayBounds(ix,lbc,ubc,dix,bnd,mb,per)
! ---- This subroutine establishs the array bounds.
! ---- Shared Variables
USE mesh ! --- shares: nx,ny,nz,xl,xr...,dx,dy,dz
USE array_bounds ! --- shares: ixlo, ixhi...
USE method_parms ! --- shares: nghost, enoOrder...
USE Interp_coeffs
USE Generic_EstablishBoundaryType
use Generic_FDInterp
! ----
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(IN) :: ix(2), mb, per(2)
DOUBLE PRECISION, INTENT(IN) :: lbc(2), ubc(2), dix(2), bnd(mb,2,2)
! ---- values to the true variables
nx = ix(1)
ny = ix(2)
xl = lbc(1)
yl = lbc(2)
xr = ubc(1)
yr = ubc(2)
dx = dix(1)
dy = dix(2)
xlg = bnd(1,1,1)
ylg = bnd(1,1,2)
xrg = bnd(1,2,1)
yrg = bnd(1,2,2)
xper = per(1)
yper = per(2)
! ---- Set the Low (lo) and High (hi) array bounds
! ---- for the domain including ghost-cells
! ---- nghost is defined in method_parms as
! ---- nghost = enoOrder, but could be expanded for LES
ixlo = 1 - nghost
iylo = 1 - nghost
ixhi = nx + nghost
iyhi = ny + nghost
mx = ixhi-ixlo+1
my = iyhi-iylo+1
! ---- Does this patch see a boundary, if so is it periodic
CALL TwoDSetLocalBoundary()
call FDInterpolateTest(ixlo, ixhi, nx, bc_ixlow, bc_ixup)
call FDInterpolateTest(iylo, iyhi, ny, bc_iylow, bc_iyup)
useExOutput = CLES_TRUE
END SUBROUTINE TwoDSetArrayBounds
SUBROUTINE ThreeDSetArrayBounds(ix,lbc,ubc,dix,bnd,mb,per)
! ---- This subroutine establishs the array bounds.
! ---- Shared Variables
USE mesh ! --- shares: nx,ny,nz,xl,xr...,dx,dy,dz
USE array_bounds ! --- shares: ixlo, ixhi...
USE method_parms ! --- shares: nghost, enoOrder...
USE Interp_coeffs
USE Generic_EstablishBoundaryType
use Generic_FDInterp
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(IN) :: ix(3), mb, per(3)
DOUBLE PRECISION, INTENT(IN) :: lbc(3), ubc(3), dix(3), bnd(mb,2,3)
call cleslog_log_enter('ThreeDSetArrayBounds')
! ---- values to the true variables
nx = ix(1)
ny = ix(2)
nz = ix(3)
xl = lbc(1)
yl = lbc(2)
zl = lbc(3)
xr = ubc(1)
yr = ubc(2)
zr = ubc(3)
dx = dix(1)
dy = dix(2)
dz = dix(3)
xlg = bnd(1,1,1)
ylg = bnd(1,1,2)
zlg = bnd(1,1,3)
xrg = bnd(1,2,1)
yrg = bnd(1,2,2)
zrg = bnd(1,2,3)
xper = per(1)
yper = per(2)
zper = per(3)
! ---- Set the Low (lo) and High (hi) array bounds
! ---- for the domain including ghost-cells
! ---- nghost is defined in method_parms as
! ---- nghost = enoOrder, but could be expanded for LES
! ---- For LES we need nghost = enoOrder + 1
! ---- When doing WENO with LES, the WENO stuff uses the
! ---- uses the first enoOrder ghostcells, and the extra
! ---- ghostcell is required for the gradients and structure
! ---- functions that go into getting the LES terms.
ixlo = 1 - nghost
iylo = 1 - nghost
izlo = 1 - nghost
ixhi = nx + nghost
iyhi = ny + nghost
izhi = nz + nghost
mx = ixhi-ixlo+1
my = iyhi-iylo+1
mz = izhi-izlo+1
! ---- Does this patch see a boundary, if so is it periodic
CALL ThreeDSetLocalBoundary()
call FDInterpolateTest(ixlo, ixhi, nx, bc_ixlow, bc_ixup)
call FDInterpolateTest(iylo, iyhi, ny, bc_iylow, bc_iyup)
call FDInterpolateTest(izlo, izhi, nz, bc_izlow, bc_izup)
useExOutput = CLES_TRUE
call cleslog_log_exit('ThreeDSetArrayBounds')
END SUBROUTINE ThreeDSetArrayBounds