From 9e123105ac2fa380512484be78541874a94ec6c0 Mon Sep 17 00:00:00 2001
From: schnetter <>
Date: Tue, 25 Feb 2003 21:57:00 +0000
Subject: Handle empty bboxes.

Handle empty bboxes.
*.F77: Better error checking whether the active region is contained in
the source and destination arrays.

*.F77: Temporarily activated per-gridpoint checking of array accesses.

bbox.cc bboxset.cc: Handle empty bboxes better -- either handle them
correctly, or abort.

gdata.cc: Recognise empty regions.

ggf.cc: Remove line that was commented out for a long time.

dh.cc: Choose send and recv regions for syncing and prolongation so
that they don't overlap.

dh.cc: Handle empty bboxes.

darcs-hash:20030225215700-07bb3-a7296dd92353c003bc0bd3ff435e4939f8041eae.gz
---
 Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 | 29 ++++++++++++++++++++----
 1 file changed, 24 insertions(+), 5 deletions(-)

(limited to 'Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77')

diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77
index 8fab444ae..a89ccfbba 100644
--- a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77
@@ -1,7 +1,20 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77,v 1.8 2003/02/24 17:43:10 schnetter Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77,v 1.9 2003/02/25 22:57:00 schnetter Exp $
       
 #include "cctk.h"
+
+
+
+#define CHKIDX(i,j,k, imax,jmax,kmax, where)                                  \
+      if ((i).lt.1 .or. (i).gt.(imax)                                         \
+           .or. (j).lt.1 .or. (j).gt.(jmax)                                   \
+           .or. (k).lt.1 .or. (k).gt.(kmax)) then                           &&\
+         write (msg, '(a, " array index out of bounds: shape is (",i4,",",i4,",",i4,"), index is (",i4,",",i4,",",i4,")")') \
+              (where), (imax), (jmax), (kmax), (i), (j), (k)                &&\
+         call CCTK_WARN (0, msg(1:len_trim(msg)))                           &&\
+      end if
+
+
       
       subroutine prolongate_3d_real8_2tl (
      $     src1, t1, src2, t2, srciext, srcjext, srckext,
@@ -48,6 +61,8 @@ c     bbox(:,3) is stride
       CCTK_REAL8 res
       integer d
       
+      character msg*1000
+      
       
       
       do d=1,3
@@ -67,16 +82,16 @@ c     bbox(:,3) is stride
      $        .or. mod(regbbox(d,1), regbbox(d,3)).ne.0) then
             call CCTK_WARN (0, "Internal error: array origins are not integer multiples of the strides")
          end if
+         if (regbbox(d,1).gt.regbbox(d,2)) then
+c     This could be handled, but is likely to point to an error elsewhere
+            call CCTK_WARN (0, "Internal error: region extent is empty")
+         end if
          if (regbbox(d,1).lt.srcbbox(d,1)
      $        .or. regbbox(d,1).lt.dstbbox(d,1)
      $        .or. regbbox(d,2).gt.srcbbox(d,2)
      $        .or. regbbox(d,2).gt.dstbbox(d,2)) then
             call CCTK_WARN (0, "Internal error: region extent is not contained in array extent")
          end if
-         if (regbbox(d,1).gt.regbbox(d,2)) then
-c     This could be handled, but is likely to point to an error elsewhere
-            call CCTK_WARN (0, "Internal error: region extent is empty")
-         end if
       end do
       
       if (srciext.ne.(srcbbox(1,2)-srcbbox(1,1))/srcbbox(1,3)+1
@@ -151,6 +166,8 @@ c     Loop over fine region
                         fac = ifac(ii) * jfac(jj) * kfac(kk)
                         
                         if (fac.ne.0) then
+                           CHKIDX (i0+ii, j0+jj, k0+kk, \
+                                   srciext,srcjext,srckext, "source")
                            res = res
      $                          + fac * s1fac * src1(i0+ii, j0+jj, k0+kk)
      $                          + fac * s2fac * src2(i0+ii, j0+jj, k0+kk)
@@ -160,6 +177,8 @@ c     Loop over fine region
                   end do
                end do
                
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
                dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
                
             end do
-- 
cgit v1.2.3