shiftset.f.html
Source file:   shiftset.f
Directory:   /Users/rjl/git/rjleveque/clawpack-4.6.3/amrclaw/2d/lib
Converted:   Mon Jan 21 2013 at 20:15:13   using clawcode2html
This documentation file will not reflect any later changes in the source file.

 
c
c ----------------------------------------------------------
c
       subroutine shiftset(intarray,intarray2,isize,jsize)
c       subroutine old_shiftset(intarray,intarray2,idir,jdir,isize,jsize)

       implicit double precision (a-h, o-z)

       include "call.i"

       integer*1 intarray (0:isize+1,0:jsize+1), 
     1           intarray2(0:isize+1,0:jsize+1)

c :::::::::::::::::::::: CSHIFT :::::::::::::::::::::::::::::::
c shift by + or - 1 in either direction (but only 1 at a time)
c used for bit calculus for proper nesting, buffering, etc.
c similar to cshift on CM machine.
c includes periodic buffering as well.
c
c NEWER VERSION: DO ALL DIRS AT SAME TIME
c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

       if (xperdom) then
          do 10 j = 0, jsize+1
             intarray(0,j) = intarray(isize,j)
             intarray(isize+1,j) = intarray(1,j)
 10       continue
       else
          do 11 j = 0, jsize+1
             intarray(0,j) = 0
             intarray(isize+1,j) = 0
 11       continue
       endif
       if (yperdom) then
          do 12 i = 0, isize+1
             intarray(i,0) = intarray(i,jsize)
             intarray(i,jsize+1) = intarray(i,1)
 12       continue
       else if (spheredom) then   !use mapped stuff for sphere
          do 14 i = 0, isize+1
             intarray(i,0)       = intarray(isize+1-i,1)
             intarray(i,jsize+1) = intarray(isize+1-i,jsize)
 14       continue
       else
          do 13 i = 0, isize+1
             intarray(i,0) = 0
             intarray(i,jsize+1) = 0
 13       continue
       endif

       do j = 1, jsize
       do i = 1, isize
          intarray2(i,j) = 0
       end do
       end do

       do j = 1, jsize
       do i = 1, isize

          intflag = intarray(i,j)
          if (intflag .gt. 0)  then
c            cell is flagged, buffer in all dirs by one cell
c            use second array to avoid propagation
             mlo = max(i - ibuff, 0)
             mhi = min(i + ibuff, isize+1)
             klo = max(j - ibuff, 0)
             khi = min(j + ibuff, jsize+1)
             do k = klo, khi 
             do m = mlo, mhi
                intarray2(m,k) = intflag  ! copy the flag (may not be = 1?)
             end do
             end do
          endif

       end do
       end do


c       if (idir .eq. 1) then
c           do 22 j = 1, jsize
c           do 22 i = 1, isize
c              intarray2(i,j) = intarray(i+1,j)
c 22        continue
c       elseif (idir .eq. -1) then
c           do 25 j = 1, jsize
c           do 25 i = 1, isize
c               intarray2(i,j) = intarray(i-1,j)
c 25        continue
c       elseif (jdir .eq. 1) then
c           do 50 j = 1, jsize
c           do 50 i = 1, isize
c               intarray2(i,j) = intarray(i,j+1)
c 50         continue
c       elseif (jdir .eq. -1) then
c           do 55 j = 1, jsize
c           do 55 i = 1, isize
c              intarray2(i,j) = intarray(i,j-1)
c 55        continue
c       endif
c

c   copy back. need flags in original array

       do 60 j = 1, jsize
       do 60 i = 1, isize
c        intarray(i,j) = max(intarray(i,j),intarray2(i,j))
         intarray(i,j) = intarray(i,j) + intarray2(i,j)
 60    continue


       return
       end