MODULE Generic_ModifyDCflag
! ---- course fine boundary flags from AMROC are
! ---- re-interperated in the standard DCflag paradigm
INTERFACE ModifyDCflagFromAMR
MODULE PROCEDURE ModifyDCflagFromAMR_1d
MODULE PROCEDURE ModifyDCflagFromAMR_2d
MODULE PROCEDURE ModifyDCflagFromAMR_3d
END INTERFACE
CONTAINS
SUBROUTINE ModifyDCflagFromAMR_1d(dcflag)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ---- Shared Procedures
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1)
INTEGER :: i
do i=1, nx+1
if ( dcflag(i,1) .eq. 1 ) then
if ( i .gt. 1 .and. dcflag(i-1,1).eq.0 ) dcflag(i-1,1) = 2
else if ( dcflag(i,1) .eq. -1 ) then
if ( i .le. nx .and. dcflag(i+1,1).eq.0 ) dcflag(i+1,1) = 2
endif
enddo
do i=1, nx+1
if ( dcflag(i,1) .ne. 0 ) dcflag(i,1) = CLES_SWITCH_WENO
enddo
RETURN
END SUBROUTINE
SUBROUTINE ModifyDCflagFromAMR_2d(dcflag)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1:ny+1,2)
INTEGER :: i,j,d
do j=1, ny
do i=1, nx+1
if ( dcflag(i,j,1) .eq. 1 ) then
if ( i .gt. 1 .and. dcflag(i-1,j,1).eq.0 ) dcflag(i-1,j,1) = 2
if ( i .gt. 1 .and. dcflag(i-1,j,2).eq.0 ) dcflag(i-1,j,2) = 2
if ( i .gt. 1 .and. dcflag(i-1,j+1,2).eq.0 ) dcflag(i-1,j+1,2) = 2
else if ( dcflag(i,j,1) .eq. -1 ) then
if ( i .le. nx .and. dcflag(i+1,j,1).eq.0 ) dcflag(i+1,j,1) = 2
if ( dcflag(i,j,2).eq.0 ) dcflag(i,j,2) = 2
if ( dcflag(i,j+1,2).eq.0 ) dcflag(i,j+1,2) = 2
endif
enddo
enddo
do j=1, ny+1
do i=1, nx
if ( dcflag(i,j,2) .eq. 1 ) then
if ( j .gt. 1 .and. dcflag(i,j-1,2).eq.0 ) dcflag(i,j-1,2) = 2
if ( j .gt. 1 .and. dcflag(i,j-1,1).eq.0 ) dcflag(i,j-1,1) = 2
if ( j .gt. 1 .and. dcflag(i+1,j-1,1).eq.0 ) dcflag(i+1,j-1,1) = 2
else if ( dcflag(i,j,2) .eq. -1 ) then
if ( j .le. ny .and. dcflag(i,j+1,2).eq.0 ) dcflag(i,j+1,2) = 2
if ( dcflag(i,j,1).eq.0 ) dcflag(i,j,1) = 2
if ( dcflag(i+1,j,1).eq.0 ) dcflag(i+1,j,1) = 2
endif
enddo
enddo
do j=1, ny+1
do i=1, nx+1
do d=1,2
if ( dcflag(i,j,d) .ne. 0 ) dcflag(i,j,d) = CLES_SWITCH_WENO
enddo
enddo
enddo
RETURN
END SUBROUTINE
SUBROUTINE ModifyDCflagFromAMR_3d(dcflag)
! ---- Shared Variables
USE mesh
USE array_bounds
USE method_parms
! ---- Shared Procedures
IMPLICIT NONE
include 'cles.i'
INTEGER, INTENT(INOUT) :: dcflag(1:nx+1,1:ny+1,1:nz+1,3)
INTEGER :: i,j,k,d
call cleslog_log_enter('ModifyDCflag3d')
do k=1, nz
do j=1, ny
do i=1, nx+1
if ( dcflag(i,j,k,1) .eq. 1 ) then
if ( i .gt. 1 .and. dcflag(i-1,j,k,1).eq.0 ) dcflag(i-1,j,k,1) = 2
if ( i .gt. 1 .and. dcflag(i-1,j,k,2).eq.0 ) dcflag(i-1,j,k,2) = 2
if ( i .gt. 1 .and. dcflag(i-1,j+1,k,2).eq.0 ) dcflag(i-1,j+1,k,2) = 2
if ( i .gt. 1 .and. dcflag(i-1,j,k,3).eq.0 ) dcflag(i-1,j,k,3) = 2
if ( i .gt. 1 .and. dcflag(i-1,j,k+1,3).eq.0 ) dcflag(i-1,j,k+1,3) = 2
else if ( dcflag(i,j,k,1) .eq. -1 ) then
if ( i .le. nx .and. dcflag(i+1,j,k,1).eq.0 ) dcflag(i+1,j,k,1) = 2
if ( dcflag(i,j,k,2).eq.0 ) dcflag(i,j,k,2) = 2
if ( dcflag(i,j+1,k,2).eq.0 ) dcflag(i,j+1,k,2) = 2
if ( dcflag(i,j,k,3).eq.0 ) dcflag(i,j,k,3) = 2
if ( dcflag(i,j,k+1,3).eq.0 ) dcflag(i,j,k+1,3) = 2
endif
enddo
enddo
enddo
do k=1, nz
do j=1, ny+1
do i=1, nx
if ( dcflag(i,j,k,2) .eq. 1 ) then
if ( j .gt. 1 .and. dcflag(i,j-1,k,2).eq.0 ) dcflag(i,j-1,k,2) = 2
if ( j .gt. 1 .and. dcflag(i,j-1,k,1).eq.0 ) dcflag(i,j-1,k,1) = 2
if ( j .gt. 1 .and. dcflag(i+1,j-1,k,1).eq.0 ) dcflag(i+1,j-1,k,1) = 2
if ( j .gt. 1 .and. dcflag(i,j-1,k,3).eq.0 ) dcflag(i,j-1,k,3) = 2
if ( j .gt. 1 .and. dcflag(i,j-1,k+1,3).eq.0 ) dcflag(i,j-1,k+1,3) = 2
else if ( dcflag(i,j,k,2) .eq. -1 ) then
if ( j .le. ny .and. dcflag(i,j+1,k,2).eq.0 ) dcflag(i,j+1,k,2) = 2
if ( dcflag(i,j,k,1).eq.0 ) dcflag(i,j,k,1) = 2
if ( dcflag(i+1,j,k,1).eq.0 ) dcflag(i+1,j,k,1) = 2
if ( dcflag(i,j,k,3).eq.0 ) dcflag(i,j,k,3) = 2
if ( dcflag(i,j,k+1,3).eq.0 ) dcflag(i,j,k+1,3) = 2
endif
enddo
enddo
enddo
do k=1, nz+1
do j=1, ny
do i=1, nx
if ( dcflag(i,j,k,3) .eq. 1 ) then
if ( k .gt. 1 .and. dcflag(i,j,k-1,3).eq.0 ) dcflag(i,j,k-1,3) = 2
if ( k .gt. 1 .and. dcflag(i,j,k-1,2).eq.0 ) dcflag(i,j,k-1,2) = 2
if ( k .gt. 1 .and. dcflag(i,j+1,k-1,2).eq.0 ) dcflag(i,j+1,k-1,2) = 2
if ( k .gt. 1 .and. dcflag(i,j,k-1,1).eq.0 ) dcflag(i,j,k-1,1) = 2
if ( k .gt. 1 .and. dcflag(i+1,j,k-1,1).eq.0 ) dcflag(i+1,j,k-1,1) = 2
else if ( dcflag(i,j,k,3) .eq. -1 ) then
if ( k .le. nz .and. dcflag(i,j,k+1,3).eq.0 ) dcflag(i,j,k+1,3) = 2
if ( dcflag(i,j,k,2).eq.0 ) dcflag(i,j,k,2) = 2
if ( dcflag(i,j+1,k,2).eq.0 ) dcflag(i,j+1,k,2) = 2
if ( dcflag(i,j,k,1).eq.0 ) dcflag(i,j,k,1) = 2
if ( dcflag(i+1,j,k,1).eq.0 ) dcflag(i+1,j,k,1) = 2
endif
enddo
enddo
enddo
do k=1, nz+1
do j=1, ny+1
do i=1, nx+1
do d=1,3
if ( dcflag(i,j,k,d) .ne. 0 ) dcflag(i,j,k,d) = CLES_SWITCH_WENO
enddo
enddo
enddo
enddo
call cleslog_log_exit('ModifyDCflag3d')
RETURN
END SUBROUTINE
END MODULE