diff options
Diffstat (limited to 'Carpet/CarpetLib/src/copy_3d_real8.F77')
| -rw-r--r-- | Carpet/CarpetLib/src/copy_3d_real8.F77 | 43 |
1 files changed, 7 insertions, 36 deletions
diff --git a/Carpet/CarpetLib/src/copy_3d_real8.F77 b/Carpet/CarpetLib/src/copy_3d_real8.F77 index 716ffd135..ae5d1c34f 100644 --- a/Carpet/CarpetLib/src/copy_3d_real8.F77 +++ b/Carpet/CarpetLib/src/copy_3d_real8.F77 @@ -1,10 +1,7 @@ c -*-Fortran-*- -c $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_real8.F77,v 1.8 2004/03/11 12:03:09 schnetter Exp $ +c $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_real8.F77,v 1.2 2001/03/22 18:42:05 eschnett Exp $ #include "cctk.h" -#include "cctk_Parameters.h" - - subroutine copy_3d_real8 ( $ src, srciext, srcjext, srckext, @@ -13,8 +10,6 @@ c $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_real8 implicit none - DECLARE_CCTK_PARAMETERS - integer srciext, srcjext, srckext CCTK_REAL8 src(srciext,srcjext,srckext) integer dstiext, dstjext, dstkext @@ -32,8 +27,6 @@ c bbox(:,3) is stride integer i, j, k integer d - character msg*1000 - do d=1,3 @@ -46,25 +39,10 @@ c bbox(:,3) is stride call CCTK_WARN (0, "Internal error: strides disagree") 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 @@ -93,19 +71,12 @@ c This could be handled, but is likely to point to an error elsewhere c Loop over region - do k = 1, regkext - do j = 1, regjext - do i = 1, regiext - - if (check_array_accesses.ne.0) then - call checkindex (srcioff+i, srcjoff+j+1, srckoff+k+1, 1,1,1, - $ "source") - call checkindex (dstioff+i, dstjoff+j+1, dstkoff+k+1, 1,1,1, - $ "destination") - end if + do k = 0, regkext-1 + do j = 0, regjext-1 + do i = 0, regiext-1 - dst (dstioff+i, dstjoff+j, dstkoff+k) - $ = src (srcioff+i, srcjoff+j, srckoff+k) + dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) + $ = src (srcioff+i+1, srcjoff+j+1, srckoff+k+1) end do end do |