diff options
| -rw-r--r-- | Carpet/CarpetLib/src/copy_3d_complex16.F77 | 7 | ||||
| -rw-r--r-- | Carpet/CarpetLib/src/data.cc | 69 | ||||
| -rw-r--r-- | Carpet/CarpetLib/src/make.code.defn | 3 |
3 files changed, 71 insertions, 8 deletions
diff --git a/Carpet/CarpetLib/src/copy_3d_complex16.F77 b/Carpet/CarpetLib/src/copy_3d_complex16.F77 index 2432e900c..931307102 100644 --- a/Carpet/CarpetLib/src/copy_3d_complex16.F77 +++ b/Carpet/CarpetLib/src/copy_3d_complex16.F77 @@ -1,5 +1,5 @@ c -*-Fortran-*- -c $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_complex16.F77,v 1.2 2004/03/11 12:01:34 schnetter Exp $ +c $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_complex16.F77,v 1.1 2004/02/09 14:58:07 schnetter Exp $ #include "cctk.h" #include "cctk_Parameters.h" @@ -54,11 +54,6 @@ c bbox(:,3) is stride 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) diff --git a/Carpet/CarpetLib/src/data.cc b/Carpet/CarpetLib/src/data.cc index 5efb769dd..0e69bb2eb 100644 --- a/Carpet/CarpetLib/src/data.cc +++ b/Carpet/CarpetLib/src/data.cc @@ -1,4 +1,4 @@ -// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/data.cc,v 1.42 2004/02/09 14:56:46 schnetter Exp $ +// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/data.cc,v 1.43 2004/02/09 14:58:07 schnetter Exp $ #include <assert.h> #include <limits.h> @@ -376,6 +376,14 @@ extern "C" { const int srcbbox[3][3], const int dstbbox[3][3], const int regbbox[3][3]); + void CCTK_FCALL CCTK_FNAME(copy_3d_complex16) + (const CCTK_COMPLEX16* src, + const int& srciext, const int& srcjext, const int& srckext, + CCTK_COMPLEX16* dst, + const int& dstiext, const int& dstjext, const int& dstkext, + const int srcbbox[3][3], + const int dstbbox[3][3], + const int regbbox[3][3]); } template<> @@ -496,6 +504,65 @@ void data<CCTK_REAL8,3> } } +template<> +void data<CCTK_COMPLEX16,3> +::copy_from_innerloop (const gdata<3>* gsrc, const ibbox& box) +{ + const data* src = (const data*)gsrc; + assert (has_storage() && src->has_storage()); + assert (all(box.lower()>=extent().lower() + && box.lower()>=src->extent().lower())); + assert (all(box.upper()<=extent().upper() + && box.upper()<=src->extent().upper())); + assert (all(box.stride()==extent().stride() + && box.stride()==src->extent().stride())); + assert (all((box.lower()-extent().lower())%box.stride() == 0 + && (box.lower()-src->extent().lower())%box.stride() == 0)); + + assert (proc() == src->proc()); + + int rank; + MPI_Comm_rank (dist::comm, &rank); + assert (rank == proc()); + + const ibbox& sext = src->extent(); + const ibbox& dext = extent(); + + int srcshp[3], dstshp[3]; + int srcbbox[3][3], dstbbox[3][3], regbbox[3][3]; + + for (int d=0; d<3; ++d) { + srcshp[d] = (sext.shape() / sext.stride())[d]; + dstshp[d] = (dext.shape() / dext.stride())[d]; + + srcbbox[0][d] = sext.lower()[d]; + srcbbox[1][d] = sext.upper()[d]; + srcbbox[2][d] = sext.stride()[d]; + + dstbbox[0][d] = dext.lower()[d]; + dstbbox[1][d] = dext.upper()[d]; + dstbbox[2][d] = dext.stride()[d]; + + regbbox[0][d] = box.lower()[d]; + regbbox[1][d] = box.upper()[d]; + regbbox[2][d] = box.stride()[d]; + } + + assert (all(dext.stride() == box.stride())); + if (all(sext.stride() == dext.stride())) { + CCTK_FNAME(copy_3d_complex16) ((const CCTK_COMPLEX16*)src->storage(), + srcshp[0], srcshp[1], srcshp[2], + (CCTK_COMPLEX16*)storage(), + dstshp[0], dstshp[1], dstshp[2], + srcbbox, + dstbbox, + regbbox); + + } else { + assert (0); + } +} + extern "C" { diff --git a/Carpet/CarpetLib/src/make.code.defn b/Carpet/CarpetLib/src/make.code.defn index 7cbecca46..a5d4ed970 100644 --- a/Carpet/CarpetLib/src/make.code.defn +++ b/Carpet/CarpetLib/src/make.code.defn @@ -1,5 +1,5 @@ # Main make.code.defn file for thorn CarpetLib -*-Makefile-*- -# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/make.code.defn,v 1.11 2004/01/25 14:57:30 schnetter Exp $ +# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/make.code.defn,v 1.12 2004/02/09 14:58:07 schnetter Exp $ # Source files in this directory SRCS = bbox.cc \ @@ -15,6 +15,7 @@ SRCS = bbox.cc \ th.cc \ vect.cc \ checkindex.F77 \ + copy_3d_complex16.F77 \ copy_3d_int4.F77 \ copy_3d_real8.F77 \ prolongate_3d_real8.F77 \ |