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) ! ---- 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