CarpetLib: Correct errors in array index checking code

Correct errors in array index checking code for the copy operators.

darcs-hash:20060925213952-dae7b-632a2159ea9f676e88ec4e27d16d2c5134b09f4f.gz

6 files changed, 45 insertions, 29 deletions

diff --git a/Carpet/CarpetLib/src/checkindex.F77 b/Carpet/CarpetLib/src/checkindex.F77
deleted file mode 100644
index 6f2f0cd83..000000000
--- a/Carpet/CarpetLib/src/checkindex.F77
+++ /dev/null
@@ -1,22 +0,0 @@
-c     -*-Fortran-*-
-      
-#include "cctk.h"
-
-
-
-      subroutine checkindex (i,j,k, di,dj,dk, imax,jmax,kmax, where)
-      implicit none
-      integer i,j,k
-      integer di,dj,dk
-      integer imax,jmax,kmax
-      character*(*) where
-      character*1000 msg
-      
-      if (      i.lt.1 .or. i+di-1.gt.imax
-     $     .or. j.lt.1 .or. j+dj-1.gt.jmax
-     $     .or. k.lt.1 .or. k+dk-1.gt.kmax) then
-         write (msg, '(a, " array index out of bounds: shape is (",i4,",",i4,",",i4,"), index is (",i4,",",i4,",",i4,"), extent is (",i4,",",i4,",",i4,")")')
-     $        where, imax,jmax,kmax, i,j,k, di,dj,dk
-         call CCTK_WARN (0, msg)
-      end if
-      end
diff --git a/Carpet/CarpetLib/src/checkindex.c b/Carpet/CarpetLib/src/checkindex.c
new file mode 100644
index 000000000..8127251f9
--- /dev/null
+++ b/Carpet/CarpetLib/src/checkindex.c
@@ -0,0 +1,32 @@
+#include <assert.h>
+#include <string.h>
+
+#include <cctk.h>
+
+
+
+void
+CCTK_FCALL
+CCTK_FNAME(checkindex) (int const * restrict const i,
+                        int const * restrict const j,
+                        int const * restrict const k,
+                        int const * restrict const di,
+                        int const * restrict const dj,
+                        int const * restrict const dk,
+                        int const * restrict const imax,
+                        int const * restrict const jmax,
+                        int const * restrict const kmax,
+                        ONE_FORTSTRING_ARG)
+{
+  if (*i < 1 || *i+*di-1 > *imax ||
+      *j < 1 || *j+*dj-1 > *jmax ||
+      *k < 1 || *k+*dk-1 > *kmax)
+  {
+    ONE_FORTSTRING_CREATE (where);
+    CCTK_VWarn (1, __LINE__, __FILE__, CCTK_THORNSTRING,
+                "%s array index out of bounds: shape is (%d,%d,%d), index is (%d,%d,%d), extent is (%d,%d,%d)",
+                where, *imax,*jmax,*kmax, *i,*j,*k, *di,*dj,*dk);
+    assert (0);
+    free (where);
+  }
+}
diff --git a/Carpet/CarpetLib/src/copy_3d_complex16.F77 b/Carpet/CarpetLib/src/copy_3d_complex16.F77
index 9839de44e..0372b4579 100644
--- a/Carpet/CarpetLib/src/copy_3d_complex16.F77
+++ b/Carpet/CarpetLib/src/copy_3d_complex16.F77
@@ -95,9 +95,11 @@ c     Loop over region
             do i = 1, regiext
                
                if (check_array_accesses.ne.0) then
-                  call checkindex (srcioff+i, srcjoff+j+1, srckoff+k+1, 1,1,1,
+                  call checkindex (srcioff+i, srcjoff+j, srckoff+k, 1,1,1,
+     $                 srciext, srcjext, srckext,
      $                 "source")
-                  call checkindex (dstioff+i, dstjoff+j+1, dstkoff+k+1, 1,1,1,
+                  call checkindex (dstioff+i, dstjoff+j, dstkoff+k, 1,1,1,
+     $                 dstiext, dstjext, dstkext,
      $                 "destination")
                end if
                
diff --git a/Carpet/CarpetLib/src/copy_3d_int4.F77 b/Carpet/CarpetLib/src/copy_3d_int4.F77
index 4422421e7..e91ef93a9 100644
--- a/Carpet/CarpetLib/src/copy_3d_int4.F77
+++ b/Carpet/CarpetLib/src/copy_3d_int4.F77
@@ -95,9 +95,11 @@ c     Loop over region
             do i = 1, regiext
                
                if (check_array_accesses.ne.0) then
-                  call checkindex (srcioff+i, srcjoff+j+1, srckoff+k+1, 1,1,1,
+                  call checkindex (srcioff+i, srcjoff+j, srckoff+k, 1,1,1,
+     $                 srciext, srcjext, srckext,
      $                 "source")
-                  call checkindex (dstioff+i, dstjoff+j+1, dstkoff+k+1, 1,1,1,
+                  call checkindex (dstioff+i, dstjoff+j, dstkoff+k, 1,1,1,
+     $                 dstiext, dstjext, dstkext,
      $                 "destination")
                end if
                
diff --git a/Carpet/CarpetLib/src/copy_3d_real8.F77 b/Carpet/CarpetLib/src/copy_3d_real8.F77
index a017dabc6..535c1aab9 100644
--- a/Carpet/CarpetLib/src/copy_3d_real8.F77
+++ b/Carpet/CarpetLib/src/copy_3d_real8.F77
@@ -121,9 +121,11 @@ c     Loop over region
             do i = 1, regiext
                
                if (check_array_accesses.ne.0) then
-                  call checkindex (srcioff+i, srcjoff+j+1, srckoff+k+1, 1,1,1,
+                  call checkindex (srcioff+i, srcjoff+j, srckoff+k, 1,1,1,
+     $                 srciext, srcjext, srckext,
      $                 "source")
-                  call checkindex (dstioff+i, dstjoff+j+1, dstkoff+k+1, 1,1,1,
+                  call checkindex (dstioff+i, dstjoff+j, dstkoff+k, 1,1,1,
+     $                 dstiext, dstjext, dstkext,
      $                 "destination")
                end if
                
diff --git a/Carpet/CarpetLib/src/make.code.defn b/Carpet/CarpetLib/src/make.code.defn
index 3fc17dfcd..7a846f845 100644
--- a/Carpet/CarpetLib/src/make.code.defn
+++ b/Carpet/CarpetLib/src/make.code.defn
@@ -15,7 +15,7 @@ SRCS =	bbox.cc					\
 	mem.cc					\
 	th.cc					\
 	vect.cc					\
-	checkindex.F77				\
+	checkindex.c				\
 	copy_3d_complex16.F77			\
 	copy_3d_int4.F77			\
 	copy_3d_real8.F77			\