From 2bc19d01691ddc1cd94725d330c6b6abbe24c130 Mon Sep 17 00:00:00 2001 From: Erik Schnetter Date: Tue, 12 Dec 2006 16:02:00 +0000 Subject: CarpetLib: Replace CHKIDX macros with calls to checkindex darcs-hash:20061212160245-dae7b-19df81c29d911d9c77ae0aaa99ae999a0f6d27c9.gz --- Carpet/CarpetLib/src/prolongate_3d_real8.F77 | 26 ++++++++-------------- Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 | 26 ++++++++-------------- .../src/prolongate_3d_real8_2tl_minmod.F77 | 19 +++++----------- .../CarpetLib/src/prolongate_3d_real8_2tl_o3.F77 | 26 ++++++++-------------- .../CarpetLib/src/prolongate_3d_real8_2tl_o5.F77 | 26 ++++++++-------------- Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77 | 26 ++++++++-------------- .../src/prolongate_3d_real8_3tl_minmod.F77 | 21 +++++------------ .../CarpetLib/src/prolongate_3d_real8_3tl_o3.F77 | 26 ++++++++-------------- .../CarpetLib/src/prolongate_3d_real8_3tl_o5.F77 | 26 ++++++++-------------- .../CarpetLib/src/prolongate_3d_real8_minmod.F77 | 19 +++++----------- Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77 | 26 ++++++++-------------- Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 | 26 ++++++++-------------- Carpet/CarpetLib/src/prolongate_3d_real8_o7.F77 | 26 ++++++++-------------- Carpet/CarpetLib/src/restrict_3d_real8.F77 | 24 ++++++-------------- 14 files changed, 115 insertions(+), 228 deletions(-) diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8.F77 index e843ae42e..4383fe0c9 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8.F77 @@ -1,17 +1,7 @@ c -*-Fortran-*- #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) &&\ - end if +#include "cctk_Parameters.h" @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -51,8 +43,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -148,8 +138,9 @@ 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") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii, j0+jj, k0+kk, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res + fac * src(i0+ii, j0+jj, k0+kk) end if @@ -181,8 +172,9 @@ c$$$ c$$$ fac = ifac(2) * jfac(2) * kfac(2) c$$$ if (fac.ne.0) res = res + fac * src(i0+2, j0+2, k0+2) - 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 index 7ec6dc3a7..0bf91a371 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.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_2tl ( $ src1, t1, src2, t2, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -60,8 +52,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -170,8 +160,9 @@ 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") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii, j0+jj, k0+kk, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res $ + fac * s1fac * src1(i0+ii, j0+jj, k0+kk) $ + fac * s2fac * src2(i0+ii, j0+jj, k0+kk) @@ -181,8 +172,9 @@ c Loop over fine region 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77 index 1032bd2e4..ab086faf7 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77 @@ -1,6 +1,7 @@ c -*-Fortran-*- #include "cctk.h" +#include "cctk_Parameters.h" c$$$ This routine performs "TVD" prolongation. It is intended to be used c$$$ with GFs that are not expected to be smooth, particularly those @@ -22,15 +23,6 @@ c$$$ The actual minmod function is defined in the routine c$$$ c$$$ prolongate_3d_real8_minmod.F77 -#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_2tl_minmod ( @@ -40,6 +32,8 @@ c$$$ prolongate_3d_real8_minmod.F77 implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -76,8 +70,6 @@ c bbox(:,3) is stride integer ii, jj, kk integer d - character msg*1000 - external minmod CCTK_REAL8 minmod @@ -305,8 +297,9 @@ c Loop over fine region 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) = $ s1fac * (src1(i0+1,j0+1,k0+1) + $ slopex(1) + slopey(1) + slopez(1)) + diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77 index f1e508195..4a0d55901 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.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_2tl_o3 ( $ src1, t1, src2, t2, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -62,8 +54,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -195,8 +185,9 @@ c Loop over fine region fac = ifac(ii) * jfac(jj) * kfac(kk) if (fac.ne.0) then - CHKIDX (i0+ii-1, j0+jj-1, k0+kk-1, \ - srciext,srcjext,srckext, "source") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii-1, j0+jj-1, k0+kk-1, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res $ + fac * s1fac * src1(i0+ii-1, j0+jj-1, k0+kk-1) $ + fac * s2fac * src2(i0+ii-1, j0+jj-1, k0+kk-1) @@ -206,8 +197,9 @@ c Loop over fine region 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77 index 9b61ea0d6..ae8f488ae 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_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_2tl_o5 ( $ src1, t1, src2, t2, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -62,8 +54,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -203,8 +193,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 * s1fac * src1(i0+ii-2, j0+jj-2, k0+kk-2) $ + fac * s2fac * src2(i0+ii-2, j0+jj-2, k0+kk-2) @@ -214,8 +205,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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77 index 83db23a27..6cb09a6b8 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.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_3tl ( $ src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -62,8 +54,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -173,8 +163,9 @@ 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") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii, j0+jj, k0+kk, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res $ + fac * s1fac * src1(i0+ii, j0+jj, k0+kk) $ + fac * s2fac * src2(i0+ii, j0+jj, k0+kk) @@ -185,8 +176,9 @@ c Loop over fine region 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77 index 30c6116be..2dad7f5eb 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77 @@ -1,6 +1,7 @@ c -*-Fortran-*- #include "cctk.h" +#include "cctk_Parameters.h" c$$$ This routine performs "TVD" prolongation. It is intended to be used @@ -24,17 +25,6 @@ c$$$ c$$$ prolongate_3d_real8_minmod.F77 -#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_3tl_minmod ( $ src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -42,6 +32,8 @@ c$$$ prolongate_3d_real8_minmod.F77 implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -80,8 +72,6 @@ c bbox(:,3) is stride integer ii, jj, kk integer d - character msg*1000 - external minmod CCTK_REAL8 minmod @@ -366,8 +356,9 @@ c Loop over fine region 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) = $ s1fac * (src1(i0+1,j0+1,k0+1) + $ slopex(1) + slopey(1) + slopez(1)) + diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77 index 7b4291baa..2271a4eb0 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.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_3tl_o3 ( $ src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -64,8 +56,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -198,8 +188,9 @@ c Loop over fine region fac = ifac(ii) * jfac(jj) * kfac(kk) if (fac.ne.0) then - CHKIDX (i0+ii-1, j0+jj-1, k0+kk-1, \ - srciext,srcjext,srckext, "source") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii-1, j0+jj-1, k0+kk-1, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res $ + fac * s1fac * src1(i0+ii-1, j0+jj-1, k0+kk-1) $ + fac * s2fac * src2(i0+ii-1, j0+jj-1, k0+kk-1) @@ -210,8 +201,9 @@ c Loop over fine region 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77 index 2429435cf..53f2642f5 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_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_3tl_o5 ( $ src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext, $ dst, t, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -64,8 +56,6 @@ c bbox(:,3) is stride CCTK_REAL8 res integer d - character msg*1000 - do d=1,3 @@ -206,8 +196,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 * s1fac * src1(i0+ii-2, j0+jj-2, k0+kk-2) $ + fac * s2fac * src2(i0+ii-2, j0+jj-2, k0+kk-2) @@ -218,8 +209,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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77 index 20895ead5..32c3e6227 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77 @@ -1,6 +1,7 @@ c -*-Fortran-*- #include "cctk.h" +#include "cctk_Parameters.h" c$$$ This routine performs "TVD" prolongation. It is intended to be used @@ -24,15 +25,6 @@ c$$$ c$$$ prolongate_3d_real8_minmod.F77 -#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 - function minmod(a, b) implicit none @@ -59,6 +51,8 @@ c$$$ prolongate_3d_real8_minmod.F77 implicit none + DECLARE_CCTK_PARAMETERS + CCTK_REAL8 one parameter (one = 1) @@ -86,8 +80,6 @@ c bbox(:,3) is stride integer ii, jj, kk integer d - character msg*1000 - external minmod CCTK_REAL8 minmod @@ -247,8 +239,9 @@ c Loop over fine region 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 checkinde (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) = . src(i0+1,j0+1,k0+1) + slopex + slopey + slopez diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77 index 8af6727ef..98b1cb62a 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o3.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_o3 ( $ 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 @@ -173,8 +163,9 @@ c Loop over fine region fac = ifac(ii) * jfac(jj) * kfac(kk) if (fac.ne.0) then - CHKIDX (i0+ii-1, j0+jj-1, k0+kk-1, \ - srciext,srcjext,srckext, "source") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii-1, j0+jj-1, k0+kk-1, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res + fac * src(i0+ii-1, j0+jj-1, k0+kk-1) end if @@ -182,8 +173,9 @@ c Loop over fine region 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 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 diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o7.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o7.F77 index afe06f137..bcafca46a 100644 --- a/Carpet/CarpetLib/src/prolongate_3d_real8_o7.F77 +++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o7.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_o7 ( $ 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 @@ -187,8 +177,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-3, j0+jj-3, k0+kk-3, \ - srciext,srcjext,srckext, "source") + if (check_array_accesses.ne.0) then + call checkindex (i0+ii-3, j0+jj-3, k0+kk-3, 1,1,1, srciext,srcjext,srckext, "source") + end if res = res + fac * src(i0+ii-3, j0+jj-3, k0+kk-3) end if @@ -196,8 +187,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 diff --git a/Carpet/CarpetLib/src/restrict_3d_real8.F77 b/Carpet/CarpetLib/src/restrict_3d_real8.F77 index 01cd4d355..05ca2776d 100644 --- a/Carpet/CarpetLib/src/restrict_3d_real8.F77 +++ b/Carpet/CarpetLib/src/restrict_3d_real8.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 restrict_3d_real8 ( $ src, srciext, srcjext, srckext, $ dst, dstiext, dstjext, dstkext, @@ -22,6 +12,8 @@ c -*-Fortran-*- implicit none + DECLARE_CCTK_PARAMETERS + integer srciext, srcjext, srckext CCTK_REAL8 src(srciext,srcjext,srckext) integer dstiext, dstjext, dstkext @@ -41,8 +33,6 @@ c bbox(:,3) is stride integer i, j, k integer d - character msg*1000 - do d=1,3 @@ -113,10 +103,10 @@ 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") + if (check_array_accesses.ne.0) then + call checkindex (srcioff+srcifac*i+1, srcjoff+srcjfac*j+1, srckoff+srckfac*k+1, 1,1,1, srciext,srcjext,srckext, "source") + 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) $ = src (srcioff+srcifac*i+1, srcjoff+srcjfac*j+1, srckoff+srckfac*k+1) -- cgit v1.2.3