! ----- Computes the physical location ! ----- of any grid point SUBROUTINE cles_xLocation(i,xc) USE mesh USE array_bounds IMPLICIT NONE INTEGER, INTENT(IN) :: i DOUBLE PRECISION, INTENT(OUT) :: xc ! ---- the location in the x direction xc = xl+(i-ixlo+0.5d0)*dx END SUBROUTINE cles_xLocation SUBROUTINE cles_yLocation(j,yc) USE mesh USE array_bounds IMPLICIT NONE INTEGER, INTENT(IN) :: j DOUBLE PRECISION, INTENT(OUT) :: yc ! ---- the location in the y direction yc = yl+(j-iylo+0.5d0)*dy END SUBROUTINE cles_yLocation SUBROUTINE cles_zLocation(k,zc) USE mesh USE array_bounds IMPLICIT NONE INTEGER, INTENT(IN) :: k DOUBLE PRECISION, INTENT(OUT) :: zc ! ---- the location in the x direction zc = zl+(k-izlo+0.5d0)*dz END SUBROUTINE cles_zLocation MODULE Generic_Distances ! ---- computes signed distance to a given location CONTAINS SUBROUTINE xDistance(i,x,xdis) ! ---- signed distance in the x direction from i to x IMPLICIT NONE INTEGER, INTENT(IN):: i DOUBLE PRECISION, INTENT(IN) :: x DOUBLE PRECISION, INTENT(OUT) :: xdis DOUBLE PRECISION :: xc CALL cles_xLocation(i,xc) xdis = x - xc END SUBROUTINE xDistance SUBROUTINE yDistance(j,y,ydis) ! ---- signed distance in the y direction from j to y IMPLICIT NONE INTEGER, INTENT(IN):: j DOUBLE PRECISION, INTENT(IN) :: y DOUBLE PRECISION, INTENT(OUT) :: ydis DOUBLE PRECISION :: yc CALL cles_yLocation(j,yc) ydis = y - yc END SUBROUTINE yDistance SUBROUTINE zDistance(k,z,zdis) ! ---- signed distance in the x direction from i to x IMPLICIT NONE INTEGER, INTENT(IN):: k DOUBLE PRECISION, INTENT(IN) :: z DOUBLE PRECISION, INTENT(OUT) :: zdis DOUBLE PRECISION :: zc CALL cles_zLocation(k,zc) zdis = z - zc END SUBROUTINE zDistance END MODULE Generic_Distances MODULE Generic_OuterBoundary ! ---- routines for determining if a given ! ---- patch contains an outer boundary ! ---- as defined by bnd(1,*,*) in SetArrayBounds CONTAINS SUBROUTINE Xlowerboundary(containsXlower) ! ----- Returns: ! ----- 1 if the lower boundary (xlg = bnd(1,1,1) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsXlower DOUBLE PRECISION :: xdist INTEGER :: iw CALL xDistance(1,xlg,xdist) containsXlower = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(xdist).lt.(iw-0.25d0)*dx ) then containsXlower = iw return endif enddo END SUBROUTINE Xlowerboundary SUBROUTINE Xupperboundary(containsXupper) ! ----- Returns: ! ----- 1 if the upper boundary (xrg = bnd(1,2,1) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsXupper DOUBLE PRECISION :: xdist INTEGER :: iw CALL xDistance(nx,xrg,xdist) containsXupper = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(xdist).lt.(iw-0.25d0)*dx ) then containsXupper = iw return endif enddo END SUBROUTINE Xupperboundary SUBROUTINE ylowerboundary(containsYlower) ! ----- Returns: ! ----- 1 if the upper boundary (ylg = bnd(1,1,2) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsYlower DOUBLE PRECISION :: ydist INTEGER :: iw CALL yDistance(1,ylg,ydist) containsYlower = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(ydist).lt.(iw-0.25d0)*dy ) then containsYlower = iw return endif enddo END SUBROUTINE Ylowerboundary SUBROUTINE yupperboundary(containsYupper) ! ----- Returns: ! ----- 1 if the upper boundary (yrg = bnd(1,2,2) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsYupper DOUBLE PRECISION :: ydist INTEGER :: iw CALL yDistance(ny,yrg,ydist) containsYupper = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(ydist).lt.(iw-0.25d0)*dy ) then containsYupper = iw return endif enddo END SUBROUTINE Yupperboundary SUBROUTINE zlowerboundary(containsZlower) ! ----- Returns: ! ----- 1 if the upper boundary (zlg = bnd(1,1,3) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsZlower DOUBLE PRECISION :: zdist INTEGER :: iw CALL zDistance(1,zlg,zdist) containsZlower = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(zdist).lt.(iw-0.25d0)*dz ) then containsZlower = iw return endif enddo END SUBROUTINE Zlowerboundary SUBROUTINE Zupperboundary(containsZupper) ! ----- Returns: ! ----- 1 if the upper boundary (zrg = bnd(1,2,3) ) is in this patch ! ----- 0 otherwise USE mesh USE array_bounds USE Generic_Distances USE Interp_coeffs IMPLICIT NONE include 'cles.i' INTEGER , INTENT(OUT) :: containsZupper DOUBLE PRECISION :: zdist INTEGER :: iw CALL zDistance(nz,zrg,zdist) containsZupper = CLES_PATCH_CORE do iw = 1, tcd_bndry_width if ( abs(zdist).lt.(iw-0.25d0)*dz ) then containsZupper = iw return endif enddo END SUBROUTINE Zupperboundary END MODULE Generic_OuterBoundary MODULE Generic_EstablishBoundaryType CONTAINS SUBROUTINE OneDSetLocalBoundary() ! ---- Shared Variables USE method_parms ! ---- Shared Procedures USE Generic_OuterBoundary IMPLICIT NONE include 'cles.i' cbc_ixlow = CLES_CBC_NONE cbc_ixup = CLES_CBC_NONE call set_use_dcflag() ! ---- eliminate the wall if the BCs are periodic IF (xper.eq.1) THEN bc_ixlow = CLES_PATCH_CORE bc_ixup = CLES_PATCH_CORE else ! ---- does this mesh contain a boundary/wall? CALL Xlowerboundary(bc_ixlow) CALL Xupperboundary(bc_ixup) ! ---- are the boundary conditions activated? if ( cbc_direction(1) .eq. CLES_CBC_NONE ) bc_ixlow = CLES_PATCH_CORE if ( bc_ixlow .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_ixlow = cbc_direction(1) if ( cbc_direction(2) .eq. CLES_CBC_NONE ) bc_ixup = CLES_PATCH_CORE if ( bc_ixup .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_ixup = cbc_direction(2) END IF END SUBROUTINE OneDSetLocalBoundary SUBROUTINE TwoDSetLocalBoundary() ! ---- Shared Variables USE method_parms ! ---- Shared Procedures USE Generic_OuterBoundary IMPLICIT NONE include 'cles.i' call OneDSetLocalBoundary() cbc_iylow = CLES_CBC_NONE cbc_iyup = CLES_CBC_NONE IF (yper.eq.1) THEN bc_iylow = CLES_PATCH_CORE bc_iyup = CLES_PATCH_CORE else ! ---- does this mesh contain a boundary/wall? CALL ylowerboundary(bc_iylow) CALL yupperboundary(bc_iyup) ! ---- are the boundary conditions activated? if ( cbc_direction(3) .eq. CLES_CBC_NONE ) bc_iylow = CLES_PATCH_CORE if ( bc_iylow .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_iylow = cbc_direction(3) if ( cbc_direction(4) .eq. CLES_CBC_NONE ) bc_iyup = CLES_PATCH_CORE if ( bc_iyup .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_iyup = cbc_direction(4) END IF RETURN END SUBROUTINE TwoDSetLocalBoundary SUBROUTINE ThreeDSetLocalBoundary() ! ---- Shared Variables USE method_parms ! ---- Shared Procedures USE Generic_OuterBoundary IMPLICIT NONE include 'cles.i' call cleslog_log_enter('ThreeDSetLocalBoundary') call TwoDSetLocalBoundary() cbc_izlow = CLES_CBC_NONE cbc_izup = CLES_CBC_NONE IF (zper.eq.1) THEN bc_izlow = CLES_PATCH_CORE bc_izup = CLES_PATCH_CORE else ! ---- does this mesh contain a boundary/wall? CALL zlowerboundary(bc_izlow) CALL zupperboundary(bc_izup) ! ---- are the boundary conditions activated? if ( cbc_direction(5) .eq. CLES_CBC_NONE ) bc_izlow = CLES_PATCH_CORE if ( bc_izlow .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_izlow = cbc_direction(5) if ( cbc_direction(6) .eq. CLES_CBC_NONE ) bc_izup = CLES_PATCH_CORE if ( bc_izup .eq. CLES_PATCH_BNDRY .and. & use_dcflag .eq. CLES_TRUE ) cbc_izup = cbc_direction(6) END IF call cleslog_log_exit('ThreeDSetLocalBoundary') RETURN END SUBROUTINE ThreeDSetLocalBoundary END MODULE Generic_EstablishBoundaryType