diff options
Diffstat (limited to 'Carpet')
-rw-r--r-- | Carpet/CarpetLib/src/checkindex.F77 | 22 | ||||
-rw-r--r-- | Carpet/CarpetLib/src/checkindex.c | 32 | ||||
-rw-r--r-- | Carpet/CarpetLib/src/copy_3d_complex16.F77 | 6 | ||||
-rw-r--r-- | Carpet/CarpetLib/src/copy_3d_int4.F77 | 6 | ||||
-rw-r--r-- | Carpet/CarpetLib/src/copy_3d_real8.F77 | 6 | ||||
-rw-r--r-- | Carpet/CarpetLib/src/make.code.defn | 2 |
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 \ |