1 files changed, 62 insertions, 0 deletions
diff --git a/src/extrapolate.F90 b/src/extrapolate.F90
new file mode 100644
index 0000000..b9b0b99
--- /dev/null
+++ b/src/extrapolate.F90
@@ -0,0 +1,62 @@
+! $Header$
+
+! Extrapolate the difference between the grid function var and oldvar to
+! var where indicated by mask.  Use the normal direction given by dirx,
+! diry, and dirz for extrapolation.
+
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+#include "maskvalues.h"
+
+subroutine excision_extrapolate (ierr, cctkgh, var, oldvar, &
+     mask, dirx, diry, dirz, ni, nj, nk)
+  
+  implicit none
+  
+  DECLARE_CCTK_FUNCTIONS
+  DECLARE_CCTK_PARAMETERS
+  
+  ! Arguments
+  
+  ! out: zero for success, nonzero for error
+  integer      :: ierr
+  
+  ! in: pointer to Cactus GH
+  CCTK_POINTER :: cctkgh
+  
+  ! in: array sizes for grid functions
+  !     (you can pass in cctk_lsh(:) for these)
+  integer      :: ni,nj,nk
+  
+  ! inout: grid function that should be interpolated
+  CCTK_REAL    :: var(ni,nj,nk)
+  
+  ! in: other grid function for interpolation
+  CCTK_REAL    :: oldvar(ni,nj,nk)
+  
+  ! in: mask
+  CCTK_REAL    :: mask(ni,nj,nk)
+  
+  ! in: normal directions to use for interpolation
+  CCTK_REAL    :: dirx(ni,nj,nk), diry(ni,nj,nk), dirz(ni,nj,nk)
+  
+  integer i,j,k
+  integer ii,jj,kk
+  
+  do k=2,nk-1
+     do j=2,nj-1
+        do i=2,ni-1
+           if (mask(i,j,k)==MASK_BOUNDARY) then
+              ii = i + dirx(i,j,k)
+              jj = j + diry(i,j,k)
+              kk = k + dirz(i,j,k)
+              var(i,j,k) = oldvar(i,j,k) + var(ii,jj,kk) - oldvar(ii,jj,kk)
+           end if
+        end do
+     end do
+  end do
+  
+  ierr = 0
+  
+end subroutine excision_extrapolate