Brought in latest differences from the SGI version. This is work

Brought in latest differences from the SGI version.  This is work
towards a code that compiles on both architectures.

darcs-hash:20010322174200-f6438-23ab5f26cf84d2666312791c6bdb5a0fc1d0390a.gz

1 files changed, 2 insertions, 36 deletions

diff --git a/Carpet/CarpetLib/src/restrict_3d_real8.F77 b/Carpet/CarpetLib/src/restrict_3d_real8.F77
index 81f4cfd0a..68ea98b11 100644
--- a/Carpet/CarpetLib/src/restrict_3d_real8.F77
+++ b/Carpet/CarpetLib/src/restrict_3d_real8.F77
@@ -1,20 +1,7 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/restrict_3d_real8.F77,v 1.7 2004/03/11 12:03:09 schnetter Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/restrict_3d_real8.F77,v 1.2 2001/03/22 18:42:06 eschnett 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 restrict_3d_real8 (
      $     src, srciext, srcjext, srckext,
@@ -42,8 +29,6 @@ c     bbox(:,3) is stride
       integer i, j, k
       integer d
       
-      character msg*1000
-      
       
       
       do d=1,3
@@ -59,25 +44,10 @@ c     bbox(:,3) is stride
             call CCTK_WARN (0, "Internal error: source strides are not integer multiples of the destination strides")
          end if
          if (mod(srcbbox(d,1), srcbbox(d,3)).ne.0
-     $        .or. mod(dstbbox(d,1), dstbbox(d,3)).ne.0
+     $     .or. mod(dstbbox(d,1), dstbbox(d,3)).ne.0
      $        .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 (mod(srcbbox(d,2) - srcbbox(d,1), srcbbox(d,3)).ne.0
-     $        .or. mod(dstbbox(d,2) - dstbbox(d,1), dstbbox(d,3)).ne.0
-     $        .or. mod(regbbox(d,2) - regbbox(d,1), regbbox(d,3)).ne.0) then
-            call CCTK_WARN (0, "Internal error: array extents are not integer multiples of the strides")
-         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
       end do
       
       if (srciext.ne.(srcbbox(1,2)-srcbbox(1,1))/srcbbox(1,3)+1
@@ -114,10 +84,6 @@ c     Loop over coarse region
          do j = 0, regjext-1
             do i = 0, regiext-1
                
-               CHKIDX (srcioff+srcifac*i+1, srcjoff+srcjfac*j+1, srckoff+srckfac*k+1, \
-                       srciext,srcjext,srckext, "source")
-               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
-                       dstiext,dstjext,dstkext, "destination")
                dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1)
      $              = src (srcioff+srcifac*i+1, srcjoff+srcjfac*j+1, srckoff+srckfac*k+1)