diff options
Diffstat (limited to 'Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77')
| -rw-r--r-- | Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 | 26 |
1 files changed, 9 insertions, 17 deletions
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 index 257ad96d0..a1a633c82 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 @@ -1,20 +1,10 @@ c -*-Fortran-*- #include "cctk.h" +#include "cctk_Parameters.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) &&\ - end if - - - subroutine prolongate_3d_real8_o5 ( $ src, srciext, srcjext, srckext, $ dst, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -53,8 +45,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -181,8 +171,9 @@ c (This expression cannot be evaluated as integer) c (This expression cannot be evaluated as integer) fac = one * ifac(ii) * jfac(jj) * kfac(kk) - CHKIDX (i0+ii-2, j0+jj-2, k0+kk-2, \ - srciext,srcjext,srckext, "source") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii-2, j0+jj-2, k0+kk-2, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res + fac * src(i0+ii-2, j0+jj-2, k0+kk-2) end if @@ -190,8 +181,9 @@ c (This expression cannot be evaluated as integer) end do end do - CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \ - dstiext,dstjext,dstkext, "destination") + if (check_array_accesses.ne.0) then + call checkindex (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, 1,1,1, dstiext,dstjext,dstkext, "destination") + end if dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res end do |