Initial revision

darcs-hash:20010301114010-f6438-12fb8a9ffcc80e86c0a97e37b5b0dae0dbc59b79.gz

61 files changed, 15060 insertions, 0 deletions

diff --git a/Carpet/CarpetLib/COPYING b/Carpet/CarpetLib/COPYING
new file mode 100644
index 000000000..1942c4334
--- /dev/null
+++ b/Carpet/CarpetLib/COPYING
@@ -0,0 +1,341 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                          59 Temple Place - Suite 330
+                          Boston, MA 02111-1307, USA.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; see the file COPYING.  If not, write to
+    the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+    Boston, MA 02111-1307, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19yy name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/Carpet/CarpetLib/README b/Carpet/CarpetLib/README
new file mode 100644
index 000000000..050a838b0
--- /dev/null
+++ b/Carpet/CarpetLib/README
@@ -0,0 +1,8 @@
+Cactus Code Thorn CarpetLib
+Authors    : Erik Schnetter <schnetter@uni-tuebingen.de>
+CVS info   : $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/README,v 1.3 2004/01/25 14:57:29 schnetter Exp $
+--------------------------------------------------------------------------
+
+Purpose of the thorn:
+
+This thorn contains the backend library that provides mesh refinement.
diff --git a/Carpet/CarpetLib/configuration.ccl b/Carpet/CarpetLib/configuration.ccl
new file mode 100644
index 000000000..1e2583eda
--- /dev/null
+++ b/Carpet/CarpetLib/configuration.ccl
@@ -0,0 +1,8 @@
+# Configuration definitions for thorn CarpetLib
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/configuration.ccl,v 1.1 2004/04/18 14:09:59 schnetter Exp $
+
+PROVIDES CarpetLib
+{
+  SCRIPT
+  LANG
+}
diff --git a/Carpet/CarpetLib/interface.ccl b/Carpet/CarpetLib/interface.ccl
new file mode 100644
index 000000000..593228e75
--- /dev/null
+++ b/Carpet/CarpetLib/interface.ccl
@@ -0,0 +1,22 @@
+# Interface definition for thorn CarpetLib
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/interface.ccl,v 1.5 2004/05/04 22:09:54 schnetter Exp $
+
+IMPLEMENTS: CarpetLib
+
+includes header: defs.hh in defs.hh
+includes header: dist.hh in dist.hh
+
+includes header: bbox.hh in bbox.hh
+includes header: bboxset.hh in bboxset.hh
+includes header: vect.hh in vect.hh
+
+includes header: data.hh in data.hh
+includes header: gdata.hh in gdata.hh
+
+includes header: dh.hh in dh.hh
+includes header: gf.hh in gf.hh
+includes header: ggf.hh in ggf.hh
+includes header: gh.hh in gh.hh
+includes header: th.hh in th.hh
+
+includes header: operators.hh in operators.hh
diff --git a/Carpet/CarpetLib/param.ccl b/Carpet/CarpetLib/param.ccl
new file mode 100644
index 000000000..1b4e14a87
--- /dev/null
+++ b/Carpet/CarpetLib/param.ccl
@@ -0,0 +1,24 @@
+# Parameter definitions for thorn CarpetLib
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/param.ccl,v 1.8 2004/05/21 18:13:41 schnetter Exp $
+
+private:
+
+BOOLEAN verbose "Print info to the screen" STEERABLE=always
+{
+} "no"
+
+BOOLEAN check_array_accesses "Check all array accesses in Fortran" STEERABLE=always
+{
+} "no"
+
+BOOLEAN barriers "Insert barriers at strategic places for debugging purposes (slows down execution)" STEERABLE=always
+{
+} "no"
+
+BOOLEAN output_bboxes "Output bounding box information to the screen" STEERABLE=always
+{
+} "no"
+
+BOOLEAN save_memory_during_regridding "Save some memory during regridding at the expense of speed"
+{
+} "no"
diff --git a/Carpet/CarpetLib/schedule.ccl b/Carpet/CarpetLib/schedule.ccl
new file mode 100644
index 000000000..ef0ff81a6
--- /dev/null
+++ b/Carpet/CarpetLib/schedule.ccl
@@ -0,0 +1,2 @@
+# Schedule definitions for thorn CarpetLib
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/schedule.ccl,v 1.2 2003/09/19 16:06:41 schnetter Exp $
diff --git a/Carpet/CarpetLib/src/bbox.cc b/Carpet/CarpetLib/src/bbox.cc
new file mode 100644
index 000000000..9269e042d
--- /dev/null
+++ b/Carpet/CarpetLib/src/bbox.cc
@@ -0,0 +1,270 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/bbox.cc,v 1.26 2004/06/26 15:08:09 schnetter Exp $
+
+#include <assert.h>
+
+#include <iostream>
+#include <limits>
+
+#include "defs.hh"
+#include "vect.hh"
+
+#include "bbox.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<class T, int D>
+bbox<T,D>::bbox (): _lower(T(1)), _upper(T(0)), _stride(T(1)) { }
+
+template<class T, int D>
+bbox<T,D>::bbox (const bbox& b)
+  : _lower(b._lower), _upper(b._upper), _stride(b._stride)
+{ }
+
+template<class T, int D>
+bbox<T,D>& bbox<T,D>::operator= (const bbox& b) {
+  _lower=b._lower; _upper=b._upper; _stride=b._stride;
+  return *this;
+}
+
+template<class T, int D>
+bbox<T,D>::bbox (const vect<T,D>& lower, const vect<T,D>& upper,
+		 const vect<T,D>& stride)
+  : _lower(lower), _upper(upper), _stride(stride)
+{
+  assert (all(_stride>T(0)));
+  assert (all((_upper-_lower)%_stride == T(0)));
+  if (numeric_limits<T>::is_integer && numeric_limits<T>::is_signed) {
+    // prevent accidental wrap-around
+    assert (all(_lower < numeric_limits<T>::max() / 2));
+    assert (all(_lower > numeric_limits<T>::min() / 2));
+    assert (all(_upper < numeric_limits<T>::max() / 2));
+    assert (all(_upper > numeric_limits<T>::min() / 2));
+  }
+}
+
+// Accessors
+template<class T, int D>
+T bbox<T,D>::size () const {
+  if (empty()) return 0;
+//   return prod((shape()+stride()-1)/stride());
+  const vect<T,D> sh((shape()+stride()-1)/stride());
+  T sz = 1, max = numeric_limits<T>::max();
+  for (int d=0; d<D; ++d) {
+    assert (sh[d] <= max);
+    sz *= sh[d];
+    max /= sh[d];
+  }
+  return sz;
+}
+
+// Queries
+template<class T, int D>
+bool bbox<T,D>::contains (const vect<T,D>& x) const {
+  return all(x>=lower() && x<=upper());
+}
+
+// Operators
+template<class T, int D>
+bool bbox<T,D>::operator== (const bbox& b) const {
+  if (empty() && b.empty()) return true;
+  assert (all(stride()==b.stride()));
+  return all(lower()==b.lower() && upper()==b.upper());
+}
+
+template<class T, int D>
+bool bbox<T,D>::operator!= (const bbox& b) const {
+  return ! (*this == b);
+}
+
+template<class T, int D>
+bool bbox<T,D>::operator< (const bbox& b) const {
+  // An arbitraty order: empty boxes come first, then sorted by lower
+  // bound, then by upper bound, then by coarseness
+  if (b.empty()) return false;
+  if (empty()) return true;
+  for (int d=D-1; d>=0; --d) {
+    if (lower()[d] < b.lower()[d]) return true;
+    if (lower()[d] > b.lower()[d]) return false;
+  }
+  for (int d=D-1; d>=0; --d) {
+    if (upper()[d] < b.upper()[d]) return true;
+    if (upper()[d] > b.upper()[d]) return false;
+  }
+  for (int d=D-1; d>=0; --d) {
+    if (stride()[d] > b.stride()[d]) return true;
+    if (stride()[d] < b.stride()[d]) return false;
+  }
+  return false;
+}
+
+template<class T, int D>
+bool bbox<T,D>::operator> (const bbox& b) const {
+  return b < *this;
+}
+
+template<class T, int D>
+bool bbox<T,D>::operator<= (const bbox& b) const {
+  return ! (b > *this);
+}
+
+template<class T, int D>
+bool bbox<T,D>::operator>= (const bbox& b) const {
+  return b <= *this;
+}
+
+// Intersection
+template<class T, int D>
+bbox<T,D> bbox<T,D>::operator& (const bbox& b) const {
+  assert (all(stride()==b.stride()));
+  vect<T,D> lo = max(lower(),b.lower());
+  vect<T,D> up = min(upper(),b.upper());
+  return bbox(lo,up,stride());
+}
+
+// Containment
+template<class T, int D>
+bool bbox<T,D>::is_contained_in (const bbox& b) const {
+  if (empty()) return true;
+  // no alignment check
+  return all(lower()>=b.lower() && upper()<=b.upper());
+}
+
+// Alignment check
+template<class T, int D>
+bool bbox<T,D>::is_aligned_with (const bbox& b) const {
+  return all(stride()==b.stride() && (lower()-b.lower()) % stride() == T(0));
+}
+
+// Expand the bbox a little by multiples of the stride
+template<class T, int D>
+bbox<T,D> bbox<T,D>::expand (const vect<T,D>& lo, const vect<T,D>& hi) const {
+  // Allow expansion only into directions where the extent is not negative
+  assert (all(lower()<=upper() || (lo==T(0) && hi==T(0))));
+  const vect<T,D> str = stride();
+  const vect<T,D> lb = lower() - lo * str;
+  const vect<T,D> ub = upper() + hi * str;
+  return bbox(lb,ub,str);
+}
+
+// Find the smallest b-compatible box around *this
+template<class T, int D>
+bbox<T,D> bbox<T,D>::expanded_for (const bbox& b) const {
+  if (empty()) return bbox(b.lower(), b.lower()-b.stride(), b.stride());
+  const vect<T,D> str = b.stride();
+  const vect<T,D> loff = ((lower() - b.lower()) % str + str) % str;
+  const vect<T,D> uoff = ((upper() - b.lower()) % str + str) % str;
+  const vect<T,D> lo = lower() - loff; // go outwards
+  const vect<T,D> up = upper() + (str - uoff) % str;
+  return bbox(lo,up,str);
+}
+
+// Find the largest b-compatible box inside *this
+template<class T, int D>
+bbox<T,D> bbox<T,D>::contracted_for (const bbox& b) const {
+  if (empty()) return bbox(b.lower(), b.lower()-b.stride(), b.stride());
+  const vect<T,D> str = b.stride();
+  const vect<T,D> loff = ((lower() - b.lower()) % str + str) % str;
+  const vect<T,D> uoff = ((upper() - b.lower()) % str + str) % str;
+  const vect<T,D> lo = lower() + (str - loff) % str; // go inwards
+  const vect<T,D> up = upper() - uoff;
+  return bbox(lo,up,str);
+}
+
+// Smallest bbox containing both boxes
+template<class T, int D>
+bbox<T,D> bbox<T,D>::expanded_containing (const bbox& b) const {
+  if (empty()) return b;
+  if (b.empty()) return *this;
+  assert (is_aligned_with(b));
+  const vect<T,D> lo = min(lower(), b.lower());
+  const vect<T,D> up = max(upper(), b.upper());
+  const vect<T,D> str = min(stride(), b.stride());
+  return bbox(lo,up,str);
+}
+
+// Iterators
+template<class T, int D>
+bbox<T,D>::iterator::iterator (const bbox& box, const vect<T,D>& pos)
+  : box(box), pos(pos) {
+  if (box.empty()) this->pos=box.upper();
+}
+
+template<class T, int D>
+bool bbox<T,D>::iterator::operator!= (const iterator& i) const {
+  return any(pos!=i.pos);
+}
+
+template<class T, int D>
+typename bbox<T,D>::iterator& bbox<T,D>::iterator::operator++ () {
+  for (int d=0; d<D; ++d) {
+    pos[d]+=box.stride()[d];
+    if (pos[d]<=box.upper()[d]) break;
+    pos[d]=box.lower()[d];
+  }
+  return *this;
+}
+
+template<class T, int D>
+typename bbox<T,D>::iterator bbox<T,D>::begin () const {
+  return iterator(*this, lower());
+}
+
+template<class T, int D>
+typename bbox<T,D>::iterator bbox<T,D>::end () const {
+  return iterator(*this, lower());
+}
+
+
+
+// Input
+template<class T,int D>
+void bbox<T,D>::input (istream& is) {
+  try {
+    skipws (is);
+    consume (is, '(');
+    is >> _lower;
+    skipws (is);
+    consume (is, ':');
+    is >> _upper;
+    skipws (is);
+    consume (is, ':');
+    is >> _stride;
+    skipws (is);
+    consume (is, ')');
+  } catch (input_error &err) {
+    cout << "Input error while reading a bbox" << endl;
+    throw err;
+  }
+  if (any(_stride<=T(0))) {
+    cout << "While reading the bbox " << *this << ":" << endl
+         << "   The stride is not positive." << endl;
+    throw input_error();
+  }
+  if (any((_upper-_lower)%_stride != T(0))) {
+    cout << "While reading the bbox " << *this << ":" << endl
+         << "   The stride does not evenly divide the extent." << endl;
+    throw input_error();
+  }
+  assert (all(_stride>T(0)));
+  assert (all((_upper-_lower)%_stride == T(0)));
+}
+
+
+
+// Output
+template<class T,int D>
+void bbox<T,D>::output (ostream& os) const {
+  os << "(" << lower() << ":" << upper() << ":" << stride() << ")";
+}
+
+
+
+// Note: We need all dimensions all the time.
+template class bbox<int,0>;
+template class bbox<int,1>;
+template class bbox<int,2>;
+template class bbox<int,3>;
+template class bbox<double,3>;
diff --git a/Carpet/CarpetLib/src/bbox.hh b/Carpet/CarpetLib/src/bbox.hh
new file mode 100644
index 000000000..e23d000ac
--- /dev/null
+++ b/Carpet/CarpetLib/src/bbox.hh
@@ -0,0 +1,171 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/bbox.hh,v 1.15 2004/04/18 13:03:44 schnetter Exp $
+
+#ifndef BBOX_HH
+#define BBOX_HH
+
+#include <iostream>
+
+#include "defs.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<class T, int D> class bbox;
+
+// Input/Output
+template<class T, int D>
+istream& operator>> (istream& is, bbox<T,D>& b);
+template<class T, int D>
+ostream& operator<< (ostream& os, const bbox<T,D>& b);
+
+
+
+/**
+ * A bounding box, i.e. a rectangle with lower and upper bound and a
+ * stride.
+ */
+template<class T, int D>
+class bbox {
+  
+  // Fields
+  
+  /** Bounding box bounds and stride.  The bounds are inclusive.  */
+  vect<T,D> _lower, _upper, _stride;
+  
+public:
+  
+  // Constructors
+  
+  /** Construct an empty bbox.  */
+  bbox ();
+  
+  /** Copy constructor.  */
+  bbox (const bbox& b);
+  
+  /** Assignment operator.  */
+  bbox& operator= (const bbox& b);
+  
+  /** Create a bbox from bounds and stride.  */
+  bbox (const vect<T,D>& lower, const vect<T,D>& upper,
+	const vect<T,D>& stride);
+  
+  // Accessors
+  // (Don't return references; *this might be a temporary)
+  
+  /** Get lower bound.  */
+  vect<T,D> lower () const { return _lower; }
+  
+  /** Get upper bound.  */
+  vect<T,D> upper () const { return _upper; }
+  
+  /** Get stride.  */
+  vect<T,D> stride () const { return _stride; }
+  
+  /** Get the shape (or extent).  */
+  vect<T,D> shape () const { return _upper - _lower + _stride; }
+  
+  /** Determine whether the bbox is empty.  */
+  bool empty() const {
+    return any(lower()>upper());
+  }
+  
+  /** Return the size, which is the product of the shape.  */
+  T size () const;
+  
+  // Queries
+  
+  /** Find out whether the bbox contains the point x.  */
+  bool contains (const vect<T,D>& x) const;
+  
+  // Operators
+  bool operator== (const bbox& b) const;
+  bool operator!= (const bbox& b) const;
+  bool operator< (const bbox& b) const;
+  bool operator> (const bbox& b) const;
+  bool operator<= (const bbox& b) const;
+  bool operator>= (const bbox& b) const;
+  
+  /** Calculate the intersection (the set of common points) with the
+      bbox b.  */
+  bbox operator& (const bbox& b) const;
+  
+  /** Find out whether this bbox is contained in the bbox b.  */
+  bool is_contained_in (const bbox& b) const;
+  
+  /** Find out whether this bbox is aligned with the bbox b.
+      ("aligned" means that both bboxes have the same stride and that
+      their boundaries are commesurate.)  */
+  bool is_aligned_with (const bbox& b) const;
+  
+  /** Expand (enlarge) the bbox by multiples of the stride.  */
+  bbox expand (const vect<T,D>& lo, const vect<T,D>& hi) const;
+  
+  /** Find the smallest b-compatible box around this bbox.
+      ("compatible" means having the same stride.)  */
+  bbox expanded_for (const bbox& b) const;
+  
+  /** Find the largest b-compatible box inside this bbox.  */
+  bbox contracted_for (const bbox& b) const;
+  
+  /** Find the smallest bbox containing both boxes.  */
+  bbox expanded_containing (const bbox<T,D>& b) const;
+  
+  // Iterators
+  
+  /** An iterator over all points in a bbox.  */
+  class iterator {
+  protected:
+    /** The bbox over which we iterate.  */
+    const bbox& box;
+    /** Current position.  */
+    vect<T,D> pos;
+  public:
+    /** Constructor.  */
+    iterator (const bbox& box, const vect<T,D>& pos);
+    /** Accessor.  */
+    const vect<T,D>& operator* () const { return pos; }
+    /** Check whether the position is the same.  */
+    bool operator!= (const iterator& i) const;
+    /** Advance.  */
+    iterator& operator++ ();
+  };
+  
+  /** Create an iterator that points to the first point in a bbox.  */
+  iterator begin () const;
+  /** Create an iterator that points "after the last point" in a bbox,
+      which means that it also points to the first point.  */
+  iterator end () const;
+  
+  // Input/Output helpers
+  void input (istream& is);
+  void output (ostream& os) const;
+};
+
+
+
+// Input
+
+/** Read a formatted bbox from a stream.  */
+template<class T,int D>
+inline istream& operator>> (istream& is, bbox<T,D>& b) {
+  b.input(is);
+  return is;
+}
+
+
+
+// Output
+
+/** Write a bbox formatted to a stream.  */
+template<class T,int D>
+inline ostream& operator<< (ostream& os, const bbox<T,D>& b) {
+  b.output(os);
+  return os;
+}
+
+
+
+#endif // BBOX_HH
diff --git a/Carpet/CarpetLib/src/bboxset.cc b/Carpet/CarpetLib/src/bboxset.cc
new file mode 100644
index 000000000..94cf1997e
--- /dev/null
+++ b/Carpet/CarpetLib/src/bboxset.cc
@@ -0,0 +1,393 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/bboxset.cc,v 1.16 2004/06/13 22:46:48 schnetter Exp $
+
+#include <assert.h>
+
+#include <iostream>
+#include <limits>
+#include <set>
+#include <stack>
+
+#include "defs.hh"
+
+#include "bboxset.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<class T, int D>
+bboxset<T,D>::bboxset () {
+  assert (invariant());
+}
+
+template<class T, int D>
+bboxset<T,D>::bboxset (const box& b) {
+  if (!b.empty()) bs.insert(b);
+  assert (invariant());
+}
+
+template<class T, int D>
+bboxset<T,D>::bboxset (const bboxset& s): bs(s.bs) {
+  assert (invariant());
+}
+
+template<class T, int D>
+bboxset<T,D>::bboxset (const bset& bs): bs(bs) {
+  assert (invariant());
+}
+
+
+
+// Invariant
+template<class T, int D>
+bool bboxset<T,D>::invariant () const {
+  for (const_iterator bi=begin(); bi!=end(); ++bi) {
+    if ((*bi).empty()) return false;
+    if (! (*bi).is_aligned_with(*bs.begin())) return false;
+    // check for overlap (quadratic -- expensive)
+    for (const_iterator bi2=begin(); bi2!=bi; ++bi2) {
+      if (! ((*bi2) & (*bi)).empty()) return false;
+    }
+  }
+  return true;
+}
+
+
+
+// Normalisation
+template<class T, int D>
+void bboxset<T,D>::normalize () {
+  assert (invariant());
+  const int num_initial_boxes = bs.size();
+  int num_combined_boxes = 0;
+  stack<box> todo, done;
+  for (typename set<box>::const_iterator elt = bs.begin(); elt != bs.end(); ++elt) {
+    done.push (*elt);
+  }
+  // TODO: This will not catch all cases where bboxes can be combined.
+  for (int d=0; d<D; ++d) {
+    todo = done;
+    done = stack<box>();
+    while (! todo.empty()) {
+    restart:;
+      box item = todo.top();
+      todo.pop();
+      stack<box> work = done;
+      done = stack<box>();
+      while (! work.empty()) {
+        box comp = work.top();
+        work.pop();
+        {
+          assert (all(comp.stride() == item.stride()));
+          if (comp.upper()[d] + item.stride()[d] == item.lower()[d]) {
+            if (all((comp.lower() == item.lower()
+                     && comp.upper() == item.upper()).replace (d, true))) {
+              box newbox = box(comp.lower(), item.upper(), item.stride());
+              todo.push (newbox);
+              while (! work.empty()) {
+                done.push (work.top());
+                work.pop();
+              }
+              ++num_combined_boxes;
+              goto restart;
+            }
+          }
+          if (item.upper()[d] + item.stride()[d] == comp.lower()[d]) {
+            if (all((comp.lower() == item.lower()
+                     && comp.upper() == item.upper()).replace (d, true))) {
+              box newbox = box(item.lower(), comp.upper(), item.stride());
+              todo.push (newbox);
+              while (! work.empty()) {
+                done.push (work.top());
+                work.pop();
+              }
+              ++num_combined_boxes;
+              goto restart;
+            }
+          }
+        }
+        done.push (comp);
+      } // while work
+      done.push (item);
+    } // while todo
+  } // for d
+  bs.clear();
+  while (! done.empty()) {
+    bs.insert (done.top());
+    done.pop();
+  }
+  const int num_final_boxes = bs.size();
+  assert (num_initial_boxes - num_combined_boxes == num_final_boxes);
+  assert (invariant());
+}
+
+
+
+// Accessors
+template<class T, int D>
+T bboxset<T,D>::size () const {
+  T s=0;
+  for (const_iterator bi=begin(); bi!=end(); ++bi) {
+    const T bs = (*bi).size();
+    assert (numeric_limits<T>::max() - bs >= s);
+    s += bs;
+  }
+  return s;
+}
+
+
+
+// Add (bboxes that don't overlap)
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator+= (const box& b) {
+  if (b.empty()) return *this;
+  // check for overlap
+  for (const_iterator bi=begin(); bi!=end(); ++bi) {
+    assert ((*bi & b).empty());
+  }
+  bs.insert(b);
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator+= (const bboxset& s) {
+  for (const_iterator bi=s.begin(); bi!=s.end(); ++bi) {
+    *this += *bi;
+  }
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator+ (const box& b) const {
+  bboxset r(*this);
+  r += b;
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator+ (const bboxset& s) const {
+  bboxset r(*this);
+  r += s;
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::plus (const bbox<T,D>& b1, const bbox<T,D>& b2) {
+  return bboxset(b1) + b2;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::plus (const bbox<T,D>& b, const bboxset<T,D>& s) {
+  return s + b;
+}
+
+
+
+// Union
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator|= (const box& b) {
+  *this += b - *this;
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator|= (const bboxset& s) {
+  *this += s - *this;
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator| (const box& b) const {
+  bboxset r(*this);
+  r |= b;
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator| (const bboxset& s) const {
+  bboxset r(*this);
+  r |= s;
+  assert (r.invariant());
+  return r;
+}
+
+
+
+// Intersection
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator& (const box& b) const {
+  // start with an empty set
+  bboxset r;
+  // walk all my elements
+  for (const_iterator bi=begin(); bi!=end(); ++bi) {
+    // insert the intersection with the bbox
+    r += *bi & b;
+  }
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator& (const bboxset& s) const {
+  // start with an empty set
+  bboxset r;
+  // walk all the bboxes
+  for (const_iterator bi=s.begin(); bi!=s.end(); ++bi) {
+    // insert the intersection with this bbox
+    r += *this & *bi;
+  }
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator&= (const box& b) {
+  *this = *this & b;
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator&= (const bboxset& s) {
+  *this = *this & s;
+  assert (invariant());
+  return *this;
+}
+
+
+
+// Difference
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::minus (const bbox<T,D>& b1, const bbox<T,D>& b2) {
+  assert (b1.is_aligned_with(b2));
+  if (b1.empty()) return bboxset<T,D>();
+  if (b2.empty()) return bboxset<T,D>(b1);
+  const vect<T,D> str = b1.stride();
+  bboxset<T,D> r;
+  for (int d=0; d<D; ++d) {
+    // make resulting bboxes as large as possible in x-direction (for
+    // better consumption by Fortranly ordered arrays)
+    vect<T,D> lb, ub;
+    bbox<T,D> b;
+    for (int dd=0; dd<D; ++dd) {
+      if (dd<d) {
+	lb[dd] = b2.lower()[dd];
+	ub[dd] = b2.upper()[dd];
+      } else if (dd>d) {
+	lb[dd] = b1.lower()[dd];
+	ub[dd] = b1.upper()[dd];
+      }
+    }
+    lb[d] = b1.lower()[d];
+    ub[d] = b2.lower()[d] - str[d];
+    b = bbox<T,D>(lb,ub,str) & b1;
+    r += b;
+    lb[d] = b2.upper()[d] + str[d];
+    ub[d] = b1.upper()[d];
+    b = bbox<T,D>(lb,ub,str) & b1;
+    r += b;
+  }
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator- (const box& b) const {
+  // start with an empty set
+  bboxset r;
+  // walk all my elements
+  for (const_iterator bi=begin(); bi!=end(); ++bi) {
+    // insert the difference with the bbox
+    r += *bi - b;
+  }
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator-= (const box& b) {
+  *this = *this - b;
+  assert (invariant());
+  return *this;
+}
+  
+template<class T, int D>
+bboxset<T,D>& bboxset<T,D>::operator-= (const bboxset& s) {
+  for (const_iterator bi=s.begin(); bi!=s.end(); ++bi) {
+    *this -= *bi;
+  }
+  assert (invariant());
+  return *this;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::operator- (const bboxset& s) const {
+  bboxset r(*this);
+  r -= s;
+  assert (r.invariant());
+  return r;
+}
+
+template<class T, int D>
+bboxset<T,D> bboxset<T,D>::minus (const bbox<T,D>& b, const bboxset<T,D>& s) {
+  bboxset<T,D> r = bboxset<T,D>(b) - s;
+  assert (r.invariant());
+  return r;
+}
+
+
+
+// Equality
+template<class T, int D>
+bool bboxset<T,D>::operator<= (const bboxset<T,D>& s) const {
+  return (*this - s).empty();
+}
+
+template<class T, int D>
+bool bboxset<T,D>::operator< (const bboxset<T,D>& s) const {
+  return (*this - s).empty() && ! (s - *this).empty();
+}
+
+template<class T, int D>
+bool bboxset<T,D>::operator>= (const bboxset<T,D>& s) const {
+  return s <= *this;
+}
+
+template<class T, int D>
+bool bboxset<T,D>::operator> (const bboxset<T,D>& s) const {
+  return s < *this;
+}
+
+template<class T, int D>
+bool bboxset<T,D>::operator== (const bboxset<T,D>& s) const {
+  return (*this <= s) && (*this >= s);
+}
+
+template<class T, int D>
+bool bboxset<T,D>::operator!= (const bboxset<T,D>& s) const {
+  return ! (*this == s);
+}
+
+
+
+// Output
+template<class T,int D>
+void bboxset<T,D>::output (ostream& os) const {
+  T Tdummy;
+  os << "bboxset<" << typestring(Tdummy) << "," << D << ">:"
+     << "size=" << size() << ","
+     << "setsize=" << setsize() << ","
+     << "set=" << bs;
+}
+
+
+
+template class bboxset<int,3>;
diff --git a/Carpet/CarpetLib/src/bboxset.hh b/Carpet/CarpetLib/src/bboxset.hh
new file mode 100644
index 000000000..a94c8940a
--- /dev/null
+++ b/Carpet/CarpetLib/src/bboxset.hh
@@ -0,0 +1,156 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/bboxset.hh,v 1.11 2003/09/19 16:06:41 schnetter Exp $
+
+#ifndef BBOXSET_HH
+#define BBOXSET_HH
+
+#include <assert.h>
+
+#include <iostream>
+#include <set>
+
+#include "bbox.hh"
+#include "defs.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<class T, int D> class bboxset;
+
+// template<class T,int D>
+// bboxset<T,D> operator+ (const bbox<T,D>& b1, const bbox<T,D>& b2);
+// template<class T,int D>
+// bboxset<T,D> operator+ (const bbox<T,D>& b, const bboxset<T,D>& s);
+
+// template<class T,int D>
+// bboxset<T,D> operator- (const bbox<T,D>& b1, const bbox<T,D>& b2);
+// template<class T,int D>
+// bboxset<T,D> operator- (const bbox<T,D>& b, const bboxset<T,D>& s);
+
+// Output
+template<class T,int D>
+ostream& operator<< (ostream& os, const bboxset<T,D>& s);
+
+
+
+// Bounding box class
+template<class T, int D>
+class bboxset {
+  
+  // Types
+  typedef bbox<T,D> box;
+  typedef set<box> bset;
+  
+  // Fields
+  bset bs;
+  // Invariant:
+  // All bboxes have the same stride.
+  // No bbox is empty.
+  // The bboxes don't overlap.
+  
+public:
+  
+  // Constructors
+  bboxset ();
+  bboxset (const box& b);
+  bboxset (const bboxset& s);
+  bboxset (const bset& bs);
+  
+  // Invariant
+  bool invariant () const;
+  
+  // Normalisation
+  void normalize ();
+  
+  // Accessors
+  bool empty () const { return bs.empty(); }
+  T size () const;
+  int setsize () const { return bs.size(); }
+  
+  // Add (bboxes that don't overlap)
+  bboxset& operator+= (const box& b);
+  bboxset& operator+= (const bboxset& s);
+  bboxset operator+ (const box& b) const;
+  bboxset operator+ (const bboxset& s) const;
+  static bboxset plus (const box& b1, const box& b2);
+  static bboxset plus (const box& b, const bboxset& s);
+  
+  // Union
+  bboxset& operator|= (const box& b);
+  bboxset& operator|= (const bboxset& s);
+  bboxset operator| (const box& b) const;
+  bboxset operator| (const bboxset& s) const;
+  
+  // Intersection
+  bboxset operator& (const box& b) const;
+  bboxset operator& (const bboxset& s) const;
+  bboxset& operator&= (const box& b);
+  bboxset& operator&= (const bboxset& s);
+  
+  // Difference
+  // friend bboxset operator- <T,D>(const box& b1, const box& b2);
+  static bboxset minus (const box& b1, const box& b2);
+  bboxset operator- (const box& b) const;
+  bboxset& operator-= (const box& b);
+  bboxset& operator-= (const bboxset& s);
+  bboxset operator- (const bboxset& s) const;
+  // friend bboxset operator- <T,D>(const box& b, const bboxset& s);
+  static bboxset minus (const box& b, const bboxset& s);
+  
+  // Equality
+  bool operator== (const bboxset& s) const;
+  bool operator!= (const bboxset& s) const;
+  bool operator< (const bboxset& s) const;
+  bool operator<= (const bboxset& s) const;
+  bool operator> (const bboxset& s) const;
+  bool operator>= (const bboxset& s) const;
+  
+  // Iterators
+  typedef typename bset::const_iterator const_iterator;
+  typedef typename bset::iterator       iterator;
+  
+  const_iterator begin () const { return bs.begin(); }
+  const_iterator end () const   { return bs.end(); }
+//   iterator begin () const { return bs.begin(); }
+//   iterator end () const   { return bs.end(); }
+  
+  // Output
+  void output (ostream& os) const;
+};
+
+
+
+template<class T,int D>
+inline bboxset<T,D> operator+ (const bbox<T,D>& b1, const bbox<T,D>& b2) {
+  return bboxset<T,D>::plus(b1,b2);
+}
+
+template<class T,int D>
+inline bboxset<T,D> operator+ (const bbox<T,D>& b, const bboxset<T,D>& s) {
+  return bboxset<T,D>::plus(b,s);
+}
+
+template<class T,int D>
+inline bboxset<T,D> operator- (const bbox<T,D>& b1, const bbox<T,D>& b2) {
+  return bboxset<T,D>::minus(b1,b2);
+}
+
+template<class T,int D>
+inline bboxset<T,D> operator- (const bbox<T,D>& b, const bboxset<T,D>& s) {
+  return bboxset<T,D>::minus(b,s);
+}
+
+
+
+// Output
+template<class T,int D>
+inline ostream& operator<< (ostream& os, const bboxset<T,D>& s) {
+  s.output(os);
+  return os;
+}
+
+
+
+#endif // BBOXSET_HH
diff --git a/Carpet/CarpetLib/src/checkindex.F77 b/Carpet/CarpetLib/src/checkindex.F77
new file mode 100644
index 000000000..e726a012b
--- /dev/null
+++ b/Carpet/CarpetLib/src/checkindex.F77
@@ -0,0 +1,23 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/checkindex.F77,v 1.1 2003/11/05 16:18:39 schnetter Exp $
+      
+#include "cctk.h"
+
+
+
+      subroutine checkindex (i,j,k, di,dj,dk, imax,jmax,kmax, where)
+      implicit none
+      integer i,j,k
+      integer di,dj,dk
+      integer imax,jmax,kmax
+      character*(*) where
+      character*1000 msg
+      
+      if (      i.lt.1 .or. i+di-1.gt.imax
+     $     .or. j.lt.1 .or. j+dj-1.gt.jmax
+     $     .or. k.lt.1 .or. k+dk-1.gt.kmax) then
+         write (msg, '(a, " array index out of bounds: shape is (",i4,",",i4,",",i4,"), index is (",i4,",",i4,",",i4,"), extent is (",i4,",",i4,",",i4,")")')
+     $        where, imax,jmax,kmax, i,j,k, di,dj,dk
+         call CCTK_WARN (0, msg(1:len_trim(msg)))
+      end if
+      end
diff --git a/Carpet/CarpetLib/src/copy_3d_complex16.F77 b/Carpet/CarpetLib/src/copy_3d_complex16.F77
new file mode 100644
index 000000000..2432e900c
--- /dev/null
+++ b/Carpet/CarpetLib/src/copy_3d_complex16.F77
@@ -0,0 +1,114 @@
+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 $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+
+      
+      subroutine copy_3d_complex16 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      integer srciext, srcjext, srckext
+      CCTK_COMPLEX16 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_COMPLEX16 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).ne.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / srcbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / srcbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / srcbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+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
+               
+               dst (dstioff+i, dstjoff+j, dstkoff+k)
+     $              = src (srcioff+i, srcjoff+j, srckoff+k)
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/copy_3d_int4.F77 b/Carpet/CarpetLib/src/copy_3d_int4.F77
new file mode 100644
index 000000000..b440a32b2
--- /dev/null
+++ b/Carpet/CarpetLib/src/copy_3d_int4.F77
@@ -0,0 +1,114 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/copy_3d_int4.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+
+      
+      subroutine copy_3d_int4 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      integer srciext, srcjext, srckext
+      CCTK_INT4 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_INT4 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).ne.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / srcbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / srcbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / srcbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+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
+               
+               dst (dstioff+i, dstjoff+j, dstkoff+k)
+     $              = src (srcioff+i, srcjoff+j, srckoff+k)
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/copy_3d_real8.F77 b/Carpet/CarpetLib/src/copy_3d_real8.F77
new file mode 100644
index 000000000..716ffd135
--- /dev/null
+++ b/Carpet/CarpetLib/src/copy_3d_real8.F77
@@ -0,0 +1,114 @@
+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 $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+
+      
+      subroutine copy_3d_real8 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).ne.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / srcbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / srcbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / srcbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+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
+               
+               dst (dstioff+i, dstjoff+j, dstkoff+k)
+     $              = src (srcioff+i, srcjoff+j, srckoff+k)
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/data.cc b/Carpet/CarpetLib/src/data.cc
new file mode 100644
index 000000000..5c9d219e7
--- /dev/null
+++ b/Carpet/CarpetLib/src/data.cc
@@ -0,0 +1,1388 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/data.cc,v 1.55 2004/05/21 18:13:41 schnetter Exp $
+
+#include <assert.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <math.h>
+
+#include <algorithm>
+#include <iostream>
+#include <limits>
+#include <sstream>
+#include <string>
+#include <vector>
+
+#include <mpi.h>
+
+#include "cctk.h"
+
+#include "bbox.hh"
+#include "defs.hh"
+#include "dist.hh"
+#include "vect.hh"
+
+#include "data.hh"
+
+using namespace std;
+
+
+
+static size_t total_allocated_bytes; // total number of allocated bytes
+
+
+
+// Constructors
+template<class T, int D>
+data<T,D>::data (const int varindex_, const operator_type transport_operator_,
+                 const int vectorlength, const int vectorindex,
+                 data* const vectorleader)
+  : gdata<D>(varindex_, transport_operator_),
+    _storage(NULL), _allocated_bytes(0),
+    vectorlength(vectorlength), vectorindex(vectorindex),
+    vectorleader(vectorleader)
+{
+  assert (vectorlength>=1);
+  assert (vectorindex>=0 && vectorindex<vectorlength);
+  assert ((vectorindex==0 && !vectorleader)
+          || (vectorindex!=0 && vectorleader));
+  if (vectorindex==0) vectorclients.resize (vectorlength);
+  if (vectorleader) vectorleader->register_client (vectorindex);
+}
+
+template<class T, int D>
+data<T,D>::data (const int varindex_, const operator_type transport_operator_,
+                 const int vectorlength, const int vectorindex,
+                 data* const vectorleader,
+                 const ibbox& extent_, const int proc_)
+  : gdata<D>(varindex_, transport_operator_),
+    _storage(NULL), _allocated_bytes(0),
+    vectorlength(vectorlength), vectorindex(vectorindex),
+    vectorleader(vectorleader)
+{
+  assert (vectorlength>=1);
+  assert (vectorindex>=0 && vectorindex<vectorlength);
+  assert ((vectorindex==0 && !vectorleader)
+          || (vectorindex!=0 && vectorleader));
+  if (vectorindex==0) vectorclients.resize (vectorlength);
+  if (vectorleader) vectorleader->register_client (vectorindex);
+  allocate(extent_, proc_);
+}
+
+// Destructors
+template<class T, int D>
+data<T,D>::~data ()
+{
+  if (vectorleader) vectorleader->unregister_client (vectorindex);
+  if (vectorindex==0) assert (! has_clients());
+  free();
+}
+  
+// Pseudo constructors
+template<class T, int D>
+data<T,D>* data<T,D>::make_typed (const int varindex_,
+                                  const operator_type transport_operator_)
+  const
+{
+  return new data(varindex_, transport_operator_);
+}
+
+
+
+// Vector mamagement
+template<class T, int D>
+void data<T,D>::register_client (const int index)
+{
+  assert (! vectorclients.at(index));
+  vectorclients.at(index) = true;
+}
+
+template<class T, int D>
+void data<T,D>::unregister_client (const int index)
+{
+  assert (vectorclients.at(index));
+  vectorclients.at(index) = false;
+}
+
+template<class T, int D>
+bool data<T,D>::has_clients ()
+{
+  bool retval = false;
+  for (size_t n=0; n<vectorlength; ++n) {
+    retval |= vectorclients.at(n);
+  }
+  return retval;
+}
+
+
+
+// Storage management
+template<class T, int D>
+void data<T,D>::getmem (const size_t nelems)
+{
+  const size_t nbytes = nelems * sizeof(T);
+  try {
+    assert (this->_allocated_bytes == 0);
+    this->_storage = new T[nelems];
+    this->_allocated_bytes = nbytes;
+  } catch (...) {
+    T Tdummy;
+    CCTK_VWarn (0, __LINE__, __FILE__, CCTK_THORNSTRING,
+                "Failed to allocate %.0f bytes (%.3f MB) of memory for type %s.  %.0f bytes (%.3f MB) are currently allocated.",
+                (double)nbytes, nbytes/1.0e6,
+                typestring(Tdummy),
+                (double)total_allocated_bytes, total_allocated_bytes/1.0e6);
+  }
+  total_allocated_bytes += nbytes;
+}
+
+
+
+template<class T, int D>
+void data<T,D>::freemem ()
+{
+  delete [] _storage;
+  total_allocated_bytes -= this->_allocated_bytes;
+  this->_allocated_bytes = 0;
+}
+
+
+
+template<class T, int D>
+void data<T,D>::allocate (const ibbox& extent_,
+                          const int proc_,
+			  void* const mem)
+{
+  assert (!this->_has_storage);
+  this->_has_storage = true;
+  // prevent accidental wrap-around
+  assert (all(extent_.lower() < numeric_limits<int>::max() / 2));
+  assert (all(extent_.lower() > numeric_limits<int>::min() / 2));
+  assert (all(extent_.upper() < numeric_limits<int>::max() / 2));
+  assert (all(extent_.upper() > numeric_limits<int>::min() / 2));
+  // data
+  this->_extent = extent_;
+  this->_shape = max(ivect(0), this->_extent.shape() / this->_extent.stride());
+  this->_size = 1;
+  for (int d=0; d<D; ++d) {
+    this->_stride[d] = this->_size;
+    assert (this->_shape[d]==0 || this->_size <= INT_MAX / this->_shape[d]);
+    this->_size *= this->_shape[d];
+  }
+  this->_proc = proc_;
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  if (rank==this->_proc) {
+    this->_owns_storage = !mem;
+    if (this->_owns_storage) {
+      if (this->vectorindex == 0) {
+        assert (! this->vectorleader);
+        getmem (this->vectorlength * this->_size);
+      } else {
+        assert (this->vectorleader);
+        this->_storage = this->vectorleader->vectordata (this->vectorindex);
+      }
+    } else {
+      this->_storage = (T*)mem;
+    }
+  } else {
+    assert (!mem);
+  }
+}
+
+template<class T, int D>
+void data<T,D>::free ()
+{
+  if (this->_storage && this->_owns_storage && this->vectorindex==0) {
+    freemem ();
+  }
+  _storage = 0;
+  this->_has_storage = false;
+}
+
+template<class T, int D>
+void data<T,D>::transfer_from (gdata<D>* gsrc)
+{
+  assert (this->vectorlength==1);
+  data* src = (data*)gsrc;
+  assert (src->vectorlength==1);
+  assert (!_storage);
+  *this = *src;
+  *src = data(this->varindex, this->transport_operator);
+}
+
+template<class T, int D>
+T* data<T,D>::vectordata (const int vectorindex) const
+{
+  assert (this->vectorindex==0);
+  assert (! this->vectorleader);
+  assert (vectorindex>=0 && vectorindex<this->vectorlength);
+  assert (this->_storage && this->_owns_storage);
+  return this->_storage + vectorindex * this->_size;
+}
+
+
+
+// Processor management
+template<class T, int D>
+void data<T,D>::change_processor (comm_state<D>& state,
+                                  const int newproc,
+                                  void* const mem)
+{
+  switch (state.thestate) {
+  case state_recv:
+    change_processor_recv (newproc, mem);
+    break;
+  case state_send:
+    change_processor_send (newproc, mem);
+    break;
+  case state_wait:
+    change_processor_wait (newproc, mem);
+    break;
+  default:
+    assert(0);
+  }
+}
+
+
+
+template<class T, int D>
+void data<T,D>::change_processor_recv (const int newproc, void* const mem)
+{
+  assert (!this->comm_active);
+  this->comm_active = true;
+  
+  if (newproc == this->_proc) {
+    assert (!mem);
+    return;
+  }
+  
+  if (this->_has_storage) {
+    int rank;
+    MPI_Comm_rank (dist::comm, &rank);
+    if (rank == newproc) {
+      // copy from other processor
+      
+      assert (!_storage);
+      this->_owns_storage = !mem;
+      if (this->_owns_storage) {
+        getmem (this->_size);
+      } else {
+	_storage = (T*)mem;
+      }
+      
+      const double wtime1 = MPI_Wtime();
+      T dummy;
+      MPI_Irecv (_storage, this->_size, dist::datatype(dummy), this->_proc,
+                 this->tag, dist::comm, &this->request);
+      const double wtime2 = MPI_Wtime();
+      this->wtime_irecv += wtime2 - wtime1;
+      
+    } else if (rank == this->_proc) {
+      // copy to other processor
+      
+    } else {
+      assert (!mem);
+      assert (!_storage);
+    }
+  }
+}
+
+
+
+template<class T, int D>
+void data<T,D>::change_processor_send (const int newproc, void* const mem)
+{
+  assert (this->comm_active);
+  
+  if (newproc == this->_proc) {
+    assert (!mem);
+    return;
+  }
+  
+  if (this->_has_storage) {
+    int rank;
+    MPI_Comm_rank (dist::comm, &rank);
+    if (rank == newproc) {
+      // copy from other processor
+      
+    } else if (rank == this->_proc) {
+      // copy to other processor
+      
+      assert (!mem);
+      assert (_storage);
+      
+      const double wtime1 = MPI_Wtime();
+      T dummy;
+      MPI_Isend (_storage, this->_size, dist::datatype(dummy), newproc,
+                 this->tag, dist::comm, &this->request);
+      const double wtime2 = MPI_Wtime();
+      this->wtime_isend += wtime2 - wtime1;
+      
+    } else {
+      assert (!mem);
+      assert (!_storage);
+    }
+  }
+}
+
+
+
+template<class T, int D>
+void data<T,D>::change_processor_wait (const int newproc, void* const mem)
+{
+  assert (this->comm_active);
+  this->comm_active = false;
+  
+  if (newproc == this->_proc) {
+    assert (!mem);
+    return;
+  }
+  
+  if (this->_has_storage) {
+    int rank;
+    MPI_Comm_rank (dist::comm, &rank);
+    if (rank == newproc) {
+      // copy from other processor
+      
+      const double wtime1 = MPI_Wtime();
+      MPI_Status status;
+      MPI_Wait (&this->request, &status);
+      const double wtime2 = MPI_Wtime();
+      this->wtime_irecvwait += wtime2 - wtime1;
+      
+    } else if (rank == this->_proc) {
+      // copy to other processor
+      
+      assert (!mem);
+      assert (_storage);
+      
+      const double wtime1 = MPI_Wtime();
+      MPI_Status status;
+      MPI_Wait (&this->request, &status);
+      const double wtime2 = MPI_Wtime();
+      this->wtime_isendwait += wtime2 - wtime1;
+      
+      if (this->_owns_storage) {
+	freemem ();
+      }
+      _storage = 0;
+      
+    } else {
+      assert (!mem);
+      assert (!_storage);
+    }
+  }
+  
+  this->_proc = newproc;
+}
+
+
+
+// Data manipulators
+template<class T, int D>
+void data<T,D>
+::copy_from_innerloop (const gdata<D>* gsrc, const ibbox& box)
+{
+  const data* src = (const data*)gsrc;
+  assert (this->has_storage() && src->has_storage());
+  assert (all(box.lower()>=this->extent().lower()
+	      && box.lower()>=src->extent().lower()));
+  assert (all(box.upper()<=this->extent().upper()
+	      && box.upper()<=src->extent().upper()));
+  assert (all(box.stride()==this->extent().stride()
+	      && box.stride()==src->extent().stride()));
+  assert (all((box.lower()-this->extent().lower())%box.stride() == 0
+	      && (box.lower()-src->extent().lower())%box.stride() == 0));
+  
+  assert (this->proc() == src->proc());
+
+  const int groupindex = CCTK_GroupIndexFromVarI(this->varindex);
+  const int group_tags_table = CCTK_GroupTagsTableI(groupindex);
+  assert (group_tags_table >= 0);
+  
+  // Disallow this.
+  T Tdummy;
+  CCTK_VWarn (0, __LINE__, __FILE__, CCTK_THORNSTRING,
+              "There is no copy operator available for the variable type %s, dimension %d.",
+              typestring(Tdummy), D);
+  
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  assert (rank == this->proc());
+  
+  for (typename ibbox::iterator it=box.begin(); it!=box.end(); ++it) {
+    const ivect index = *it;
+    (*this)[index] = (*src)[index];
+  }
+  
+}
+
+
+
+template<class T, int D>
+void data<T,D>
+::interpolate_from_innerloop (const vector<const gdata<D>*> gsrcs,
+			      const vector<CCTK_REAL> times,
+			      const ibbox& box, const CCTK_REAL time,
+			      const int order_space,
+			      const int order_time)
+{
+  assert (this->has_storage());
+  assert (all(box.lower()>=this->extent().lower()));
+  assert (all(box.upper()<=this->extent().upper()));
+  assert (all(box.stride()==this->extent().stride()));
+  assert (all((box.lower()-this->extent().lower())%box.stride() == 0));
+  vector<const data*> srcs(gsrcs.size());
+  for (int t=0; t<(int)srcs.size(); ++t) srcs[t] = (const data*)gsrcs[t];
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs[t]->has_storage());
+    assert (all(box.lower()>=srcs[t]->extent().lower()));
+    assert (all(box.upper()<=srcs[t]->extent().upper()));
+    assert (this->proc() == srcs[t]->proc());
+  }
+  assert (order_space >= 0);
+  assert (order_time >= 0);
+  
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  assert (rank == this->proc());
+  
+  assert (this->varindex >= 0);
+  const int groupindex = CCTK_GroupIndexFromVarI (this->varindex);
+  assert (groupindex >= 0);
+  char* groupname = CCTK_GroupName(groupindex);
+  T Tdummy;
+  CCTK_VWarn (0, __LINE__, __FILE__, CCTK_THORNSTRING,
+	      "There is no interpolator available for the group \"%s\" with variable type %s, dimension %d, spatial interpolation order %d, temporal interpolation order %d.",
+	      groupname, typestring(Tdummy), D, order_space, order_time);
+  ::free (groupname);
+}
+
+
+
+extern "C" {
+  void CCTK_FCALL CCTK_FNAME(copy_3d_int4)
+    (const CCTK_INT4* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_INT4* 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]);
+  void CCTK_FCALL CCTK_FNAME(copy_3d_real8)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  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<>
+void data<CCTK_INT4,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_int4) ((const CCTK_INT4*)src->storage(),
+                              srcshp[0], srcshp[1], srcshp[2],
+                              (CCTK_INT4*)storage(),
+                              dstshp[0], dstshp[1], dstshp[2],
+                              srcbbox,
+                              dstbbox,
+                              regbbox);
+    
+  } else {
+    assert (0);
+  }
+}
+
+template<>
+void data<CCTK_REAL8,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_real8) ((const CCTK_REAL8*)src->storage(),
+			       srcshp[0], srcshp[1], srcshp[2],
+			       (CCTK_REAL8*)storage(),
+			       dstshp[0], dstshp[1], dstshp[2],
+			       srcbbox,
+			       dstbbox,
+			       regbbox);
+    
+  } else {
+    assert (0);
+  }
+}
+
+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" {
+  
+  void CCTK_FCALL CCTK_FNAME(restrict_3d_real8)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(restrict_3d_real8_rf2)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  
+  
+  
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_rf2)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_o3)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_o3_rf2)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_minmod)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_eno)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_o5)
+    (const CCTK_REAL8* src,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* 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]);
+  
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_rf2)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_o3)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_o3_rf2)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_minmod)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_eno)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_2tl_o5)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_rf2)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_o3)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_o3_rf2)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_minmod)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_eno)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     const int& dstiext, const int& dstjext, const int& dstkext,
+     const int srcbbox[3][3],
+     const int dstbbox[3][3],
+     const int regbbox[3][3]);
+  void CCTK_FCALL CCTK_FNAME(prolongate_3d_real8_3tl_o5)
+    (const CCTK_REAL8* src1, const CCTK_REAL8& t1,
+     const CCTK_REAL8* src2, const CCTK_REAL8& t2,
+     const CCTK_REAL8* src3, const CCTK_REAL8& t3,
+     const int& srciext, const int& srcjext, const int& srckext,
+     CCTK_REAL8* dst, const CCTK_REAL8& t,
+     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<>
+void data<CCTK_REAL8,3>
+::interpolate_from_innerloop (const vector<const gdata<3>*> gsrcs,
+			      const vector<CCTK_REAL> times,
+			      const ibbox& box, const CCTK_REAL time,
+			      const int order_space,
+			      const int order_time)
+{
+  const CCTK_REAL eps = 1.0e-10;
+  
+  assert (has_storage());
+  assert (all(box.lower()>=extent().lower()));
+  assert (all(box.upper()<=extent().upper()));
+  assert (all(box.stride()==extent().stride()));
+  assert (all((box.lower()-extent().lower())%box.stride() == 0));
+  vector<const data*> srcs(gsrcs.size());
+  for (int t=0; t<(int)srcs.size(); ++t) srcs[t] = (const data*)gsrcs[t];
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs[t]->has_storage());
+    assert (all(box.lower()>=srcs[t]->extent().lower()));
+    assert (all(box.upper()<=srcs[t]->extent().upper()));
+  }
+  
+  assert (proc() == srcs[0]->proc());
+  
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  assert (rank == proc());
+  
+  const ibbox& sext = srcs[0]->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];
+  }
+  
+  // Check that the times are consistent
+  assert (times.size() > 0);
+  CCTK_REAL min_time = times[0];
+  CCTK_REAL max_time = times[0];
+  for (size_t tl=1; tl<times.size(); ++tl) {
+    // Catch broken compilers that only know min(int) and max(int)
+    assert (min(1.3, 1.4) > 1.2);
+    min_time = min(min_time, times[tl]);
+    max_time = max(max_time, times[tl]);
+  }
+  if (time < min_time - eps || time > max_time + eps) {
+    ostringstream buf;
+    buf << "Internal error: extrapolation in time."
+        << "  time=" << time
+        << "  times=" << times;
+    CCTK_WARN (0, buf.str().c_str());
+  }
+  
+  // Is it necessary to interpolate in time?
+  if (times.size() > 1) {
+    for (size_t tl=0; tl<times.size(); ++tl) {
+      // Catch broken compilers that only know abs(int)
+      assert (abs(1.5) > 1.4);
+      if (abs(times[tl] - time) < eps) {
+        // It is not.
+        vector<const gdata<3>*> my_gsrcs(1);
+        vector<CCTK_REAL> my_times(1);
+        my_gsrcs[0] = gsrcs[tl];
+        my_times[0] = times[tl];
+        const int my_order_time = 0;
+        this->interpolate_from_innerloop
+          (my_gsrcs, my_times, box, time, order_space, my_order_time);
+        return;
+      }
+    }
+  }
+  
+  assert (all(dext.stride() == box.stride()));
+  if (all(sext.stride() < dext.stride())) {
+    // Restrict
+    
+    assert (times.size() == 1);
+    assert (abs(times[0] - time) < eps);
+    
+    switch (transport_operator) {
+      
+    case op_Lagrange:
+    case op_TVD:
+    case op_ENO:
+      assert (srcs.size() == 1);
+      if (all (dext.stride() == sext.stride() * 2)) {
+        CCTK_FNAME(restrict_3d_real8_rf2)
+          ((const CCTK_REAL8*)srcs[0]->storage(),
+           srcshp[0], srcshp[1], srcshp[2],
+           (CCTK_REAL8*)storage(),
+           dstshp[0], dstshp[1], dstshp[2],
+           srcbbox, dstbbox, regbbox);
+      } else {
+        CCTK_FNAME(restrict_3d_real8)
+          ((const CCTK_REAL8*)srcs[0]->storage(),
+           srcshp[0], srcshp[1], srcshp[2],
+           (CCTK_REAL8*)storage(),
+           dstshp[0], dstshp[1], dstshp[2],
+           srcbbox, dstbbox, regbbox);
+      }
+      break;
+      
+    default:
+      assert (0);
+      
+    } // switch (transport_operator)
+    
+  } else if (all(sext.stride() > dext.stride())) {
+    // Prolongate
+    
+    switch (transport_operator) {
+      
+    case op_Lagrange:
+      switch (order_time) {
+        
+      case 0:
+        assert (times.size() == 1);
+        assert (abs(times[0] - time) < eps);
+        assert (srcs.size()>=1);
+        switch (order_space) {
+        case 0:
+        case 1:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(),
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(),
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8)
+              ((const CCTK_REAL8*)srcs[0]->storage(),
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(),
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 2:
+        case 3:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_o3_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(),
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(),
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8_o3)
+              ((const CCTK_REAL8*)srcs[0]->storage(),
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(),
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 4:
+        case 5:
+          CCTK_FNAME(prolongate_3d_real8_o5)
+            ((const CCTK_REAL8*)srcs[0]->storage(),
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(),
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+        
+      case 1:
+        assert (srcs.size()>=2);
+        switch (order_space) {
+        case 0:
+        case 1:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_2tl_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8_2tl)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 2:
+        case 3:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_2tl_o3_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8_2tl_o3)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 4:
+        case 5:
+          CCTK_FNAME(prolongate_3d_real8_2tl_o5)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+        
+      case 2:
+        assert (srcs.size()>=3);
+        switch (order_space) {
+        case 0:
+        case 1:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_3tl_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8_3tl)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 2:
+        case 3:
+          if (all (sext.stride() == dext.stride() * 2)) {
+            CCTK_FNAME(prolongate_3d_real8_3tl_o3_rf2)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          } else {
+            CCTK_FNAME(prolongate_3d_real8_3tl_o3)
+              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+               (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+               srcshp[0], srcshp[1], srcshp[2],
+               (CCTK_REAL8*)storage(), time,
+               dstshp[0], dstshp[1], dstshp[2],
+               srcbbox, dstbbox, regbbox);
+          }
+          break;
+        case 4:
+        case 5:
+          CCTK_FNAME(prolongate_3d_real8_3tl_o5)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+        
+      default:
+        assert (0);
+      } // switch (order_time)
+      break;
+      
+    case op_TVD:
+      switch (order_time) {
+      case 0: 
+        assert (times.size() == 1);
+        assert (abs(times[0] - time) < eps);
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"TVD\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_rf2)
+            ((const CCTK_REAL8*)srcs[0]->storage(),
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(),
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+//            CCTK_FNAME(prolongate_3d_real8_minmod)
+//              ((const CCTK_REAL8*)srcs[0]->storage(),
+//               srcshp[0], srcshp[1], srcshp[2],
+//               (CCTK_REAL8*)storage(),
+//               dstshp[0], dstshp[1], dstshp[2],
+//               srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      case 1:
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"TVD\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_2tl_rf2)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+//            CCTK_FNAME(prolongate_3d_real8_2tl_minmod)
+//              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+//               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+//               srcshp[0], srcshp[1], srcshp[2],
+//               (CCTK_REAL8*)storage(), time,
+//               dstshp[0], dstshp[1], dstshp[2],
+//               srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      case 2: 
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"TVD\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_3tl_rf2)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+//            CCTK_FNAME(prolongate_3d_real8_3tl_minmod)
+//              ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+//               (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+//               (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+//               srcshp[0], srcshp[1], srcshp[2],
+//               (CCTK_REAL8*)storage(), time,
+//               dstshp[0], dstshp[1], dstshp[2],
+//               srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      default:
+        assert (0);
+      } // switch (order_time)
+      break;
+      
+    case op_ENO:
+      switch (order_time) {
+      case 0: 
+        assert (times.size() == 1);
+        assert (abs(times[0] - time) < eps);
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"ENO\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_eno)
+            ((const CCTK_REAL8*)srcs[0]->storage(),
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(),
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      case 1:
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"ENO\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_2tl_eno)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      case 2: 
+        switch (order_space) {
+        case 0:
+        case 1:
+          CCTK_WARN (0, "There is no stencil for op=\"ENO\" with order_space=1");
+          break;
+        case 2:
+        case 3:
+          CCTK_FNAME(prolongate_3d_real8_3tl_eno)
+            ((const CCTK_REAL8*)srcs[0]->storage(), times[0],
+             (const CCTK_REAL8*)srcs[1]->storage(), times[1],
+             (const CCTK_REAL8*)srcs[2]->storage(), times[2],
+             srcshp[0], srcshp[1], srcshp[2],
+             (CCTK_REAL8*)storage(), time,
+             dstshp[0], dstshp[1], dstshp[2],
+             srcbbox, dstbbox, regbbox);
+          break;
+        default:
+          assert (0);
+        }
+        break;
+      default:
+        assert (0);
+      } // switch (order_time)
+      break;
+      
+    default:
+      assert(0);
+    } // switch (transport_operator)
+    
+  } else {
+    assert (0);
+  }
+}
+
+  
+
+
+
+// Output
+template<class T,int D>
+ostream& data<T,D>::output (ostream& os) const
+{
+  T Tdummy;
+  os << "data<" << typestring(Tdummy) << "," << D << ">:"
+     << "extent=" << this->extent() << ","
+     << "stride=" << this->stride() << ",size=" << this->size();
+  return os;
+}
+
+
+
+#define INSTANTIATE(T)				\
+template class data<T,3>;
+
+#include "instantiate"
+
+#undef INSTANTIATE
diff --git a/Carpet/CarpetLib/src/data.hh b/Carpet/CarpetLib/src/data.hh
new file mode 100644
index 000000000..ba44556ff
--- /dev/null
+++ b/Carpet/CarpetLib/src/data.hh
@@ -0,0 +1,130 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/data.hh,v 1.23 2004/06/08 22:57:22 schnetter Exp $
+
+#ifndef DATA_HH
+#define DATA_HH
+
+#include <cassert>
+#include <iostream>
+#include <string>
+#include <vector>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "dist.hh"
+#include "bbox.hh"
+#include "gdata.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// A distributed multi-dimensional array
+template<class T,int D>
+class data: public gdata<D>
+{
+  
+  // Types
+  typedef vect<int,D> ivect;
+  typedef bbox<int,D> ibbox;
+
+  // Fields
+  T* _storage;			// the data (if located on this processor)
+  size_t _allocated_bytes;      // number of allocated bytes
+  
+  // For vector groups with contiguous storage
+  int vectorlength;             // number of vector elements
+  int vectorindex;              // index of this vector element
+  data* vectorleader;           // if index!=0: first vector element
+  vector<bool> vectorclients;   // if index==0: registered elements
+  
+  void register_client (int index);
+  void unregister_client (int index);
+  bool has_clients ();
+  
+public:
+  
+  // Constructors
+  data (const int varindex = -1,
+        const operator_type transport_operator = op_error,
+        const int vectorlength = 1, const int vectorindex = 0,
+        data* const vectorleader = NULL);
+  data (const int varindex, const operator_type transport_operator,
+        const int vectorlength, const int vectorindex,
+        data* const vectorleader,
+        const ibbox& extent, const int proc);
+
+  // Destructors
+  virtual ~data ();
+
+  // Pseudo constructors
+  virtual data* make_typed (const int varindex,
+                            const operator_type transport_operator) const;
+
+  // Storage management
+private:
+  void getmem (const size_t nelems);
+  void freemem ();
+public:
+  virtual void allocate (const ibbox& extent, const int proc,
+			 void* const mem=0);
+  virtual void free ();
+  virtual void transfer_from (gdata<D>* gsrc);
+
+private:
+  T* vectordata (const int vectorindex) const;
+public:
+
+  // Processor management
+  virtual void change_processor (comm_state<D>& state,
+                                 const int newproc, void* const mem=0);
+private:
+  virtual void change_processor_recv (const int newproc, void* const mem=0);
+  virtual void change_processor_send (const int newproc, void* const mem=0);
+  virtual void change_processor_wait (const int newproc, void* const mem=0);
+public:
+
+  // Accessors
+  virtual const void* storage () const
+  {
+    assert (this->_has_storage);
+    return _storage;
+  }
+
+  virtual void* storage () {
+    assert (this->_has_storage);
+    return _storage;
+  }
+  
+  // Data accessors
+  const T& operator[] (const ivect& index) const
+  {
+    assert (_storage);
+    return _storage[offset(index)];
+  }
+  
+  T& operator[] (const ivect& index)
+  {
+    assert (_storage);
+    return _storage[offset(index)];
+  }
+  
+  // Data manipulators
+  void copy_from_innerloop (const gdata<D>* gsrc,
+			    const ibbox& box);
+  void interpolate_from_innerloop (const vector<const gdata<D>*> gsrcs,
+				   const vector<CCTK_REAL> times,
+				   const ibbox& box, const CCTK_REAL time,
+				   const int order_space,
+				   const int order_time);
+  
+public:
+
+  // Output
+  ostream& output (ostream& os) const;
+};
+
+
+
+#endif // DATA_HH
diff --git a/Carpet/CarpetLib/src/defs.cc b/Carpet/CarpetLib/src/defs.cc
new file mode 100644
index 000000000..69cd22fca
--- /dev/null
+++ b/Carpet/CarpetLib/src/defs.cc
@@ -0,0 +1,176 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/defs.cc,v 1.19 2004/05/21 18:13:41 schnetter Exp $
+
+#include <assert.h>
+#include <ctype.h>
+
+#include <iostream>
+#include <list>
+#include <set>
+#include <stack>
+#include <vector>
+
+#include "cctk.h"
+
+#include "defs.hh"
+
+using namespace std;
+
+
+
+template<class T>
+T ipow (T x, int y) {
+  if (y<0) {
+    y = -y;
+    x = T(1)/x;
+  }
+  T res = T(1);
+  for (;;) {
+    if (y%2) res *= x;
+    y /= 2;
+    if (y==0) break;
+    x *= x;
+  }
+  return res;
+}
+
+
+
+void skipws (istream& is) {
+  while (is.good() && isspace(is.peek())) {
+    is.get();
+  }
+}
+
+
+
+void expect (istream& is, const char c) {
+  if (is.peek() == c) return;
+  cout << "While reading characters from a stream:" << endl
+       << "   Character '" << c << "' expected, but not found." << endl
+       << "   The next up to 100 available characters are \"";
+  for (int i=0; i<100; ++i) {
+    const int uc = is.get();
+    if (uc<0) break;
+    cout << (unsigned char)uc;
+  }
+  cout << "\"." << endl;
+  throw input_error();
+}
+
+
+
+void consume (istream& is, const char c) {
+  expect (is, c);
+  is.get();
+}
+
+
+
+// Vector input
+template<class T>
+istream& input (istream& is, vector<T>& v) {
+  v.clear();
+  try {
+    skipws (is);
+    consume (is, '[');
+    skipws (is);
+    while (is.good() && is.peek() != ']') {
+      T elem;
+      is >> elem;
+      v.push_back (elem);
+      skipws (is);
+      if (is.peek() != ',') break;
+      is.get();
+      skipws (is);
+    }
+    skipws (is);
+    consume (is, ']');
+  } catch (input_error &err) {
+    cout << "Input error while reading a vector<>" << endl
+         << "   The following elements have been read so far: " << v << endl;
+    throw err;
+  }
+  return is;
+}
+
+
+
+// List output
+template<class T>
+ostream& output (ostream& os, const list<T>& l) {
+  os << "[";
+  for (typename list<T>::const_iterator ti=l.begin(); ti!=l.end(); ++ti) {
+    if (ti!=l.begin()) os << ",";
+    os << *ti;
+  }
+  os << "]";
+  return os;
+}
+
+// Set output
+template<class T>
+ostream& output (ostream& os, const set<T>& s) {
+  os << "{";
+  for (typename set<T>::const_iterator ti=s.begin(); ti!=s.end(); ++ti) {
+    if (ti!=s.begin()) os << ",";
+    os << *ti;
+  }
+  os << "}";
+  return os;
+}
+
+// Stack output
+template<class T>
+ostream& output (ostream& os, const stack<T>& s) {
+  stack<T> s2 (s);
+  list<T> l;
+  while (! s2.empty()) {
+    l.insert (l.begin(), s2.top());
+    s2.pop();
+  }
+  return output (os, l);
+}
+
+// Vector output
+template<class T>
+ostream& output (ostream& os, const vector<T>& v) {
+  os << "[";
+  int cnt=0;
+  for (typename vector<T>::const_iterator ti=v.begin(); ti!=v.end(); ++ti) {
+    if (ti!=v.begin()) os << ",";
+    os << cnt++ << ":" << *ti;
+  }
+  os << "]";
+  return os;
+}
+
+
+
+#include "bbox.hh"
+#include "bboxset.hh"
+
+template int ipow (int x, int y);
+
+template istream& input (istream& os, vector<bbox<int,3> >& v);
+template istream& input (istream& os, vector<bbox<CCTK_REAL,3> >& v);
+template istream& input (istream& os, vector<vector<bbox<int,3> > >& v);
+template istream& input (istream& os, vector<vector<bbox<CCTK_REAL,3> > >& v);
+template istream& input (istream& os, vector<vect<vect<bool,2>,3> >& v);
+template istream& input (istream& os, vector<vector<vect<vect<bool,2>,3> > >& v);
+
+template ostream& output (ostream& os, const list<bbox<int,3> >& l);
+template ostream& output (ostream& os, const set<bbox<int,3> >& s);
+template ostream& output (ostream& os, const set<bboxset<int,3> >& s);
+template ostream& output (ostream& os, const stack<bbox<int,3> >& s);
+template ostream& output (ostream& os, const vector<int>& v);
+template ostream& output (ostream& os, const vector<CCTK_REAL>& v);
+template ostream& output (ostream& os, const vector<bbox<int,3> >& v);
+template ostream& output (ostream& os, const vector<bbox<CCTK_REAL,3> >& v);
+template ostream& output (ostream& os, const vector<list<bbox<int,3> > >& v);
+template ostream& output (ostream& os, const vector<vector<int> >& v);
+template ostream& output (ostream& os, const vector<vector<CCTK_REAL> >& v);
+template ostream& output (ostream& os, const vector<vector<bbox<int,3> > >& v);
+template ostream& output (ostream& os, const vector<vector<bbox<CCTK_REAL,3> > >& v);
+template ostream& output (ostream& os, const vector<vector<vect<vect<bool,2>,3> > >& v);
+template ostream& output (ostream& os, const vector<vect<vect<bool,2>,3> >& v);
+template ostream& output (ostream& os, const vector<vector<vector<bbox<int,3> > > >& v);
diff --git a/Carpet/CarpetLib/src/defs.hh b/Carpet/CarpetLib/src/defs.hh
new file mode 100644
index 000000000..4297ba8c6
--- /dev/null
+++ b/Carpet/CarpetLib/src/defs.hh
@@ -0,0 +1,194 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/defs.hh,v 1.13 2004/03/01 19:43:08 schnetter Exp $
+
+#ifndef DEFS_HH
+#define DEFS_HH
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include <assert.h>
+
+#include <algorithm>
+#include <complex>
+#include <iostream>
+#include <list>
+#include <set>
+#include <stack>
+#include <vector>
+
+#include "cctk.h"
+
+using namespace std;
+
+// A general type
+enum centering { vertex_centered, cell_centered };
+
+// Useful helper
+template<class T>
+inline T square (const T& x) { return x*x; }
+
+// Another useful helper
+template<class T>
+T ipow (T x, int y);
+
+
+
+// Input streams
+struct input_error { };
+void skipws (istream& is);
+void expect (istream& is, const char c);
+void consume (istream& is, const char c);
+
+
+
+// Names for types
+
+#if 0
+
+inline const char * typestring (const char& dummy)
+{ return "char"; }
+
+inline const char * typestring (const signed char& dummy)
+{ return "signed char"; }
+
+inline const char * typestring (const unsigned char& dummy)
+{ return "unsigned char"; }
+
+inline const char * typestring (const short& dummy)
+{ return "short"; }
+
+inline const char * typestring (const unsigned short& dummy)
+{ return "unsigned short"; }
+
+inline const char * typestring (const int& dummy)
+{ return "int"; }
+
+inline const char * typestring (const unsigned int& dummy)
+{ return "unsigned int"; }
+
+inline const char * typestring (const long& dummy)
+{ return "long"; }
+
+inline const char * typestring (const unsigned long& dummy)
+{ return "unsigned long"; }
+
+inline const char * typestring (const long long& dummy)
+{ return "long long"; }
+
+inline const char * typestring (const unsigned long long& dummy)
+{ return "unsigned long long"; }
+
+inline const char * typestring (const float& dummy)
+{ return "float"; }
+
+inline const char * typestring (const double& dummy)
+{ return "double"; }
+
+inline const char * typestring (const long double& dummy)
+{ return "long double"; }
+
+inline const char * typestring (const complex<float>& dummy)
+{ return "complex<float>"; }
+
+inline const char * typestring (const complex<double>& dummy)
+{ return "complex<double>"; }
+
+inline const char * typestring (const complex<long double>& dummy)
+{ return "complex<long double>"; }
+
+#else
+
+#  ifdef CCTK_INT1
+inline const char * typestring (const CCTK_INT1& dummy)
+{ return "CCTK_INT1"; }
+#  endif
+
+#  ifdef CCTK_INT2
+inline const char * typestring (const CCTK_INT2& dummy)
+{ return "CCTK_INT2"; }
+#  endif
+
+#  ifdef CCTK_INT4
+inline const char * typestring (const CCTK_INT4& dummy)
+{ return "CCTK_INT4"; }
+#  endif
+
+#  ifdef CCTK_INT8
+inline const char * typestring (const CCTK_INT8& dummy)
+{ return "CCTK_INT8"; }
+#  endif
+
+#  ifdef CCTK_REAL4
+inline const char * typestring (const CCTK_REAL4& dummy)
+{ return "CCTK_REAL4"; }
+#  endif
+
+#  ifdef CCTK_REAL8
+inline const char * typestring (const CCTK_REAL8& dummy)
+{ return "CCTK_REAL8"; }
+#  endif
+
+#  ifdef CCTK_REAL16
+inline const char * typestring (const CCTK_REAL16& dummy)
+{ return "CCTK_REAL16"; }
+#  endif
+
+#  ifdef CCTK_REAL4
+inline const char * typestring (const CCTK_COMPLEX8& dummy)
+{ return "CCTK_COMPLEX8"; }
+#  endif
+
+#  ifdef CCTK_REAL8
+inline const char * typestring (const CCTK_COMPLEX16& dummy)
+{ return "CCTK_COMPLEX16"; }
+#  endif
+
+#  ifdef CCTK_REAL16
+inline const char * typestring (const CCTK_COMPLEX32& dummy)
+{ return "CCTK_COMPLEX32"; }
+#  endif
+
+#endif
+
+
+
+// Container input
+template<class T> istream& input (istream& is, vector<T>& v);
+
+template<class T>
+inline istream& operator>> (istream& is, vector<T>& v) {
+  return input(is,v);
+}
+
+
+
+// Container output
+template<class T> ostream& output (ostream& os, const list<T>& l);
+template<class T> ostream& output (ostream& os, const set<T>& s);
+template<class T> ostream& output (ostream& os, const stack<T>& s);
+template<class T> ostream& output (ostream& os, const vector<T>& v);
+
+template<class T>
+inline ostream& operator<< (ostream& os, const list<T>& l) {
+  return output(os,l);
+}
+
+template<class T>
+inline ostream& operator<< (ostream& os, const set<T>& s) {
+  return output(os,s);
+}
+
+template<class T>
+inline ostream& operator<< (ostream& os, const stack<T>& s) {
+  return output(os,s);
+}
+
+template<class T>
+inline ostream& operator<< (ostream& os, const vector<T>& v) {
+  return output(os,v);
+}
+
+
+
+#endif // DEFS_HH
diff --git a/Carpet/CarpetLib/src/dh.cc b/Carpet/CarpetLib/src/dh.cc
new file mode 100644
index 000000000..e7e8778ff
--- /dev/null
+++ b/Carpet/CarpetLib/src/dh.cc
@@ -0,0 +1,689 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/dh.cc,v 1.57 2004/09/17 16:37:26 schnetter Exp $
+
+#include <assert.h>
+
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+#include "defs.hh"
+#include "dist.hh"
+#include "ggf.hh"
+#include "vect.hh"
+
+#include "dh.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<int D>
+dh<D>::dh (gh<D>& h,
+           const ivect& lghosts, const ivect& ughosts,
+	   const int prolongation_order_space, const int buffer_width)
+  : h(h),
+    lghosts(lghosts), ughosts(ughosts),
+    prolongation_order_space(prolongation_order_space),
+    buffer_width(buffer_width)
+{
+  assert (all(lghosts>=0 && ughosts>=0));
+  assert (prolongation_order_space>=0);
+  assert (buffer_width>=0);
+  h.add(this);
+  CHECKPOINT;
+  recompose (false);
+}
+
+// Destructors
+template<int D>
+dh<D>::~dh ()
+{
+  CHECKPOINT;
+  h.remove(this);
+}
+
+// Helpers
+template<int D>
+int dh<D>::prolongation_stencil_size () const {
+  assert (prolongation_order_space>=0);
+  return prolongation_order_space/2;
+}
+
+// Modifiers
+template<int D>
+void dh<D>::recompose (const bool do_prolongate) {
+  DECLARE_CCTK_PARAMETERS;
+  
+  CHECKPOINT;
+  
+  boxes.clear();
+  
+  boxes.resize(h.reflevels());
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    boxes.at(rl).resize(h.components(rl));
+    for (int c=0; c<h.components(rl); ++c) {
+      boxes.at(rl).at(c).resize(h.mglevels(rl,c));
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+       	const ibbox intr = h.extents.at(rl).at(c).at(ml);
+	
+       	// Interior
+       	// (the interior of the grid has the extent as specified by
+       	// the user)
+       	boxes.at(rl).at(c).at(ml).interior = intr;
+	
+       	// Exterior (add ghost zones)
+       	// (the content of the exterior is completely determined by
+       	// the interior of this or other components; the content of
+       	// the exterior is redundant)
+	ivect ldist(lghosts), udist(ughosts);
+	for (int d=0; d<D; ++d) {
+	  if (h.outer_boundaries.at(rl).at(c)[d][0]) ldist[d] = 0;
+	  if (h.outer_boundaries.at(rl).at(c)[d][1]) udist[d] = 0;
+	}
+        boxes.at(rl).at(c).at(ml).exterior = intr.expand(ldist, udist);
+	
+       	// Boundaries (ghost zones only)
+       	// (interior + boundaries = exterior)
+       	boxes.at(rl).at(c).at(ml).boundaries
+          = boxes.at(rl).at(c).at(ml).exterior - intr;
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+	
+      	// Sync boxes
+      	const int cs = h.components(rl);
+      	boxes.at(rl).at(c).at(ml).send_sync.resize(cs);
+      	boxes.at(rl).at(c).at(ml).recv_sync.resize(cs);
+      	
+      	// Refinement boxes
+      	if (rl>0) {
+      	  const int csm1 = h.components(rl-1);
+      	  boxes.at(rl).at(c).at(ml).send_ref_coarse.resize(csm1);
+      	  boxes.at(rl).at(c).at(ml).recv_ref_coarse.resize(csm1);
+      	  boxes.at(rl).at(c).at(ml).recv_ref_bnd_coarse.resize(csm1);
+      	}
+      	if (rl<h.reflevels()-1) {
+      	  const int csp1 = h.components(rl+1);
+      	  boxes.at(rl).at(c).at(ml).recv_ref_fine.resize(csp1);
+      	  boxes.at(rl).at(c).at(ml).send_ref_fine.resize(csp1);
+      	  boxes.at(rl).at(c).at(ml).send_ref_bnd_fine.resize(csp1);
+      	}
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      	const ibset& bnds = boxes.at(rl).at(c).at(ml).boundaries;
+	
+      	// Sync boxes
+      	for (int cc=0; cc<h.components(rl); ++cc) {
+      	  assert (ml<h.mglevels(rl,cc));
+      	  // intersect boundaries with interior of that component
+          ibset ovlp = bnds & boxes.at(rl).at(cc).at(ml).interior;
+          ovlp.normalize();
+      	  for (typename ibset::const_iterator b=ovlp.begin();
+	       b!=ovlp.end(); ++b) {
+	    boxes.at(rl).at(c ).at(ml).recv_sync.at(cc).push_back(*b);
+	    boxes.at(rl).at(cc).at(ml).send_sync.at(c ).push_back(*b);
+	  }
+      	} // for cc
+      	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      	const ibbox& intr = boxes.at(rl).at(c).at(ml).interior;
+      	const ibbox& extr = boxes.at(rl).at(c).at(ml).exterior;
+	
+      	// Multigrid boxes
+      	if (ml>0) {
+      	  const ibbox intrf = boxes.at(rl).at(c).at(ml-1).interior;
+      	  const ibbox extrf = boxes.at(rl).at(c).at(ml-1).exterior;
+      	  // Restriction (interior)
+      	  {
+      	    // (the restriction must fill all of the interior of the
+      	    // coarse grid, and may use the exterior of the fine grid)
+      	    const ibbox recv = intr;
+            assert (intr.empty() || ! recv.empty());
+      	    const ibbox send = recv.expanded_for(extrf);
+            assert (intr.empty() || ! send.empty());
+            // TODO: put the check back in, taking outer boundaries
+            // into account
+#if 0
+      	    assert (send.is_contained_in(extrf));
+#endif
+      	    boxes.at(rl).at(c).at(ml-1).send_mg_coarse.push_back(send);
+      	    boxes.at(rl).at(c).at(ml  ).recv_mg_fine  .push_back(recv);
+      	  }
+      	  // Prolongation (interior)
+      	  {
+      	    // (the prolongation may use the exterior of the coarse
+      	    // grid, and may fill only the interior of the fine grid,
+      	    // and the bbox must be as large as possible)
+      	    const ibbox recv = extr.contracted_for(intrf) & intrf;
+            assert (intr.empty() || ! recv.empty());
+      	    const ibbox send = recv.expanded_for(extr);
+            assert (intr.empty() || ! send.empty());
+      	    boxes.at(rl).at(c).at(ml-1).recv_mg_coarse.push_back(recv);
+      	    boxes.at(rl).at(c).at(ml  ).send_mg_fine  .push_back(send);
+      	  }
+      	} // if not finest multigrid level
+        
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      	const ibbox& intr = boxes.at(rl).at(c).at(ml).interior;
+      	const ibbox& extr = boxes.at(rl).at(c).at(ml).exterior;
+	
+      	// Refinement boxes
+      	if (rl<h.reflevels()-1) {
+      	  for (int cc=0; cc<h.components(rl+1); ++cc) {
+      	    const ibbox intrf = boxes.at(rl+1).at(cc).at(ml).interior;
+      	    // Prolongation (interior)
+            // TODO: prefer boxes from the same processor
+      	    {
+      	      // (the prolongation may use the exterior of the coarse
+      	      // grid, and must fill all of the interior of the fine
+      	      // grid)
+              const int pss = prolongation_stencil_size();
+              ibset recvs
+                = extr.expand(-pss,-pss).contracted_for(intrf) & intrf;
+              const iblistvect& rrc
+                = boxes.at(rl+1).at(cc).at(ml).recv_ref_coarse;
+              for (typename iblistvect::const_iterator lvi=rrc.begin();
+                   lvi!=rrc.end(); ++lvi) {
+                for (typename iblist::const_iterator li=lvi->begin();
+                     li!=lvi->end(); ++li) {
+                  recvs -= *li;
+                }
+              }
+              recvs.normalize();
+              assert (recvs.setsize() <= 1);
+              if (recvs.setsize() == 1) {
+                const ibbox recv = *recvs.begin();
+                const ibbox send = recv.expanded_for(extr);
+                assert (! send.empty());
+                assert (send.is_contained_in(extr));
+                boxes.at(rl+1).at(cc).at(ml).recv_ref_coarse.at(c )
+                  .push_back(recv);
+                boxes.at(rl  ).at(c ).at(ml).send_ref_fine  .at(cc)
+                  .push_back(send);
+              }
+      	    }
+            
+      	  } // for cc
+      	} // if not finest refinement level
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      	const ibbox& intr = boxes.at(rl).at(c).at(ml).interior;
+      	const ibbox& extr = boxes.at(rl).at(c).at(ml).exterior;
+	
+      	// Refinement boxes
+      	if (rl<h.reflevels()-1) {
+      	  for (int cc=0; cc<h.components(rl+1); ++cc) {
+      	    const ibbox intrf = boxes.at(rl+1).at(cc).at(ml).interior;
+            const ibbox& extrf = boxes.at(rl+1).at(cc).at(ml).exterior;
+            const ibset& bndsf = boxes.at(rl+1).at(cc).at(ml).boundaries;
+      	    // Prolongation (boundaries)
+            // TODO: prefer boxes from the same processor
+      	    {
+              // (the prolongation may use the exterior of the coarse
+              // grid, and must fill all of the boundary of the fine
+              // grid)
+              const int pss = prolongation_stencil_size();
+              // Prolongation boundaries
+              ibset pbndsf = bndsf;
+              {
+                // Do not count what is synced
+                const iblistvect& rs
+                  = boxes.at(rl+1).at(cc).at(ml).recv_sync;
+                for (typename iblistvect::const_iterator lvi=rs.begin();
+                     lvi!=rs.end(); ++lvi) {
+                  for (typename iblist::const_iterator li=lvi->begin();
+                       li!=lvi->end(); ++li) {
+                    pbndsf -= *li;
+                  }
+                }
+                pbndsf.normalize();
+              }
+              // Buffer zones
+              ibset buffers;
+              {
+                for (typename ibset::const_iterator pbi=pbndsf.begin();
+                     pbi!=pbndsf.end(); ++pbi) {
+                  buffers |= (*pbi).expand(buffer_width, buffer_width) & extrf;
+                }
+                buffers.normalize();
+              }
+              // Add boundaries
+              const ibbox maxrecvs
+                = extr.expand(-pss,-pss).contracted_for(extrf);
+              ibset recvs = buffers & maxrecvs;
+              recvs.normalize();
+              {
+                // Do not prolongate what is already prolongated
+                const iblistvect& rrbc
+                  = boxes.at(rl+1).at(cc).at(ml).recv_ref_bnd_coarse;
+                for (typename iblistvect::const_iterator lvi=rrbc.begin();
+                     lvi!=rrbc.end(); ++lvi) {
+                  for (typename iblist::const_iterator li=lvi->begin();
+                       li!=lvi->end(); ++li) {
+                    recvs -= *li;
+                  }
+                }
+                recvs.normalize();
+              }
+              {
+                for (typename ibset::const_iterator ri = recvs.begin();
+                     ri != recvs.end(); ++ri) {
+                  const ibbox & recv = *ri;
+                  const ibbox send = recv.expanded_for(extr);
+                  assert (! send.empty());
+                  assert (send.is_contained_in(extr));
+                  assert (send.is_contained_in(extr.expand(-pss,-pss)));
+                  boxes.at(rl+1).at(cc).at(ml).recv_ref_bnd_coarse.at(c )
+                    .push_back(recv);
+                  boxes.at(rl  ).at(c ).at(ml).send_ref_bnd_fine  .at(cc)
+                    .push_back(send);
+                }
+      	      }
+      	    }
+            
+      	  } // for cc
+      	} // if not finest refinement level
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      	const ibbox& intr = boxes.at(rl).at(c).at(ml).interior;
+      	const ibbox& extr = boxes.at(rl).at(c).at(ml).exterior;
+	
+      	// Refinement boxes
+      	if (rl<h.reflevels()-1) {
+      	  for (int cc=0; cc<h.components(rl+1); ++cc) {
+      	    const ibbox intrf = boxes.at(rl+1).at(cc).at(ml).interior;
+      	    // Restriction (interior)
+      	    {
+      	      // (the restriction may fill the interior of the of the
+      	      // coarse grid, and may use the interior of the fine
+      	      // grid, and the bbox must be as large as possible)
+              // (the restriction must not use points that are filled
+              // by boundary prolongation)
+              ibset sends = intrf & intr.expanded_for(intrf);
+              // remove what is received during boundary prolongation
+              for (int ccc=0; ccc<h.components(rl); ++ccc) {
+                const iblist& sendlist
+                  = boxes.at(rl+1).at(cc).at(ml).recv_ref_bnd_coarse.at(ccc);
+                for (typename iblist::const_iterator sli = sendlist.begin();
+                     sli != sendlist.end(); ++sli) {
+                  sends -= *sli;
+                }
+              }
+              sends.normalize();
+              for (typename ibset::const_iterator si = sends.begin();
+                   si != sends.end(); ++si) {
+                const ibbox recv = (*si).contracted_for(intr);
+                if (! recv.empty()) {
+                  const ibbox & send = recv.expanded_for(intrf);
+                  assert (! send.empty());
+                  boxes.at(rl+1).at(cc).at(ml).send_ref_coarse.at(c )
+                    .push_back(send);
+                  boxes.at(rl  ).at(c ).at(ml).recv_ref_fine  .at(cc)
+                    .push_back(recv);
+                }
+              }
+      	    }
+            
+      	  } // for cc
+      	} // if not finest refinement level
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+	
+	// Boundaries that are not synced, or are neither synced nor
+	// prolonged to from coarser grids (outer boundaries)
+        ibset& sync_not = boxes.at(rl).at(c).at(ml).sync_not;
+        ibset& recv_not = boxes.at(rl).at(c).at(ml).recv_not;
+        
+        // The whole boundary
+        sync_not = boxes.at(rl).at(c).at(ml).boundaries;
+        recv_not = boxes.at(rl).at(c).at(ml).boundaries;
+        
+        // Subtract boxes received during synchronisation
+        const iblistvect& recv_sync = boxes.at(rl).at(c).at(ml).recv_sync;
+        for (typename iblistvect::const_iterator lvi=recv_sync.begin();
+             lvi!=recv_sync.end(); ++lvi) {
+          for (typename iblist::const_iterator li=lvi->begin();
+               li!=lvi->end(); ++li) {
+            sync_not -= *li;
+            recv_not -= *li;
+          }
+        }
+        
+        // Subtract boxes received during prolongation
+        const iblistvect& recv_ref_bnd_coarse
+          = boxes.at(rl).at(c).at(ml).recv_ref_bnd_coarse;
+        for (typename iblistvect::const_iterator
+               lvi=recv_ref_bnd_coarse.begin();
+             lvi!=recv_ref_bnd_coarse.end(); ++lvi) {
+          for (typename iblist::const_iterator li=lvi->begin();
+               li!=lvi->end(); ++li) {
+            recv_not -= *li;
+          }
+        }
+	
+      } // for ml
+    } // for c
+  } // for rl
+  
+  // Calculate bases
+  bases.resize(h.reflevels());
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    if (h.components(rl)==0) {
+      bases.at(rl).resize(0);
+    } else {
+      bases.at(rl).resize(h.mglevels(rl,0));
+      for (int ml=0; ml<h.mglevels(rl,0); ++ml) {
+	bases.at(rl).at(ml).exterior = ibbox();
+	bases.at(rl).at(ml).interior = ibbox();
+	for (int c=0; c<h.components(rl); ++c) {
+	  bases.at(rl).at(ml).exterior
+	    = (bases.at(rl).at(ml).exterior
+	       .expanded_containing(boxes.at(rl).at(c).at(ml).exterior));
+	  bases.at(rl).at(ml).interior
+	    = (bases.at(rl).at(ml).interior
+	       .expanded_containing(boxes.at(rl).at(c).at(ml).interior));
+	}
+	bases.at(rl).at(ml).boundaries
+	  = bases.at(rl).at(ml).exterior - bases.at(rl).at(ml).interior;
+      }
+    }
+  }
+  
+  if (output_bboxes) {
+    cout << endl << h << endl;
+    for (int rl=0; rl<h.reflevels(); ++rl) {
+      for (int c=0; c<h.components(rl); ++c) {
+	for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+	  cout << endl;
+	  cout << "dh bboxes:" << endl;
+	  cout << "rl=" << rl << " c=" << c << " ml=" << ml << endl;
+	  cout << "exterior=" << boxes.at(rl).at(c).at(ml).exterior << endl;
+	  cout << "interior=" << boxes.at(rl).at(c).at(ml).interior << endl;
+	  cout << "send_mg_fine=" << boxes.at(rl).at(c).at(ml).send_mg_fine << endl;
+	  cout << "send_mg_coarse=" << boxes.at(rl).at(c).at(ml).send_mg_coarse << endl;
+	  cout << "recv_mg_fine=" << boxes.at(rl).at(c).at(ml).recv_mg_fine << endl;
+	  cout << "recv_mg_coarse=" << boxes.at(rl).at(c).at(ml).recv_mg_coarse << endl;
+	  cout << "send_ref_fine=" << boxes.at(rl).at(c).at(ml).send_ref_fine << endl;
+	  cout << "send_ref_coarse=" << boxes.at(rl).at(c).at(ml).send_ref_coarse << endl;
+	  cout << "recv_ref_fine=" << boxes.at(rl).at(c).at(ml).recv_ref_fine << endl;
+	  cout << "recv_ref_coarse=" << boxes.at(rl).at(c).at(ml).recv_ref_coarse << endl;
+	  cout << "send_sync=" << boxes.at(rl).at(c).at(ml).send_sync << endl;
+	  cout << "send_ref_bnd_fine=" << boxes.at(rl).at(c).at(ml).send_ref_bnd_fine << endl;
+	  cout << "boundaries=" << boxes.at(rl).at(c).at(ml).boundaries << endl;
+	  cout << "recv_sync=" << boxes.at(rl).at(c).at(ml).recv_sync << endl;
+	  cout << "recv_ref_bnd_coarse=" << boxes.at(rl).at(c).at(ml).recv_ref_bnd_coarse << endl;
+	  cout << "sync_not=" << boxes.at(rl).at(c).at(ml).sync_not << endl;
+	  cout << "recv_not=" << boxes.at(rl).at(c).at(ml).recv_not << endl;
+	}
+      }
+    }
+    for (int rl=0; rl<h.reflevels(); ++rl) {
+      if (h.components(rl)>0) {
+	for (int ml=0; ml<h.mglevels(rl,0); ++ml) {
+	  cout << endl;
+	  cout << "dh bases:" << endl;
+	  cout << "rl=" << rl << " ml=" << ml << endl;
+	  cout << "exterior=" << bases.at(rl).at(ml).exterior << endl;
+	  cout << "interior=" << bases.at(rl).at(ml).interior << endl;
+	  cout << "boundaries=" << bases.at(rl).at(ml).boundaries << endl;
+	}
+      }
+    }
+  } // if output_bboxes
+  
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+	
+	// Assert that all boundaries are synced or received
+        {
+          const ibset& sync_not = boxes.at(rl).at(c).at(ml).sync_not;
+#if 0
+          const ibset& recv_not = boxes.at(rl).at(c).at(ml).recv_not;
+#endif
+          
+          // Check that no boundaries are left over
+          if (rl==0) assert (sync_not.empty());
+#if 0
+          assert (recv_not.empty());
+#endif
+        }
+	
+        // Assert that the interior is received exactly once during
+        // prolongation, and that nothing else is received
+        {
+          if (rl==0) {
+            const iblistvect& recv_ref_coarse
+              = boxes.at(rl).at(c).at(ml).recv_ref_coarse;
+            assert (recv_ref_coarse.empty());
+          } else {              // rl!=0
+            const iblistvect& recv_ref_coarse
+              = boxes.at(rl).at(c).at(ml).recv_ref_coarse;
+            ibset intr = boxes.at(rl).at(c).at(ml).interior;
+            for (typename iblistvect::const_iterator
+                   lvi=recv_ref_coarse.begin();
+                 lvi!=recv_ref_coarse.end(); ++lvi) {
+              for (typename iblist::const_iterator li=lvi->begin();
+                   li!=lvi->end(); ++li) {
+                const int old_sz = intr.size();
+                const int this_sz = li->size();
+                intr -= *li;
+                const int new_sz = intr.size();
+                // TODO
+                assert (new_sz + this_sz == old_sz);
+              }
+            }
+            // TODO
+            // This need not be empty at outer boundaries.  Check that
+            // those are indeed outer boundaries!  But what size of the
+            // boundary region should be used for that?
+#if 0
+            assert (intr.empty());
+#endif
+          }
+        }
+        
+        // Assert that the boundaries are received at most once during
+        // prolongation and synchronisation, and that nothing else is
+        // received
+        {
+          const iblistvect& recv_sync = boxes.at(rl).at(c).at(ml).recv_sync;
+          const iblistvect& recv_ref_bnd_coarse
+            = boxes.at(rl).at(c).at(ml).recv_ref_bnd_coarse;
+          ibset bnds = boxes.at(rl).at(c).at(ml).boundaries;
+          for (typename iblistvect::const_iterator lvi=recv_sync.begin();
+               lvi!=recv_sync.end(); ++lvi) {
+            for (typename iblist::const_iterator li=lvi->begin();
+                 li!=lvi->end(); ++li) {
+              const int old_sz = bnds.size();
+              const int this_sz = li->size();
+              bnds -= *li;
+              const int new_sz = bnds.size();
+              assert (new_sz + this_sz == old_sz);
+            }
+          }
+          for (typename iblistvect::const_iterator
+                 lvi=recv_ref_bnd_coarse.begin();
+               lvi!=recv_ref_bnd_coarse.end(); ++lvi) {
+            for (typename iblist::const_iterator li=lvi->begin();
+                 li!=lvi->end(); ++li) {
+              const int old_sz = bnds.size();
+              const int this_sz = li->size();
+              bnds -= *li;
+              const int new_sz = bnds.size();
+              // TODO
+              // The new size can be larger if part of the
+              // prolongation went into the buffer zone.
+//               assert (new_sz + this_sz == old_sz);
+              assert (new_sz + this_sz >= old_sz);
+            }
+          }
+          // TODO
+          // This need not be empty at outer boundaries.  Check that
+          // those are indeed outer boundaries!  But what size of the
+          // boundary region should be used for that?
+#if 0
+          assert (bnds.empty());
+#endif
+        }
+        
+      } // for ml
+    } // for c
+  } // for rl
+  
+  if (! save_memory_during_regridding) {
+    
+    for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+      (*f)->recompose_crop ();
+    }
+    for (int rl=0; rl<h.reflevels(); ++rl) {
+      for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+        (*f)->recompose_allocate (rl);
+      }
+      for (comm_state<D> state; !state.done(); state.step()) {
+        for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+          (*f)->recompose_fill (state, rl, do_prolongate);
+        }
+      }
+      for (typename list<ggf<D>*>::reverse_iterator f=gfs.rbegin(); f!=gfs.rend(); ++f) {
+        (*f)->recompose_free (rl);
+      }
+      for (comm_state<D> state; !state.done(); state.step()) {
+        for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+          (*f)->recompose_bnd_prolongate (state, rl, do_prolongate);
+        }
+      }
+      for (comm_state<D> state; !state.done(); state.step()) {
+        for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+          (*f)->recompose_sync (state, rl, do_prolongate);
+        }
+      }
+    } // for rl
+    
+  } else {                      // save memory
+    
+    ggf<D>* vectorleader = NULL;
+    for (typename list<ggf<D>*>::iterator f=gfs.begin(); f!=gfs.end(); ++f) {
+      
+      (*f)->recompose_crop ();
+      for (int rl=0; rl<h.reflevels(); ++rl) {
+        (*f)->recompose_allocate (rl);
+        for (comm_state<D> state; !state.done(); state.step()) {
+          (*f)->recompose_fill (state, rl, do_prolongate);
+        }
+        assert ((*f)->vectorlength >= 1);
+        if ((*f)->vectorlength == 1) {
+          assert (! vectorleader);
+          (*f)->recompose_free (rl);
+        } else {
+          // treat vector groups specially: delete the leader only
+          // after all other elements have been deleted
+          if ((*f)->vectorindex == 0) {
+            // first element: delete nothing
+            if (rl == 0) {
+              assert (! vectorleader);
+              vectorleader = *f;
+            }
+            assert (vectorleader);
+          } else {
+            assert (vectorleader);
+            (*f)->recompose_free (rl);
+            if ((*f)->vectorindex == (*f)->vectorlength-1) {
+              // this was the last element: delete the leader as well
+              vectorleader->recompose_free (rl);
+              if (rl == h.reflevels()-1) {
+                vectorleader = NULL;
+              }
+            }
+          }
+        }
+        for (comm_state<D> state; !state.done(); state.step()) {
+          (*f)->recompose_bnd_prolongate (state, rl, do_prolongate);
+        }
+        for (comm_state<D> state; !state.done(); state.step()) {
+          (*f)->recompose_sync (state, rl, do_prolongate);
+        }
+      } // for rl
+      
+    } // for gf
+    assert (! vectorleader);
+    
+  } // save memory
+}
+
+
+
+// Grid function management
+template<int D>
+void dh<D>::add (ggf<D>* f) {
+  CHECKPOINT;
+  gfs.push_back(f);
+}
+
+template<int D>
+void dh<D>::remove (ggf<D>* f) {
+  CHECKPOINT;
+  gfs.remove(f);
+}
+
+
+
+// Output
+template<int D>
+void dh<D>::output (ostream& os) const {
+  os << "dh<" << D << ">:"
+     << "ghosts=[" << lghosts << "," << ughosts << "],"
+     << "gfs={";
+  int cnt=0;
+  for (typename list<ggf<D>*>::const_iterator f = gfs.begin();
+       f != gfs.end(); ++f) {
+    if (cnt++) os << ",";
+    (*f)->output(os);
+  }
+  os << "}";
+}
+
+
+
+template class dh<3>;
diff --git a/Carpet/CarpetLib/src/dh.hh b/Carpet/CarpetLib/src/dh.hh
new file mode 100644
index 000000000..22a9bd425
--- /dev/null
+++ b/Carpet/CarpetLib/src/dh.hh
@@ -0,0 +1,146 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/dh.hh,v 1.20 2004/08/07 19:47:11 schnetter Exp $
+
+#ifndef DH_HH
+#define DH_HH
+
+#include <assert.h>
+
+#include <iostream>
+#include <list>
+#include <string>
+#include <vector>
+
+#include "bbox.hh"
+#include "bboxset.hh"
+#include "defs.hh"
+#include "gh.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<int D> class ggf;
+template<int D> class dh;
+
+// Output
+template<int D>
+ostream& operator<< (ostream& os, const dh<D>& d);
+
+
+
+// A data hierarchy (grid hierarchy plus ghost zones)
+template<int D>
+class dh {
+  
+  // Types
+  typedef vect<int,D>    ivect;
+  typedef bbox<int,D>    ibbox;
+  typedef bboxset<int,D> ibset;
+  typedef list<ibbox>    iblist;
+  typedef vector<iblist> iblistvect; // vector of lists
+  
+public:
+  
+  // in here, the term "boundary" means both ghost zones and
+  // refinement boundaries, but does not refer to outer (physical)
+  // boundaries.
+  
+  // ghost zones, refinement boundaries, and outer boundaries are not
+  // used as sources for synchronisation.  this design choice might
+  // not be good.
+  
+  struct dboxes {
+    ibbox exterior;		// whole region (including boundaries)
+    
+    ibbox interior;		// interior (without boundaries)
+    iblist send_mg_fine;
+    iblist send_mg_coarse;
+    iblist recv_mg_fine;
+    iblist recv_mg_coarse;
+    iblistvect send_ref_fine;
+    iblistvect send_ref_coarse;
+    iblistvect recv_ref_fine;
+    iblistvect recv_ref_coarse;
+    iblistvect send_sync;	// send while syncing
+    iblistvect send_ref_bnd_fine; // sent to finer grids
+    
+    ibset boundaries;		// boundaries
+    iblistvect recv_sync;	// received while syncing
+    iblistvect recv_ref_bnd_coarse; // received from coarser grids
+    ibset sync_not;		// not received while syncing (outer boundary of that level)
+    ibset recv_not;		// not received while syncing or prolongating (globally outer boundary)
+    
+#if 0
+    // after regridding:
+    iblistvect prev_send;       // sent from previous dh
+    iblistvect recv_prev;       // received from previous dh
+    iblistvect send_prev_fine;  // sent to finer
+    iblistvect recv_prev_coarse; // received from coarser
+#endif
+  };
+  
+private:
+  
+  struct dbases {
+    ibbox exterior;		// whole region (including boundaries)
+    ibbox interior;		// interior (without boundaries)
+    ibset boundaries;		// boundaries
+  };
+  
+  typedef vector<dboxes> mboxes; // ... for each multigrid level
+  typedef vector<mboxes> cboxes; // ... for each component
+  typedef vector<cboxes> rboxes; // ... for each refinement level
+  
+  typedef vector<dbases> mbases; // ... for each multigrid level
+  typedef vector<mbases> rbases; // ... for each refinement level
+  
+public:				// should be readonly
+  
+  // Fields
+  gh<D>& h;			// hierarchy
+  ivect lghosts, ughosts;	// ghost zones
+  
+  int prolongation_order_space;	// order of spatial prolongation operator
+  int buffer_width;             // buffer inside refined grids
+  
+  rboxes boxes;
+  rbases bases;
+  
+  list<ggf<D>*> gfs;            // list of all grid functions
+  
+public:
+  
+  // Constructors
+  dh (gh<D>& h, const ivect& lghosts, const ivect& ughosts,
+      int prolongation_order_space, int buffer_width);
+  
+  // Destructors
+  virtual ~dh ();
+  
+  // Helpers
+  int prolongation_stencil_size () const;
+  
+  // Modifiers
+  void recompose (const bool do_prolongate);
+  
+  // Grid function management
+  void add (ggf<D>* f);
+  void remove (ggf<D>* f);
+  
+  // Output
+  virtual void output (ostream& os) const;
+};
+
+
+
+template<int D>
+inline ostream& operator<< (ostream& os, const dh<D>& d) {
+  d.output(os);
+  return os;
+}
+
+
+
+#endif // DH_HH
diff --git a/Carpet/CarpetLib/src/dist.cc b/Carpet/CarpetLib/src/dist.cc
new file mode 100644
index 000000000..7e41e3cdb
--- /dev/null
+++ b/Carpet/CarpetLib/src/dist.cc
@@ -0,0 +1,83 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/dist.cc,v 1.8 2004/07/08 12:36:01 tradke Exp $
+
+#include <assert.h>
+
+#include <mpi.h>
+
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+#include "defs.hh"
+
+#include "dist.hh"
+
+using namespace std;
+
+
+
+namespace dist {
+  
+  MPI_Comm comm = MPI_COMM_NULL;
+  
+#if 0
+  MPI_Datatype mpi_complex_float;
+  MPI_Datatype mpi_complex_double;
+  MPI_Datatype mpi_complex_long_double;
+#else
+  MPI_Datatype mpi_complex8;
+  MPI_Datatype mpi_complex16;
+  MPI_Datatype mpi_complex32;
+#endif
+  
+  void init (int& argc, char**& argv) {
+    MPI_Init (&argc, &argv);
+    pseudoinit();
+  }
+  
+  void pseudoinit () {
+    comm = MPI_COMM_WORLD;
+    
+#if 0
+    MPI_Type_contiguous (2, MPI_FLOAT, &mpi_complex_float);
+    MPI_Type_commit (&mpi_complex_float);
+    MPI_Type_contiguous (2, MPI_DOUBLE, &mpi_complex_double);
+    MPI_Type_commit (&mpi_complex_double);
+    MPI_Type_contiguous (2, MPI_LONG_DOUBLE, &mpi_complex_long_double);
+    MPI_Type_commit (&mpi_complex_long_double);
+#else
+#  ifdef CCTK_REAL4
+    CCTK_REAL4 dummy4;
+    MPI_Type_contiguous (2, datatype(dummy4), &mpi_complex8);
+    MPI_Type_commit (&mpi_complex8);
+#  endif
+#  ifdef CCTK_REAL8
+    CCTK_REAL8 dummy8;
+    MPI_Type_contiguous (2, datatype(dummy8), &mpi_complex16);
+    MPI_Type_commit (&mpi_complex16);
+#  endif
+#  ifdef CCTK_REAL16
+    CCTK_REAL16 dummy16;
+    MPI_Type_contiguous (2, datatype(dummy16), &mpi_complex32);
+    MPI_Type_commit (&mpi_complex32);
+#  endif
+#endif
+  }
+  
+  void finalize () {
+    MPI_Finalize ();
+  }
+  
+  void checkpoint (const char* file, int line) {
+    DECLARE_CCTK_PARAMETERS;
+    if (verbose) {
+      int rank;
+      MPI_Comm_rank (comm, &rank);
+      printf ("CHECKPOINT: processor %d, file %s, line %d\n",
+	      rank, file, line);
+    }
+    if (barriers) {
+      MPI_Barrier (comm);
+    }
+  }
+  
+} // namespace dist
diff --git a/Carpet/CarpetLib/src/dist.hh b/Carpet/CarpetLib/src/dist.hh
new file mode 100644
index 000000000..ab89ae580
--- /dev/null
+++ b/Carpet/CarpetLib/src/dist.hh
@@ -0,0 +1,120 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/dist.hh,v 1.10 2004/03/01 19:43:39 schnetter Exp $
+
+#ifndef DIST_HH
+#define DIST_HH
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <complex>
+
+#include <mpi.h>
+
+#include "cctk.h"
+
+#include "defs.hh"
+
+using namespace std;
+
+
+
+namespace dist {
+  
+  extern MPI_Comm comm;
+  
+#if 0
+  extern MPI_Datatype mpi_complex_float;
+  extern MPI_Datatype mpi_complex_double;
+  extern MPI_Datatype mpi_complex_long_double;
+#else
+  extern MPI_Datatype mpi_complex8;
+  extern MPI_Datatype mpi_complex16;
+  extern MPI_Datatype mpi_complex32;
+#endif
+  
+  void init (int& argc, char**& argv);
+  void pseudoinit ();
+  void finalize ();
+  
+  // Debugging output
+#define CHECKPOINT dist::checkpoint(__FILE__, __LINE__)
+  void checkpoint (const char* file, int line);
+  
+  
+  
+  // Datatype helpers
+  inline MPI_Datatype datatype (const char& dummy)
+  { return MPI_CHAR; }
+  
+  inline MPI_Datatype datatype (const signed char& dummy)
+  { return MPI_UNSIGNED_CHAR; }
+  
+  inline MPI_Datatype datatype (const unsigned char& dummy)
+  { return MPI_BYTE; }
+  
+  inline MPI_Datatype datatype (const short& dummy)
+  { return MPI_SHORT; }
+  
+  inline MPI_Datatype datatype (const unsigned short& dummy)
+  { return MPI_UNSIGNED_SHORT; }
+  
+  inline MPI_Datatype datatype (const int& dummy)
+  { return MPI_INT; }
+  
+  inline MPI_Datatype datatype (const unsigned int& dummy)
+  { return MPI_UNSIGNED; }
+  
+  inline MPI_Datatype datatype (const long& dummy)
+  { return MPI_LONG; }
+  
+  inline MPI_Datatype datatype (const unsigned long& dummy)
+  { return MPI_UNSIGNED_LONG; }
+  
+  inline MPI_Datatype datatype (const long long& dummy)
+  { return MPI_LONG_LONG_INT; }
+  
+  inline MPI_Datatype datatype (const float& dummy)
+  { return MPI_FLOAT; }
+  
+  inline MPI_Datatype datatype (const double& dummy)
+  { return MPI_DOUBLE; }
+  
+  inline MPI_Datatype datatype (const long double& dummy)
+  { return MPI_LONG_DOUBLE; }
+  
+#if 0
+  
+  inline MPI_Datatype datatype (const complex<float>& dummy)
+  { return mpi_complex_float; }
+  
+  inline MPI_Datatype datatype (const complex<double>& dummy)
+  { return mpi_complex_double; }
+  
+  inline MPI_Datatype datatype (const complex<long double>& dummy)
+  { return mpi_complex_long_double; }
+  
+#else
+  
+#  ifdef CCTK_REAL4
+  inline MPI_Datatype datatype (const CCTK_COMPLEX8& dummy)
+  { return mpi_complex8; }
+#  endif
+  
+#  ifdef CCTK_REAL8
+  inline MPI_Datatype datatype (const CCTK_COMPLEX16& dummy)
+  { return mpi_complex16; }
+#  endif
+  
+#  ifdef CCTK_REAL16
+  inline MPI_Datatype datatype (const CCTK_COMPLEX32& dummy)
+  { return mpi_complex32; }
+#  endif
+  
+#endif
+  
+} // namespace dist
+
+
+
+#endif // DIST_HH
diff --git a/Carpet/CarpetLib/src/gdata.cc b/Carpet/CarpetLib/src/gdata.cc
new file mode 100644
index 000000000..f05c88122
--- /dev/null
+++ b/Carpet/CarpetLib/src/gdata.cc
@@ -0,0 +1,438 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gdata.cc,v 1.29 2004/04/07 16:58:07 schnetter Exp $
+
+#include <assert.h>
+#include <stdlib.h>
+
+#include <iostream>
+
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+#include "util_ErrorCodes.h"
+#include "util_Table.h"
+
+#include "bbox.hh"
+#include "defs.hh"
+#include "dist.hh"
+#include "vect.hh"
+
+#include "gdata.hh"
+
+using namespace std;
+
+
+
+// Communication state control
+template<int D>
+comm_state<D>::comm_state ()
+  : thestate(state_recv),
+    current(0)
+{
+}
+
+template<int D>
+void comm_state<D>::step ()
+{
+  assert (thestate!=state_done);
+  assert (current==tmps.size());
+  thestate=astate(size_t(thestate)+1);
+  current=0;
+}
+
+template<int D>
+bool comm_state<D>::done ()
+{
+  return thestate==state_done;
+}
+
+template<int D>
+comm_state<D>::~comm_state ()
+{
+  assert (thestate==state_recv || thestate==state_done);
+}
+
+
+
+// Hand out the next MPI tag
+static int nexttag ()
+{
+  static int last = 100;
+  ++last;
+  if (last > 30000) last = 100;
+  return last;
+}
+
+
+
+// Constructors
+template<int D>
+gdata<D>::gdata (const int varindex_, const operator_type transport_operator_)
+  : varindex(varindex_), transport_operator(transport_operator_),
+    wtime_isend(0.0), wtime_isendwait(0.0),
+    wtime_irecv(0.0), wtime_irecvwait(0.0),
+    _has_storage(false),
+    comm_active(false),
+    tag(nexttag())
+{
+  DECLARE_CCTK_PARAMETERS;
+  if (barriers) {
+    MPI_Barrier (dist::comm);
+  }
+}
+
+// Destructors
+template<int D>
+gdata<D>::~gdata ()
+{
+  DECLARE_CCTK_PARAMETERS;
+  if (barriers) {
+    MPI_Barrier (dist::comm);
+  }
+}
+
+
+
+// Data manipulators
+template<int D>
+void gdata<D>::copy_from (comm_state<D>& state,
+                          const gdata* src, const ibbox& box)
+{
+  switch (state.thestate) {
+  case state_recv:
+    copy_from_recv (state, src, box);
+    break;
+  case state_send:
+    copy_from_send (state, src, box);
+    break;
+  case state_wait:
+    copy_from_wait (state, src, box);
+    break;
+  default:
+    assert(0);
+  }
+}
+
+
+
+template<int D>
+void gdata<D>::copy_from_nocomm (const gdata* src, const ibbox& box)
+{
+  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));
+  
+  if (box.empty()) return;
+  
+  assert (proc() == src->proc());
+  
+  // copy on same processor
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  if (rank == proc()) {
+    copy_from_innerloop (src, box);
+  }
+}
+
+
+
+template<int D>
+void gdata<D>::copy_from_recv (comm_state<D>& state,
+                               const gdata* src, const ibbox& box)
+{
+  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));
+  
+  if (box.empty()) return;
+  
+  if (proc() == src->proc()) {
+    // copy on same processor
+    
+  } else {
+    
+    // copy to different processor
+    gdata<D>* const tmp = make_typed(varindex, transport_operator);
+    // TODO: is this efficient?
+    state.tmps.push_back (tmp);
+    ++state.current;
+    tmp->allocate (box, src->proc());
+    tmp->change_processor_recv (proc());
+    
+  }
+}
+
+
+
+template<int D>
+void gdata<D>::copy_from_send (comm_state<D>& state,
+                               const gdata* src, const ibbox& box)
+{
+  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));
+  
+  if (box.empty()) return;
+  
+  if (proc() == src->proc()) {
+    // copy on same processor
+    
+    copy_from_nocomm (src, box);
+    
+  } else {
+    
+    // copy to different processor
+    gdata<D>* const tmp = state.tmps.at(state.current++);
+    assert (tmp);
+    tmp->copy_from_nocomm (src, box);
+    tmp->change_processor_send (proc());
+    
+  }
+}
+
+
+
+template<int D>
+void gdata<D>::copy_from_wait (comm_state<D>& state,
+                               const gdata* src, const ibbox& box)
+{
+  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));
+  
+  if (box.empty()) return;
+  
+  if (proc() == src->proc()) {
+    // copy on same processor
+    
+  } else {
+    
+    // copy to different processor
+    gdata<D>* const tmp = state.tmps.at(state.current++);
+    assert (tmp);
+    tmp->change_processor_wait (proc());
+    copy_from_nocomm (tmp, box);
+    delete tmp;
+    
+  }
+}
+
+
+
+template<int D>
+void gdata<D>
+::interpolate_from (comm_state<D>& state,
+                    const vector<const gdata*> srcs,
+                    const vector<CCTK_REAL> times,
+                    const ibbox& box, const CCTK_REAL time,
+                    const int order_space,
+                    const int order_time)
+{
+  assert (transport_operator != op_error);
+  if (transport_operator == op_none) return;
+  switch (state.thestate) {
+  case state_recv:
+    interpolate_from_recv (state, srcs, times, box, time, order_space, order_time);
+    break;
+  case state_send:
+    interpolate_from_send (state, srcs, times, box, time, order_space, order_time);
+    break;
+  case state_wait:
+    interpolate_from_wait (state, srcs, times, box, time, order_space, order_time);
+    break;
+  default:
+    assert(0);
+  }
+}
+
+
+
+template<int D>
+void gdata<D>
+::interpolate_from_nocomm (const vector<const gdata*> srcs,
+                           const vector<CCTK_REAL> times,
+                           const ibbox& box, const CCTK_REAL time,
+                           const int order_space,
+                           const int order_time)
+{
+  assert (has_storage());
+  assert (all(box.lower()>=extent().lower()));
+  assert (all(box.upper()<=extent().upper()));
+  assert (all(box.stride()==extent().stride()));
+  assert (all((box.lower()-extent().lower())%box.stride() == 0));
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs.at(t)->has_storage());
+    assert (all(box.lower()>=srcs.at(t)->extent().lower()));
+    assert (all(box.upper()<=srcs.at(t)->extent().upper()));
+  }
+  
+  assert (! box.empty());
+  if (box.empty()) return;
+  
+  assert (proc() == srcs.at(0)->proc());
+  
+  assert (transport_operator != op_error);
+  assert (transport_operator != op_none);
+  
+  // interpolate on same processor
+  int rank;
+  MPI_Comm_rank (dist::comm, &rank);
+  if (rank == proc()) {
+    interpolate_from_innerloop
+      (srcs, times, box, time, order_space, order_time);
+  }
+}
+
+
+
+template<int D>
+void gdata<D>
+::interpolate_from_recv (comm_state<D>& state,
+                         const vector<const gdata*> srcs,
+                         const vector<CCTK_REAL> times,
+                         const ibbox& box, const CCTK_REAL time,
+                         const int order_space,
+                         const int order_time)
+{
+  assert (has_storage());
+  assert (all(box.lower()>=extent().lower()));
+  assert (all(box.upper()<=extent().upper()));
+  assert (all(box.stride()==extent().stride()));
+  assert (all((box.lower()-extent().lower())%box.stride() == 0));
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs.at(t)->has_storage());
+    assert (all(box.lower()>=srcs.at(t)->extent().lower()));
+    assert (all(box.upper()<=srcs.at(t)->extent().upper()));
+  }
+  
+  assert (! box.empty());
+  if (box.empty()) return;
+  
+  if (proc() == srcs.at(0)->proc()) {
+    // interpolate on same processor
+    
+  } else {
+    // interpolate from other processor
+    
+    gdata<D>* const tmp = make_typed(varindex, transport_operator);
+    // TODO: is this efficient?
+    state.tmps.push_back (tmp);
+    ++state.current;
+    tmp->allocate (box, srcs.at(0)->proc());
+    tmp->change_processor_recv (proc());
+    
+  }
+}
+
+
+
+template<int D>
+void gdata<D>
+::interpolate_from_send (comm_state<D>& state,
+                         const vector<const gdata*> srcs,
+                         const vector<CCTK_REAL> times,
+                         const ibbox& box, const CCTK_REAL time,
+                         const int order_space,
+                         const int order_time)
+{
+  assert (has_storage());
+  assert (all(box.lower()>=extent().lower()));
+  assert (all(box.upper()<=extent().upper()));
+  assert (all(box.stride()==extent().stride()));
+  assert (all((box.lower()-extent().lower())%box.stride() == 0));
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs.at(t)->has_storage());
+    assert (all(box.lower()>=srcs.at(t)->extent().lower()));
+    assert (all(box.upper()<=srcs.at(t)->extent().upper()));
+  }
+  
+  assert (! box.empty());
+  if (box.empty()) return;
+  
+  if (proc() == srcs.at(0)->proc()) {
+    // interpolate on same processor
+    
+    interpolate_from_nocomm (srcs, times, box, time, order_space, order_time);
+    
+  } else {
+    // interpolate from other processor
+    
+    gdata<D>* const tmp = state.tmps.at(state.current++);
+    assert (tmp);
+    tmp->interpolate_from_nocomm (srcs, times, box, time, order_space, order_time);
+    tmp->change_processor_send (proc());
+    
+  }
+}
+
+
+
+template<int D>
+void gdata<D>
+::interpolate_from_wait (comm_state<D>& state,
+                         const vector<const gdata*> srcs,
+                         const vector<CCTK_REAL> times,
+                         const ibbox& box, const CCTK_REAL time,
+                         const int order_space,
+                         const int order_time)
+{
+  assert (has_storage());
+  assert (all(box.lower()>=extent().lower()));
+  assert (all(box.upper()<=extent().upper()));
+  assert (all(box.stride()==extent().stride()));
+  assert (all((box.lower()-extent().lower())%box.stride() == 0));
+  assert (srcs.size() == times.size() && srcs.size()>0);
+  for (int t=0; t<(int)srcs.size(); ++t) {
+    assert (srcs.at(t)->has_storage());
+    assert (all(box.lower()>=srcs.at(t)->extent().lower()));
+    assert (all(box.upper()<=srcs.at(t)->extent().upper()));
+  }
+  
+  assert (! box.empty());
+  if (box.empty()) return;
+  
+  if (proc() == srcs.at(0)->proc()) {
+    // interpolate on same processor
+    
+  } else {
+    // interpolate from other processor
+    
+    gdata<D>* const tmp = state.tmps.at(state.current++);
+    assert (tmp);
+    tmp->change_processor_wait (proc());
+    copy_from_nocomm (tmp, box);
+    delete tmp;
+    
+  }
+}
+
+
+
+template class comm_state<3>;
+template class gdata<3>;
diff --git a/Carpet/CarpetLib/src/gdata.hh b/Carpet/CarpetLib/src/gdata.hh
new file mode 100644
index 000000000..9355238dd
--- /dev/null
+++ b/Carpet/CarpetLib/src/gdata.hh
@@ -0,0 +1,219 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gdata.hh,v 1.24 2004/04/19 07:56:35 schnetter Exp $
+
+#ifndef GDATA_HH
+#define GDATA_HH
+
+#include <assert.h>
+#include <stdlib.h>
+
+#include <iostream>
+#include <string>
+#include <vector>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "dist.hh"
+#include "bbox.hh"
+#include "operators.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+  
+
+template<int D>
+class gdata;
+
+
+
+// State information for communications
+enum astate { state_recv, state_send, state_wait, state_done };
+
+template<int D>
+struct comm_state {
+  astate thestate;
+  comm_state ();
+  void step ();
+  bool done ();
+  ~comm_state ();
+  
+  vector<gdata<D>*> tmps;
+  size_t current;
+};
+
+
+
+// A generic data storage without type information
+template<int D>
+class gdata {
+
+  // Types
+  typedef vect<int,D> ivect;
+  typedef bbox<int,D> ibbox;
+
+protected:                      // should be readonly
+
+  // Fields
+  int varindex;                 // Cactus variable index, or -1
+  operator_type transport_operator;
+  
+  double wtime_isend, wtime_isendwait;
+  double wtime_irecv, wtime_irecvwait;
+  
+  bool _has_storage;		// has storage associated (on some processor)
+  bool _owns_storage;		// owns the storage
+  // (only valid if there is storage on this processor; it means that
+  // the memory is allocated and freed by this class)
+  int _size;			// size
+
+  int _proc;			// stored on processor
+  
+  ivect _shape, _stride;      	// shape and index order
+  
+  ibbox _extent;		// bbox for all data
+  
+  bool comm_active;
+  MPI_Request request;
+  
+  int tag;                      // MPI tag for this object
+  
+public:
+
+  // Constructors
+  gdata (const int varindex,
+         const operator_type transport_operator = op_error);
+
+  // Destructors
+  virtual ~gdata ();
+
+  // Pseudo constructors
+  virtual gdata<D>*
+  make_typed (const int varindex,
+              const operator_type transport_operator = op_error) const = 0;
+  
+  // Processor management
+  virtual void change_processor (comm_state<D>& state,
+                                 const int newproc, void* const mem=0) = 0;
+ protected:
+  virtual void change_processor_recv (const int newproc, void* const mem=0) = 0;
+  virtual void change_processor_send (const int newproc, void* const mem=0) = 0;
+  virtual void change_processor_wait (const int newproc, void* const mem=0) = 0;
+ public:
+  
+  // Storage management
+  virtual void transfer_from (gdata<D>* src) = 0;
+  
+  virtual void allocate (const ibbox& extent, const int proc,
+			 void* const mem=0) = 0;
+  virtual void free () = 0;
+  
+  // Accessors
+
+  bool has_storage () const {
+    return _has_storage;
+  }
+  bool owns_storage () const {
+    assert (_has_storage);
+    return _owns_storage;
+  }
+  
+  virtual const void* storage () const = 0;
+  
+  virtual void* storage () = 0;
+  
+  int size () const {
+    assert (_has_storage);
+    return _size;
+  }
+
+  int proc () const {
+    assert (_has_storage);
+    return _proc;
+  }
+  
+  const ivect& shape () const {
+    assert (_has_storage);
+    return _shape;
+  }
+
+  const ivect& stride () const {
+    assert (_has_storage);
+    return _stride;
+  }
+  
+  const ibbox& extent () const {
+    assert (_has_storage);
+    return _extent;
+  }
+
+  // Data accessors
+  int offset (const ivect& index) const {
+    assert (_has_storage);
+    assert (all((index-extent().lower()) % extent().stride() == 0));
+    ivect ind = (index-extent().lower()) / extent().stride();
+    assert (all(ind>=0 && ind<=shape()));
+    return dot(ind, stride());
+  }
+  
+  // Data manipulators
+ public:
+    void copy_from (comm_state<D>& state,
+                    const gdata* src, const ibbox& box);
+ private:
+  void copy_from_nocomm (const gdata* src, const ibbox& box);
+  void copy_from_recv (comm_state<D>& state,
+                       const gdata* src, const ibbox& box);
+  void copy_from_send (comm_state<D>& state,
+                       const gdata* src, const ibbox& box);
+  void copy_from_wait (comm_state<D>& state,
+                       const gdata* src, const ibbox& box);
+ public:
+  void interpolate_from (comm_state<D>& state,
+                         const vector<const gdata*> srcs,
+                         const vector<CCTK_REAL> times,
+                         const ibbox& box, const CCTK_REAL time,
+                         const int order_space,
+                         const int order_time);
+ private:
+  void interpolate_from_nocomm (const vector<const gdata*> srcs,
+                                const vector<CCTK_REAL> times,
+                                const ibbox& box, const CCTK_REAL time,
+                                const int order_space,
+                                const int order_time);
+  void interpolate_from_recv (comm_state<D>& state,
+                              const vector<const gdata*> srcs,
+                              const vector<CCTK_REAL> times,
+                              const ibbox& box, const CCTK_REAL time,
+                              const int order_space,
+                              const int order_time);
+  void interpolate_from_send (comm_state<D>& state,
+                              const vector<const gdata*> srcs,
+                              const vector<CCTK_REAL> times,
+                              const ibbox& box, const CCTK_REAL time,
+                              const int order_space,
+                              const int order_time);
+  void interpolate_from_wait (comm_state<D>& state,
+                              const vector<const gdata*> srcs,
+                              const vector<CCTK_REAL> times,
+                              const ibbox& box, const CCTK_REAL time,
+                              const int order_space,
+                              const int order_time);
+ public:
+  
+protected:
+  virtual void
+  copy_from_innerloop (const gdata* src, const ibbox& box) = 0;
+  virtual void
+  interpolate_from_innerloop (const vector<const gdata*> srcs,
+			      const vector<CCTK_REAL> times,
+			      const ibbox& box, const CCTK_REAL time,
+			      const int order_space,
+			      const int order_time) = 0;
+  
+};
+
+
+
+#endif // GDATA_HH
diff --git a/Carpet/CarpetLib/src/gf.cc b/Carpet/CarpetLib/src/gf.cc
new file mode 100644
index 000000000..69537d537
--- /dev/null
+++ b/Carpet/CarpetLib/src/gf.cc
@@ -0,0 +1,91 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gf.cc,v 1.21 2004/08/07 19:47:11 schnetter Exp $
+
+#include <assert.h>
+
+#include "cctk.h"
+
+#include "defs.hh"
+
+#include "gf.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<class T,int D>
+gf<T,D>::gf (const int varindex, const operator_type transport_operator,
+             th<D>& t, dh<D>& d,
+	     const int tmin, const int tmax, const int prolongation_order_time,
+             const int vectorlength, const int vectorindex,
+             gf* const vectorleader)
+  : ggf<D>(varindex, transport_operator,
+           t, d, tmin, tmax, prolongation_order_time,
+           vectorlength, vectorindex, vectorleader)
+{
+  // this->recompose ();
+  this->recompose_crop ();
+  for (int rl=0; rl<this->h.reflevels(); ++rl) {
+    this->recompose_allocate (rl);
+#if 0
+    for (comm_state<D> state; !state.done(); state.step()) {
+      this->recompose_fill (state, rl, false);
+    }
+#endif
+    this->recompose_free (rl);
+#if 0
+    for (comm_state<D> state; !state.done(); state.step()) {
+      this->recompose_bnd_prolongate (state, rl, false);
+    }
+    for (comm_state<D> state; !state.done(); state.step()) {
+      this->recompose_sync (state, rl, false);
+    }
+#endif
+  } // for rl
+}
+
+// Destructors
+template<class T,int D>
+gf<T,D>::~gf () { }
+
+
+
+// Access to the data
+template<class T,int D>
+const data<T,D>* gf<T,D>::operator() (int tl, int rl, int c, int ml) const {
+  assert (tl>=this->tmin && tl<=this->tmax);
+  assert (rl>=0 && rl<this->h.reflevels());
+  assert (c>=0 && c<this->h.components(rl));
+  assert (ml>=0 && ml<this->h.mglevels(rl,c));
+  return (const data<T,D>*)this->storage.at(tl-this->tmin).at(rl).at(c).at(ml);
+}
+
+template<class T,int D>
+data<T,D>* gf<T,D>::operator() (int tl, int rl, int c, int ml) {
+  assert (tl>=this->tmin && tl<=this->tmax);
+  assert (rl>=0 && rl<this->h.reflevels());
+  assert (c>=0 && c<this->h.components(rl));
+  assert (ml>=0 && ml<this->h.mglevels(rl,c));
+  return (data<T,D>*)this->storage.at(tl-this->tmin).at(rl).at(c).at(ml);
+}
+
+
+
+// Output
+template<class T,int D>
+ostream& gf<T,D>::output (ostream& os) const {
+  T Tdummy;
+  os << "gf<" << typestring(Tdummy) << "," << D << ">:"
+     << this->varindex << "[" << CCTK_VarName(this->varindex) << "],"
+     << "dt=[" << this->tmin << ":" << this->tmax<< "]";
+  return os;
+}
+
+
+
+#define INSTANTIATE(T)				\
+template class gf<T,3>;
+
+#include "instantiate"
+
+#undef INSTANTIATE
diff --git a/Carpet/CarpetLib/src/gf.hh b/Carpet/CarpetLib/src/gf.hh
new file mode 100644
index 000000000..13fc8107e
--- /dev/null
+++ b/Carpet/CarpetLib/src/gf.hh
@@ -0,0 +1,87 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gf.hh,v 1.12 2004/03/23 12:40:27 schnetter Exp $
+
+#ifndef GF_HH
+#define GF_HH
+
+#include <assert.h>
+#include <math.h>
+
+#include <iostream>
+#include <string>
+
+#include "bbox.hh"
+#include "bboxset.hh"
+#include "data.hh"
+#include "defs.hh"
+#include "dh.hh"
+#include "ggf.hh"
+#include "th.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// A real grid function
+template<class T,int D>
+class gf: public ggf<D> {
+  
+  // Types
+  typedef vect<int,D>    ivect;
+  typedef bbox<int,D>    ibbox;
+  typedef bboxset<int,D> ibset;
+  typedef list<ibbox>    iblist;
+  typedef vector<iblist> iblistvect;
+  
+  typedef data<T,D>*    tdata;	        // data ...
+  typedef vector<tdata> mdata;	        // ... for each multigrid level
+  typedef vector<mdata> cdata;	        // ... for each component
+  typedef vector<cdata> rdata;	        // ... for each refinement level
+  typedef vector<rdata> fdata;          // ... for each time level
+
+public:
+  
+  // Constructors
+  gf (const int varindex, const operator_type transport_operator,
+      th<D>& t, dh<D>& d,
+      const int tmin, const int tmax, const int prolongation_order_time,
+      const int vectorlength, const int vectorindex,
+      gf* const vectorleader);
+  
+  // Destructors
+  virtual ~gf ();
+  
+  
+  
+  // Helpers
+  
+protected:
+  
+  virtual gdata<D>* typed_data (int tl, int rl, int c, int ml)
+  {
+    return new data<T,D>(this->varindex, this->transport_operator,
+                         this->vectorlength, this->vectorindex,
+                         this->vectorleader
+                         ? (data<T,D>*)(*this->vectorleader)(tl,rl,c,ml)
+                         : NULL);
+  }
+  
+  
+  
+  // Access to the data
+  
+public:
+  
+  virtual const data<T,D>* operator() (int tl, int rl, int c, int ml) const;
+  
+  virtual data<T,D>* operator() (int tl, int rl, int c, int ml);
+  
+  
+  
+  // Output
+  virtual ostream& output (ostream& os) const;
+};
+
+
+
+#endif // GF_HH
diff --git a/Carpet/CarpetLib/src/ggf.cc b/Carpet/CarpetLib/src/ggf.cc
new file mode 100644
index 000000000..c26b22dbc
--- /dev/null
+++ b/Carpet/CarpetLib/src/ggf.cc
@@ -0,0 +1,608 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/ggf.cc,v 1.46 2004/09/17 16:37:26 schnetter Exp $
+
+#include <assert.h>
+#include <math.h>
+#include <stdlib.h>
+
+#include <iostream>
+#include <string>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "dh.hh"
+#include "th.hh"
+
+#include "ggf.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<int D>
+ggf<D>::ggf (const int varindex, const operator_type transport_operator,
+             th<D>& t, dh<D>& d,
+             const int tmin, const int tmax,
+             const int prolongation_order_time,
+             const int vectorlength, const int vectorindex,
+             ggf* const vectorleader)
+  : varindex(varindex), transport_operator(transport_operator), t(t),
+    tmin(tmin), tmax(tmax),
+    prolongation_order_time(prolongation_order_time),
+    h(d.h), d(d),
+    storage(tmax-tmin+1),
+    vectorlength(vectorlength), vectorindex(vectorindex),
+    vectorleader(vectorleader)
+{
+  assert (&t.h == &d.h);
+  
+  assert (vectorlength >= 1);
+  assert (vectorindex >= 0 && vectorindex < vectorlength);
+  assert ((vectorindex==0 && !vectorleader)
+          || (vectorindex!=0 && vectorleader));
+  
+  d.add(this);
+}
+
+// Destructors
+template<int D>
+ggf<D>::~ggf () {
+  d.remove(this);
+}
+
+// Comparison
+template<int D>
+bool ggf<D>::operator== (const ggf<D>& f) const {
+  return this == &f;
+}
+
+
+
+// Modifiers
+template<int D>
+void ggf<D>::recompose_crop ()
+{
+  // Free storage that will not be needed
+  storage.resize(tmax-tmin+1);
+  for (int tl=tmin; tl<=tmax; ++tl) {
+    for (int rl=h.reflevels(); rl<(int)storage.at(tl-tmin).size(); ++rl) {
+      for (int c=0; c<(int)storage.at(tl-tmin).at(rl).size(); ++c) {
+        for (int ml=0; ml<(int)storage.at(tl-tmin).at(rl).at(c).size(); ++ml) {
+          delete storage.at(tl-tmin).at(rl).at(c).at(ml);
+        } // for ml
+      } // for c
+    } // for rl
+    storage.at(tl-tmin).resize(h.reflevels());
+  } // for tl
+}
+
+template<int D>
+void ggf<D>::recompose_allocate (const int rl)
+{
+  // TODO: restructure storage only when needed
+  
+  // Retain storage that might be needed
+  oldstorage.resize(tmax-tmin+1);
+  for (int tl=tmin; tl<=tmax; ++tl) {
+    oldstorage.at(tl-tmin).resize(h.reflevels());
+    assert (oldstorage.at(tl-tmin).at(rl).size() == 0);
+    oldstorage.at(tl-tmin).at(rl) = storage.at(tl-tmin).at(rl);
+    storage.at(tl-tmin).at(rl).resize(0);
+  }
+  
+  // Resize structure and allocate storage
+  storage.resize(tmax-tmin+1);
+  for (int tl=tmin; tl<=tmax; ++tl) {
+    storage.at(tl-tmin).resize(h.reflevels());
+    storage.at(tl-tmin).at(rl).resize(h.components(rl));
+    for (int c=0; c<h.components(rl); ++c) {
+      storage.at(tl-tmin).at(rl).at(c).resize(h.mglevels(rl,c));
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+        storage.at(tl-tmin).at(rl).at(c).at(ml) = typed_data(tl,rl,c,ml);
+        storage.at(tl-tmin).at(rl).at(c).at(ml)->allocate
+          (d.boxes.at(rl).at(c).at(ml).exterior, h.proc(rl,c));
+      } // for ml
+    } // for c
+  } // for tl
+}
+
+template<int D>
+void ggf<D>::recompose_fill (comm_state<D>& state, const int rl,
+                             const bool do_prolongate)
+{
+  // Initialise the new storage
+  for (int c=0; c<h.components(rl); ++c) {
+    for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+      for (int tl=tmin; tl<=tmax; ++tl) {
+        
+        // Find out which regions need to be prolongated
+        // (Copy the exterior because some variables are not prolongated)
+        // TODO: do this once in the dh instead of for each variable here
+        ibset work (d.boxes.at(rl).at(c).at(ml).exterior);
+        
+        // Copy from old storage, if possible
+        // TODO: copy only from interior regions?
+        if (rl<(int)oldstorage.at(tl-tmin).size()) {
+          for (int cc=0; cc<(int)oldstorage.at(tl-tmin).at(rl).size(); ++cc) {
+            if (ml<(int)oldstorage.at(tl-tmin).at(rl).at(cc).size()) {
+              // TODO: prefer same processor, etc., see dh.cc
+              ibset ovlp
+                = work & oldstorage.at(tl-tmin).at(rl).at(cc).at(ml)->extent();
+              ovlp.normalize();
+              work -= ovlp;
+              for (typename ibset::const_iterator r=ovlp.begin(); r!=ovlp.end(); ++r) {
+                storage.at(tl-tmin).at(rl).at(c).at(ml)->copy_from
+                  (state, oldstorage.at(tl-tmin).at(rl).at(cc).at(ml), *r);
+              }
+            } // if ml
+          } // for cc
+        } // if rl
+        
+        if (do_prolongate) {
+          // Initialise from coarser level, if possible
+          if (rl>0) {
+            if (transport_operator != op_none) {
+              const int numtl = prolongation_order_time+1;
+              assert (tmax-tmin+1 >= numtl);
+              vector<int> tls(numtl);
+              vector<CCTK_REAL> times(numtl);
+              for (int i=0; i<numtl; ++i) {
+                tls.at(i) = tmax - i;
+                times.at(i) = t.time(tls.at(i),rl-1,ml);
+              }
+              for (int cc=0; cc<(int)storage.at(tl-tmin).at(rl-1).size(); ++cc) {
+                vector<const gdata<D>*> gsrcs(numtl);
+                for (int i=0; i<numtl; ++i) {
+                  gsrcs.at(i)
+                    = storage.at(tls.at(i)-tmin).at(rl-1).at(cc).at(ml);
+                  assert (gsrcs.at(i)->extent() == gsrcs.at(0)->extent());
+                }
+                const CCTK_REAL time = t.time(tl,rl,ml);
+                
+                // TODO: choose larger regions first
+                // TODO: prefer regions from the same processor
+                const iblist& list
+                  = d.boxes.at(rl).at(c).at(ml).recv_ref_coarse.at(cc);
+                for (typename iblist::const_iterator iter=list.begin(); iter!=list.end(); ++iter) {
+                  ibset ovlp = work & *iter;
+                  ovlp.normalize();
+                  work -= ovlp;
+                  for (typename ibset::const_iterator r=ovlp.begin(); r!=ovlp.end(); ++r) {
+                    storage.at(tl-tmin).at(rl).at(c).at(ml)->interpolate_from
+                      (state, gsrcs, times, *r, time,
+                       d.prolongation_order_space, prolongation_order_time);
+                  } // for r
+                } // for iter
+              } // for cc
+            } // if transport_operator
+          } // if rl
+        } // if do_prolongate
+        
+        // Note that work need not be empty here; in this case, not
+        // everything could be initialised.  This is okay on outer
+        // boundaries.
+        // TODO: check this.
+        
+      } // for tl
+    } // for ml
+  } // for c
+}
+
+template<int D>
+void ggf<D>::recompose_free (const int rl)
+{
+  // Delete old storage
+  for (int tl=tmin; tl<=tmax; ++tl) {
+    for (int c=0; c<(int)oldstorage.at(tl-tmin).at(rl).size(); ++c) {
+      for (int ml=0; ml<(int)oldstorage.at(tl-tmin).at(rl).at(c).size(); ++ml) {
+        delete oldstorage.at(tl-tmin).at(rl).at(c).at(ml);
+      } // for ml
+    } // for c
+    oldstorage.at(tl-tmin).at(rl).resize(0);
+  } // for tl
+}
+
+template<int D>
+void ggf<D>::recompose_bnd_prolongate (comm_state<D>& state, const int rl,
+                                       const bool do_prolongate)
+{
+  if (do_prolongate) {
+    // Set boundaries
+    if (rl>0) {
+      for (int c=0; c<h.components(rl); ++c) {
+        for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+          for (int tl=tmin; tl<=tmax; ++tl) {
+            
+            // TODO: assert that reflevel 0 boundaries are copied
+            const CCTK_REAL time = t.time(tl,rl,ml);
+            ref_bnd_prolongate (state,tl,rl,c,ml,time);
+            
+          } // for tl
+        } // for ml
+      } // for c
+    } // if rl
+  } // if do_prolongate
+}
+
+template<int D>
+void ggf<D>::recompose_sync (comm_state<D>& state, const int rl,
+                             const bool do_prolongate)
+{
+  if (do_prolongate) {
+    // Set boundaries
+    for (int c=0; c<h.components(rl); ++c) {
+      for (int ml=0; ml<h.mglevels(rl,c); ++ml) {
+        for (int tl=tmin; tl<=tmax; ++tl) {
+          
+          sync (state,tl,rl,c,ml);
+          
+        } // for tl
+      } // for ml
+    } // for c
+  } // if do_prolongate
+}
+
+
+
+// Cycle the time levels by rotating the data sets
+template<int D>
+void ggf<D>::cycle (int rl, int c, int ml) {
+  assert (rl>=0 && rl<h.reflevels());
+  assert (c>=0 && c<h.components(rl));
+  assert (ml>=0 && ml<h.mglevels(rl,c));
+  gdata<D>* tmpdata = storage.at(tmin-tmin).at(rl).at(c).at(ml);
+  for (int tl=tmin; tl<=tmax-1; ++tl) {
+    storage.at(tl-tmin).at(rl).at(c).at(ml) = storage.at(tl+1-tmin).at(rl).at(c).at(ml);
+  }
+  storage.at(tmax-tmin).at(rl).at(c).at(ml) = tmpdata;
+}
+
+// Flip the time levels by exchanging the data sets
+template<int D>
+void ggf<D>::flip (int rl, int c, int ml) {
+  assert (rl>=0 && rl<h.reflevels());
+  assert (c>=0 && c<h.components(rl));
+  assert (ml>=0 && ml<h.mglevels(rl,c));
+  for (int t=0; t<(tmax-tmin)/2; ++t) {
+    const int tl1 = tmin + t;
+    const int tl2 = tmax - t;
+    assert (tl1 < tl2);
+    gdata<D>* tmpdata = storage.at(tl1-tmin).at(rl).at(c).at(ml);
+    storage.at(tl1-tmin).at(rl).at(c).at(ml) = storage.at(tl2-tmin).at(rl).at(c).at(ml);
+    storage.at(tl2-tmin).at(rl).at(c).at(ml) = tmpdata;
+  }
+}
+
+
+
+// Operations
+
+// Copy a region
+template<int D>
+void ggf<D>::copycat (comm_state<D>& state,
+                      int tl1, int rl1, int c1, int ml1,
+                      const ibbox dh<D>::dboxes::* recv_box,
+                      int tl2, int rl2, int ml2,
+                      const ibbox dh<D>::dboxes::* send_box)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  assert (tl2>=tmin && tl2<=tmax);
+  assert (rl2>=0 && rl2<h.reflevels());
+  const int c2=c1;
+  assert (ml2<h.mglevels(rl2,c2));
+  const ibbox recv = d.boxes.at(rl1).at(c1).at(ml1).*recv_box;
+  const ibbox send = d.boxes.at(rl2).at(c2).at(ml2).*send_box;
+  assert (all(recv.shape()==send.shape()));
+  // copy the content
+  assert (recv==send);
+  storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->copy_from
+    (state, storage.at(tl2-tmin).at(rl2).at(c2).at(ml2), recv);
+}
+
+// Copy regions
+template<int D>
+void ggf<D>::copycat (comm_state<D>& state,
+                      int tl1, int rl1, int c1, int ml1,
+                      const iblist dh<D>::dboxes::* recv_list,
+                      int tl2, int rl2, int ml2,
+                      const iblist dh<D>::dboxes::* send_list)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  assert (tl2>=tmin && tl2<=tmax);
+  assert (rl2>=0 && rl2<h.reflevels());
+  const int c2=c1;
+  assert (ml2<h.mglevels(rl2,c2));
+  const iblist recv = d.boxes.at(rl1).at(c1).at(ml1).*recv_list;
+  const iblist send = d.boxes.at(rl2).at(c2).at(ml2).*send_list;
+  assert (recv.size()==send.size());
+  // walk all boxes
+  for (typename iblist::const_iterator r=recv.begin(), s=send.begin();
+       r!=recv.end(); ++r, ++s) {
+    // (use the send boxes for communication)
+    // copy the content
+    storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->copy_from
+      (state, storage.at(tl2-tmin).at(rl2).at(c2).at(ml2), *r);
+  }
+}
+
+// Copy regions
+template<int D>
+void ggf<D>::copycat (comm_state<D>& state,
+                      int tl1, int rl1, int c1, int ml1,
+                      const iblistvect dh<D>::dboxes::* recv_listvect,
+                      int tl2, int rl2, int ml2,
+                      const iblistvect dh<D>::dboxes::* send_listvect)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  assert (tl2>=tmin && tl2<=tmax);
+  assert (rl2>=0 && rl2<h.reflevels());
+  // walk all components
+  for (int c2=0; c2<h.components(rl2); ++c2) {
+    assert (ml2<h.mglevels(rl2,c2));
+    const iblist recv = (d.boxes.at(rl1).at(c1).at(ml1).*recv_listvect).at(c2);
+    const iblist send = (d.boxes.at(rl2).at(c2).at(ml2).*send_listvect).at(c1);
+    assert (recv.size()==send.size());
+    // walk all boxes
+    for (typename iblist::const_iterator r=recv.begin(), s=send.begin();
+      	 r!=recv.end(); ++r, ++s) {
+      // (use the send boxes for communication)
+      // copy the content
+      storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->copy_from
+      	(state, storage.at(tl2-tmin).at(rl2).at(c2).at(ml2), *r);
+    }
+  }
+}
+
+// Interpolate a region
+template<int D>
+void ggf<D>::intercat (comm_state<D>& state,
+                       int tl1, int rl1, int c1, int ml1,
+                       const ibbox dh<D>::dboxes::* recv_list,
+                       const vector<int> tl2s, int rl2, int ml2,
+                       const ibbox dh<D>::dboxes::* send_list,
+                       CCTK_REAL time)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  for (int i=0; i<(int)tl2s.size(); ++i) {
+    assert (tl2s.at(i)>=tmin && tl2s.at(i)<=tmax);
+  }
+  assert (rl2>=0 && rl2<h.reflevels());
+  const int c2=c1;
+  assert (ml2>=0 && ml2<h.mglevels(rl2,c2));
+  
+  vector<const gdata<D>*> gsrcs(tl2s.size());
+  vector<CCTK_REAL> times(tl2s.size());
+  for (int i=0; i<(int)gsrcs.size(); ++i) {
+    assert (rl2<(int)storage.at(tl2s.at(i)-tmin).size());
+    assert (c2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).size());
+    assert (ml2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).size());
+    gsrcs.at(i) = storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).at(ml2);
+    times.at(i) = t.time(tl2s.at(i),rl2,ml2);
+  }
+  
+  const ibbox recv = d.boxes.at(rl1).at(c1).at(ml1).*recv_list;
+  const ibbox send = d.boxes.at(rl2).at(c2).at(ml2).*send_list;
+  assert (all(recv.shape()==send.shape()));
+  // interpolate the content
+  assert (recv==send);
+  storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->interpolate_from
+    (state, gsrcs, times, recv, time,
+     d.prolongation_order_space, prolongation_order_time);
+}
+
+// Interpolate regions
+template<int D>
+void ggf<D>::intercat (comm_state<D>& state,
+                       int tl1, int rl1, int c1, int ml1,
+                       const iblist dh<D>::dboxes::* recv_list,
+                       const vector<int> tl2s, int rl2, int ml2,
+                       const iblist dh<D>::dboxes::* send_list,
+                       const CCTK_REAL time)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  for (int i=0; i<(int)tl2s.size(); ++i) {
+    assert (tl2s.at(i)>=tmin && tl2s.at(i)<=tmax);
+  }
+  assert (rl2>=0 && rl2<h.reflevels());
+  const int c2=c1;
+  assert (ml2>=0 && ml2<h.mglevels(rl2,c2));
+  
+  vector<const gdata<D>*> gsrcs(tl2s.size());
+  vector<CCTK_REAL> times(tl2s.size());
+  for (int i=0; i<(int)gsrcs.size(); ++i) {
+    assert (rl2<(int)storage.at(tl2s.at(i)-tmin).size());
+    assert (c2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).size());
+    assert (ml2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).size());
+    gsrcs.at(i) = storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).at(ml2);
+    times.at(i) = t.time(tl2s.at(i),rl2,ml2);
+  }
+  
+  const iblist recv = d.boxes.at(rl1).at(c1).at(ml1).*recv_list;
+  const iblist send = d.boxes.at(rl2).at(c2).at(ml2).*send_list;
+  assert (recv.size()==send.size());
+  // walk all boxes
+  for (typename iblist::const_iterator r=recv.begin(), s=send.begin();
+       r!=recv.end(); ++r, ++s) {
+    // (use the send boxes for communication)
+    // interpolate the content
+    storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->interpolate_from
+      (state, gsrcs, times, *r, time,
+       d.prolongation_order_space, prolongation_order_time);
+  }
+}
+
+// Interpolate regions
+template<int D>
+void ggf<D>::intercat (comm_state<D>& state,
+                       int tl1, int rl1, int c1, int ml1,
+                       const iblistvect dh<D>::dboxes::* recv_listvect,
+                       const vector<int> tl2s, int rl2, int ml2,
+                       const iblistvect dh<D>::dboxes::* send_listvect,
+                       const CCTK_REAL time)
+{
+  assert (tl1>=tmin && tl1<=tmax);
+  assert (rl1>=0 && rl1<h.reflevels());
+  assert (c1>=0 && c1<h.components(rl1));
+  assert (ml1>=0 && ml1<h.mglevels(rl1,c1));
+  for (int i=0; i<(int)tl2s.size(); ++i) {
+    assert (tl2s.at(i)>=tmin && tl2s.at(i)<=tmax);
+  }
+  assert (rl2>=0 && rl2<h.reflevels());
+  // walk all components
+  for (int c2=0; c2<h.components(rl2); ++c2) {
+    assert (ml2>=0 && ml2<h.mglevels(rl2,c2));
+    
+    vector<const gdata<D>*> gsrcs(tl2s.size());
+    vector<CCTK_REAL> times(tl2s.size());
+    for (int i=0; i<(int)gsrcs.size(); ++i) {
+      assert (rl2<(int)storage.at(tl2s.at(i)-tmin).size());
+      assert (c2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).size());
+      assert (ml2<(int)storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).size());
+      gsrcs.at(i) = storage.at(tl2s.at(i)-tmin).at(rl2).at(c2).at(ml2);
+      times.at(i) = t.time(tl2s.at(i),rl2,ml2);
+    }
+    
+    const iblist recv = (d.boxes.at(rl1).at(c1).at(ml1).*recv_listvect).at(c2);
+    const iblist send = (d.boxes.at(rl2).at(c2).at(ml2).*send_listvect).at(c1);
+    assert (recv.size()==send.size());
+    // walk all boxes
+    for (typename iblist::const_iterator r=recv.begin(), s=send.begin();
+      	 r!=recv.end(); ++r, ++s) {
+      // (use the send boxes for communication)
+      // interpolate the content
+      storage.at(tl1-tmin).at(rl1).at(c1).at(ml1)->interpolate_from
+      	(state, gsrcs, times, *r, time,
+	 d.prolongation_order_space, prolongation_order_time);
+    }
+  }
+}
+
+
+
+// Copy a component from the next time level
+template<int D>
+void ggf<D>::copy (comm_state<D>& state, int tl, int rl, int c, int ml)
+{
+  // Copy
+  copycat (state,
+           tl  ,rl,c,ml, &dh<D>::dboxes::exterior,
+      	   tl+1,rl,  ml, &dh<D>::dboxes::exterior);
+}
+
+// Synchronise the boundaries a component
+template<int D>
+void ggf<D>::sync (comm_state<D>& state, int tl, int rl, int c, int ml)
+{
+  // Copy
+  copycat (state,
+           tl,rl,c,ml, &dh<D>::dboxes::recv_sync,
+      	   tl,rl,  ml, &dh<D>::dboxes::send_sync);
+}
+
+// Prolongate the boundaries of a component
+template<int D>
+void ggf<D>::ref_bnd_prolongate (comm_state<D>& state, 
+                                 int tl, int rl, int c, int ml,
+                                 CCTK_REAL time)
+{
+  // Interpolate
+  assert (rl>=1);
+  if (transport_operator == op_none) return;
+  vector<int> tl2s;
+  // Interpolation in time
+  assert (tmax-tmin+1 >= prolongation_order_time+1);
+  tl2s.resize(prolongation_order_time+1);
+  for (int i=0; i<=prolongation_order_time; ++i) tl2s.at(i) = tmax - i;
+  intercat (state,
+            tl  ,rl  ,c,ml, &dh<D>::dboxes::recv_ref_bnd_coarse,
+	    tl2s,rl-1,  ml, &dh<D>::dboxes::send_ref_bnd_fine,
+	    time);
+}
+
+// Restrict a multigrid level
+template<int D>
+void ggf<D>::mg_restrict (comm_state<D>& state,
+                          int tl, int rl, int c, int ml,
+                          CCTK_REAL time)
+{
+  // Require same times
+  assert (abs(t.get_time(rl,ml) - t.get_time(rl,ml-1))
+	  <= 1.0e-8 * abs(t.get_time(rl,ml)));
+  const vector<int> tl2s(1,tl);
+  intercat (state,
+            tl  ,rl,c,ml,   &dh<D>::dboxes::recv_mg_coarse,
+	    tl2s,rl,  ml-1, &dh<D>::dboxes::send_mg_fine,
+	    time);
+}
+
+// Prolongate a multigrid level
+template<int D>
+void ggf<D>::mg_prolongate (comm_state<D>& state,
+                            int tl, int rl, int c, int ml,
+                            CCTK_REAL time)
+{
+  // Require same times
+  assert (abs(t.get_time(rl,ml) - t.get_time(rl,ml+1))
+	  <= 1.0e-8 * abs(t.get_time(rl,ml)));
+  const vector<int> tl2s(1,tl);
+  intercat (state,
+            tl  ,rl,c,ml,   &dh<D>::dboxes::recv_mg_coarse,
+	    tl2s,rl,  ml+1, &dh<D>::dboxes::send_mg_fine,
+	    time);
+}
+
+// Restrict a refinement level
+template<int D>
+void ggf<D>::ref_restrict (comm_state<D>& state,
+                           int tl, int rl, int c, int ml,
+                           CCTK_REAL time)
+{
+  // Require same times
+  assert (abs(t.get_time(rl,ml) - t.get_time(rl+1,ml))
+	  <= 1.0e-8 * abs(t.get_time(rl,ml)));
+  if (transport_operator == op_none) return;
+  const vector<int> tl2s(1,tl);
+  intercat (state,
+            tl  ,rl  ,c,ml, &dh<D>::dboxes::recv_ref_fine,
+	    tl2s,rl+1,  ml, &dh<D>::dboxes::send_ref_coarse,
+	    time);
+}
+
+// Prolongate a refinement level
+template<int D>
+void ggf<D>::ref_prolongate (comm_state<D>& state,
+                             int tl, int rl, int c, int ml,
+                             CCTK_REAL time)
+{
+  assert (rl>=1);
+  if (transport_operator == op_none) return;
+  vector<int> tl2s;
+  // Interpolation in time
+  assert (tmax-tmin+1 >= prolongation_order_time+1);
+  tl2s.resize(prolongation_order_time+1);
+  for (int i=0; i<=prolongation_order_time; ++i) tl2s.at(i) = tmax - i;
+  intercat (state,
+            tl  ,rl  ,c,ml, &dh<D>::dboxes::recv_ref_coarse,
+	    tl2s,rl-1,  ml, &dh<D>::dboxes::send_ref_fine,
+	    time);
+}
+
+
+
+template class ggf<3>;
diff --git a/Carpet/CarpetLib/src/ggf.hh b/Carpet/CarpetLib/src/ggf.hh
new file mode 100644
index 000000000..b6a551cf3
--- /dev/null
+++ b/Carpet/CarpetLib/src/ggf.hh
@@ -0,0 +1,225 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/ggf.hh,v 1.25 2004/08/07 19:47:11 schnetter Exp $
+
+#ifndef GGF_HH
+#define GGF_HH
+
+#include <assert.h>
+
+#include <iostream>
+#include <string>
+#include <vector>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "dh.hh"
+#include "gdata.hh"
+#include "gh.hh"
+#include "th.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<int D> class ggf;
+
+// Output
+template<int D>
+ostream& operator<< (ostream& os, const ggf<D>& f);
+
+
+
+// A generic grid function without type information
+template<int D>
+class ggf {
+
+  // Types
+
+  typedef vect<int,D>    ivect;
+  typedef bbox<int,D>    ibbox;
+  typedef bboxset<int,D> ibset;
+  typedef list<ibbox>    iblist;
+  typedef vector<iblist> iblistvect;
+
+  typedef gdata<D>*     tdata;  // data ...
+  typedef vector<tdata> mdata;  // ... for each multigrid level
+  typedef vector<mdata> cdata;  // ... for each component
+  typedef vector<cdata> rdata;  // ... for each refinement level
+  typedef vector<rdata> fdata;  // ... for each time level
+  
+public:				// should be readonly
+  
+  // Fields
+  int varindex;                 // Cactus variable index
+  operator_type transport_operator;
+  
+  th<D> &t;			// time hierarchy
+  int tmin, tmax;		// timelevels
+  int prolongation_order_time;	// order of temporal prolongation operator
+  
+  gh<D> &h;			// grid hierarchy
+  dh<D> &d;			// data hierarchy
+
+protected:
+  fdata storage;		// storage
+  
+public:
+  int vectorlength;             // vector length
+  int vectorindex;              // index of *this
+  ggf* vectorleader;            // first vector element
+  
+private:
+  fdata oldstorage;
+  
+public:
+
+  // Constructors
+  ggf (const int varindex, const operator_type transport_operator,
+       th<D>& t, dh<D>& d,
+       const int tmin, const int tmax,
+       const int prolongation_order_time,
+       const int vectorlength, const int vectorindex,
+       ggf* const vectorleader);
+
+  // Destructors
+  virtual ~ggf ();
+
+  // Comparison
+  bool operator== (const ggf<D>& f) const;
+
+
+
+  // Modifiers
+  // void recompose ();
+  void recompose_crop ();
+  void recompose_allocate (int rl);
+  void recompose_fill (comm_state<D>& state, int rl, bool do_prolongate);
+  void recompose_free (int rl);
+  void recompose_bnd_prolongate (comm_state<D>& state, int rl, bool do_prolongate);
+  void recompose_sync (comm_state<D>& state, int rl, bool do_prolongate);
+
+  // Cycle the time levels by rotating the data sets
+  void cycle (int rl, int c, int ml);
+  
+  // Flip the time levels by exchanging the data sets
+  void flip (int rl, int c, int ml);
+  
+  
+  
+  // Helpers
+  
+protected:
+  
+  virtual gdata<D>* typed_data (int tl, int rl, int c, int ml) = 0;
+  
+  
+  
+  // Operations
+  
+protected:
+  
+  // Copy a region
+  void copycat (comm_state<D>& state,
+                int tl1, int rl1, int c1, int ml1,
+		const ibbox dh<D>::dboxes::* recv_list,
+		int tl2, int rl2, int ml2,
+		const ibbox dh<D>::dboxes::* send_list);
+
+  // Copy regions
+  void copycat (comm_state<D>& state,
+                int tl1, int rl1, int c1, int ml1,
+		const iblist dh<D>::dboxes::* recv_list,
+		int tl2, int rl2, int ml2,
+		const iblist dh<D>::dboxes::* send_list);
+
+  // Copy regions
+  void copycat (comm_state<D>& state,
+                int tl1, int rl1, int c1, int ml1,
+		const iblistvect dh<D>::dboxes::* recv_listvect,
+		int tl2, int rl2, int ml2,
+		const iblistvect dh<D>::dboxes::* send_listvect);
+  
+  // Interpolate a region
+  void intercat (comm_state<D>& state,
+                 int tl1, int rl1, int c1, int ml1,
+		 const ibbox dh<D>::dboxes::* recv_list,
+		 const vector<int> tl2s, int rl2, int ml2,
+		 const ibbox dh<D>::dboxes::* send_list,
+		 CCTK_REAL time);
+
+  // Interpolate regions
+  void intercat (comm_state<D>& state,
+                 int tl1, int rl1, int c1, int ml1,
+		 const iblist dh<D>::dboxes::* recv_list,
+		 const vector<int> tl2s, int rl2, int ml2,
+		 const iblist dh<D>::dboxes::* send_list,
+		 CCTK_REAL time);
+
+  // Interpolate regions
+  void intercat (comm_state<D>& state,
+                 int tl1, int rl1, int c1, int ml1,
+		 const iblistvect dh<D>::dboxes::* recv_listvect,
+		 const vector<int> tl2s, int rl2, int ml2,
+		 const iblistvect dh<D>::dboxes::* send_listvect,
+		 CCTK_REAL time);
+
+
+
+public:
+
+  // The grid boundaries have to be updated after calling mg_restrict,
+  // mg_prolongate, ref_restrict, or ref_prolongate.
+
+  // "Updating" means here that the boundaries have to be
+  // synchronised.  They don't need to be prolongated.
+
+  // Copy a component from the next time level
+  void copy (comm_state<D>& state, int tl, int rl, int c, int ml);
+
+  // Synchronise the boundaries of a component
+  void sync (comm_state<D>& state, int tl, int rl, int c, int ml);
+
+  // Prolongate the boundaries of a component
+  void ref_bnd_prolongate (comm_state<D>& state,
+                           int tl, int rl, int c, int ml, CCTK_REAL time);
+
+  // Restrict a multigrid level
+  void mg_restrict (comm_state<D>& state,
+                    int tl, int rl, int c, int ml, CCTK_REAL time);
+
+  // Prolongate a multigrid level
+  void mg_prolongate (comm_state<D>& state,
+                      int tl, int rl, int c, int ml, CCTK_REAL time);
+
+  // Restrict a refinement level
+  void ref_restrict (comm_state<D>& state,
+                     int tl, int rl, int c, int ml, CCTK_REAL time);
+
+  // Prolongate a refinement level
+  void ref_prolongate (comm_state<D>& state,
+                       int tl, int rl, int c, int ml, CCTK_REAL time);
+  
+  
+  
+  // Access to the data
+  virtual const gdata<D>* operator() (int tl, int rl, int c, int ml) const = 0;
+  
+  virtual gdata<D>* operator() (int tl, int rl, int c, int ml) = 0;
+  
+  
+  
+  // Output
+  virtual ostream& output (ostream& os) const = 0;
+};
+
+
+
+template<int D>
+inline ostream& operator<< (ostream& os, const ggf<D>& f) {
+  return f.output(os);
+}
+
+
+
+#endif // GGF_HH
diff --git a/Carpet/CarpetLib/src/gh.cc b/Carpet/CarpetLib/src/gh.cc
new file mode 100644
index 000000000..32df39bf0
--- /dev/null
+++ b/Carpet/CarpetLib/src/gh.cc
@@ -0,0 +1,240 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gh.cc,v 1.29 2004/08/07 19:47:11 schnetter Exp $
+
+#include <assert.h>
+#include <stdlib.h>
+#include <iostream>
+
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+#include "defs.hh"
+#include "dh.hh"
+#include "th.hh"
+
+#include "gh.hh"
+
+using namespace std;
+
+
+
+  // Constructors
+template<int D>
+gh<D>::gh (const int reffact, const centering refcent,
+	   const int mgfact, const centering mgcent,
+           const ibbox baseextent)
+  : reffact(reffact), refcent(refcent),
+    mgfact(mgfact), mgcent(mgcent),
+    baseextent(baseextent)
+{
+}
+
+// Destructors
+template<int D>
+gh<D>::~gh () { }
+
+// Modifiers
+template<int D>
+void gh<D>::recompose (const rexts& exts,
+                       const rbnds& outer_bounds,
+		       const rprocs& procs,
+                       const bool do_prolongate)
+{
+  DECLARE_CCTK_PARAMETERS;
+  
+  extents = exts;
+  outer_boundaries = outer_bounds;
+  processors = procs;
+  
+  // Consistency checks
+  
+  // nota bene: there might be 0 refinement levels.
+  
+  // Check processor number consistency
+  for (int rl=0; rl<reflevels(); ++rl) {
+    assert (processors.size() == extents.size());
+    assert (outer_boundaries.size() == extents.size());
+    for (int c=0; c<components(rl); ++c) {
+      assert (processors.at(rl).size() == extents.at(rl).size());
+      assert (outer_boundaries.at(rl).size() == extents.at(rl).size());
+    }
+  }
+  
+  // Check multigrid consistency
+  for (int rl=0; rl<reflevels(); ++rl) {
+    for (int c=0; c<components(rl); ++c) {
+      assert (mglevels(rl,c)>0);
+      for (int ml=1; ml<mglevels(rl,c); ++ml) {
+	assert (all(extents.at(rl).at(c).at(ml).stride()
+		    == ivect(mgfact) * extents.at(rl).at(c).at(ml-1).stride()));
+        // TODO: put the check back in, taking outer boundaries into
+        // account
+#if 0
+	assert (extents.at(rl).at(c).at(ml)
+		.contracted_for(extents.at(rl).at(c).at(ml-1))
+		.is_contained_in(extents.at(rl).at(c).at(ml-1)));
+#endif
+      }
+    }
+  }
+  
+  // Check component consistency
+  for (int rl=0; rl<reflevels(); ++rl) {
+    assert (components(rl)>0);
+    for (int c=0; c<components(rl); ++c) {
+      for (int ml=0; ml<mglevels(rl,c); ++ml) {
+	assert (all(extents.at(rl).at(c).at(ml).stride()
+		    == extents.at(rl).at(0).at(ml).stride()));
+	assert (extents.at(rl).at(c).at(ml).is_aligned_with(extents.at(rl).at(0).at(ml)));
+        for (int cc=c+1; cc<components(rl); ++cc) {
+          assert ((extents.at(rl).at(c).at(ml) & extents.at(rl).at(cc).at(ml)).empty());
+        }
+      }
+    }
+  }
+  
+  // Check base grid extent
+  if (reflevels()>0) {
+    for (int c=0; c<components(0); ++c) {
+      // TODO: put the check back in, taking outer boundaries into
+      // account
+#if 0
+      assert (extents.at(0).at(c).at(0).is_contained_in(baseextent));
+#endif
+    }
+  }
+  
+  // Check refinement levels
+  for (int rl=1; rl<reflevels(); ++rl) {
+    assert (all(extents.at(rl-1).at(0).at(0).stride()
+		== ivect(reffact) * extents.at(rl).at(0).at(0).stride()));
+    // Check contained-ness:
+    // first take all coarse grids ...
+    bboxset<int,D> all;
+    for (int c=0; c<components(rl-1); ++c) {
+      all |= extents.at(rl-1).at(c).at(0);
+    }
+    // ... remember their size ...
+    const int sz = all.size();
+    // ... then add the coarsified fine grids ...
+    for (int c=0; c<components(rl); ++c) {
+      all |= extents.at(rl).at(c).at(0).contracted_for(extents.at(rl-1).at(0).at(0));
+    }
+    // ... and then check the sizes:
+    assert (all.size() == sz);
+  }
+  
+  // Calculate base extents of all levels
+  bases.resize(reflevels());
+  for (int rl=0; rl<reflevels(); ++rl) {
+    if (components(rl)==0) {
+      bases.at(rl).resize(0);
+    } else {
+      bases.at(rl).resize(mglevels(rl,0));
+      for (int ml=0; ml<mglevels(rl,0); ++ml) {
+	bases.at(rl).at(ml) = ibbox();
+	for (int c=0; c<components(rl); ++c) {
+	  bases.at(rl).at(ml)
+	    = bases.at(rl).at(ml).expanded_containing(extents.at(rl).at(c).at(ml));
+	}
+      }
+    }
+  }
+  
+  if (output_bboxes) {
+    for (int rl=0; rl<reflevels(); ++rl) {
+      for (int c=0; c<components(rl); ++c) {
+	for (int ml=0; ml<mglevels(rl,c); ++ml) {
+	  cout << endl;
+          cout << "gh bboxes:" << endl;
+	  cout << "rl=" << rl << " c=" << c << " ml=" << ml << endl;
+          cout << "extent=" << extents.at(rl).at(c).at(ml) << endl;
+          cout << "outer_boundary=" << outer_boundaries.at(rl).at(c) << endl;
+          cout << "processor=" << processors.at(rl).at(c) << endl;
+        }
+      }
+    }
+    for (int rl=0; rl<reflevels(); ++rl) {
+      if (components(rl)>0) {
+	for (int ml=0; ml<mglevels(rl,0); ++ml) {
+	  cout << endl;
+          cout << "gh bases:" << endl;
+	  cout << "rl=" << rl << " ml=" << ml << endl;
+          cout << "base=" << bases.at(rl).at(ml) << endl;
+        }
+      }
+    }
+  }
+  
+  // Recompose the other hierarchies
+  
+  for (typename list<th<D>*>::iterator t=ths.begin(); t!=ths.end(); ++t) {
+    (*t)->recompose();
+  }
+  
+  for (typename list<dh<D>*>::iterator d=dhs.begin(); d!=dhs.end(); ++d) {
+    (*d)->recompose (do_prolongate);
+  }
+}
+
+
+
+// Accessors
+template<int D>
+int gh<D>::local_components (const int rl) const {
+  int lc = 0;
+  for (int c=0; c<components(rl); ++c) {
+    if (is_local(rl,c)) ++lc;
+  }
+  return lc;
+}
+
+
+
+// Time hierarchy management
+template<int D>
+void gh<D>::add (th<D>* t) {
+  ths.push_back(t);
+}
+
+template<int D>
+void gh<D>::remove (th<D>* t) {
+  ths.remove(t);
+}
+
+
+
+// Data hierarchy management
+template<int D>
+void gh<D>::add (dh<D>* d) {
+  dhs.push_back(d);
+}
+
+template<int D>
+void gh<D>::remove (dh<D>* d) {
+  dhs.remove(d);
+}
+
+
+
+template<int D>
+ostream& gh<D>::output (ostream& os) const {
+  os << "gh<" << D << ">:"
+     << "reffactor=" << reffact << ",refcentering=" << refcent << ","
+     << "mgfactor=" << mgfact << ",mgcentering=" << mgcent << ","
+     << "extents=" << extents << ","
+     << "outer_boundaries=" << outer_boundaries << ","
+     << "processors=" << processors << ","
+     << "dhs={";
+  int cnt=0;
+  for (typename list<dh<D>*>::const_iterator d = dhs.begin();
+       d != dhs.end(); ++d) {
+    if (cnt++) os << ",";
+    (*d)->output(os);
+  }
+  os << "}";
+  return os;
+}
+
+
+
+template class gh<3>;
diff --git a/Carpet/CarpetLib/src/gh.hh b/Carpet/CarpetLib/src/gh.hh
new file mode 100644
index 000000000..edf149000
--- /dev/null
+++ b/Carpet/CarpetLib/src/gh.hh
@@ -0,0 +1,142 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/gh.hh,v 1.18 2004/08/07 19:47:11 schnetter Exp $
+
+#ifndef GH_HH
+#define GH_HH
+
+#include <assert.h>
+
+#include <iostream>
+#include <list>
+#include <vector>
+
+#include "bbox.hh"
+#include "defs.hh"
+#include "dist.hh"
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<int D> class dh;
+template<int D> class th;
+template<int D> class gh;
+
+// Output
+template<int D>
+ostream& operator<< (ostream& os, const gh<D>& h);
+
+
+
+// A refinement hierarchy, where higher levels are finer than the base
+// level.  The extents do not include ghost zones.
+template<int D>
+class gh {
+  
+public:
+  
+  // Types
+  typedef vect<int,D> ivect;
+  typedef bbox<int,D> ibbox;
+  
+  typedef vect<vect<bool,2>,D> bvect;
+  
+  typedef vector<ibbox> mexts;	// ... for each multigrid level
+  typedef vector<mexts> cexts;	// ... for each component
+  typedef vector<cexts> rexts;	// ... for each refinement level
+  
+  typedef vector<bvect> cbnds;	// ... for each component
+  typedef vector<cbnds> rbnds;	// ... for each refinement level
+  
+  typedef vector<int>    cprocs; // ... for each component
+  typedef vector<cprocs> rprocs; // ... for each refinement level
+  
+public:				// should be readonly
+  
+  // Fields
+  int reffact;			// refinement factor
+  centering refcent;		// vertex or cell centered
+  
+  int mgfact;			// default multigrid factor
+  centering mgcent;		// default (vertex or cell centered)
+  
+  list<th<D>*> ths;		// list of all time hierarchies
+  
+  ibbox baseextent;
+  vector<vector<ibbox> > bases; // [rl][ml]
+  
+  // TODO: invent structure for this
+  rexts extents;		// extents of all grids
+  rbnds outer_boundaries;	// boundary descriptions of all grids
+  rprocs processors;		// processor numbers of all grids
+  
+  list<dh<D>*> dhs;		// list of all data hierarchies
+  
+public:
+  
+  // Constructors
+  gh (const int reffact, const centering refcent,
+      const int mgfact, const centering mgcent,
+      const ibbox baseextent);
+  
+  // Destructors
+  virtual ~gh ();
+  
+  // Modifiers
+  void recompose (const rexts& exts, const rbnds& outer_bounds,
+		  const rprocs& procs,
+                  const bool do_prolongate);
+  
+  // Accessors
+  int reflevels () const {
+    return (int)extents.size();
+  }
+  
+  int components (const int rl) const {
+    return (int)extents.at(rl).size();
+  }
+  
+  int mglevels (const int rl, const int c) const {
+    return (int)extents.at(rl).at(c).size();
+  }
+  
+  bvect outer_boundary (const int rl, const int c) const {
+    return outer_boundaries.at(rl).at(c);
+  }
+  
+  int proc (const int rl, const int c) const {
+    return processors.at(rl).at(c);
+  }
+
+  bool is_local (const int rl, const int c) const {
+    int rank;
+    MPI_Comm_rank (dist::comm, &rank);
+    return proc(rl,c) == rank;
+  }
+  
+  int local_components (const int rl) const;
+  
+  // Time hierarchy management
+  void add (th<D>* t);
+  void remove (th<D>* t);
+  
+  // Data hierarchy management
+  void add (dh<D>* d);
+  void remove (dh<D>* d);
+  
+  // Output
+  virtual ostream& output (ostream& os) const;
+};
+
+
+
+template<int D>
+inline ostream& operator<< (ostream& os, const gh<D>& h) {
+  h.output(os);
+  return os;
+}
+
+
+
+#endif // GH_HH
diff --git a/Carpet/CarpetLib/src/instantiate b/Carpet/CarpetLib/src/instantiate
new file mode 100644
index 000000000..1f4e2d6d7
--- /dev/null
+++ b/Carpet/CarpetLib/src/instantiate
@@ -0,0 +1,178 @@
+// Instantiate templates for all available types    -*-C++-*-
+// (C) 2001 Erik Schnetter <schnetter@uni-tuebingen.de>
+
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/instantiate,v 1.10 2004/03/01 21:35:13 schnetter Exp $
+
+// Usage:
+// Define the macro INSTANTIATE(T) to instantiate for the type T,
+// then include this file,
+// then undefine the macro INSTANTIATE.
+
+
+
+// Decide which types to instantiate
+
+#ifdef CARPET_ALL
+#  undef CARPET_BYTE
+#  undef CARPET_INT
+#  undef CARPET_REAL
+#  undef CARPET_COMPLEX
+#  define CARPET_BYTE
+#  define CARPET_INT
+#  define CARPET_REAL
+#  define CARPET_COMPLEX
+#endif
+
+#ifdef CARPET_ALL_INT
+#  undef CARPET_INT1
+#  undef CARPET_INT2
+#  undef CARPET_INT4
+#  undef CARPET_INT8
+#  define CARPET_INT1
+#  define CARPET_INT2
+#  define CARPET_INT4
+#  define CARPET_INT8
+#endif
+
+#ifdef CARPET_ALL_REAL
+#  undef CARPET_REAL4
+#  undef CARPET_REAL8
+#  undef CARPET_REAL16
+#  define CARPET_REAL4
+#  define CARPET_REAL8
+#  define CARPET_REAL16
+#endif
+
+#ifdef CARPET_ALL_COMPLEX
+#  undef CARPET_COMPLEX8
+#  undef CARPET_COMPLEX16
+#  undef CARPET_COMPLEX32
+#  define CARPET_COMPLEX8
+#  define CARPET_COMPLEX16
+#  define CARPET_COMPLEX32
+#endif
+
+#if !defined(CARPET_BYTE) && !defined(CARPET_INT) && !defined(CARPET_INT1) && !defined(CARPET_INT2) && !defined(CARPET_INT4) && !defined(CARPET_INT8) && !defined(CARPET_REAL) && !defined(CARPET_REAL4) && !defined(CARPET_REAL8) && !defined(CARPET_REAL16) && !defined(CARPET_COMPLEX) && !defined(CARPET_COMPLEX8) && !defined(CARPET_COMPLEX16) && !defined(CARPET_COMPLEX32)
+// Assume the user just wants INT, REAL, and COMPLEX
+#  undef CARPET_INT
+#  define CARPET_INT
+#  undef CARPET_REAL
+#  define CARPET_REAL
+#  undef CARPET_COMPLEX
+#  define CARPET_COMPLEX
+#endif
+
+#ifdef CARPET_INT
+#  ifdef CCTK_INTEGER_PRECISION_1
+#    undef CARPET_INT1
+#    define CARPET_INT1
+#  endif
+#  ifdef CCTK_INTEGER_PRECISION_2
+#    undef CARPET_INT2
+#    define CARPET_INT2
+#  endif
+#  ifdef CCTK_INTEGER_PRECISION_4
+#    undef CARPET_INT4
+#    define CARPET_INT4
+#  endif
+#  ifdef CCTK_INTEGER_PRECISION_8
+#    undef CARPET_INT8
+#    define CARPET_INT8
+#  endif
+#endif
+#ifdef CARPET_REAL
+#  ifdef CCTK_REAL_PRECISION_4
+#    undef CARPET_REAL4
+#    define CARPET_REAL4
+#  endif
+#  ifdef CCTK_REAL_PRECISION_8
+#    undef CARPET_REAL8
+#    define CARPET_REAL8
+#  endif
+#  ifdef CCTK_REAL_PRECISION_16
+#    undef CARPET_REAL16
+#    define CARPET_REAL16
+#  endif
+#endif
+#ifdef CARPET_COMPLEX
+#  ifdef CCTK_REAL_PRECISION_4
+#    undef CARPET_COMPLEX8
+#    define CARPET_COMPLEX8
+#  endif
+#  ifdef CCTK_REAL_PRECISION_8
+#    undef CARPET_COMPLEX16
+#    define CARPET_COMPLEX16
+#  endif
+#  ifdef CCTK_REAL_PRECISION_16
+#    undef CARPET_COMPLEX32
+#    define CARPET_COMPLEX32
+#  endif
+#endif
+
+
+
+// // Check
+// #if !defined(CARPET_BYTE) && !defined(CARPET_INT1) && !defined(CARPET_INT2) && !defined(CARPET_INT4) && !defined(CARPET_INT8) && !defined(CARPET_REAL4) && !defined(CARPET_REAL8) && !defined(CARPET_REAL16) && !defined(CARPET_COMPLEX8) && !defined(CARPET_COMPLEX16) && !defined(CARPET_COMPLEX32)
+// #  error "You have not defined which grid function types to instantiate."
+// #endif
+
+
+
+// Instantiate the desired types
+
+#ifdef CARPET_BYTE
+INSTANTIATE(CCTK_BYTE)
+#endif
+
+#ifdef CARPET_INT1
+#  ifdef CCTK_INT1
+INSTANTIATE(CCTK_INT1)
+#  endif
+#endif
+#ifdef CARPET_INT2
+#  ifdef CCTK_INT2
+INSTANTIATE(CCTK_INT2)
+#  endif
+#endif
+#ifdef CARPET_INT4
+#  ifdef CCTK_INT4
+INSTANTIATE(CCTK_INT4)
+#  endif
+#endif
+#ifdef CARPET_INT8
+#  ifdef CCTK_INT8
+INSTANTIATE(CCTK_INT8)
+#  endif
+#endif
+
+#ifdef CARPET_REAL4
+#  ifdef CCTK_REAL4
+INSTANTIATE(CCTK_REAL4)
+#  endif
+#endif
+#ifdef CARPET_REAL8
+#  ifdef CCTK_REAL8
+INSTANTIATE(CCTK_REAL8)
+#  endif
+#endif
+#ifdef CARPET_REAL16
+#  ifdef CCTK_REAL16
+INSTANTIATE(CCTK_REAL16)
+#  endif
+#endif
+
+#ifdef CARPET_COMPLEX8
+#  ifdef CCTK_REAL4
+INSTANTIATE(CCTK_COMPLEX8)
+#  endif
+#endif
+#ifdef CARPET_COMPLEX16
+#  ifdef CCTK_REAL8
+INSTANTIATE(CCTK_COMPLEX16)
+#  endif
+#endif
+#ifdef CARPET_COMPLEX32
+#  ifdef CCTK_REAL16
+INSTANTIATE(CCTK_COMPLEX32)
+#  endif
+#endif
diff --git a/Carpet/CarpetLib/src/make.code.defn b/Carpet/CarpetLib/src/make.code.defn
new file mode 100644
index 000000000..4bfcaec4f
--- /dev/null
+++ b/Carpet/CarpetLib/src/make.code.defn
@@ -0,0 +1,47 @@
+# Main make.code.defn file for thorn CarpetLib   -*-Makefile-*-
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/make.code.defn,v 1.13 2004/03/03 15:30:40 hawke Exp $
+
+# Source files in this directory
+SRCS =	bbox.cc					\
+	bboxset.cc				\
+	data.cc					\
+	defs.cc					\
+	dh.cc					\
+	dist.cc					\
+	gdata.cc				\
+	gf.cc					\
+	ggf.cc					\
+	gh.cc					\
+	th.cc					\
+	vect.cc					\
+	checkindex.F77				\
+	copy_3d_complex16.F77			\
+	copy_3d_int4.F77			\
+	copy_3d_real8.F77			\
+	prolongate_3d_real8.F77			\
+	prolongate_3d_real8_rf2.F77		\
+	prolongate_3d_real8_o3.F77		\
+	prolongate_3d_real8_o3_rf2.F77		\
+	prolongate_3d_real8_o5.F77		\
+	prolongate_3d_real8_2tl.F77		\
+	prolongate_3d_real8_2tl_rf2.F77		\
+	prolongate_3d_real8_2tl_o3.F77		\
+	prolongate_3d_real8_2tl_o3_rf2.F77	\
+	prolongate_3d_real8_2tl_o5.F77		\
+	prolongate_3d_real8_3tl.F77		\
+	prolongate_3d_real8_3tl_rf2.F77		\
+	prolongate_3d_real8_3tl_o3.F77		\
+	prolongate_3d_real8_3tl_o3_rf2.F77	\
+	prolongate_3d_real8_3tl_o5.F77		\
+	prolongate_3d_real8_minmod.F77		\
+	prolongate_3d_real8_2tl_minmod.F77	\
+	prolongate_3d_real8_3tl_minmod.F77	\
+	prolongate_3d_real8_eno.F90		\
+	prolongate_3d_real8_2tl_eno.F90		\
+	prolongate_3d_real8_3tl_eno.F90		\
+	restrict_3d_real8.F77			\
+	restrict_3d_real8_rf2.F77
+
+# Subdirectories containing source files
+SUBDIRS = 
+
diff --git a/Carpet/CarpetLib/src/make.configuration.defn b/Carpet/CarpetLib/src/make.configuration.defn
new file mode 100644
index 000000000..a70db23a6
--- /dev/null
+++ b/Carpet/CarpetLib/src/make.configuration.defn
@@ -0,0 +1,7 @@
+# Main make.configuration.defn file for thorn CarpetLib   -*-Makefile-*-
+# $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/make.configuration.defn,v 1.5 2004/04/29 22:15:06 tradke Exp $
+
+# Ensure that MPI is available
+ifeq ($(strip $(HAVE_MPI)), )
+    $(error Configuration error: The Carpet thorns require MPI.  Please configure with MPI, or remove the Carpet thorns from the ThornList.)
+endif
diff --git a/Carpet/CarpetLib/src/operators.hh b/Carpet/CarpetLib/src/operators.hh
new file mode 100644
index 000000000..b65ff23cb
--- /dev/null
+++ b/Carpet/CarpetLib/src/operators.hh
@@ -0,0 +1,8 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/operators.hh,v 1.2 2004/03/03 15:30:40 hawke Exp $
+
+#ifndef OPERATORS_HH
+#define OPERATORS_HH
+
+enum operator_type { op_error, op_none, op_Lagrange, op_TVD, op_ENO };
+
+#endif // OPERATORS_HH
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8.F77
new file mode 100644
index 000000000..8eae50332
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8.F77
@@ -0,0 +1,193 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8.F77,v 1.11 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(2), jfac(2), kfac(2)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (dstifac * dstjfac * dstkfac)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk-dstkfac) * (-1)
+         kfac(2) = (fk        ) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj-dstjfac) * (-1)
+            jfac(2) = (fj        ) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi-dstifac) * (-1)
+               ifac(2) = (fi        ) * 1
+               
+               res = 0
+               
+               do kk=1,2
+                  do jj=1,2
+                     do ii=1,2
+                        
+                        fac = ifac(ii) * jfac(jj) * kfac(kk)
+                        
+                        if (fac.ne.0) then
+                           CHKIDX (i0+ii, j0+jj, k0+kk, \
+                                   srciext,srcjext,srckext, "source")
+                           res = res + fac * src(i0+ii, j0+jj, k0+kk)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+c$$$               fac = ifac(1) * jfac(1) * kfac(1)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+1, j0+1, k0+1)
+c$$$               
+c$$$               fac = ifac(2) * jfac(1) * kfac(1)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+2, j0+1, k0+1)
+c$$$               
+c$$$               fac = ifac(1) * jfac(2) * kfac(1)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+1, j0+2, k0+1)
+c$$$               
+c$$$               fac = ifac(2) * jfac(2) * kfac(1)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+2, j0+2, k0+1)
+c$$$               
+c$$$               fac = ifac(1) * jfac(1) * kfac(2)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+1, j0+1, k0+2)
+c$$$               
+c$$$               fac = ifac(2) * jfac(1) * kfac(2)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+2, j0+1, k0+2)
+c$$$               
+c$$$               fac = ifac(1) * jfac(2) * kfac(2)
+c$$$               if (fac.ne.0) res = res + fac * src(i0+1, j0+2, k0+2)
+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")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77
new file mode 100644
index 000000000..8fd69178f
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77
@@ -0,0 +1,193 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl.F77,v 1.12 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_2tl (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(2), jfac(2), kfac(2)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Linear (first order) interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (dstifac * dstjfac * dstkfac)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk-dstkfac) * (-1)
+         kfac(2) = (fk        ) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj-dstjfac) * (-1)
+            jfac(2) = (fj        ) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi-dstifac) * (-1)
+               ifac(2) = (fi        ) * 1
+               
+               res = 0
+               
+               do kk=1,2
+                  do jj=1,2
+                     do ii=1,2
+                        
+                        fac = ifac(ii) * jfac(jj) * kfac(kk)
+                        
+                        if (fac.ne.0) then
+                           CHKIDX (i0+ii, j0+jj, k0+kk, \
+                                   srciext,srcjext,srckext, "source")
+                           res = res
+     $                          + fac * s1fac * src1(i0+ii, j0+jj, k0+kk)
+     $                          + fac * s2fac * src2(i0+ii, j0+jj, k0+kk)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_eno.F90 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_eno.F90
new file mode 100644
index 000000000..03a151cdd
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_eno.F90
@@ -0,0 +1,302 @@
+!!$     -*-Fortran-*-
+!!$     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_eno.F90,v 1.1 2004/03/03 15:30:40 hawke Exp $
+
+#include "cctk.h"
+
+
+!!$ This routine performs "ENO" prolongation. It is intended to be used 
+!!$ with GFs that are not expected to be smooth, particularly those
+!!$ that must also obey certain constraints. The obvious example is the 
+!!$ density in hydrodynamics, which may be discontinuous yet must be
+!!$ strictly positive.
+!!$
+!!$ To ensure that this prolongation method is used you should add the
+!!$ tag
+!!$
+!!$      tags='Prolongation="ENO"'
+!!$
+!!$ to the interface.ccl on the appropriate group.
+!!$
+!!$ This applies ENO2 type limiting to the slope, checking over the
+!!$ entire coarse grid cell for the least oscillatory quadratic in each 
+!!$ direction. If the slope changes sign over the extrema, linear
+!!$ interpolation is used instead.
+!!$
+!!$ The actual eno1d function is defined in the routine
+!!$
+!!$      prolongate_3d_real8_eno.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(1:len_trim(msg)))                           &&\
+end if
+
+subroutine prolongate_3d_real8_2tl_eno (src1, t1, src2, t2, &
+     srciext, srcjext, srckext, dst, t, dstiext, dstjext, dstkext, &
+     srcbbox, dstbbox, regbbox)
+
+  implicit none
+
+  CCTK_REAL8 one
+  parameter (one = 1)
+
+  CCTK_REAL8 eps
+  parameter (eps = 1.0d-10)
+            
+  integer srciext, srcjext, srckext
+  CCTK_REAL8 src1(srciext,srcjext,srckext)
+  CCTK_REAL8 t1
+  CCTK_REAL8 src2(srciext,srcjext,srckext)
+  CCTK_REAL8 t2
+  integer dstiext, dstjext, dstkext
+  CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+  CCTK_REAL8 t
+
+!!$     bbox(:,1) is lower boundary (inclusive)
+!!$     bbox(:,2) is upper boundary (inclusive)
+!!$     bbox(:,3) is stride
+  integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+
+  integer offsetlo, offsethi
+
+  integer regiext, regjext, regkext
+
+  integer dstifac, dstjfac, dstkfac
+
+  integer srcioff, srcjoff, srckoff
+  integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac
+
+  integer i, j, k
+  integer i0, j0, k0
+  integer fi, fj, fk
+  integer ifac(4), jfac(4), kfac(4)
+  integer ii, jj, kk
+  integer fac
+  CCTK_REAL8 res
+  integer d
+
+  character msg*1000
+
+  CCTK_REAL8, dimension(0:3,0:3) :: tmp1
+  CCTK_REAL8, dimension(0:3) :: tmp2
+  CCTK_REAL8 :: dsttmp1, dsttmp2
+
+  external eno1d
+  CCTK_REAL8 eno1d
+
+  CCTK_REAL8 half, zero
+  parameter (half = 0.5)
+  parameter (zero = 0)
+
+  do d=1,3
+    if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0 &
+         .or. regbbox(d,3).eq.0) then
+      call CCTK_WARN (0, "Internal error: stride is zero")
+    end if
+    if (srcbbox(d,3).le.regbbox(d,3) &
+         .or. dstbbox(d,3).ne.regbbox(d,3)) then
+      call CCTK_WARN (0, "Internal error: strides disagree")
+    end if
+    if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+      call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+!!$     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
+    regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+    dstkfac = srcbbox(d,3) / dstbbox(d,3)
+    srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+    offsetlo = regbbox(d,3)
+    if (mod(srckoff + 0, dstkfac).eq.0) then
+      offsetlo = 0
+      if (regkext.gt.1) then
+        offsetlo = regbbox(d,3)
+      end if
+    end if
+    offsethi = regbbox(d,3)
+    if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+      offsethi = 0
+      if (regkext.gt.1) then
+        offsethi = regbbox(d,3)
+      end if
+    end if
+    if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1) &
+         .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2) &
+         .or. regbbox(d,1).lt.dstbbox(d,1) &
+         .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 &
+       .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1 &
+       .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1 &
+       .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1 &
+       .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1 &
+       .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+    call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+  end if
+
+  regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+  regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+  regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+
+  dstifac = srcbbox(1,3) / dstbbox(1,3)
+  dstjfac = srcbbox(2,3) / dstbbox(2,3)
+  dstkfac = srcbbox(3,3) / dstbbox(3,3)
+
+  srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+  srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+  srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+
+  dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+  dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+  dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+!!$  Linear (first order) interpolation
+  if (t1.eq.t2) then
+    call CCTK_WARN (0, "Internal error: arrays have same time")
+  end if
+  if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+    call CCTK_WARN (0, "Internal error: extrapolation in time")
+  end if
+  
+  s1fac = (t - t2) / (t1 - t2)
+  s2fac = (t - t1) / (t2 - t1)
+
+!!$     Loop over fine region
+
+  do k = 0, regkext-1
+    k0 = (srckoff + k) / dstkfac
+    fk = mod(srckoff + k, dstkfac)
+
+    do j = 0, regjext-1
+      j0 = (srcjoff + j) / dstjfac
+      fj = mod(srcjoff + j, dstjfac)
+
+      do i = 0, regiext-1
+        i0 = (srcioff + i) / dstifac
+        fi = mod(srcioff + i, dstifac)
+
+!!$        Where is the fine grid point w.r.t the coarse grid?
+
+        select case (fi + 10*fj + 100*fk)
+        case (0)
+!!$            On a coarse grid point exactly!
+
+          dsttmp1 = src1(i0+1,j0+1,k0+1)
+          dsttmp2 = src2(i0+1,j0+1,k0+1)
+
+        case (1)
+!!$          Interpolate only in x
+
+          dsttmp1 = eno1d(src1(i0:i0+3,j0+1,k0+1))
+          dsttmp2 = eno1d(src2(i0:i0+3,j0+1,k0+1))
+
+        case (10)
+!!$          Interpolate only in y
+
+          dsttmp1 = eno1d(src1(i0+1,j0:j0+3,k0+1))
+          dsttmp2 = eno1d(src2(i0+1,j0:j0+3,k0+1))
+
+        case (11)
+!!$          Interpolate only in x and y
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src1(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src2(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+        case (100)
+!!$          Interpolate only in z
+
+          dsttmp1 = eno1d(src1(i0+1,j0+1,k0:k0+3))
+          dsttmp2 = eno1d(src2(i0+1,j0+1,k0:k0+3))
+
+        case (101)
+!!$          Interpolate only in x and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src1(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src2(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+        case (110)
+!!$          Interpolate only in y and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src1(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src2(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+        case (111)
+!!$          Interpolate in all of x, y, and z
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src1(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src2(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dsttmp2 = eno1d(tmp2(0:3))
+
+        case default
+          call CCTK_WARN(0, "Internal error in ENO prolongation. Should only be used with refinement factor 2!")
+        end select
+
+        dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+             s1fac * dsttmp1 + s2fac * dsttmp2
+        
+      end do
+    end do
+  end do
+
+end subroutine prolongate_3d_real8_2tl_eno
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77
new file mode 100644
index 000000000..61db42539
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77
@@ -0,0 +1,325 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_minmod.F77,v 1.6 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.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
+c$$$ that must also obey certain constraints. The obvious example is the 
+c$$$ density in hydrodynamics, which may be discontinuous yet must be
+c$$$ strictly positive.
+c$$$
+c$$$ To ensure that this prolongation method is used you should add the
+c$$$ tag
+c$$$
+c$$$      tags='Prolongation="TVD"'
+c$$$
+c$$$ to the interface.ccl on the appropriate group.
+c$$$
+c$$$ This applies minmod type limiting to the slope, checking over the
+c$$$ entire coarse grid cell for the minimum modulus in each direction.
+c$$$
+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(1:len_trim(msg)))                           &&\
+      end if
+
+
+      
+      subroutine prolongate_3d_real8_2tl_minmod (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      external minmod
+      CCTK_REAL8 minmod
+
+      CCTK_REAL8 half, zero
+      parameter (half = 0.5)
+      parameter (zero = 0)
+      CCTK_REAL8 dupw, dloc, slopex(2), slopey(2), slopez(2)
+
+      logical firstloop
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Linear (first order) interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+c     Loop over fine region
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+
+               slopex(1) = zero
+               slopey(1) = zero
+               slopez(1) = zero
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src1(i0+1 ,j0+jj,k0+kk) - src1(i0+0 ,j0+jj,k0+kk)
+                   dloc = src1(i0+2 ,j0+jj,k0+kk) - src1(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex(1) = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex(1) = 
+     $                    minmod(slopex(1), half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src1(i0+ii,j0+1 ,k0+kk) - src1(i0+ii,j0+0 ,k0+kk)
+                   dloc = src1(i0+ii,j0+2 ,k0+kk) - src1(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                     slopey(1) = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey(1) = 
+     $                    minmod(slopey(1), half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src1(i0+ii,j0+jj,k0+1 ) - src1(i0+ii,j0+jj,k0+0 )
+                   dloc = src1(i0+ii,j0+jj,k0+2 ) - src1(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez(1) = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez(1) = 
+     $                    minmod(slopez(1), half * dble(fk) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               slopex(2) = zero
+               slopey(2) = zero
+               slopez(2) = zero
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src2(i0+1 ,j0+jj,k0+kk) - src2(i0+0 ,j0+jj,k0+kk)
+                   dloc = src2(i0+2 ,j0+jj,k0+kk) - src2(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex(2) = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex(2) = 
+     $                    minmod(slopex(2), half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src2(i0+ii,j0+1 ,k0+kk) - src2(i0+ii,j0+0 ,k0+kk)
+                   dloc = src2(i0+ii,j0+2 ,k0+kk) - src2(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                     slopey(2) = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey(2) = 
+     $                    minmod(slopey(2), half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src2(i0+ii,j0+jj,k0+1 ) - src2(i0+ii,j0+jj,k0+0 )
+                   dloc = src2(i0+ii,j0+jj,k0+2 ) - src2(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez(2) = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez(2) = 
+     $                    minmod(slopez(2), half * dble(fk) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+                              
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = 
+     $                      s1fac * (src1(i0+1,j0+1,k0+1) + 
+     $                      slopex(1) + slopey(1) + slopez(1)) +
+     $                      s2fac * (src2(i0+1,j0+1,k0+1) + 
+     $                      slopex(2) + slopey(2) + slopez(2))
+
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77
new file mode 100644
index 000000000..0f0509cff
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77
@@ -0,0 +1,218 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3.F77,v 1.13 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_2tl_o3 (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Linear (first order) interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (6*dstifac**3 * 6*dstjfac**3 * 6*dstkfac**3)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (-1)
+         kfac(2) = (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * 3
+         kfac(3) = (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (-3)
+         kfac(4) = (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (-1)
+            jfac(2) = (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * 3
+            jfac(3) = (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (-3)
+            jfac(4) = (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (-1)
+               ifac(2) = (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * 3
+               ifac(3) = (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (-3)
+               ifac(4) = (fi+dstifac) * (fi        ) * (fi-  dstifac) * 1
+               
+               res = 0
+               
+               do kk=1,4
+                  do jj=1,4
+                     do ii=1,4
+                        
+                        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")
+                           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)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3_rf2.F77
new file mode 100644
index 000000000..d9d62741b
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3_rf2.F77
@@ -0,0 +1,628 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o3_rf2.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_2tl_o3_rf2 (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      CCTK_REAL8 one, half, fourth, eighth, sixteenth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      parameter (sixteenth = one/16)
+      CCTK_REAL8 f1, f2, f3, f4
+      parameter (f1 = - sixteenth)
+      parameter (f2 = 9*sixteenth)
+      parameter (f3 = 9*sixteenth)
+      parameter (f4 = - sixteenth)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer offsetlo, offsethi
+      
+      CCTK_REAL8 s1fac, s2fac
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      CCTK_REAL8 res1, res2
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff, 2).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, 2).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) time interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + s1fac * src1(is,js,ks)
+     $     + s2fac * src2(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks, 4,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is-1,js,ks) + f2 * s1fac * src1(is  ,js,ks)
+     $     + f3 * s1fac * src1(is+1,js,ks) + f4 * s1fac * src1(is+2,js,ks)
+     $     + f1 * s2fac * src2(is-1,js,ks) + f2 * s2fac * src2(is  ,js,ks)
+     $     + f3 * s2fac * src2(is+1,js,ks) + f4 * s2fac * src2(is+2,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks, 1,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is,js-1,ks) + f2 * s1fac * src1(is,js  ,ks)
+     $     + f3 * s1fac * src1(is,js+1,ks) + f4 * s1fac * src1(is,js+2,ks)
+     $     + f1 * s2fac * src2(is,js-1,ks) + f2 * s2fac * src2(is,js  ,ks)
+     $     + f3 * s2fac * src2(is,js+1,ks) + f4 * s2fac * src2(is,js+2,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks, 4,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is-1,js-1,ks)
+     $     + f2*f1 * s1fac * src1(is  ,js-1,ks)
+     $     + f3*f1 * s1fac * src1(is+1,js-1,ks)
+     $     + f4*f1 * s1fac * src1(is+2,js-1,ks)
+     $     + f1*f2 * s1fac * src1(is-1,js  ,ks)
+     $     + f2*f2 * s1fac * src1(is  ,js  ,ks)
+     $     + f3*f2 * s1fac * src1(is+1,js  ,ks)
+     $     + f4*f2 * s1fac * src1(is+2,js  ,ks)
+     $     + f1*f3 * s1fac * src1(is-1,js+1,ks)
+     $     + f2*f3 * s1fac * src1(is  ,js+1,ks)
+     $     + f3*f3 * s1fac * src1(is+1,js+1,ks)
+     $     + f4*f3 * s1fac * src1(is+2,js+1,ks)
+     $     + f1*f4 * s1fac * src1(is-1,js+2,ks)
+     $     + f2*f4 * s1fac * src1(is  ,js+2,ks)
+     $     + f3*f4 * s1fac * src1(is+1,js+2,ks)
+     $     + f4*f4 * s1fac * src1(is+2,js+2,ks)
+     $     
+     $     + f1*f1 * s2fac * src2(is-1,js-1,ks)
+     $     + f2*f1 * s2fac * src2(is  ,js-1,ks)
+     $     + f3*f1 * s2fac * src2(is+1,js-1,ks)
+     $     + f4*f1 * s2fac * src2(is+2,js-1,ks)
+     $     + f1*f2 * s2fac * src2(is-1,js  ,ks)
+     $     + f2*f2 * s2fac * src2(is  ,js  ,ks)
+     $     + f3*f2 * s2fac * src2(is+1,js  ,ks)
+     $     + f4*f2 * s2fac * src2(is+2,js  ,ks)
+     $     + f1*f3 * s2fac * src2(is-1,js+1,ks)
+     $     + f2*f3 * s2fac * src2(is  ,js+1,ks)
+     $     + f3*f3 * s2fac * src2(is+1,js+1,ks)
+     $     + f4*f3 * s2fac * src2(is+2,js+1,ks)
+     $     + f1*f4 * s2fac * src2(is-1,js+2,ks)
+     $     + f2*f4 * s2fac * src2(is  ,js+2,ks)
+     $     + f3*f4 * s2fac * src2(is+1,js+2,ks)
+     $     + f4*f4 * s2fac * src2(is+2,js+2,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks-1, 1,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is,js,ks-1) + f2 * s1fac * src1(is,js,ks  )
+     $     + f3 * s1fac * src1(is,js,ks+1) + f4 * s1fac * src1(is,js,ks+2)
+     $     + f1 * s2fac * src2(is,js,ks-1) + f2 * s2fac * src2(is,js,ks  )
+     $     + f3 * s2fac * src2(is,js,ks+1) + f4 * s2fac * src2(is,js,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks-1, 4,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is-1,js,ks-1)
+     $     + f2*f1 * s1fac * src1(is  ,js,ks-1)
+     $     + f3*f1 * s1fac * src1(is+1,js,ks-1)
+     $     + f4*f1 * s1fac * src1(is+2,js,ks-1)
+     $     + f1*f2 * s1fac * src1(is-1,js,ks  )
+     $     + f2*f2 * s1fac * src1(is  ,js,ks  )
+     $     + f3*f2 * s1fac * src1(is+1,js,ks  )
+     $     + f4*f2 * s1fac * src1(is+2,js,ks  )
+     $     + f1*f3 * s1fac * src1(is-1,js,ks+1)
+     $     + f2*f3 * s1fac * src1(is  ,js,ks+1)
+     $     + f3*f3 * s1fac * src1(is+1,js,ks+1)
+     $     + f4*f3 * s1fac * src1(is+2,js,ks+1)
+     $     + f1*f4 * s1fac * src1(is-1,js,ks+2)
+     $     + f2*f4 * s1fac * src1(is  ,js,ks+2)
+     $     + f3*f4 * s1fac * src1(is+1,js,ks+2)
+     $     + f4*f4 * s1fac * src1(is+2,js,ks+2)
+     $     
+     $     + f1*f1 * s2fac * src2(is-1,js,ks-1)
+     $     + f2*f1 * s2fac * src2(is  ,js,ks-1)
+     $     + f3*f1 * s2fac * src2(is+1,js,ks-1)
+     $     + f4*f1 * s2fac * src2(is+2,js,ks-1)
+     $     + f1*f2 * s2fac * src2(is-1,js,ks  )
+     $     + f2*f2 * s2fac * src2(is  ,js,ks  )
+     $     + f3*f2 * s2fac * src2(is+1,js,ks  )
+     $     + f4*f2 * s2fac * src2(is+2,js,ks  )
+     $     + f1*f3 * s2fac * src2(is-1,js,ks+1)
+     $     + f2*f3 * s2fac * src2(is  ,js,ks+1)
+     $     + f3*f3 * s2fac * src2(is+1,js,ks+1)
+     $     + f4*f3 * s2fac * src2(is+2,js,ks+1)
+     $     + f1*f4 * s2fac * src2(is-1,js,ks+2)
+     $     + f2*f4 * s2fac * src2(is  ,js,ks+2)
+     $     + f3*f4 * s2fac * src2(is+1,js,ks+2)
+     $     + f4*f4 * s2fac * src2(is+2,js,ks+2)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks-1, 1,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is,js-1,ks-1)
+     $     + f2*f1 * s1fac * src1(is,js  ,ks-1)
+     $     + f3*f1 * s1fac * src1(is,js+1,ks-1)
+     $     + f4*f1 * s1fac * src1(is,js+2,ks-1)
+     $     + f1*f2 * s1fac * src1(is,js-1,ks  )
+     $     + f2*f2 * s1fac * src1(is,js  ,ks  )
+     $     + f3*f2 * s1fac * src1(is,js+1,ks  )
+     $     + f4*f2 * s1fac * src1(is,js+2,ks  )
+     $     + f1*f3 * s1fac * src1(is,js-1,ks+1)
+     $     + f2*f3 * s1fac * src1(is,js  ,ks+1)
+     $     + f3*f3 * s1fac * src1(is,js+1,ks+1)
+     $     + f4*f3 * s1fac * src1(is,js+2,ks+1)
+     $     + f1*f4 * s1fac * src1(is,js-1,ks+2)
+     $     + f2*f4 * s1fac * src1(is,js  ,ks+2)
+     $     + f3*f4 * s1fac * src1(is,js+1,ks+2)
+     $     + f4*f4 * s1fac * src1(is,js+2,ks+2)
+     $     
+     $     + f1*f1 * s2fac * src2(is,js-1,ks-1)
+     $     + f2*f1 * s2fac * src2(is,js  ,ks-1)
+     $     + f3*f1 * s2fac * src2(is,js+1,ks-1)
+     $     + f4*f1 * s2fac * src2(is,js+2,ks-1)
+     $     + f1*f2 * s2fac * src2(is,js-1,ks  )
+     $     + f2*f2 * s2fac * src2(is,js  ,ks  )
+     $     + f3*f2 * s2fac * src2(is,js+1,ks  )
+     $     + f4*f2 * s2fac * src2(is,js+2,ks  )
+     $     + f1*f3 * s2fac * src2(is,js-1,ks+1)
+     $     + f2*f3 * s2fac * src2(is,js  ,ks+1)
+     $     + f3*f3 * s2fac * src2(is,js+1,ks+1)
+     $     + f4*f3 * s2fac * src2(is,js+2,ks+1)
+     $     + f1*f4 * s2fac * src2(is,js-1,ks+2)
+     $     + f2*f4 * s2fac * src2(is,js  ,ks+2)
+     $     + f3*f4 * s2fac * src2(is,js+1,ks+2)
+     $     + f4*f4 * s2fac * src2(is,js+2,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks-1, 4,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      res1 =
+     $     + f1*f1*f1 * s1fac * src1(is-1,js-1,ks-1)
+     $     + f2*f1*f1 * s1fac * src1(is  ,js-1,ks-1)
+     $     + f3*f1*f1 * s1fac * src1(is+1,js-1,ks-1)
+     $     + f4*f1*f1 * s1fac * src1(is+2,js-1,ks-1)
+     $     + f1*f2*f1 * s1fac * src1(is-1,js  ,ks-1)
+     $     + f2*f2*f1 * s1fac * src1(is  ,js  ,ks-1)
+     $     + f3*f2*f1 * s1fac * src1(is+1,js  ,ks-1)
+     $     + f4*f2*f1 * s1fac * src1(is+2,js  ,ks-1)
+     $     + f1*f3*f1 * s1fac * src1(is-1,js+1,ks-1)
+     $     + f2*f3*f1 * s1fac * src1(is  ,js+1,ks-1)
+     $     + f3*f3*f1 * s1fac * src1(is+1,js+1,ks-1)
+     $     + f4*f3*f1 * s1fac * src1(is+2,js+1,ks-1)
+     $     + f1*f4*f1 * s1fac * src1(is-1,js+2,ks-1)
+     $     + f2*f4*f1 * s1fac * src1(is  ,js+2,ks-1)
+     $     + f3*f4*f1 * s1fac * src1(is+1,js+2,ks-1)
+     $     + f4*f4*f1 * s1fac * src1(is+2,js+2,ks-1)
+     $     
+     $     + f1*f1*f2 * s1fac * src1(is-1,js-1,ks  )
+     $     + f2*f1*f2 * s1fac * src1(is  ,js-1,ks  )
+     $     + f3*f1*f2 * s1fac * src1(is+1,js-1,ks  )
+     $     + f4*f1*f2 * s1fac * src1(is+2,js-1,ks  )
+     $     + f1*f2*f2 * s1fac * src1(is-1,js  ,ks  )
+     $     + f2*f2*f2 * s1fac * src1(is  ,js  ,ks  )
+     $     + f3*f2*f2 * s1fac * src1(is+1,js  ,ks  )
+     $     + f4*f2*f2 * s1fac * src1(is+2,js  ,ks  )
+     $     + f1*f3*f2 * s1fac * src1(is-1,js+1,ks  )
+     $     + f2*f3*f2 * s1fac * src1(is  ,js+1,ks  )
+     $     + f3*f3*f2 * s1fac * src1(is+1,js+1,ks  )
+     $     + f4*f3*f2 * s1fac * src1(is+2,js+1,ks  )
+     $     + f1*f4*f2 * s1fac * src1(is-1,js+2,ks  )
+     $     + f2*f4*f2 * s1fac * src1(is  ,js+2,ks  )
+     $     + f3*f4*f2 * s1fac * src1(is+1,js+2,ks  )
+     $     + f4*f4*f2 * s1fac * src1(is+2,js+2,ks  )
+     $     
+     $     + f1*f1*f3 * s1fac * src1(is-1,js-1,ks+1)
+     $     + f2*f1*f3 * s1fac * src1(is  ,js-1,ks+1)
+     $     + f3*f1*f3 * s1fac * src1(is+1,js-1,ks+1)
+     $     + f4*f1*f3 * s1fac * src1(is+2,js-1,ks+1)
+     $     + f1*f2*f3 * s1fac * src1(is-1,js  ,ks+1)
+     $     + f2*f2*f3 * s1fac * src1(is  ,js  ,ks+1)
+     $     + f3*f2*f3 * s1fac * src1(is+1,js  ,ks+1)
+     $     + f4*f2*f3 * s1fac * src1(is+2,js  ,ks+1)
+     $     + f1*f3*f3 * s1fac * src1(is-1,js+1,ks+1)
+     $     + f2*f3*f3 * s1fac * src1(is  ,js+1,ks+1)
+     $     + f3*f3*f3 * s1fac * src1(is+1,js+1,ks+1)
+     $     + f4*f3*f3 * s1fac * src1(is+2,js+1,ks+1)
+     $     + f1*f4*f3 * s1fac * src1(is-1,js+2,ks+1)
+     $     + f2*f4*f3 * s1fac * src1(is  ,js+2,ks+1)
+     $     + f3*f4*f3 * s1fac * src1(is+1,js+2,ks+1)
+     $     + f4*f4*f3 * s1fac * src1(is+2,js+2,ks+1)
+     $     
+     $     + f1*f1*f4 * s1fac * src1(is-1,js-1,ks+2)
+     $     + f2*f1*f4 * s1fac * src1(is  ,js-1,ks+2)
+     $     + f3*f1*f4 * s1fac * src1(is+1,js-1,ks+2)
+     $     + f4*f1*f4 * s1fac * src1(is+2,js-1,ks+2)
+     $     + f1*f2*f4 * s1fac * src1(is-1,js  ,ks+2)
+     $     + f2*f2*f4 * s1fac * src1(is  ,js  ,ks+2)
+     $     + f3*f2*f4 * s1fac * src1(is+1,js  ,ks+2)
+     $     + f4*f2*f4 * s1fac * src1(is+2,js  ,ks+2)
+     $     + f1*f3*f4 * s1fac * src1(is-1,js+1,ks+2)
+     $     + f2*f3*f4 * s1fac * src1(is  ,js+1,ks+2)
+     $     + f3*f3*f4 * s1fac * src1(is+1,js+1,ks+2)
+     $     + f4*f3*f4 * s1fac * src1(is+2,js+1,ks+2)
+     $     + f1*f4*f4 * s1fac * src1(is-1,js+2,ks+2)
+     $     + f2*f4*f4 * s1fac * src1(is  ,js+2,ks+2)
+     $     + f3*f4*f4 * s1fac * src1(is+1,js+2,ks+2)
+     $     + f4*f4*f4 * s1fac * src1(is+2,js+2,ks+2)
+      res2 =
+     $     + f1*f1*f1 * s2fac * src2(is-1,js-1,ks-1)
+     $     + f2*f1*f1 * s2fac * src2(is  ,js-1,ks-1)
+     $     + f3*f1*f1 * s2fac * src2(is+1,js-1,ks-1)
+     $     + f4*f1*f1 * s2fac * src2(is+2,js-1,ks-1)
+     $     + f1*f2*f1 * s2fac * src2(is-1,js  ,ks-1)
+     $     + f2*f2*f1 * s2fac * src2(is  ,js  ,ks-1)
+     $     + f3*f2*f1 * s2fac * src2(is+1,js  ,ks-1)
+     $     + f4*f2*f1 * s2fac * src2(is+2,js  ,ks-1)
+     $     + f1*f3*f1 * s2fac * src2(is-1,js+1,ks-1)
+     $     + f2*f3*f1 * s2fac * src2(is  ,js+1,ks-1)
+     $     + f3*f3*f1 * s2fac * src2(is+1,js+1,ks-1)
+     $     + f4*f3*f1 * s2fac * src2(is+2,js+1,ks-1)
+     $     + f1*f4*f1 * s2fac * src2(is-1,js+2,ks-1)
+     $     + f2*f4*f1 * s2fac * src2(is  ,js+2,ks-1)
+     $     + f3*f4*f1 * s2fac * src2(is+1,js+2,ks-1)
+     $     + f4*f4*f1 * s2fac * src2(is+2,js+2,ks-1)
+     $     
+     $     + f1*f1*f2 * s2fac * src2(is-1,js-1,ks  )
+     $     + f2*f1*f2 * s2fac * src2(is  ,js-1,ks  )
+     $     + f3*f1*f2 * s2fac * src2(is+1,js-1,ks  )
+     $     + f4*f1*f2 * s2fac * src2(is+2,js-1,ks  )
+     $     + f1*f2*f2 * s2fac * src2(is-1,js  ,ks  )
+     $     + f2*f2*f2 * s2fac * src2(is  ,js  ,ks  )
+     $     + f3*f2*f2 * s2fac * src2(is+1,js  ,ks  )
+     $     + f4*f2*f2 * s2fac * src2(is+2,js  ,ks  )
+     $     + f1*f3*f2 * s2fac * src2(is-1,js+1,ks  )
+     $     + f2*f3*f2 * s2fac * src2(is  ,js+1,ks  )
+     $     + f3*f3*f2 * s2fac * src2(is+1,js+1,ks  )
+     $     + f4*f3*f2 * s2fac * src2(is+2,js+1,ks  )
+     $     + f1*f4*f2 * s2fac * src2(is-1,js+2,ks  )
+     $     + f2*f4*f2 * s2fac * src2(is  ,js+2,ks  )
+     $     + f3*f4*f2 * s2fac * src2(is+1,js+2,ks  )
+     $     + f4*f4*f2 * s2fac * src2(is+2,js+2,ks  )
+     $     
+     $     + f1*f1*f3 * s2fac * src2(is-1,js-1,ks+1)
+     $     + f2*f1*f3 * s2fac * src2(is  ,js-1,ks+1)
+     $     + f3*f1*f3 * s2fac * src2(is+1,js-1,ks+1)
+     $     + f4*f1*f3 * s2fac * src2(is+2,js-1,ks+1)
+     $     + f1*f2*f3 * s2fac * src2(is-1,js  ,ks+1)
+     $     + f2*f2*f3 * s2fac * src2(is  ,js  ,ks+1)
+     $     + f3*f2*f3 * s2fac * src2(is+1,js  ,ks+1)
+     $     + f4*f2*f3 * s2fac * src2(is+2,js  ,ks+1)
+     $     + f1*f3*f3 * s2fac * src2(is-1,js+1,ks+1)
+     $     + f2*f3*f3 * s2fac * src2(is  ,js+1,ks+1)
+     $     + f3*f3*f3 * s2fac * src2(is+1,js+1,ks+1)
+     $     + f4*f3*f3 * s2fac * src2(is+2,js+1,ks+1)
+     $     + f1*f4*f3 * s2fac * src2(is-1,js+2,ks+1)
+     $     + f2*f4*f3 * s2fac * src2(is  ,js+2,ks+1)
+     $     + f3*f4*f3 * s2fac * src2(is+1,js+2,ks+1)
+     $     + f4*f4*f3 * s2fac * src2(is+2,js+2,ks+1)
+     $     
+     $     + f1*f1*f4 * s2fac * src2(is-1,js-1,ks+2)
+     $     + f2*f1*f4 * s2fac * src2(is  ,js-1,ks+2)
+     $     + f3*f1*f4 * s2fac * src2(is+1,js-1,ks+2)
+     $     + f4*f1*f4 * s2fac * src2(is+2,js-1,ks+2)
+     $     + f1*f2*f4 * s2fac * src2(is-1,js  ,ks+2)
+     $     + f2*f2*f4 * s2fac * src2(is  ,js  ,ks+2)
+     $     + f3*f2*f4 * s2fac * src2(is+1,js  ,ks+2)
+     $     + f4*f2*f4 * s2fac * src2(is+2,js  ,ks+2)
+     $     + f1*f3*f4 * s2fac * src2(is-1,js+1,ks+2)
+     $     + f2*f3*f4 * s2fac * src2(is  ,js+1,ks+2)
+     $     + f3*f3*f4 * s2fac * src2(is+1,js+1,ks+2)
+     $     + f4*f3*f4 * s2fac * src2(is+2,js+1,ks+2)
+     $     + f1*f4*f4 * s2fac * src2(is-1,js+2,ks+2)
+     $     + f2*f4*f4 * s2fac * src2(is  ,js+2,ks+2)
+     $     + f3*f4*f4 * s2fac * src2(is+1,js+2,ks+2)
+     $     + f4*f4*f4 * s2fac * src2(is+2,js+2,ks+2)
+      dst(id,jd,kd) = res1 + res2
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77
new file mode 100644
index 000000000..e28354048
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77
@@ -0,0 +1,226 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_o5.F77,v 1.3 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_2tl_o5 (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(6), jfac(6), kfac(6)
+      integer ii, jj, kk
+      CCTK_REAL8 fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Linear (first order) interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+c     Loop over fine region
+c     (This expression cannot be evaluated as integer)
+      dstdiv = one / (120*dstifac**5) / (120*dstjfac**5) / (120*dstkfac**5)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk+  dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (- 1)
+         kfac(2) = (fk+2*dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (  5)
+         kfac(3) = (fk+2*dstkfac) * (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (-10)
+         kfac(4) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (fk-3*dstkfac) * ( 10)
+         kfac(5) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-3*dstkfac) * (- 5)
+         kfac(6) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-2*dstkfac) * (  1)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj+  dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (- 1)
+            jfac(2) = (fj+2*dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (  5)
+            jfac(3) = (fj+2*dstjfac) * (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (-10)
+            jfac(4) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (fj-3*dstjfac) * ( 10)
+            jfac(5) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-3*dstjfac) * (- 5)
+            jfac(6) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-2*dstjfac) * (  1)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi+  dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (- 1)
+               ifac(2) = (fi+2*dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (  5)
+               ifac(3) = (fi+2*dstifac) * (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (-10)
+               ifac(4) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (fi-3*dstifac) * ( 10)
+               ifac(5) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-3*dstifac) * (- 5)
+               ifac(6) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-2*dstifac) * (  1)
+               
+               res = 0
+               
+               do kk=1,6
+                  do jj=1,6
+                     do ii=1,6
+                        
+                        if (ifac(ii).ne.0 .and. jfac(jj).ne.0 .and. kfac(kk).ne.0) then
+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")
+                           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)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_rf2.F77
new file mode 100644
index 000000000..727c2581f
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_rf2.F77
@@ -0,0 +1,402 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_2tl_rf2.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_2tl_rf2 (
+     $     src1, t1, src2, t2, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      CCTK_REAL8 one, half, fourth, eighth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) time interpolation
+      if (t1.eq.t2) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2)-eps .or. t.gt.max(t1,t2)+eps) then
+         call  CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) / (t1 - t2)
+      s2fac = (t - t1) / (t2 - t1)
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + s1fac * src1(is,js,ks)
+     $     + s2fac * src2(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is+1,js,ks)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is+1,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is,js+1,ks)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is,js+1,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $              + fourth * s1fac * src1(is,js,ks)
+     $              + fourth * s1fac * src1(is+1,js,ks)
+     $              + fourth * s1fac * src1(is,js+1,ks)
+     $              + fourth * s1fac * src1(is+1,js+1,ks)
+     $              + fourth * s2fac * src2(is,js,ks)
+     $              + fourth * s2fac * src2(is+1,js,ks)
+     $              + fourth * s2fac * src2(is,js+1,ks)
+     $              + fourth * s2fac * src2(is+1,js+1,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is,js,ks+1)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is,js,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * s1fac * src1(is,js,ks)
+     $     + fourth * s1fac * src1(is+1,js,ks)
+     $     + fourth * s1fac * src1(is,js,ks+1)
+     $     + fourth * s1fac * src1(is+1,js,ks+1)
+     $     + fourth * s2fac * src1(is,js,ks)
+     $     + fourth * s2fac * src2(is+1,js,ks)
+     $     + fourth * s2fac * src2(is,js,ks+1)
+     $     + fourth * s2fac * src2(is+1,js,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * s1fac * src1(is,js,ks)
+     $     + fourth * s1fac * src1(is,js+1,ks)
+     $     + fourth * s1fac * src1(is,js,ks+1)
+     $     + fourth * s1fac * src1(is,js+1,ks+1)
+     $     + fourth * s2fac * src2(is,js,ks)
+     $     + fourth * s2fac * src2(is,js+1,ks)
+     $     + fourth * s2fac * src2(is,js,ks+1)
+     $     + fourth * s2fac * src2(is,js+1,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + eighth * s1fac * src1(is,js,ks)
+     $     + eighth * s1fac * src1(is+1,js,ks)
+     $     + eighth * s1fac * src1(is,js+1,ks)
+     $     + eighth * s1fac * src1(is+1,js+1,ks)
+     $     + eighth * s1fac * src1(is,js,ks+1)
+     $     + eighth * s1fac * src1(is+1,js,ks+1)
+     $     + eighth * s1fac * src1(is,js+1,ks+1)
+     $     + eighth * s1fac * src1(is+1,js+1,ks+1)
+     $     
+     $     + eighth * s2fac * src2(is,js,ks)
+     $     + eighth * s2fac * src2(is+1,js,ks)
+     $     + eighth * s2fac * src2(is,js+1,ks)
+     $     + eighth * s2fac * src2(is+1,js+1,ks)
+     $     + eighth * s2fac * src2(is,js,ks+1)
+     $     + eighth * s2fac * src2(is+1,js,ks+1)
+     $     + eighth * s2fac * src2(is,js+1,ks+1)
+     $     + eighth * s2fac * src2(is+1,js+1,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77
new file mode 100644
index 000000000..9f3e3d944
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77
@@ -0,0 +1,197 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl.F77,v 1.9 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_3tl (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(2), jfac(2), kfac(2)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (dstifac * dstjfac * dstkfac)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk-dstkfac) * (-1)
+         kfac(2) = (fk        ) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj-dstjfac) * (-1)
+            jfac(2) = (fj        ) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi-dstifac) * (-1)
+               ifac(2) = (fi        ) * 1
+               
+               res = 0
+               
+               do kk=1,2
+                  do jj=1,2
+                     do ii=1,2
+                        
+                        fac = ifac(ii) * jfac(jj) * kfac(kk)
+                        
+                        if (fac.ne.0) then
+                           CHKIDX (i0+ii, j0+jj, k0+kk, \
+                                   srciext,srcjext,srckext, "source")
+                           res = res
+     $                          + fac * s1fac * src1(i0+ii, j0+jj, k0+kk)
+     $                          + fac * s2fac * src2(i0+ii, j0+jj, k0+kk)
+     $                          + fac * s3fac * src3(i0+ii, j0+jj, k0+kk)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_eno.F90 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_eno.F90
new file mode 100644
index 000000000..df253af97
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_eno.F90
@@ -0,0 +1,370 @@
+!!$     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_eno.F90,v 1.1 2004/03/03 15:30:40 hawke Exp $
+
+#include "cctk.h"
+
+
+!!$ This routine performs "ENO" prolongation. It is intended to be used 
+!!$ with GFs that are not expected to be smooth, particularly those
+!!$ that must also obey certain constraints. The obvious example is the 
+!!$ density in hydrodynamics, which may be discontinuous yet must be
+!!$ strictly positive.
+!!$
+!!$ To ensure that this prolongation method is used you should add the
+!!$ tag
+!!$
+!!$      tags='Prolongation="ENO"'
+!!$
+!!$ to the interface.ccl on the appropriate group.
+!!$
+!!$ This applies ENO2 type limiting to the slope, checking over the
+!!$ entire coarse grid cell for the least oscillatory quadratic in each 
+!!$ direction. If the slope changes sign over the extrema, linear
+!!$ interpolation is used instead.
+!!$
+!!$ The actual eno1d function is defined in the routine
+!!$
+!!$      prolongate_3d_real8_eno.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(1:len_trim(msg)))                           &&\
+end if
+
+subroutine prolongate_3d_real8_3tl_eno (src1, t1, src2, t2, &
+     src3, t3, srciext, srcjext, srckext, dst, t, dstiext, &
+     dstjext, dstkext, srcbbox, dstbbox, regbbox)
+      
+  implicit none
+
+  CCTK_REAL8 one
+  parameter (one = 1)
+
+  CCTK_REAL8 eps
+  parameter (eps = 1.0d-10)
+
+  integer srciext, srcjext, srckext
+  CCTK_REAL8 src1(srciext,srcjext,srckext)
+  CCTK_REAL8 t1
+  CCTK_REAL8 src2(srciext,srcjext,srckext)
+  CCTK_REAL8 t2
+  CCTK_REAL8 src3(srciext,srcjext,srckext)
+  CCTK_REAL8 t3
+  integer dstiext, dstjext, dstkext
+  CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+  CCTK_REAL8 t
+!!$     bbox(:,1) is lower boundary (inclusive)
+!!$     bbox(:,2) is upper boundary (inclusive)
+!!$     bbox(:,3) is stride
+  integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+
+  integer offsetlo, offsethi
+
+  integer regiext, regjext, regkext
+
+  integer dstifac, dstjfac, dstkfac
+
+  integer srcioff, srcjoff, srckoff
+  integer dstioff, dstjoff, dstkoff
+      
+  CCTK_REAL8 s1fac, s2fac, s3fac, tmps1fac, tmps2fac, tmps3fac
+
+  integer i, j, k
+  integer i0, j0, k0
+  integer fi, fj, fk
+  integer ifac(4), jfac(4), kfac(4)
+  integer ii, jj, kk
+  integer fac
+  CCTK_REAL8 res
+  integer d
+
+  character msg*1000
+
+  CCTK_REAL8, dimension(0:3,0:3) :: tmp1
+  CCTK_REAL8, dimension(0:3) :: tmp2
+  CCTK_REAL8 :: dsttmp1, dsttmp2, dsttmp3
+
+  external eno1d
+  CCTK_REAL8 eno1d
+
+  CCTK_REAL8 half, zero
+  parameter (half = 0.5)
+  parameter (zero = 0)
+
+  do d=1,3
+    if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0 &
+         .or. regbbox(d,3).eq.0) then
+      call CCTK_WARN (0, "Internal error: stride is zero")
+    end if
+    if (srcbbox(d,3).le.regbbox(d,3) &
+         .or. dstbbox(d,3).ne.regbbox(d,3)) then
+      call CCTK_WARN (0, "Internal error: strides disagree")
+    end if
+    if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+      call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+!!$     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
+    regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+    dstkfac = srcbbox(d,3) / dstbbox(d,3)
+    srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+    offsetlo = regbbox(d,3)
+    if (mod(srckoff + 0, dstkfac).eq.0) then
+      offsetlo = 0
+      if (regkext.gt.1) then
+        offsetlo = regbbox(d,3)
+      end if
+    end if
+    offsethi = regbbox(d,3)
+    if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+      offsethi = 0
+      if (regkext.gt.1) then
+        offsethi = regbbox(d,3)
+      end if
+    end if
+    if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1) &
+         .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2) &
+         .or. regbbox(d,1).lt.dstbbox(d,1) &
+         .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 &
+       .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1 &
+       .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1 &
+       .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1 &
+       .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1 &
+       .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+    call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+  end if
+
+  regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+  regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+  regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+
+  dstifac = srcbbox(1,3) / dstbbox(1,3)
+  dstjfac = srcbbox(2,3) / dstbbox(2,3)
+  dstkfac = srcbbox(3,3) / dstbbox(3,3)
+
+  srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+  srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+  srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+
+  dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+  dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+  dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+!!$     Quadratic (second order) interpolation
+  if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+    call CCTK_WARN (0, "Internal error: arrays have same time")
+  end if
+  if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+    call CCTK_WARN (0, "Internal error: extrapolation in time")
+  end if
+  
+  s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+  s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+  s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+!!$     Loop over fine region
+
+  do k = 0, regkext-1
+    k0 = (srckoff + k) / dstkfac
+    fk = mod(srckoff + k, dstkfac)
+
+    do j = 0, regjext-1
+      j0 = (srcjoff + j) / dstjfac
+      fj = mod(srcjoff + j, dstjfac)
+
+      do i = 0, regiext-1
+        i0 = (srcioff + i) / dstifac
+        fi = mod(srcioff + i, dstifac)
+
+!!$        Where is the fine grid point w.r.t the coarse grid?
+
+!!$        write(*,*) i,j,k,fi,fj,fk
+
+        select case (fi + 10*fj + 100*fk)
+        case (0)
+!!$            On a coarse grid point exactly!
+
+          dsttmp1 = src1(i0+1,j0+1,k0+1)
+          dsttmp2 = src2(i0+1,j0+1,k0+1)
+          dsttmp3 = src3(i0+1,j0+1,k0+1)
+
+        case (1)
+!!$          Interpolate only in x
+
+          dsttmp1 = eno1d(src1(i0:i0+3,j0+1,k0+1))
+          dsttmp2 = eno1d(src2(i0:i0+3,j0+1,k0+1))
+          dsttmp3 = eno1d(src3(i0:i0+3,j0+1,k0+1))
+
+        case (10)
+!!$          Interpolate only in y
+
+          dsttmp1 = eno1d(src1(i0+1,j0:j0+3,k0+1))
+          dsttmp2 = eno1d(src2(i0+1,j0:j0+3,k0+1))
+          dsttmp3 = eno1d(src3(i0+1,j0:j0+3,k0+1))
+
+        case (11)
+!!$          Interpolate only in x and y
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src1(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src2(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src3(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dsttmp3 = eno1d(tmp2(0:3))
+
+        case (100)
+!!$          Interpolate only in z
+
+          dsttmp1 = eno1d(src1(i0+1,j0+1,k0:k0+3))
+          dsttmp2 = eno1d(src2(i0+1,j0+1,k0:k0+3))
+          dsttmp3 = eno1d(src3(i0+1,j0+1,k0:k0+3))
+
+        case (101)
+!!$          Interpolate only in x and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src1(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src2(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src3(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dsttmp3 = eno1d(tmp2(0:3))
+
+        case (110)
+!!$          Interpolate only in y and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src1(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src2(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dsttmp2 = eno1d(tmp2(0:3))
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src3(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dsttmp3 = eno1d(tmp2(0:3))
+
+        case (111)
+!!$          Interpolate in all of x, y, and z
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src1(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dsttmp1 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src2(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dsttmp2 = eno1d(tmp2(0:3))
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src3(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dsttmp3 = eno1d(tmp2(0:3))
+
+        case default
+          call CCTK_WARN(0, "Internal error in ENO prolongation. Should only be used with refinement factor 2!")
+        end select
+
+        dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+             s1fac * dsttmp1 + s2fac * dsttmp2 + s3fac * dsttmp3
+
+!!$        write(*,*) i,j,k,dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1),&
+!!$             s1fac,s2fac,s3fac,dsttmp1,dsttmp2,dsttmp3
+
+        if ( (dst(dstioff+i+1, dstjoff+j+1, dstkoff+k+1) - &
+             max(dsttmp1, dsttmp2, dsttmp3)) * &
+             (dst(dstioff+i+1, dstjoff+j+1, dstkoff+k+1) - &
+             min(dsttmp1, dsttmp2, dsttmp3)) .lt. 0 ) then
+
+!!$          Do linear interpolation in time instead
+
+!!$          write(*,*) t,t1,t2,t3
+
+          if (t < t2) then
+
+            tmps2fac = (t - t3) / (t2 - t3)
+            tmps3fac = (t - t2) / (t3 - t2)
+
+            dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+                 tmps2fac * dsttmp2 + tmps3fac * dsttmp3
+
+          else
+            
+            tmps1fac = (t - t2) / (t1 - t2)
+            tmps2fac = (t - t1) / (t2 - t1)
+            
+            dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+                 tmps1fac * dsttmp1 + tmps2fac * dsttmp2          
+
+          end if
+          
+        end if
+        
+      end do
+    end do
+  end do
+
+end subroutine prolongate_3d_real8_3tl_eno
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77
new file mode 100644
index 000000000..9018a364b
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77
@@ -0,0 +1,388 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_minmod.F77,v 1.6 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.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
+c$$$ that must also obey certain constraints. The obvious example is the 
+c$$$ density in hydrodynamics, which may be discontinuous yet must be
+c$$$ strictly positive.
+c$$$
+c$$$ To ensure that this prolongation method is used you should add the
+c$$$ tag
+c$$$
+c$$$      tags='Prolongation="TVD"'
+c$$$
+c$$$ to the interface.ccl on the appropriate group.
+c$$$
+c$$$ This applies minmod type limiting to the slope, checking over the
+c$$$ entire coarse grid cell for the minimum modulus in each direction.
+c$$$
+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(1:len_trim(msg)))                           &&\
+      end if
+
+
+      
+      subroutine prolongate_3d_real8_3tl_minmod (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+
+      external minmod
+      CCTK_REAL8 minmod
+
+      CCTK_REAL8 half, zero
+      parameter (half = 0.5)
+      parameter (zero = 0)
+      CCTK_REAL8 dupw, dloc, slopex(3), slopey(3), slopez(3)
+      logical firstloop
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+c     Loop over fine region
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+
+
+               slopex(1) = zero
+               slopey(1) = zero
+               slopez(1) = zero
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src1(i0+1 ,j0+jj,k0+kk) - src1(i0+0 ,j0+jj,k0+kk)
+                   dloc = src1(i0+2 ,j0+jj,k0+kk) - src1(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex(1) = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex(1) = 
+     $                    minmod(slopex(1), half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src1(i0+ii,j0+1 ,k0+kk) - src1(i0+ii,j0+0 ,k0+kk)
+                   dloc = src1(i0+ii,j0+2 ,k0+kk) - src1(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                     slopey(1) = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey(1) = 
+     $                    minmod(slopey(1), half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1,  2
+                 do ii = 1, 2
+                   dupw = src1(i0+ii,j0+jj,k0+1 ) - src1(i0+ii,j0+jj,k0+0 )
+                   dloc = src1(i0+ii,j0+jj,k0+2 ) - src1(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez(1) = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez(1) = 
+     $                    minmod(slopez(1), half * dble(fk) * minmod(dupw,dloc))
+                   end if
+
+                 end do
+               end do
+
+               slopex(2) = zero
+               slopey(2) = zero
+               slopez(2) = zero
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src2(i0+1 ,j0+jj,k0+kk) - src2(i0+0 ,j0+jj,k0+kk)
+                   dloc = src2(i0+2 ,j0+jj,k0+kk) - src2(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex(2) = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex(2) = 
+     $                    minmod(slopex(2), half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src2(i0+ii,j0+1 ,k0+kk) - src2(i0+ii,j0+0 ,k0+kk)
+                   dloc = src2(i0+ii,j0+2 ,k0+kk) - src2(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                   slopey(2) = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey(2) = 
+     $                    minmod(slopey(2), half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src2(i0+ii,j0+jj,k0+1 ) - src2(i0+ii,j0+jj,k0+0 )
+                   dloc = src2(i0+ii,j0+jj,k0+2 ) - src2(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez(2) = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez(2) = 
+     $                    minmod(slopez(2), half * dble(fk) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               slopex(3) = zero
+               slopey(3) = zero
+               slopez(3) = zero
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src3(i0+1 ,j0+jj,k0+kk) - src3(i0+0 ,j0+jj,k0+kk)
+                   dloc = src3(i0+2 ,j0+jj,k0+kk) - src3(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex(3) = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex(3) = 
+     $                    minmod(slopex(3), half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src3(i0+ii,j0+1 ,k0+kk) - src3(i0+ii,j0+0 ,k0+kk)
+                   dloc = src3(i0+ii,j0+2 ,k0+kk) - src3(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                     slopey(3) = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey(3) = 
+     $                    minmod(slopey(3), half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src3(i0+ii,j0+jj,k0+1 ) - src3(i0+ii,j0+jj,k0+0 )
+                   dloc = src3(i0+ii,j0+jj,k0+2 ) - src3(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez(3) = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez(3) = 
+     $                    minmod(slopez(3), half * dble(fk) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+                              
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = 
+     $                      s1fac * (src1(i0+1,j0+1,k0+1) + 
+     $                      slopex(1) + slopey(1) + slopez(1)) +
+     $                      s2fac * (src2(i0+1,j0+1,k0+1) + 
+     $                      slopex(2) + slopey(2) + slopez(2)) +
+     $                      s3fac * (src3(i0+1,j0+1,k0+1) + 
+     $                      slopex(3) + slopey(3) + slopez(3))
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77
new file mode 100644
index 000000000..c44e1119f
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77
@@ -0,0 +1,222 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3.F77,v 1.13 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_3tl_o3 (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (6*dstifac**3 * 6*dstjfac**3 * 6*dstkfac**3)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (-1)
+         kfac(2) = (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * 3
+         kfac(3) = (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (-3)
+         kfac(4) = (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (-1)
+            jfac(2) = (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * 3
+            jfac(3) = (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (-3)
+            jfac(4) = (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (-1)
+               ifac(2) = (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * 3
+               ifac(3) = (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (-3)
+               ifac(4) = (fi+dstifac) * (fi        ) * (fi-  dstifac) * 1
+               
+               res = 0
+               
+               do kk=1,4
+                  do jj=1,4
+                     do ii=1,4
+                        
+                        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")
+                           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)
+     $                          + fac * s3fac * src3(i0+ii-1, j0+jj-1, k0+kk-1)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3_rf2.F77
new file mode 100644
index 000000000..daa130251
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3_rf2.F77
@@ -0,0 +1,757 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o3_rf2.F77,v 1.3 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_3tl_o3_rf2 (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      CCTK_REAL8 one, half, fourth, eighth, sixteenth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      parameter (sixteenth = one/16)
+      CCTK_REAL8 f1, f2, f3, f4
+      parameter (f1 = - sixteenth)
+      parameter (f2 = 9*sixteenth)
+      parameter (f3 = 9*sixteenth)
+      parameter (f4 = - sixteenth)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer offsetlo, offsethi
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      CCTK_REAL8 res1, res2, res3
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff, 2).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, 2).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) time interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + s1fac * src1(is,js,ks)
+     $     + s2fac * src2(is,js,ks)
+     $     + s3fac * src3(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks, 4,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is-1,js,ks) + f2 * s1fac * src1(is  ,js,ks)
+     $     + f3 * s1fac * src1(is+1,js,ks) + f4 * s1fac * src1(is+2,js,ks)
+     $     + f1 * s2fac * src2(is-1,js,ks) + f2 * s2fac * src2(is  ,js,ks)
+     $     + f3 * s2fac * src2(is+1,js,ks) + f4 * s2fac * src2(is+2,js,ks)
+     $     + f1 * s3fac * src3(is-1,js,ks) + f2 * s3fac * src3(is  ,js,ks)
+     $     + f3 * s3fac * src3(is+1,js,ks) + f4 * s3fac * src3(is+2,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks, 1,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is,js-1,ks) + f2 * s1fac * src1(is,js  ,ks)
+     $     + f3 * s1fac * src1(is,js+1,ks) + f4 * s1fac * src1(is,js+2,ks)
+     $     + f1 * s2fac * src2(is,js-1,ks) + f2 * s2fac * src2(is,js  ,ks)
+     $     + f3 * s2fac * src2(is,js+1,ks) + f4 * s2fac * src2(is,js+2,ks)
+     $     + f1 * s3fac * src3(is,js-1,ks) + f2 * s3fac * src3(is,js  ,ks)
+     $     + f3 * s3fac * src3(is,js+1,ks) + f4 * s3fac * src3(is,js+2,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks, 4,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is-1,js-1,ks)
+     $     + f2*f1 * s1fac * src1(is  ,js-1,ks)
+     $     + f3*f1 * s1fac * src1(is+1,js-1,ks)
+     $     + f4*f1 * s1fac * src1(is+2,js-1,ks)
+     $     + f1*f2 * s1fac * src1(is-1,js  ,ks)
+     $     + f2*f2 * s1fac * src1(is  ,js  ,ks)
+     $     + f3*f2 * s1fac * src1(is+1,js  ,ks)
+     $     + f4*f2 * s1fac * src1(is+2,js  ,ks)
+     $     + f1*f3 * s1fac * src1(is-1,js+1,ks)
+     $     + f2*f3 * s1fac * src1(is  ,js+1,ks)
+     $     + f3*f3 * s1fac * src1(is+1,js+1,ks)
+     $     + f4*f3 * s1fac * src1(is+2,js+1,ks)
+     $     + f1*f4 * s1fac * src1(is-1,js+2,ks)
+     $     + f2*f4 * s1fac * src1(is  ,js+2,ks)
+     $     + f3*f4 * s1fac * src1(is+1,js+2,ks)
+     $     + f4*f4 * s1fac * src1(is+2,js+2,ks)
+     $     
+     $     + f1*f1 * s2fac * src2(is-1,js-1,ks)
+     $     + f2*f1 * s2fac * src2(is  ,js-1,ks)
+     $     + f3*f1 * s2fac * src2(is+1,js-1,ks)
+     $     + f4*f1 * s2fac * src2(is+2,js-1,ks)
+     $     + f1*f2 * s2fac * src2(is-1,js  ,ks)
+     $     + f2*f2 * s2fac * src2(is  ,js  ,ks)
+     $     + f3*f2 * s2fac * src2(is+1,js  ,ks)
+     $     + f4*f2 * s2fac * src2(is+2,js  ,ks)
+     $     + f1*f3 * s2fac * src2(is-1,js+1,ks)
+     $     + f2*f3 * s2fac * src2(is  ,js+1,ks)
+     $     + f3*f3 * s2fac * src2(is+1,js+1,ks)
+     $     + f4*f3 * s2fac * src2(is+2,js+1,ks)
+     $     + f1*f4 * s2fac * src2(is-1,js+2,ks)
+     $     + f2*f4 * s2fac * src2(is  ,js+2,ks)
+     $     + f3*f4 * s2fac * src2(is+1,js+2,ks)
+     $     + f4*f4 * s2fac * src2(is+2,js+2,ks)
+     $     
+     $     + f1*f1 * s3fac * src3(is-1,js-1,ks)
+     $     + f2*f1 * s3fac * src3(is  ,js-1,ks)
+     $     + f3*f1 * s3fac * src3(is+1,js-1,ks)
+     $     + f4*f1 * s3fac * src3(is+2,js-1,ks)
+     $     + f1*f2 * s3fac * src3(is-1,js  ,ks)
+     $     + f2*f2 * s3fac * src3(is  ,js  ,ks)
+     $     + f3*f2 * s3fac * src3(is+1,js  ,ks)
+     $     + f4*f2 * s3fac * src3(is+2,js  ,ks)
+     $     + f1*f3 * s3fac * src3(is-1,js+1,ks)
+     $     + f2*f3 * s3fac * src3(is  ,js+1,ks)
+     $     + f3*f3 * s3fac * src3(is+1,js+1,ks)
+     $     + f4*f3 * s3fac * src3(is+2,js+1,ks)
+     $     + f1*f4 * s3fac * src3(is-1,js+2,ks)
+     $     + f2*f4 * s3fac * src3(is  ,js+2,ks)
+     $     + f3*f4 * s3fac * src3(is+1,js+2,ks)
+     $     + f4*f4 * s3fac * src3(is+2,js+2,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks-1, 1,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * s1fac * src1(is,js,ks-1) + f2 * s1fac * src1(is,js,ks  )
+     $     + f3 * s1fac * src1(is,js,ks+1) + f4 * s1fac * src1(is,js,ks+2)
+     $     + f1 * s2fac * src2(is,js,ks-1) + f2 * s2fac * src2(is,js,ks  )
+     $     + f3 * s2fac * src2(is,js,ks+1) + f4 * s2fac * src2(is,js,ks+2)
+     $     + f1 * s3fac * src3(is,js,ks-1) + f2 * s3fac * src3(is,js,ks  )
+     $     + f3 * s3fac * src3(is,js,ks+1) + f4 * s3fac * src3(is,js,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks-1, 4,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is-1,js,ks-1)
+     $     + f2*f1 * s1fac * src1(is  ,js,ks-1)
+     $     + f3*f1 * s1fac * src1(is+1,js,ks-1)
+     $     + f4*f1 * s1fac * src1(is+2,js,ks-1)
+     $     + f1*f2 * s1fac * src1(is-1,js,ks  )
+     $     + f2*f2 * s1fac * src1(is  ,js,ks  )
+     $     + f3*f2 * s1fac * src1(is+1,js,ks  )
+     $     + f4*f2 * s1fac * src1(is+2,js,ks  )
+     $     + f1*f3 * s1fac * src1(is-1,js,ks+1)
+     $     + f2*f3 * s1fac * src1(is  ,js,ks+1)
+     $     + f3*f3 * s1fac * src1(is+1,js,ks+1)
+     $     + f4*f3 * s1fac * src1(is+2,js,ks+1)
+     $     + f1*f4 * s1fac * src1(is-1,js,ks+2)
+     $     + f2*f4 * s1fac * src1(is  ,js,ks+2)
+     $     + f3*f4 * s1fac * src1(is+1,js,ks+2)
+     $     + f4*f4 * s1fac * src1(is+2,js,ks+2)
+     $     
+     $     + f1*f1 * s2fac * src2(is-1,js,ks-1)
+     $     + f2*f1 * s2fac * src2(is  ,js,ks-1)
+     $     + f3*f1 * s2fac * src2(is+1,js,ks-1)
+     $     + f4*f1 * s2fac * src2(is+2,js,ks-1)
+     $     + f1*f2 * s2fac * src2(is-1,js,ks  )
+     $     + f2*f2 * s2fac * src2(is  ,js,ks  )
+     $     + f3*f2 * s2fac * src2(is+1,js,ks  )
+     $     + f4*f2 * s2fac * src2(is+2,js,ks  )
+     $     + f1*f3 * s2fac * src2(is-1,js,ks+1)
+     $     + f2*f3 * s2fac * src2(is  ,js,ks+1)
+     $     + f3*f3 * s2fac * src2(is+1,js,ks+1)
+     $     + f4*f3 * s2fac * src2(is+2,js,ks+1)
+     $     + f1*f4 * s2fac * src2(is-1,js,ks+2)
+     $     + f2*f4 * s2fac * src2(is  ,js,ks+2)
+     $     + f3*f4 * s2fac * src2(is+1,js,ks+2)
+     $     + f4*f4 * s2fac * src2(is+2,js,ks+2)
+     $     
+     $     + f1*f1 * s3fac * src3(is-1,js,ks-1)
+     $     + f2*f1 * s3fac * src3(is  ,js,ks-1)
+     $     + f3*f1 * s3fac * src3(is+1,js,ks-1)
+     $     + f4*f1 * s3fac * src3(is+2,js,ks-1)
+     $     + f1*f2 * s3fac * src3(is-1,js,ks  )
+     $     + f2*f2 * s3fac * src3(is  ,js,ks  )
+     $     + f3*f2 * s3fac * src3(is+1,js,ks  )
+     $     + f4*f2 * s3fac * src3(is+2,js,ks  )
+     $     + f1*f3 * s3fac * src3(is-1,js,ks+1)
+     $     + f2*f3 * s3fac * src3(is  ,js,ks+1)
+     $     + f3*f3 * s3fac * src3(is+1,js,ks+1)
+     $     + f4*f3 * s3fac * src3(is+2,js,ks+1)
+     $     + f1*f4 * s3fac * src3(is-1,js,ks+2)
+     $     + f2*f4 * s3fac * src3(is  ,js,ks+2)
+     $     + f3*f4 * s3fac * src3(is+1,js,ks+2)
+     $     + f4*f4 * s3fac * src3(is+2,js,ks+2)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks-1, 1,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * s1fac * src1(is,js-1,ks-1)
+     $     + f2*f1 * s1fac * src1(is,js  ,ks-1)
+     $     + f3*f1 * s1fac * src1(is,js+1,ks-1)
+     $     + f4*f1 * s1fac * src1(is,js+2,ks-1)
+     $     + f1*f2 * s1fac * src1(is,js-1,ks  )
+     $     + f2*f2 * s1fac * src1(is,js  ,ks  )
+     $     + f3*f2 * s1fac * src1(is,js+1,ks  )
+     $     + f4*f2 * s1fac * src1(is,js+2,ks  )
+     $     + f1*f3 * s1fac * src1(is,js-1,ks+1)
+     $     + f2*f3 * s1fac * src1(is,js  ,ks+1)
+     $     + f3*f3 * s1fac * src1(is,js+1,ks+1)
+     $     + f4*f3 * s1fac * src1(is,js+2,ks+1)
+     $     + f1*f4 * s1fac * src1(is,js-1,ks+2)
+     $     + f2*f4 * s1fac * src1(is,js  ,ks+2)
+     $     + f3*f4 * s1fac * src1(is,js+1,ks+2)
+     $     + f4*f4 * s1fac * src1(is,js+2,ks+2)
+     $     
+     $     + f1*f1 * s2fac * src2(is,js-1,ks-1)
+     $     + f2*f1 * s2fac * src2(is,js  ,ks-1)
+     $     + f3*f1 * s2fac * src2(is,js+1,ks-1)
+     $     + f4*f1 * s2fac * src2(is,js+2,ks-1)
+     $     + f1*f2 * s2fac * src2(is,js-1,ks  )
+     $     + f2*f2 * s2fac * src2(is,js  ,ks  )
+     $     + f3*f2 * s2fac * src2(is,js+1,ks  )
+     $     + f4*f2 * s2fac * src2(is,js+2,ks  )
+     $     + f1*f3 * s2fac * src2(is,js-1,ks+1)
+     $     + f2*f3 * s2fac * src2(is,js  ,ks+1)
+     $     + f3*f3 * s2fac * src2(is,js+1,ks+1)
+     $     + f4*f3 * s2fac * src2(is,js+2,ks+1)
+     $     + f1*f4 * s2fac * src2(is,js-1,ks+2)
+     $     + f2*f4 * s2fac * src2(is,js  ,ks+2)
+     $     + f3*f4 * s2fac * src2(is,js+1,ks+2)
+     $     + f4*f4 * s2fac * src2(is,js+2,ks+2)
+     $     
+     $     + f1*f1 * s3fac * src3(is,js-1,ks-1)
+     $     + f2*f1 * s3fac * src3(is,js  ,ks-1)
+     $     + f3*f1 * s3fac * src3(is,js+1,ks-1)
+     $     + f4*f1 * s3fac * src3(is,js+2,ks-1)
+     $     + f1*f2 * s3fac * src3(is,js-1,ks  )
+     $     + f2*f2 * s3fac * src3(is,js  ,ks  )
+     $     + f3*f2 * s3fac * src3(is,js+1,ks  )
+     $     + f4*f2 * s3fac * src3(is,js+2,ks  )
+     $     + f1*f3 * s3fac * src3(is,js-1,ks+1)
+     $     + f2*f3 * s3fac * src3(is,js  ,ks+1)
+     $     + f3*f3 * s3fac * src3(is,js+1,ks+1)
+     $     + f4*f3 * s3fac * src3(is,js+2,ks+1)
+     $     + f1*f4 * s3fac * src3(is,js-1,ks+2)
+     $     + f2*f4 * s3fac * src3(is,js  ,ks+2)
+     $     + f3*f4 * s3fac * src3(is,js+1,ks+2)
+     $     + f4*f4 * s3fac * src3(is,js+2,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks-1, 4,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      res1 =
+     $     + f1*f1*f1 * s1fac * src1(is-1,js-1,ks-1)
+     $     + f2*f1*f1 * s1fac * src1(is  ,js-1,ks-1)
+     $     + f3*f1*f1 * s1fac * src1(is+1,js-1,ks-1)
+     $     + f4*f1*f1 * s1fac * src1(is+2,js-1,ks-1)
+     $     + f1*f2*f1 * s1fac * src1(is-1,js  ,ks-1)
+     $     + f2*f2*f1 * s1fac * src1(is  ,js  ,ks-1)
+     $     + f3*f2*f1 * s1fac * src1(is+1,js  ,ks-1)
+     $     + f4*f2*f1 * s1fac * src1(is+2,js  ,ks-1)
+     $     + f1*f3*f1 * s1fac * src1(is-1,js+1,ks-1)
+     $     + f2*f3*f1 * s1fac * src1(is  ,js+1,ks-1)
+     $     + f3*f3*f1 * s1fac * src1(is+1,js+1,ks-1)
+     $     + f4*f3*f1 * s1fac * src1(is+2,js+1,ks-1)
+     $     + f1*f4*f1 * s1fac * src1(is-1,js+2,ks-1)
+     $     + f2*f4*f1 * s1fac * src1(is  ,js+2,ks-1)
+     $     + f3*f4*f1 * s1fac * src1(is+1,js+2,ks-1)
+     $     + f4*f4*f1 * s1fac * src1(is+2,js+2,ks-1)
+     $     
+     $     + f1*f1*f2 * s1fac * src1(is-1,js-1,ks  )
+     $     + f2*f1*f2 * s1fac * src1(is  ,js-1,ks  )
+     $     + f3*f1*f2 * s1fac * src1(is+1,js-1,ks  )
+     $     + f4*f1*f2 * s1fac * src1(is+2,js-1,ks  )
+     $     + f1*f2*f2 * s1fac * src1(is-1,js  ,ks  )
+     $     + f2*f2*f2 * s1fac * src1(is  ,js  ,ks  )
+     $     + f3*f2*f2 * s1fac * src1(is+1,js  ,ks  )
+     $     + f4*f2*f2 * s1fac * src1(is+2,js  ,ks  )
+     $     + f1*f3*f2 * s1fac * src1(is-1,js+1,ks  )
+     $     + f2*f3*f2 * s1fac * src1(is  ,js+1,ks  )
+     $     + f3*f3*f2 * s1fac * src1(is+1,js+1,ks  )
+     $     + f4*f3*f2 * s1fac * src1(is+2,js+1,ks  )
+     $     + f1*f4*f2 * s1fac * src1(is-1,js+2,ks  )
+     $     + f2*f4*f2 * s1fac * src1(is  ,js+2,ks  )
+     $     + f3*f4*f2 * s1fac * src1(is+1,js+2,ks  )
+     $     + f4*f4*f2 * s1fac * src1(is+2,js+2,ks  )
+     $     
+     $     + f1*f1*f3 * s1fac * src1(is-1,js-1,ks+1)
+     $     + f2*f1*f3 * s1fac * src1(is  ,js-1,ks+1)
+     $     + f3*f1*f3 * s1fac * src1(is+1,js-1,ks+1)
+     $     + f4*f1*f3 * s1fac * src1(is+2,js-1,ks+1)
+     $     + f1*f2*f3 * s1fac * src1(is-1,js  ,ks+1)
+     $     + f2*f2*f3 * s1fac * src1(is  ,js  ,ks+1)
+     $     + f3*f2*f3 * s1fac * src1(is+1,js  ,ks+1)
+     $     + f4*f2*f3 * s1fac * src1(is+2,js  ,ks+1)
+     $     + f1*f3*f3 * s1fac * src1(is-1,js+1,ks+1)
+     $     + f2*f3*f3 * s1fac * src1(is  ,js+1,ks+1)
+     $     + f3*f3*f3 * s1fac * src1(is+1,js+1,ks+1)
+     $     + f4*f3*f3 * s1fac * src1(is+2,js+1,ks+1)
+     $     + f1*f4*f3 * s1fac * src1(is-1,js+2,ks+1)
+     $     + f2*f4*f3 * s1fac * src1(is  ,js+2,ks+1)
+     $     + f3*f4*f3 * s1fac * src1(is+1,js+2,ks+1)
+     $     + f4*f4*f3 * s1fac * src1(is+2,js+2,ks+1)
+     $     
+     $     + f1*f1*f4 * s1fac * src1(is-1,js-1,ks+2)
+     $     + f2*f1*f4 * s1fac * src1(is  ,js-1,ks+2)
+     $     + f3*f1*f4 * s1fac * src1(is+1,js-1,ks+2)
+     $     + f4*f1*f4 * s1fac * src1(is+2,js-1,ks+2)
+     $     + f1*f2*f4 * s1fac * src1(is-1,js  ,ks+2)
+     $     + f2*f2*f4 * s1fac * src1(is  ,js  ,ks+2)
+     $     + f3*f2*f4 * s1fac * src1(is+1,js  ,ks+2)
+     $     + f4*f2*f4 * s1fac * src1(is+2,js  ,ks+2)
+     $     + f1*f3*f4 * s1fac * src1(is-1,js+1,ks+2)
+     $     + f2*f3*f4 * s1fac * src1(is  ,js+1,ks+2)
+     $     + f3*f3*f4 * s1fac * src1(is+1,js+1,ks+2)
+     $     + f4*f3*f4 * s1fac * src1(is+2,js+1,ks+2)
+     $     + f1*f4*f4 * s1fac * src1(is-1,js+2,ks+2)
+     $     + f2*f4*f4 * s1fac * src1(is  ,js+2,ks+2)
+     $     + f3*f4*f4 * s1fac * src1(is+1,js+2,ks+2)
+     $     + f4*f4*f4 * s1fac * src1(is+2,js+2,ks+2)
+      res2 =
+     $     + f1*f1*f1 * s2fac * src2(is-1,js-1,ks-1)
+     $     + f2*f1*f1 * s2fac * src2(is  ,js-1,ks-1)
+     $     + f3*f1*f1 * s2fac * src2(is+1,js-1,ks-1)
+     $     + f4*f1*f1 * s2fac * src2(is+2,js-1,ks-1)
+     $     + f1*f2*f1 * s2fac * src2(is-1,js  ,ks-1)
+     $     + f2*f2*f1 * s2fac * src2(is  ,js  ,ks-1)
+     $     + f3*f2*f1 * s2fac * src2(is+1,js  ,ks-1)
+     $     + f4*f2*f1 * s2fac * src2(is+2,js  ,ks-1)
+     $     + f1*f3*f1 * s2fac * src2(is-1,js+1,ks-1)
+     $     + f2*f3*f1 * s2fac * src2(is  ,js+1,ks-1)
+     $     + f3*f3*f1 * s2fac * src2(is+1,js+1,ks-1)
+     $     + f4*f3*f1 * s2fac * src2(is+2,js+1,ks-1)
+     $     + f1*f4*f1 * s2fac * src2(is-1,js+2,ks-1)
+     $     + f2*f4*f1 * s2fac * src2(is  ,js+2,ks-1)
+     $     + f3*f4*f1 * s2fac * src2(is+1,js+2,ks-1)
+     $     + f4*f4*f1 * s2fac * src2(is+2,js+2,ks-1)
+     $     
+     $     + f1*f1*f2 * s2fac * src2(is-1,js-1,ks  )
+     $     + f2*f1*f2 * s2fac * src2(is  ,js-1,ks  )
+     $     + f3*f1*f2 * s2fac * src2(is+1,js-1,ks  )
+     $     + f4*f1*f2 * s2fac * src2(is+2,js-1,ks  )
+     $     + f1*f2*f2 * s2fac * src2(is-1,js  ,ks  )
+     $     + f2*f2*f2 * s2fac * src2(is  ,js  ,ks  )
+     $     + f3*f2*f2 * s2fac * src2(is+1,js  ,ks  )
+     $     + f4*f2*f2 * s2fac * src2(is+2,js  ,ks  )
+     $     + f1*f3*f2 * s2fac * src2(is-1,js+1,ks  )
+     $     + f2*f3*f2 * s2fac * src2(is  ,js+1,ks  )
+     $     + f3*f3*f2 * s2fac * src2(is+1,js+1,ks  )
+     $     + f4*f3*f2 * s2fac * src2(is+2,js+1,ks  )
+     $     + f1*f4*f2 * s2fac * src2(is-1,js+2,ks  )
+     $     + f2*f4*f2 * s2fac * src2(is  ,js+2,ks  )
+     $     + f3*f4*f2 * s2fac * src2(is+1,js+2,ks  )
+     $     + f4*f4*f2 * s2fac * src2(is+2,js+2,ks  )
+     $     
+     $     + f1*f1*f3 * s2fac * src2(is-1,js-1,ks+1)
+     $     + f2*f1*f3 * s2fac * src2(is  ,js-1,ks+1)
+     $     + f3*f1*f3 * s2fac * src2(is+1,js-1,ks+1)
+     $     + f4*f1*f3 * s2fac * src2(is+2,js-1,ks+1)
+     $     + f1*f2*f3 * s2fac * src2(is-1,js  ,ks+1)
+     $     + f2*f2*f3 * s2fac * src2(is  ,js  ,ks+1)
+     $     + f3*f2*f3 * s2fac * src2(is+1,js  ,ks+1)
+     $     + f4*f2*f3 * s2fac * src2(is+2,js  ,ks+1)
+     $     + f1*f3*f3 * s2fac * src2(is-1,js+1,ks+1)
+     $     + f2*f3*f3 * s2fac * src2(is  ,js+1,ks+1)
+     $     + f3*f3*f3 * s2fac * src2(is+1,js+1,ks+1)
+     $     + f4*f3*f3 * s2fac * src2(is+2,js+1,ks+1)
+     $     + f1*f4*f3 * s2fac * src2(is-1,js+2,ks+1)
+     $     + f2*f4*f3 * s2fac * src2(is  ,js+2,ks+1)
+     $     + f3*f4*f3 * s2fac * src2(is+1,js+2,ks+1)
+     $     + f4*f4*f3 * s2fac * src2(is+2,js+2,ks+1)
+     $     
+     $     + f1*f1*f4 * s2fac * src2(is-1,js-1,ks+2)
+     $     + f2*f1*f4 * s2fac * src2(is  ,js-1,ks+2)
+     $     + f3*f1*f4 * s2fac * src2(is+1,js-1,ks+2)
+     $     + f4*f1*f4 * s2fac * src2(is+2,js-1,ks+2)
+     $     + f1*f2*f4 * s2fac * src2(is-1,js  ,ks+2)
+     $     + f2*f2*f4 * s2fac * src2(is  ,js  ,ks+2)
+     $     + f3*f2*f4 * s2fac * src2(is+1,js  ,ks+2)
+     $     + f4*f2*f4 * s2fac * src2(is+2,js  ,ks+2)
+     $     + f1*f3*f4 * s2fac * src2(is-1,js+1,ks+2)
+     $     + f2*f3*f4 * s2fac * src2(is  ,js+1,ks+2)
+     $     + f3*f3*f4 * s2fac * src2(is+1,js+1,ks+2)
+     $     + f4*f3*f4 * s2fac * src2(is+2,js+1,ks+2)
+     $     + f1*f4*f4 * s2fac * src2(is-1,js+2,ks+2)
+     $     + f2*f4*f4 * s2fac * src2(is  ,js+2,ks+2)
+     $     + f3*f4*f4 * s2fac * src2(is+1,js+2,ks+2)
+     $     + f4*f4*f4 * s2fac * src2(is+2,js+2,ks+2)
+      res3 =
+     $     + f1*f1*f1 * s3fac * src3(is-1,js-1,ks-1)
+     $     + f2*f1*f1 * s3fac * src3(is  ,js-1,ks-1)
+     $     + f3*f1*f1 * s3fac * src3(is+1,js-1,ks-1)
+     $     + f4*f1*f1 * s3fac * src3(is+2,js-1,ks-1)
+     $     + f1*f2*f1 * s3fac * src3(is-1,js  ,ks-1)
+     $     + f2*f2*f1 * s3fac * src3(is  ,js  ,ks-1)
+     $     + f3*f2*f1 * s3fac * src3(is+1,js  ,ks-1)
+     $     + f4*f2*f1 * s3fac * src3(is+2,js  ,ks-1)
+     $     + f1*f3*f1 * s3fac * src3(is-1,js+1,ks-1)
+     $     + f2*f3*f1 * s3fac * src3(is  ,js+1,ks-1)
+     $     + f3*f3*f1 * s3fac * src3(is+1,js+1,ks-1)
+     $     + f4*f3*f1 * s3fac * src3(is+2,js+1,ks-1)
+     $     + f1*f4*f1 * s3fac * src3(is-1,js+2,ks-1)
+     $     + f2*f4*f1 * s3fac * src3(is  ,js+2,ks-1)
+     $     + f3*f4*f1 * s3fac * src3(is+1,js+2,ks-1)
+     $     + f4*f4*f1 * s3fac * src3(is+2,js+2,ks-1)
+     $     
+     $     + f1*f1*f2 * s3fac * src3(is-1,js-1,ks  )
+     $     + f2*f1*f2 * s3fac * src3(is  ,js-1,ks  )
+     $     + f3*f1*f2 * s3fac * src3(is+1,js-1,ks  )
+     $     + f4*f1*f2 * s3fac * src3(is+2,js-1,ks  )
+     $     + f1*f2*f2 * s3fac * src3(is-1,js  ,ks  )
+     $     + f2*f2*f2 * s3fac * src3(is  ,js  ,ks  )
+     $     + f3*f2*f2 * s3fac * src3(is+1,js  ,ks  )
+     $     + f4*f2*f2 * s3fac * src3(is+2,js  ,ks  )
+     $     + f1*f3*f2 * s3fac * src3(is-1,js+1,ks  )
+     $     + f2*f3*f2 * s3fac * src3(is  ,js+1,ks  )
+     $     + f3*f3*f2 * s3fac * src3(is+1,js+1,ks  )
+     $     + f4*f3*f2 * s3fac * src3(is+2,js+1,ks  )
+     $     + f1*f4*f2 * s3fac * src3(is-1,js+2,ks  )
+     $     + f2*f4*f2 * s3fac * src3(is  ,js+2,ks  )
+     $     + f3*f4*f2 * s3fac * src3(is+1,js+2,ks  )
+     $     + f4*f4*f2 * s3fac * src3(is+2,js+2,ks  )
+     $     
+     $     + f1*f1*f3 * s3fac * src3(is-1,js-1,ks+1)
+     $     + f2*f1*f3 * s3fac * src3(is  ,js-1,ks+1)
+     $     + f3*f1*f3 * s3fac * src3(is+1,js-1,ks+1)
+     $     + f4*f1*f3 * s3fac * src3(is+2,js-1,ks+1)
+     $     + f1*f2*f3 * s3fac * src3(is-1,js  ,ks+1)
+     $     + f2*f2*f3 * s3fac * src3(is  ,js  ,ks+1)
+     $     + f3*f2*f3 * s3fac * src3(is+1,js  ,ks+1)
+     $     + f4*f2*f3 * s3fac * src3(is+2,js  ,ks+1)
+     $     + f1*f3*f3 * s3fac * src3(is-1,js+1,ks+1)
+     $     + f2*f3*f3 * s3fac * src3(is  ,js+1,ks+1)
+     $     + f3*f3*f3 * s3fac * src3(is+1,js+1,ks+1)
+     $     + f4*f3*f3 * s3fac * src3(is+2,js+1,ks+1)
+     $     + f1*f4*f3 * s3fac * src3(is-1,js+2,ks+1)
+     $     + f2*f4*f3 * s3fac * src3(is  ,js+2,ks+1)
+     $     + f3*f4*f3 * s3fac * src3(is+1,js+2,ks+1)
+     $     + f4*f4*f3 * s3fac * src3(is+2,js+2,ks+1)
+     $     
+     $     + f1*f1*f4 * s3fac * src3(is-1,js-1,ks+2)
+     $     + f2*f1*f4 * s3fac * src3(is  ,js-1,ks+2)
+     $     + f3*f1*f4 * s3fac * src3(is+1,js-1,ks+2)
+     $     + f4*f1*f4 * s3fac * src3(is+2,js-1,ks+2)
+     $     + f1*f2*f4 * s3fac * src3(is-1,js  ,ks+2)
+     $     + f2*f2*f4 * s3fac * src3(is  ,js  ,ks+2)
+     $     + f3*f2*f4 * s3fac * src3(is+1,js  ,ks+2)
+     $     + f4*f2*f4 * s3fac * src3(is+2,js  ,ks+2)
+     $     + f1*f3*f4 * s3fac * src3(is-1,js+1,ks+2)
+     $     + f2*f3*f4 * s3fac * src3(is  ,js+1,ks+2)
+     $     + f3*f3*f4 * s3fac * src3(is+1,js+1,ks+2)
+     $     + f4*f3*f4 * s3fac * src3(is+2,js+1,ks+2)
+     $     + f1*f4*f4 * s3fac * src3(is-1,js+2,ks+2)
+     $     + f2*f4*f4 * s3fac * src3(is  ,js+2,ks+2)
+     $     + f3*f4*f4 * s3fac * src3(is+1,js+2,ks+2)
+     $     + f4*f4*f4 * s3fac * src3(is+2,js+2,ks+2)
+      dst(id,jd,kd) = res1 + res2 + res3
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77
new file mode 100644
index 000000000..28f8c155f
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77
@@ -0,0 +1,230 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_o5.F77,v 1.3 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_3tl_o5 (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(6), jfac(6), kfac(6)
+      integer ii, jj, kk
+      CCTK_REAL8 fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+c     Loop over fine region
+c     (This expression cannot be evaluated as integer)
+      dstdiv = one / (120*dstifac**5) / (120*dstjfac**5) / (120*dstkfac**5)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk+  dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (- 1)
+         kfac(2) = (fk+2*dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (  5)
+         kfac(3) = (fk+2*dstkfac) * (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (-10)
+         kfac(4) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (fk-3*dstkfac) * ( 10)
+         kfac(5) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-3*dstkfac) * (- 5)
+         kfac(6) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-2*dstkfac) * (  1)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj+  dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (- 1)
+            jfac(2) = (fj+2*dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (  5)
+            jfac(3) = (fj+2*dstjfac) * (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (-10)
+            jfac(4) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (fj-3*dstjfac) * ( 10)
+            jfac(5) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-3*dstjfac) * (- 5)
+            jfac(6) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-2*dstjfac) * (  1)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi+  dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (- 1)
+               ifac(2) = (fi+2*dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (  5)
+               ifac(3) = (fi+2*dstifac) * (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (-10)
+               ifac(4) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (fi-3*dstifac) * ( 10)
+               ifac(5) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-3*dstifac) * (- 5)
+               ifac(6) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-2*dstifac) * (  1)
+               
+               res = 0
+               
+               do kk=1,6
+                  do jj=1,6
+                     do ii=1,6
+                        
+                        if (ifac(ii).ne.0 .and. jfac(jj).ne.0 .and. kfac(kk).ne.0) then
+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")
+                           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)
+     $                          + fac * s3fac * src3(i0+ii-2, j0+jj-2, k0+kk-2)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_rf2.F77
new file mode 100644
index 000000000..a77498fef
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_rf2.F77
@@ -0,0 +1,430 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_3tl_rf2.F77,v 1.3 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_3tl_rf2 (
+     $     src1, t1, src2, t2, src3, t3, srciext, srcjext, srckext,
+     $     dst, t, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 eps
+      parameter (eps = 1.0d-10)
+      
+      CCTK_REAL8 one, half, fourth, eighth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src1(srciext,srcjext,srckext)
+      CCTK_REAL8 t1
+      CCTK_REAL8 src2(srciext,srcjext,srckext)
+      CCTK_REAL8 t2
+      CCTK_REAL8 src3(srciext,srcjext,srckext)
+      CCTK_REAL8 t3
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Quadratic (second order) time interpolation
+      if (t1.eq.t2 .or. t1.eq.t3 .or. t2.eq.t3) then
+         call CCTK_WARN (0, "Internal error: arrays have same time")
+      end if
+      if (t.lt.min(t1,t2,t3)-eps .or. t.gt.max(t1,t2,t3)+eps) then
+         call CCTK_WARN (0, "Internal error: extrapolation in time")
+      end if
+      
+      s1fac = (t - t2) * (t - t3) / ((t1 - t2) * (t1 - t3))
+      s2fac = (t - t1) * (t - t3) / ((t2 - t1) * (t2 - t3))
+      s3fac = (t - t1) * (t - t2) / ((t3 - t1) * (t3 - t2))
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + s1fac * src1(is,js,ks)
+     $     + s2fac * src2(is,js,ks)
+     $     + s3fac * src3(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is+1,js,ks)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is+1,js,ks)
+     $     + half * s3fac * src3(is,js,ks) + half * s3fac * src3(is+1,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is,js+1,ks)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is,js+1,ks)
+     $     + half * s3fac * src3(is,js,ks) + half * s3fac * src3(is,js+1,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $              + fourth * s1fac * src1(is,js,ks)
+     $              + fourth * s1fac * src1(is+1,js,ks)
+     $              + fourth * s1fac * src1(is,js+1,ks)
+     $              + fourth * s1fac * src1(is+1,js+1,ks)
+     $              + fourth * s2fac * src2(is,js,ks)
+     $              + fourth * s2fac * src2(is+1,js,ks)
+     $              + fourth * s2fac * src2(is,js+1,ks)
+     $              + fourth * s2fac * src2(is+1,js+1,ks)
+     $              + fourth * s3fac * src3(is,js,ks)
+     $              + fourth * s3fac * src3(is+1,js,ks)
+     $              + fourth * s3fac * src3(is,js+1,ks)
+     $              + fourth * s3fac * src3(is+1,js+1,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + half * s1fac * src1(is,js,ks) + half * s1fac * src1(is,js,ks+1)
+     $     + half * s2fac * src2(is,js,ks) + half * s2fac * src2(is,js,ks+1)
+     $     + half * s3fac * src3(is,js,ks) + half * s3fac * src3(is,js,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * s1fac * src1(is,js,ks)
+     $     + fourth * s1fac * src1(is+1,js,ks)
+     $     + fourth * s1fac * src1(is,js,ks+1)
+     $     + fourth * s1fac * src1(is+1,js,ks+1)
+     $     + fourth * s2fac * src1(is,js,ks)
+     $     + fourth * s2fac * src2(is+1,js,ks)
+     $     + fourth * s2fac * src2(is,js,ks+1)
+     $     + fourth * s2fac * src2(is+1,js,ks+1)
+     $     + fourth * s3fac * src3(is,js,ks)
+     $     + fourth * s3fac * src3(is+1,js,ks)
+     $     + fourth * s3fac * src3(is,js,ks+1)
+     $     + fourth * s3fac * src3(is+1,js,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * s1fac * src1(is,js,ks)
+     $     + fourth * s1fac * src1(is,js+1,ks)
+     $     + fourth * s1fac * src1(is,js,ks+1)
+     $     + fourth * s1fac * src1(is,js+1,ks+1)
+     $     + fourth * s2fac * src2(is,js,ks)
+     $     + fourth * s2fac * src2(is,js+1,ks)
+     $     + fourth * s2fac * src2(is,js,ks+1)
+     $     + fourth * s2fac * src2(is,js+1,ks+1)
+     $     + fourth * s3fac * src3(is,js,ks)
+     $     + fourth * s3fac * src3(is,js+1,ks)
+     $     + fourth * s3fac * src3(is,js,ks+1)
+     $     + fourth * s3fac * src3(is,js+1,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + eighth * s1fac * src1(is,js,ks)
+     $     + eighth * s1fac * src1(is+1,js,ks)
+     $     + eighth * s1fac * src1(is,js+1,ks)
+     $     + eighth * s1fac * src1(is+1,js+1,ks)
+     $     + eighth * s1fac * src1(is,js,ks+1)
+     $     + eighth * s1fac * src1(is+1,js,ks+1)
+     $     + eighth * s1fac * src1(is,js+1,ks+1)
+     $     + eighth * s1fac * src1(is+1,js+1,ks+1)
+     $     
+     $     + eighth * s2fac * src2(is,js,ks)
+     $     + eighth * s2fac * src2(is+1,js,ks)
+     $     + eighth * s2fac * src2(is,js+1,ks)
+     $     + eighth * s2fac * src2(is+1,js+1,ks)
+     $     + eighth * s2fac * src2(is,js,ks+1)
+     $     + eighth * s2fac * src2(is+1,js,ks+1)
+     $     + eighth * s2fac * src2(is,js+1,ks+1)
+     $     + eighth * s2fac * src2(is+1,js+1,ks+1)
+     $     
+     $     + eighth * s3fac * src3(is,js,ks)
+     $     + eighth * s3fac * src3(is+1,js,ks)
+     $     + eighth * s3fac * src3(is,js+1,ks)
+     $     + eighth * s3fac * src3(is+1,js+1,ks)
+     $     + eighth * s3fac * src3(is,js,ks+1)
+     $     + eighth * s3fac * src3(is+1,js,ks+1)
+     $     + eighth * s3fac * src3(is,js+1,ks+1)
+     $     + eighth * s3fac * src3(is+1,js+1,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_eno.F90 b/Carpet/CarpetLib/src/prolongate_3d_real8_eno.F90
new file mode 100644
index 000000000..573b279ae
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_eno.F90
@@ -0,0 +1,299 @@
+!!$     -*-Fortran-*-
+!!$     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_eno.F90,v 1.1 2004/03/03 15:30:40 hawke Exp $
+
+#include "cctk.h"
+
+
+!!$ This routine performs "ENO" prolongation. It is intended to be used 
+!!$ with GFs that are not expected to be smooth, particularly those
+!!$ that must also obey certain constraints. The obvious example is the 
+!!$ density in hydrodynamics, which may be discontinuous yet must be
+!!$ strictly positive.
+!!$
+!!$ To ensure that this prolongation method is used you should add the
+!!$ tag
+!!$
+!!$      tags='Prolongation="ENO"'
+!!$
+!!$ to the interface.ccl on the appropriate group.
+!!$
+!!$ This applies ENO2 type limiting to the slope, checking over the
+!!$ entire coarse grid cell for the least oscillatory quadratic in each 
+!!$ direction. If the slope changes sign over the extrema, linear
+!!$ interpolation is used instead.
+!!$
+!!$ The actual eno1d function is defined in the routine
+!!$
+!!$      prolongate_3d_real8_eno.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(1:len_trim(msg)))                           &&\
+end if
+
+function eno1d(q)
+  
+  implicit none
+
+  CCTK_REAL8 :: eno1d
+  CCTK_REAL8 :: q(4)
+  CCTK_REAL8 :: zero, one, two, three, six, half, eighth
+  parameter (zero = 0)
+  parameter (two = 2)
+  parameter (one = 1)
+  parameter (three = 3)
+  parameter (six = 6)
+  parameter (eighth = one / 8)
+  parameter (half = one / two)
+  CCTK_REAL8 :: diffleft, diffright
+
+!!$  Directly find the second undivided differences
+
+  diffleft  = q(1) + q(3) - two * q(2)
+  diffright = q(2) + q(4) - two * q(3)
+
+  if ( abs(diffleft) .lt. abs(diffright) ) then
+
+!!$      Apply the left quadratic
+
+    eno1d = eighth * (-q(1) + six * q(2) + three * q(3))
+    
+  else
+
+!!$      Apply the right quadratic
+
+    eno1d = eighth * (three * q(2) + six * q(3) - q(4))
+    
+  end if
+
+!!$    Check that the quadratic is reasonable
+
+  if ( (q(2)-eno1d) * (q(3)-eno1d) .lt. zero ) then
+      
+!!$      Not reasonable. Linear interpolation
+
+    eno1d = half * (q(2) + q(3))
+
+  end if
+  
+end function eno1d
+
+subroutine prolongate_3d_real8_eno (src, srciext, srcjext, &
+     srckext, dst, dstiext, dstjext, dstkext, srcbbox, &
+     dstbbox, regbbox)
+
+  implicit none
+
+  CCTK_REAL8 one
+  parameter (one = 1)
+
+  integer srciext, srcjext, srckext
+  CCTK_REAL8 src(srciext,srcjext,srckext)
+  integer dstiext, dstjext, dstkext
+  CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+!!$     bbox(:,1) is lower boundary (inclusive)
+!!$     bbox(:,2) is upper boundary (inclusive)
+!!$     bbox(:,3) is stride
+  integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+
+  integer offsetlo, offsethi
+
+  integer regiext, regjext, regkext
+
+  integer dstifac, dstjfac, dstkfac
+
+  integer srcioff, srcjoff, srckoff
+  integer dstioff, dstjoff, dstkoff
+
+  integer i, j, k
+  integer i0, j0, k0
+  integer fi, fj, fk
+  integer ifac(4), jfac(4), kfac(4)
+  integer ii, jj, kk
+  integer fac
+  CCTK_REAL8 res
+  integer d
+
+  character msg*1000
+
+  CCTK_REAL8, dimension(0:3,0:3) :: tmp1
+  CCTK_REAL8, dimension(0:3) :: tmp2
+
+  external eno1d
+  CCTK_REAL8 eno1d
+
+  CCTK_REAL8 half, zero
+  parameter (half = 0.5)
+  parameter (zero = 0)
+
+  do d=1,3
+    if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0 &
+         .or. regbbox(d,3).eq.0) then
+      call CCTK_WARN (0, "Internal error: stride is zero")
+    end if
+    if (srcbbox(d,3).le.regbbox(d,3) &
+         .or. dstbbox(d,3).ne.regbbox(d,3)) then
+      call CCTK_WARN (0, "Internal error: strides disagree")
+    end if
+    if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+      call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+!!$     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
+    regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+    dstkfac = srcbbox(d,3) / dstbbox(d,3)
+    srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+    offsetlo = regbbox(d,3)
+    if (mod(srckoff + 0, dstkfac).eq.0) then
+      offsetlo = 0
+      if (regkext.gt.1) then
+        offsetlo = regbbox(d,3)
+      end if
+    end if
+    offsethi = regbbox(d,3)
+    if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+      offsethi = 0
+      if (regkext.gt.1) then
+        offsethi = regbbox(d,3)
+      end if
+    end if
+    if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1) &
+         .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2) &
+         .or. regbbox(d,1).lt.dstbbox(d,1) &
+         .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 &
+       .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1 &
+       .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1 &
+       .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1 &
+       .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1 &
+       .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+    call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+  end if
+
+  regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+  regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+  regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+
+  dstifac = srcbbox(1,3) / dstbbox(1,3)
+  dstjfac = srcbbox(2,3) / dstbbox(2,3)
+  dstkfac = srcbbox(3,3) / dstbbox(3,3)
+
+  srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+  srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+  srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+
+  dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+  dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+  dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+
+!!$     Loop over fine region
+
+  do k = 0, regkext-1
+    k0 = (srckoff + k) / dstkfac
+    fk = mod(srckoff + k, dstkfac)
+
+    do j = 0, regjext-1
+      j0 = (srcjoff + j) / dstjfac
+      fj = mod(srcjoff + j, dstjfac)
+
+      do i = 0, regiext-1
+        i0 = (srcioff + i) / dstifac
+        fi = mod(srcioff + i, dstifac)
+
+!!$        Where is the fine grid point w.r.t the coarse grid?
+
+        select case (fi + 10*fj + 100*fk)
+        case (0)
+!!$            On a coarse grid point exactly!
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               src(i0+1,j0+1,k0+1)
+
+        case (1)
+!!$          Interpolate only in x
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(src(i0:i0+3,j0+1,k0+1))
+
+        case (10)
+!!$          Interpolate only in y
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(src(i0+1,j0:j0+3,k0+1))
+
+        case (11)
+!!$          Interpolate only in x and y
+
+          do jj = 0, 3
+            tmp2(jj) = eno1d(src(i0:i0+3,j0+jj,k0+1))
+          end do
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(tmp2(0:3))
+
+        case (100)
+!!$          Interpolate only in z
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(src(i0+1,j0+1,k0:k0+3))
+
+        case (101)
+!!$          Interpolate only in x and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src(i0:i0+3,j0+1,k0+kk))
+          end do
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(tmp2(0:3))
+
+        case (110)
+!!$          Interpolate only in y and z
+
+          do kk = 0, 3
+            tmp2(kk) = eno1d(src(i0+1,j0:j0+3,k0+kk))
+          end do
+
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(tmp2(0:3))
+
+        case (111)
+!!$          Interpolate in all of x, y, and z
+
+          do jj = 0, 3
+            do kk = 0, 3
+              tmp1(jj,kk) = eno1d(src(i0:i0+3,j0+jj,k0+kk))
+            end do
+          end do
+          do ii = 0, 3
+            tmp2(ii) = eno1d(tmp1(0:3,ii))
+          end do
+          
+          dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = &
+               eno1d(tmp2(0:3))
+
+        case default
+          call CCTK_WARN(0, "Internal error in ENO prolongation. Should only be used with refinement factor 2!")
+        end select
+
+      end do
+    end do
+  end do
+
+end subroutine prolongate_3d_real8_eno
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77
new file mode 100644
index 000000000..a8dc28af4
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77
@@ -0,0 +1,264 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_minmod.F77,v 1.4 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.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
+c$$$ that must also obey certain constraints. The obvious example is the 
+c$$$ density in hydrodynamics, which may be discontinuous yet must be
+c$$$ strictly positive.
+c$$$
+c$$$ To ensure that this prolongation method is used you should add the
+c$$$ tag
+c$$$
+c$$$      tags='Prolongation="TVD"'
+c$$$
+c$$$ to the interface.ccl on the appropriate group.
+c$$$
+c$$$ This applies minmod type limiting to the slope, checking over the
+c$$$ entire coarse grid cell for the minimum modulus in each direction.
+c$$$
+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(1:len_trim(msg)))                           &&\
+      end if
+
+      function minmod(a, b)
+
+      implicit none
+
+      CCTK_REAL8 minmod
+      CCTK_REAL8 a, b
+      CCTK_REAL8 zero
+      parameter (zero = 0)
+
+      if (a * b .lt. zero) then
+        minmod = zero
+      else if (abs(a) < abs(b)) then
+        minmod = a
+      else
+        minmod = b
+      end if
+
+      end function
+      
+      subroutine prolongate_3d_real8_minmod (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      external minmod
+      CCTK_REAL8 minmod
+
+      CCTK_REAL8 half, zero
+      parameter (half = 0.5)
+      parameter (zero = 0)
+      CCTK_REAL8 dupw, dloc, slopex, slopey, slopez
+      logical firstloop
+      
+
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over fine region
+
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+
+               slopex = zero
+               slopey = zero
+               slopez = zero
+
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do jj = 1, 2
+
+                   dupw = src(i0+1 ,j0+jj,k0+kk) - src(i0+0 ,j0+jj,k0+kk)
+                   dloc = src(i0+2 ,j0+jj,k0+kk) - src(i0+1 ,j0+kk,k0+kk)
+                   if (firstloop) then
+                     slopex = half * dble(fi) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopex = 
+     $                    minmod(slopex, half * dble(fi) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+               
+               firstloop = .true.
+
+               do kk = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src(i0+ii,j0+1 ,k0+kk) - src(i0+ii,j0+0 ,k0+kk)
+                   dloc = src(i0+ii,j0+2 ,k0+kk) - src(i0+ii,j0+1 ,k0+kk)
+                   if (firstloop) then
+                     slopey = half * dble(fj) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopey = 
+     $                    minmod(slopey, half * dble(fj) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               firstloop = .true.
+
+               do jj = 1, 2
+                 do ii = 1, 2
+
+                   dupw = src(i0+ii,j0+jj,k0+1 ) - src(i0+ii,j0+jj,k0+0 )
+                   dloc = src(i0+ii,j0+jj,k0+2 ) - src(i0+ii,j0+jj,k0+1 )
+                   if (firstloop) then
+                     slopez = half * dble(fk) * minmod(dupw,dloc)
+                     firstloop = .false.
+                   else
+                     slopez = 
+     $                    minmod(slopez, half * dble(fk) * minmod(dupw,dloc))
+                   end if
+                 end do
+               end do
+
+               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(i0+1,j0+1,k0+1) + slopex + slopey + slopez
+               
+
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77
new file mode 100644
index 000000000..21d82a733
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77
@@ -0,0 +1,194 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_o3.F77,v 1.9 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_o3 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(4), jfac(4), kfac(4)
+      integer ii, jj, kk
+      integer fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over fine region
+      dstdiv = one / (6*dstifac**3 * 6*dstjfac**3 * 6*dstkfac**3)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (-1)
+         kfac(2) = (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * 3
+         kfac(3) = (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (-3)
+         kfac(4) = (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * 1
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (-1)
+            jfac(2) = (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * 3
+            jfac(3) = (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (-3)
+            jfac(4) = (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * 1
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (-1)
+               ifac(2) = (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * 3
+               ifac(3) = (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (-3)
+               ifac(4) = (fi+dstifac) * (fi        ) * (fi-  dstifac) * 1
+               
+               res = 0
+               
+               do kk=1,4
+                  do jj=1,4
+                     do ii=1,4
+                        
+                        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")
+                           res = res + fac * src(i0+ii-1, j0+jj-1, k0+kk-1)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o3_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o3_rf2.F77
new file mode 100644
index 000000000..8a3b2629d
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o3_rf2.F77
@@ -0,0 +1,420 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_o3_rf2.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_o3_rf2 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 one, half, fourth, eighth, sixteenth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      parameter (sixteenth = one/16)
+      CCTK_REAL8 f1, f2, f3, f4
+      parameter (f1 = - sixteenth)
+      parameter (f2 = 9*sixteenth)
+      parameter (f3 = 9*sixteenth)
+      parameter (f4 = - sixteenth)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer offsetlo, offsethi
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff, 2).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, 2).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) = src(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks, 4,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * src(is-1,js,ks) + f2 * src(is  ,js,ks)
+     $     + f3 * src(is+1,js,ks) + f4 * src(is+2,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks, 1,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * src(is,js-1,ks) + f2 * src(is,js  ,ks)
+     $     + f3 * src(is,js+1,ks) + f4 * src(is,js+2,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks, 4,4,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * src(is-1,js-1,ks) + f2*f1 * src(is  ,js-1,ks)
+     $     + f3*f1 * src(is+1,js-1,ks) + f4*f1 * src(is+2,js-1,ks)
+     $     + f1*f2 * src(is-1,js  ,ks) + f2*f2 * src(is  ,js  ,ks)
+     $     + f3*f2 * src(is+1,js  ,ks) + f4*f2 * src(is+2,js  ,ks)
+     $     + f1*f3 * src(is-1,js+1,ks) + f2*f3 * src(is  ,js+1,ks)
+     $     + f3*f3 * src(is+1,js+1,ks) + f4*f3 * src(is+2,js+1,ks)
+     $     + f1*f4 * src(is-1,js+2,ks) + f2*f4 * src(is  ,js+2,ks)
+     $     + f3*f4 * src(is+1,js+2,ks) + f4*f4 * src(is+2,js+2,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks-1, 1,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1 * src(is,js,ks-1) + f2 * src(is,js,ks  )
+     $     + f3 * src(is,js,ks+1) + f4 * src(is,js,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js,ks-1, 4,1,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * src(is-1,js,ks-1) + f2*f1 * src(is  ,js,ks-1)
+     $     + f3*f1 * src(is+1,js,ks-1) + f4*f1 * src(is+2,js,ks-1)
+     $     + f1*f2 * src(is-1,js,ks  ) + f2*f2 * src(is  ,js,ks  )
+     $     + f3*f2 * src(is+1,js,ks  ) + f4*f2 * src(is+2,js,ks  )
+     $     + f1*f3 * src(is-1,js,ks+1) + f2*f3 * src(is  ,js,ks+1)
+     $     + f3*f3 * src(is+1,js,ks+1) + f4*f3 * src(is+2,js,ks+1)
+     $     + f1*f4 * src(is-1,js,ks+2) + f2*f4 * src(is  ,js,ks+2)
+     $     + f3*f4 * src(is+1,js,ks+2) + f4*f4 * src(is+2,js,ks+2)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js-1,ks-1, 1,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + f1*f1 * src(is,js-1,ks-1) + f2*f1 * src(is,js  ,ks-1)
+     $     + f3*f1 * src(is,js+1,ks-1) + f4*f1 * src(is,js+2,ks-1)
+     $     + f1*f2 * src(is,js-1,ks  ) + f2*f2 * src(is,js  ,ks  )
+     $     + f3*f2 * src(is,js+1,ks  ) + f4*f2 * src(is,js+2,ks  )
+     $     + f1*f3 * src(is,js-1,ks+1) + f2*f3 * src(is,js  ,ks+1)
+     $     + f3*f3 * src(is,js+1,ks+1) + f4*f3 * src(is,js+2,ks+1)
+     $     + f1*f4 * src(is,js-1,ks+2) + f2*f4 * src(is,js  ,ks+2)
+     $     + f3*f4 * src(is,js+1,ks+2) + f4*f4 * src(is,js+2,ks+2)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is-1,js-1,ks-1, 4,4,4, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $        + f1*f1*f1 * src(is-1,js-1,ks-1) + f2*f1*f1 * src(is  ,js-1,ks-1)
+     $        + f3*f1*f1 * src(is+1,js-1,ks-1) + f4*f1*f1 * src(is+2,js-1,ks-1)
+     $        + f1*f2*f1 * src(is-1,js  ,ks-1) + f2*f2*f1 * src(is  ,js  ,ks-1)
+     $        + f3*f2*f1 * src(is+1,js  ,ks-1) + f4*f2*f1 * src(is+2,js  ,ks-1)
+     $        + f1*f3*f1 * src(is-1,js+1,ks-1) + f2*f3*f1 * src(is  ,js+1,ks-1)
+     $        + f3*f3*f1 * src(is+1,js+1,ks-1) + f4*f3*f1 * src(is+2,js+1,ks-1)
+     $        + f1*f4*f1 * src(is-1,js+2,ks-1) + f2*f4*f1 * src(is  ,js+2,ks-1)
+     $        + f3*f4*f1 * src(is+1,js+2,ks-1) + f4*f4*f1 * src(is+2,js+2,ks-1)
+     $   
+     $        + f1*f1*f2 * src(is-1,js-1,ks  ) + f2*f1*f2 * src(is  ,js-1,ks  )
+     $        + f3*f1*f2 * src(is+1,js-1,ks  ) + f4*f1*f2 * src(is+2,js-1,ks  )
+     $        + f1*f2*f2 * src(is-1,js  ,ks  ) + f2*f2*f2 * src(is  ,js  ,ks  )
+     $        + f3*f2*f2 * src(is+1,js  ,ks  ) + f4*f2*f2 * src(is+2,js  ,ks  )
+     $        + f1*f3*f2 * src(is-1,js+1,ks  ) + f2*f3*f2 * src(is  ,js+1,ks  )
+     $        + f3*f3*f2 * src(is+1,js+1,ks  ) + f4*f3*f2 * src(is+2,js+1,ks  )
+     $        + f1*f4*f2 * src(is-1,js+2,ks  ) + f2*f4*f2 * src(is  ,js+2,ks  )
+     $        + f3*f4*f2 * src(is+1,js+2,ks  ) + f4*f4*f2 * src(is+2,js+2,ks  )
+     $   
+     $        + f1*f1*f3 * src(is-1,js-1,ks+1) + f2*f1*f3 * src(is  ,js-1,ks+1)
+     $        + f3*f1*f3 * src(is+1,js-1,ks+1) + f4*f1*f3 * src(is+2,js-1,ks+1)
+     $        + f1*f2*f3 * src(is-1,js  ,ks+1) + f2*f2*f3 * src(is  ,js  ,ks+1)
+     $        + f3*f2*f3 * src(is+1,js  ,ks+1) + f4*f2*f3 * src(is+2,js  ,ks+1)
+     $        + f1*f3*f3 * src(is-1,js+1,ks+1) + f2*f3*f3 * src(is  ,js+1,ks+1)
+     $        + f3*f3*f3 * src(is+1,js+1,ks+1) + f4*f3*f3 * src(is+2,js+1,ks+1)
+     $        + f1*f4*f3 * src(is-1,js+2,ks+1) + f2*f4*f3 * src(is  ,js+2,ks+1)
+     $        + f3*f4*f3 * src(is+1,js+2,ks+1) + f4*f4*f3 * src(is+2,js+2,ks+1)
+     $   
+     $        + f1*f1*f4 * src(is-1,js-1,ks+2) + f2*f1*f4 * src(is  ,js-1,ks+2)
+     $        + f3*f1*f4 * src(is+1,js-1,ks+2) + f4*f1*f4 * src(is+2,js-1,ks+2)
+     $        + f1*f2*f4 * src(is-1,js  ,ks+2) + f2*f2*f4 * src(is  ,js  ,ks+2)
+     $        + f3*f2*f4 * src(is+1,js  ,ks+2) + f4*f2*f4 * src(is+2,js  ,ks+2)
+     $        + f1*f3*f4 * src(is-1,js+1,ks+2) + f2*f3*f4 * src(is  ,js+1,ks+2)
+     $        + f3*f3*f4 * src(is+1,js+1,ks+2) + f4*f3*f4 * src(is+2,js+1,ks+2)
+     $        + f1*f4*f4 * src(is-1,js+2,ks+2) + f2*f4*f4 * src(is  ,js+2,ks+2)
+     $        + f3*f4*f4 * src(is+1,js+2,ks+2) + f4*f4*f4 * src(is+2,js+2,ks+2)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77
new file mode 100644
index 000000000..8c86178ad
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77
@@ -0,0 +1,205 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_o5.F77,v 1.2 2004/03/11 12:03:09 schnetter 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 prolongate_3d_real8_o5 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      CCTK_REAL8 one
+      parameter (one = 1)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+      CCTK_REAL8 t
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer offsetlo, offsethi
+      
+      integer regiext, regjext, regkext
+      
+      integer dstifac, dstjfac, dstkfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      CCTK_REAL8 s1fac, s2fac, s3fac
+      
+      CCTK_REAL8 dstdiv
+      integer i, j, k
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer ifac(6), jfac(6), kfac(6)
+      integer ii, jj, kk
+      CCTK_REAL8 fac
+      CCTK_REAL8 res
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(srcbbox(d,3), dstbbox(d,3)).ne.0) then
+            call CCTK_WARN (0, "Internal error: destination strides are not integer multiples of the source 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(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
+         regkext = (regbbox(d,2) - regbbox(d,1)) / regbbox(d,3) + 1
+         dstkfac = srcbbox(d,3) / dstbbox(d,3)
+         srckoff = (regbbox(d,1) - srcbbox(d,1)) / dstbbox(d,3)
+         offsetlo = regbbox(d,3)
+         if (mod(srckoff + 0, dstkfac).eq.0) then
+            offsetlo = 0
+            if (regkext.gt.1) then
+               offsetlo = regbbox(d,3)
+            end if
+         end if
+         offsethi = regbbox(d,3)
+         if (mod(srckoff + regkext-1, dstkfac).eq.0) then
+            offsethi = 0
+            if (regkext.gt.1) then
+               offsethi = regbbox(d,3)
+            end if
+         end if
+         if (regbbox(d,1)-offsetlo.lt.srcbbox(d,1)
+     $        .or. regbbox(d,2)+offsethi.gt.srcbbox(d,2)
+     $        .or. regbbox(d,1).lt.dstbbox(d,1)
+     $        .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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      dstifac = srcbbox(1,3) / dstbbox(1,3)
+      dstjfac = srcbbox(2,3) / dstbbox(2,3)
+      dstkfac = srcbbox(3,3) / dstbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over fine region
+c     (This expression cannot be evaluated as integer)
+      dstdiv = one / (120*dstifac**5) / (120*dstjfac**5) / (120*dstkfac**5)
+      
+      do k = 0, regkext-1
+         k0 = (srckoff + k) / dstkfac
+         fk = mod(srckoff + k, dstkfac)
+         kfac(1) = (fk+  dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (- 1)
+         kfac(2) = (fk+2*dstkfac) * (fk        ) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (  5)
+         kfac(3) = (fk+2*dstkfac) * (fk+dstkfac) * (fk-dstkfac) * (fk-2*dstkfac) * (fk-3*dstkfac) * (-10)
+         kfac(4) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-2*dstkfac) * (fk-3*dstkfac) * ( 10)
+         kfac(5) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-3*dstkfac) * (- 5)
+         kfac(6) = (fk+2*dstkfac) * (fk+dstkfac) * (fk        ) * (fk-  dstkfac) * (fk-2*dstkfac) * (  1)
+         
+         do j = 0, regjext-1
+            j0 = (srcjoff + j) / dstjfac
+            fj = mod(srcjoff + j, dstjfac)
+            jfac(1) = (fj+  dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (- 1)
+            jfac(2) = (fj+2*dstjfac) * (fj        ) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (  5)
+            jfac(3) = (fj+2*dstjfac) * (fj+dstjfac) * (fj-dstjfac) * (fj-2*dstjfac) * (fj-3*dstjfac) * (-10)
+            jfac(4) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-2*dstjfac) * (fj-3*dstjfac) * ( 10)
+            jfac(5) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-3*dstjfac) * (- 5)
+            jfac(6) = (fj+2*dstjfac) * (fj+dstjfac) * (fj        ) * (fj-  dstjfac) * (fj-2*dstjfac) * (  1)
+            
+            do i = 0, regiext-1
+               i0 = (srcioff + i) / dstifac
+               fi = mod(srcioff + i, dstifac)
+               ifac(1) = (fi+  dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (- 1)
+               ifac(2) = (fi+2*dstifac) * (fi        ) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (  5)
+               ifac(3) = (fi+2*dstifac) * (fi+dstifac) * (fi-dstifac) * (fi-2*dstifac) * (fi-3*dstifac) * (-10)
+               ifac(4) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-2*dstifac) * (fi-3*dstifac) * ( 10)
+               ifac(5) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-3*dstifac) * (- 5)
+               ifac(6) = (fi+2*dstifac) * (fi+dstifac) * (fi        ) * (fi-  dstifac) * (fi-2*dstifac) * (  1)
+               
+               res = 0
+               
+               do kk=1,6
+                  do jj=1,6
+                     do ii=1,6
+                        
+                        if (ifac(ii).ne.0 .and. jfac(jj).ne.0 .and. kfac(kk).ne.0) then
+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")
+                           res = res + fac * src(i0+ii-2, j0+jj-2, k0+kk-2)
+                        end if
+                        
+                     end do
+                  end do
+               end do
+               
+               CHKIDX (dstioff+i+1, dstjoff+j+1, dstkoff+k+1, \
+                       dstiext,dstjext,dstkext, "destination")
+               dst (dstioff+i+1, dstjoff+j+1, dstkoff+k+1) = dstdiv * res
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/prolongate_3d_real8_rf2.F77 b/Carpet/CarpetLib/src/prolongate_3d_real8_rf2.F77
new file mode 100644
index 000000000..556f4d092
--- /dev/null
+++ b/Carpet/CarpetLib/src/prolongate_3d_real8_rf2.F77
@@ -0,0 +1,341 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/prolongate_3d_real8_rf2.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+      
+
+
+      subroutine prolongate_3d_real8_rf2 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      CCTK_REAL8 one, half, fourth, eighth
+      parameter (one = 1)
+      parameter (half = one/2)
+      parameter (fourth = one/4)
+      parameter (eighth = one/8)
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i0, j0, k0
+      integer fi, fj, fk
+      integer is, js, ks
+      integer id, jd, kd
+      integer i, j, k
+      
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).le.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (srcbbox(d,3).ne.dstbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: source strides are not twice 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / dstbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / dstbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / dstbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+      fi = mod(srcioff, 2)
+      fj = mod(srcjoff, 2)
+      fk = mod(srckoff, 2)
+      
+      i0 = srcioff / 2
+      j0 = srcjoff / 2
+      k0 = srckoff / 2
+      
+      
+      
+c     Loop over fine region
+c     Label scheme: 8 fk fj fi
+      
+c     begin k loop
+ 8    continue
+      k = 0
+      ks = k0+1
+      kd = dstkoff+1
+      if (fk.eq.0) goto 80
+      if (fk.eq.1) goto 81
+      stop
+      
+c     begin j loop
+ 80   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 800
+      if (fj.eq.1) goto 801
+      stop
+      
+c     begin i loop
+ 800  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8000
+      if (fi.eq.1) goto 8001
+      stop
+      
+c     kernel
+ 8000 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) = src(is,js,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8001
+      goto 900
+      
+c     kernel
+ 8001 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) = half * src(is,js,ks) + half * src(is+1,js,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8000
+      goto 900
+      
+c     end i loop
+ 900  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 801
+      goto 90
+      
+c     begin i loop
+ 801  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8010
+      if (fi.eq.1) goto 8011
+      stop
+      
+c     kernel
+ 8010 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) = half * src(is,js,ks) + half * src(is,js+1,ks)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8011
+      goto 901
+      
+c     kernel
+ 8011 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,1, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * src(is,js,ks)   + fourth * src(is+1,js,ks)
+     $     + fourth * src(is,js+1,ks) + fourth * src(is+1,js+1,ks)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8010
+      goto 901
+      
+c     end i loop
+ 901  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 800
+      goto 90
+      
+c     end j loop
+ 90   continue
+      k = k+1
+      kd = kd+1
+      if (k.lt.regkext) goto 81
+      goto 9
+      
+c     begin j loop
+ 81   continue
+      j = 0
+      js = j0+1
+      jd = dstjoff+1
+      if (fj.eq.0) goto 810
+      if (fj.eq.1) goto 811
+      stop
+      
+c     begin i loop
+ 810  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8100
+      if (fi.eq.1) goto 8101
+      stop
+      
+c     kernel
+ 8100 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) = half * src(is,js,ks) + half * src(is,js,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8101
+      goto 910
+      
+c     kernel
+ 8101 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,1,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * src(is,js,ks)   + fourth * src(is+1,js,ks)
+     $     + fourth * src(is,js,ks+1) + fourth * src(is+1,js,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8100
+      goto 910
+      
+c     end i loop
+ 910  continue
+      j = j+1
+      jd = jd+1
+      if (j.lt.regjext) goto 811
+      goto 91
+      
+c     begin i loop
+ 811  continue
+      i = 0
+      is = i0+1
+      id = dstioff+1
+      if (fi.eq.0) goto 8110
+      if (fi.eq.1) goto 8111
+      stop
+      
+c     kernel
+ 8110 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 1,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + fourth * src(is,js,ks)   + fourth * src(is,js+1,ks)
+     $     + fourth * src(is,js,ks+1) + fourth * src(is,js+1,ks+1)
+      i = i+1
+      id = id+1
+      if (i.lt.regiext) goto 8111
+      goto 911
+      
+c     kernel
+ 8111 continue
+      if (check_array_accesses.ne.0) then
+         call checkindex (is,js,ks, 2,2,2, srciext,srcjext,srckext, "source")
+         call checkindex (id,jd,kd, 1,1,1, dstiext,dstjext,dstkext, "destination")
+      end if
+      dst(id,jd,kd) =
+     $     + eighth * src(is,js,ks)     + eighth * src(is+1,js,ks)
+     $     + eighth * src(is,js+1,ks)   + eighth * src(is+1,js+1,ks)
+     $     + eighth * src(is,js,ks+1)   + eighth * src(is+1,js,ks+1)
+     $     + eighth * src(is,js+1,ks+1) + eighth * src(is+1,js+1,ks+1)
+      i = i+1
+      id = id+1
+      is = is+1
+      if (i.lt.regiext) goto 8110
+      goto 911
+      
+c     end i loop
+ 911  continue
+      j = j+1
+      jd = jd+1
+      js = js+1
+      if (j.lt.regjext) goto 810
+      goto 91
+      
+c     end j loop
+ 91   continue
+      k = k+1
+      kd = kd+1
+      ks = ks+1
+      if (k.lt.regkext) goto 80
+      goto 9
+      
+c     end k loop
+ 9    continue
+      
+      end
diff --git a/Carpet/CarpetLib/src/restrict_3d_real8.F77 b/Carpet/CarpetLib/src/restrict_3d_real8.F77
new file mode 100644
index 000000000..81f4cfd0a
--- /dev/null
+++ b/Carpet/CarpetLib/src/restrict_3d_real8.F77
@@ -0,0 +1,128 @@
+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 $
+      
+#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,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      
+      integer srcifac, srcjfac, srckfac
+      
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer d
+      
+      character msg*1000
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).ge.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (mod(dstbbox(d,3), srcbbox(d,3)).ne.0) then
+            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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcifac = dstbbox(1,3) / srcbbox(1,3)
+      srcjfac = dstbbox(2,3) / srcbbox(2,3)
+      srckfac = dstbbox(3,3) / srcbbox(3,3)
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / srcbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / srcbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / srcbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over coarse region
+      do k = 0, regkext-1
+         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)
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/restrict_3d_real8_rf2.F77 b/Carpet/CarpetLib/src/restrict_3d_real8_rf2.F77
new file mode 100644
index 000000000..b7f6a0454
--- /dev/null
+++ b/Carpet/CarpetLib/src/restrict_3d_real8_rf2.F77
@@ -0,0 +1,111 @@
+c     -*-Fortran-*-
+c     $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/restrict_3d_real8_rf2.F77,v 1.2 2004/03/11 12:03:09 schnetter Exp $
+      
+#include "cctk.h"
+#include "cctk_Parameters.h"
+
+
+
+      subroutine restrict_3d_real8_rf2 (
+     $     src, srciext, srcjext, srckext,
+     $     dst, dstiext, dstjext, dstkext,
+     $     srcbbox, dstbbox, regbbox)
+      
+      implicit none
+      
+      DECLARE_CCTK_PARAMETERS
+      
+      integer srciext, srcjext, srckext
+      CCTK_REAL8 src(srciext,srcjext,srckext)
+      integer dstiext, dstjext, dstkext
+      CCTK_REAL8 dst(dstiext,dstjext,dstkext)
+c     bbox(:,1) is lower boundary (inclusive)
+c     bbox(:,2) is upper boundary (inclusive)
+c     bbox(:,3) is stride
+      integer srcbbox(3,3), dstbbox(3,3), regbbox(3,3)
+      
+      integer regiext, regjext, regkext
+      integer srcioff, srcjoff, srckoff
+      integer dstioff, dstjoff, dstkoff
+      
+      integer i, j, k
+      integer d
+      
+      
+      
+      do d=1,3
+         if (srcbbox(d,3).eq.0 .or. dstbbox(d,3).eq.0
+     $        .or. regbbox(d,3).eq.0) then
+            call CCTK_WARN (0, "Internal error: stride is zero")
+         end if
+         if (srcbbox(d,3).ge.regbbox(d,3)
+     $        .or. dstbbox(d,3).ne.regbbox(d,3)) then
+            call CCTK_WARN (0, "Internal error: strides disagree")
+         end if
+         if (dstbbox(d,3).ne.srcbbox(d,3)*2) then
+            call CCTK_WARN (0, "Internal error: destination strides are not twice the source 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(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
+     $     .or. srcjext.ne.(srcbbox(2,2)-srcbbox(2,1))/srcbbox(2,3)+1
+     $     .or. srckext.ne.(srcbbox(3,2)-srcbbox(3,1))/srcbbox(3,3)+1
+     $     .or. dstiext.ne.(dstbbox(1,2)-dstbbox(1,1))/dstbbox(1,3)+1
+     $     .or. dstjext.ne.(dstbbox(2,2)-dstbbox(2,1))/dstbbox(2,3)+1
+     $     .or. dstkext.ne.(dstbbox(3,2)-dstbbox(3,1))/dstbbox(3,3)+1) then
+         call CCTK_WARN (0, "Internal error: array sizes don't agree with bounding boxes")
+      end if
+      
+      
+      
+      regiext = (regbbox(1,2) - regbbox(1,1)) / regbbox(1,3) + 1
+      regjext = (regbbox(2,2) - regbbox(2,1)) / regbbox(2,3) + 1
+      regkext = (regbbox(3,2) - regbbox(3,1)) / regbbox(3,3) + 1
+      
+      srcioff = (regbbox(1,1) - srcbbox(1,1)) / srcbbox(1,3)
+      srcjoff = (regbbox(2,1) - srcbbox(2,1)) / srcbbox(2,3)
+      srckoff = (regbbox(3,1) - srcbbox(3,1)) / srcbbox(3,3)
+      
+      dstioff = (regbbox(1,1) - dstbbox(1,1)) / dstbbox(1,3)
+      dstjoff = (regbbox(2,1) - dstbbox(2,1)) / dstbbox(2,3)
+      dstkoff = (regbbox(3,1) - dstbbox(3,1)) / dstbbox(3,3)
+      
+      
+      
+c     Loop over coarse region
+      do k = 0, regkext-1
+         do j = 0, regjext-1
+            do i = 0, regiext-1
+               
+               if (check_array_accesses.ne.0) then
+                  call checkindex (srcioff+2*i+1, srcjoff+2*j+1, srckoff+2*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+2*i+1, srcjoff+2*j+1, srckoff+2*k+1)
+               
+            end do
+         end do
+      end do
+      
+      end
diff --git a/Carpet/CarpetLib/src/th.cc b/Carpet/CarpetLib/src/th.cc
new file mode 100644
index 000000000..0ad9beca1
--- /dev/null
+++ b/Carpet/CarpetLib/src/th.cc
@@ -0,0 +1,81 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/th.cc,v 1.14 2004/03/23 19:30:14 schnetter Exp $
+
+#include <assert.h>
+#include <math.h>
+
+#include <iostream>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "gh.hh"
+
+#include "th.hh"
+
+using namespace std;
+
+
+
+// Constructors
+template<int D>
+th<D>::th (gh<D>& h, const CCTK_REAL basedelta)
+  : h(h), delta(basedelta) {
+  h.add(this);
+}
+
+// Destructors
+template<int D>
+th<D>::~th () {
+  h.remove(this);
+}
+
+// Modifiers
+template<int D>
+void th<D>::recompose () {
+  times.resize(h.reflevels());
+  deltas.resize(h.reflevels());
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    const int old_mglevels = times.at(rl).size();
+    CCTK_REAL mgtime;
+    // Select default time
+    if (old_mglevels==0 && rl==0) {
+      mgtime = 0;
+    } else if (old_mglevels==0) {
+      mgtime = times.at(rl-1).at(0);
+    } else {
+      mgtime = times.at(rl).at(old_mglevels-1);
+    }
+    times.at(rl).resize(h.mglevels(rl,0), mgtime);
+    deltas.at(rl).resize(h.mglevels(rl,0));
+    for (int ml=0; ml<h.mglevels(rl,0); ++ml) {
+      if (rl==0 && ml==0) {
+	deltas.at(rl).at(ml) = delta;
+      } else if (ml==0) {
+	deltas.at(rl).at(ml) = deltas.at(rl-1).at(ml) / h.reffact;
+      } else {
+	deltas.at(rl).at(ml) = deltas.at(rl).at(ml-1) * h.mgfact;
+      }
+    }
+  }
+}
+
+
+
+// Output
+template<int D>
+void th<D>::output (ostream& os) const {
+  os << "th<" << D << ">:"
+     << "times={";
+  for (int rl=0; rl<h.reflevels(); ++rl) {
+    for (int ml=0; ml<h.mglevels(rl,0); ++ml) {
+      if (!(rl==0 && ml==0)) os << ",";
+      os << rl << ":" << ml << ":"
+	 << times.at(rl).at(ml) << "(" << deltas.at(rl).at(ml) << ")";
+    }
+  }
+  os << "}";
+}
+
+
+
+template class th<3>;
diff --git a/Carpet/CarpetLib/src/th.hh b/Carpet/CarpetLib/src/th.hh
new file mode 100644
index 000000000..12c77d782
--- /dev/null
+++ b/Carpet/CarpetLib/src/th.hh
@@ -0,0 +1,104 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/th.hh,v 1.11 2004/03/23 19:30:14 schnetter Exp $
+
+#ifndef TH_HH
+#define TH_HH
+
+#include <assert.h>
+
+#include <iostream>
+#include <vector>
+
+#include "cctk.h"
+
+#include "defs.hh"
+#include "gh.hh"
+
+using namespace std;
+
+
+
+// Forward declaration
+template<int D> class th;
+
+// Output
+template<int D>
+ostream& operator<< (ostream& os, const th<D>& t);
+
+
+
+// The time hierarchy (information about the current time)
+template<int D>
+class th {
+  
+public:				// should be readonly
+  
+  // Fields
+  gh<D>& h;                     // hierarchy
+  
+private:
+  
+  CCTK_REAL delta;		// time step
+  vector<vector<CCTK_REAL> > times; // current times
+  vector<vector<CCTK_REAL> > deltas; // time steps
+  
+public:
+  
+  // Constructors
+  th (gh<D>& h, const CCTK_REAL basedelta);
+  
+  // Destructors
+  ~th ();
+  
+  // Modifiers
+  void recompose ();
+  
+  // Time management
+  CCTK_REAL get_time (const int rl, const int ml) const {
+    assert (rl>=0 && rl<h.reflevels());
+    assert (ml>=0 && ml<h.mglevels(rl,0));
+    return times.at(rl).at(ml);
+  }
+  
+  void set_time (const int rl, const int ml, const CCTK_REAL t) {
+    assert (rl>=0 && rl<h.reflevels());
+    assert (ml>=0 && ml<h.mglevels(rl,0));
+    times.at(rl).at(ml) = t;
+  }
+  
+  void advance_time (const int rl, const int ml) {
+    set_time(rl,ml, get_time(rl,ml) + get_delta(rl,ml));
+  }
+  
+  CCTK_REAL get_delta (const int rl, const int ml) const {
+    assert (rl>=0 && rl<h.reflevels());
+    assert (ml>=0 && ml<h.mglevels(rl,0));
+    return deltas.at(rl).at(ml);
+  }
+  
+  void set_delta (const int rl, const int ml, const CCTK_REAL dt) {
+    assert (rl>=0 && rl<h.reflevels());
+    assert (ml>=0 && ml<h.mglevels(rl,0));
+    deltas.at(rl).at(ml) = dt;
+  }
+  
+  CCTK_REAL time (const int tl, const int rl, const int ml) const {
+    assert (rl>=0 && rl<h.reflevels());
+    assert (ml>=0 && ml<h.mglevels(rl,0));
+    return get_time(rl, ml) + tl * get_delta(rl, ml);
+  }
+  
+  // Output
+  void output (ostream& os) const;
+};
+
+
+
+template<int D>
+inline ostream& operator<< (ostream& os, const th<D>& t) {
+  t.output(os);
+  return os;
+}
+
+
+
+#endif // TH_HH
diff --git a/Carpet/CarpetLib/src/vect.cc b/Carpet/CarpetLib/src/vect.cc
new file mode 100644
index 000000000..9af8bca1a
--- /dev/null
+++ b/Carpet/CarpetLib/src/vect.cc
@@ -0,0 +1,59 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/vect.cc,v 1.14 2004/02/18 15:10:17 schnetter Exp $
+
+#include <assert.h>
+
+#include <iostream>
+
+#include "defs.hh"
+
+#include "vect.hh"
+
+using namespace std;
+
+
+
+// Input
+template<class T,int D>
+void vect<T,D>::input (istream& is) {
+  skipws (is);
+  consume (is, '[');
+  for (int d=0; d<D; ++d) {
+    is >> (*this)[d];
+    if (d<D-1) {
+      skipws (is);
+      consume (is, ',');
+    }
+  }
+  skipws (is);
+  consume (is, ']');
+}
+
+
+
+// Output
+template<class T,int D>
+void vect<T,D>::output (ostream& os) const {
+  os << "[";
+  for (int d=0; d<D; ++d) {
+    os << (*this)[d];
+    if (d<D-1) os << ",";
+  }
+  os << "]";
+}
+
+
+
+// Note: We need all dimensions all the time.
+template class vect<int,0>;
+template class vect<int,1>;
+template class vect<int,2>;
+template class vect<int,3>;
+
+template void vect<double,3>::input (istream& is);
+template void vect<vect<bool,2>,3>::input (istream& is);
+
+template void vect<bool,2>::output (ostream& os) const;
+template void vect<bool,3>::output (ostream& os) const;
+template void vect<double,3>::output (ostream& os) const;
+template void vect<vect<bool,2>,3>::output (ostream& os) const;
+template void vect<vect<int,2>,3>::output (ostream& os) const;
diff --git a/Carpet/CarpetLib/src/vect.hh b/Carpet/CarpetLib/src/vect.hh
new file mode 100644
index 000000000..9160c76aa
--- /dev/null
+++ b/Carpet/CarpetLib/src/vect.hh
@@ -0,0 +1,797 @@
+// $Header: /home/eschnett/C/carpet/Carpet/Carpet/CarpetLib/src/vect.hh,v 1.29 2004/08/14 07:41:25 schnetter Exp $
+
+#ifndef VECT_HH
+#define VECT_HH
+
+#include <algorithm>
+#include <cassert>
+#include <cmath>
+#include <iostream>
+
+using namespace std;
+
+
+
+// Forward definition
+template<class T, int D> class vect;
+
+// Input/Output
+template<class T,int D>
+istream& operator>> (istream& is, vect<T,D>& a);
+template<class T,int D>
+ostream& operator<< (ostream& os, const vect<T,D>& a);
+
+
+
+/**
+ * A short vector with a size that is specified at compile time.
+ */
+template<class T, int D>
+class vect {
+  
+  // Fields
+  
+  /** Vector elements.  */
+  T elt[D==0 ? 1 : D];
+  
+public:
+  
+  // Constructors
+  
+  /** Explicit empty constructor.  */
+  explicit vect () { }
+  
+  /** Copy constructor.  */
+  vect (const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]=a.elt[d];
+  }
+  
+  /** Constructor from a single element.  This constructor might be
+      confusing, but it is very convenient.  */
+  vect (const T x) {
+    for (int d=0; d<D; ++d) elt[d]=x;
+  }
+  
+  /** Constructor for 2-element vectors from 2 elements.  */
+  vect (const T x, const T y) {
+    assert (D==2);
+    // Note: this statement may give "index out of range" warnings.
+    // You can safely ignore these.
+    elt[0]=x; elt[1]=y;
+  }
+  
+  /** Constructor for 3-element vectors from 3 elements.  */
+  vect (const T x, const T y, const T z) {
+    assert (D==3);
+    // Note: this statement may give "index out of range" warnings.
+    // You can safely ignore these.
+    elt[0]=x; elt[1]=y; elt[2]=z;
+  }
+  
+  /** Constructor for 4-element vectors from 4 elements.  */
+  vect (const T x, const T y, const T z, const T t) {
+    assert (D==4);
+    // Note: this statement may give "index out of range" warnings.
+    // You can safely ignore these.
+    elt[0]=x; elt[1]=y; elt[2]=z; elt[3]=t;
+  }
+  
+#if 0
+  // This creates confusion
+  /** Constructor from a pointer, i.e.\ a C array.  */
+  explicit vect (const T* const x) {
+    for (int d=0; d<D; ++d) elt[d]=x[d];
+  }
+#endif
+  
+  /** Constructor from a vector with a different type.  */
+  template<class S>
+  /*explicit*/ vect (const vect<S,D>& a) {
+    for (int d=0; d<D; ++d) elt[d]=(T)a[d];
+  }
+  
+  /** Create a new 0-element vector with a specific type.  */
+  static vect make () {
+    assert (D==0);
+    return vect();
+  }
+  
+  /** Create a new 1-element vector with a specific type.  */
+  static vect make (const T x) {
+    assert (D==1);
+    return vect(x);
+  }
+  
+  /** Create a new 2-element vector with a specific type.  */
+  static vect make (const T x, const T y) {
+    assert (D==2);
+    return vect(x, y);
+  }
+  
+  /** Create a new 3-element vector with a specific type.  */
+  static vect make (const T x, const T y, const T z) {
+    assert (D==3);
+    return vect(x, y, z);
+  }
+  
+  /** Create a new 4-element vector with a specific type.  */
+  static vect make (const T x, const T y, const T z, const T t) {
+    assert (D==4);
+    return vect(x, y, z, t);
+  }
+  
+  /** Treat a constant pointer as a reference to a constant vector.  */
+  static const vect& ref (const T* const x) {
+    return *(const vect*)x;
+  }
+  
+  /** Treat a pointer as a reference to a vector.  */
+  static vect& ref (T* const x) {
+    return *(vect*)x;
+  }
+  
+  /** Create a vector with one element set to 1 and all other elements
+      set to zero.  */
+  static vect dir (const int d) {
+    vect r=(T)0;
+    r[d]=1;
+    return r;
+  }
+  
+  /** Create a vector with e[i] = i.  */
+  static vect seq () {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=d;
+    return r;
+  }
+  
+  /** Create a vector with e[i] = n + i.  */
+  static vect seq (const int n) {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=n+d;
+    return r;
+  }
+  
+  /** Create a vector with e[i] = n + s * i.  */
+  static vect seq (const int n, const int s) {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=n+s*d;
+    return r;
+  }
+  
+  // Accessors
+  
+  /** Return a non-writable element of a vector.  */
+  // (Don't return a reference; *this might be a temporary)
+  // Do return a reference, so that a vector can be accessed as array
+  const T& operator[] (const int d) const {
+    assert(d>=0 && d<D);
+    return elt[d];
+  }
+  
+  /** Return a writable element of a vector as reference.  */
+  T& operator[] (const int d) {
+    assert(d>=0 && d<D);
+    return elt[d];
+  }
+  
+#if 0
+  // This creates confusion
+  /** Return a pointer to a vector.  */
+  operator const T* () const {
+    return this;
+  }
+#endif
+  
+  /** Return a combination of the vector elements e[a[i]].  The
+      element combination is selected by another vector.  */
+  template<class TT, int DD>
+  vect<T,DD> operator[] (const vect<TT,DD>& a) const {
+    vect<T,DD> r;
+    // (*this)[] performs index checking
+    for (int d=0; d<DD; ++d) r[d] = (*this)[a[d]];
+    return r;
+  }
+  
+  // Modifying operators
+  vect& operator+=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]+=x;
+    return *this;
+  }
+  
+  vect& operator-=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]-=x;
+    return *this;
+  }
+  
+  vect& operator*=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]*=x;
+    return *this;
+  }
+  
+  vect& operator/=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]/=x;
+    return *this;
+  }
+  
+  vect& operator%=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]%=x;
+    return *this;
+  }
+  
+  vect& operator&=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]&=x;
+    return *this;
+  }
+  
+  vect& operator|=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]|=x;
+    return *this;
+  }
+  
+  vect& operator^=(const T x) {
+    for (int d=0; d<D; ++d) elt[d]^=x;
+    return *this;
+  }
+  
+  vect& operator+=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]+=a[d];
+    return *this;
+  }
+  
+  vect& operator-=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]-=a[d];
+    return *this;
+  }
+  
+  vect& operator*=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]*=a[d];
+    return *this;
+  }
+  
+  vect& operator/=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]/=a[d];
+    return *this;
+  }
+  
+  vect& operator%=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]%=a[d];
+    return *this;
+  }
+  
+  vect& operator&=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]&=a[d];
+    return *this;
+  }
+  
+  vect& operator|=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]|=a[d];
+    return *this;
+  }
+  
+  vect& operator^=(const vect& a) {
+    for (int d=0; d<D; ++d) elt[d]^=a[d];
+    return *this;
+  }
+  
+  // Non-modifying operators
+  
+  /** Return a new vector where one element has been replaced.  */
+  vect replace (const int d, const T x) const {
+    assert (d>=0 && d<D);
+    vect r;
+    for (int dd=0; dd<D; ++dd) r[dd]=dd==d?x:elt[dd];
+    return r;
+  }
+  
+  vect operator+ () const {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=+elt[d];
+    return r;
+  }
+  
+  vect operator- () const {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=-elt[d];
+    return r;
+  }
+  
+  vect<bool,D> operator! () const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=!elt[d];
+    return r;
+  }
+  
+  vect operator~ () const {
+    vect r;
+    for (int d=0; d<D; ++d) r[d]=~elt[d];
+    return r;
+  }
+  
+  vect operator+ (const T x) const {
+    vect r(*this);
+    r+=x;
+    return r;
+  }
+  
+  vect operator- (const T x) const {
+    vect r(*this);
+    r-=x;
+    return r;
+  }
+  
+  vect operator* (const T x) const {
+    vect r(*this);
+    r*=x;
+    return r;
+  }
+  
+  vect operator/ (const T x) const {
+    vect r(*this);
+    r/=x;
+    return r;
+  }
+  
+  vect operator% (const T x) const {
+    vect r(*this);
+    r%=x;
+    return r;
+  }
+  
+  vect operator& (const T x) const {
+    vect r(*this);
+    r&=x;
+    return r;
+  }
+  
+  vect operator| (const T x) const {
+    vect r(*this);
+    r|=x;
+    return r;
+  }
+  
+  vect operator^ (const T x) const {
+    vect r(*this);
+    r^=x;
+    return r;
+  }
+  
+  vect<bool,D> operator&& (const T x) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]&&x;
+    return r;
+  }
+  
+  vect<bool,D> operator|| (const T x) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]||x;
+    return r;
+  }
+  
+  vect operator+ (const vect& a) const {
+    vect r(*this);
+    r+=a;
+    return r;
+  }
+  
+  vect operator- (const vect& a) const {
+    vect r(*this);
+    r-=a;
+    return r;
+  }
+  
+  vect operator* (const vect& a) const {
+    vect r(*this);
+    r*=a;
+    return r;
+  }
+  
+  vect operator/ (const vect& a) const {
+    vect r(*this);
+    r/=a;
+    return r;
+  }
+  
+  vect operator% (const vect& a) const {
+    vect r(*this);
+    r%=a;
+    return r;
+  }
+  
+  vect operator& (const vect& a) const {
+    vect r(*this);
+    r&=a;
+    return r;
+  }
+  
+  vect operator| (const vect& a) const {
+    vect r(*this);
+    r|=a;
+    return r;
+  }
+  
+  vect operator^ (const vect& a) const {
+    vect r(*this);
+    r^=a;
+    return r;
+  }
+  
+  vect<bool,D> operator&& (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]&&a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator|| (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]||a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator== (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]==a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator!= (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]!=a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator< (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]<a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator<= (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]<=a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator> (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]>a[d];
+    return r;
+  }
+  
+  vect<bool,D> operator>= (const vect& a) const {
+    vect<bool,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]>=a[d];
+    return r;
+  }
+  
+  /** This corresponds to the ?: operator.  Return a vector with the
+      elements set to either a[i] or b[i], depending on whether
+      (*this)[i] is true or not.  */
+  template<class TT>
+  vect<TT,D> ifthen (const vect<TT,D>& a, const vect<TT,D>& b) const {
+    vect<TT,D> r;
+    for (int d=0; d<D; ++d) r[d]=elt[d]?a[d]:b[d];
+    return r;
+  }
+  
+  // Iterators
+#if 0
+  // This is non-standard
+  class iter {
+    vect &vec;
+    int d;
+  public:
+    iter (vect &a): vec(a), d(0) { }
+    iter& operator++ () { assert(d<D); ++d; return *this; }
+    bool operator bool () { return d==D; }
+    T& operator* { return vec[d]; }
+  };
+#endif
+  
+  // Input/Output helpers
+  void input (istream& is);
+  void output (ostream& os) const;
+};
+
+
+
+// Operators
+
+/** This corresponds to the ?: operator.  Return a vector with the
+    elements set to either b[i] or c[i], depending on whether a[i] is
+    true or not.  */
+template<class T,int D>
+inline vect<T,D> either (const vect<bool,D>& a,
+                         const vect<T,D>& b, const vect<T,D>& c) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=a[d]?b[d]:c[d];
+  return r;
+}
+
+/** Transpose a vector of a vector */
+template<class T, int D, int DD>
+inline vect<vect<T,D>,DD> xpose (vect<vect<T,DD>,D> const & a) {
+  vect<vect<T,D>,DD> r;
+  for (int dd=0; dd<DD; ++dd) for (int d=0; d<D; ++d) r[dd][d] = a[d][dd];
+  return r;
+}
+
+/** Return the element-wise absolute value.  */
+template<class T,int D>
+inline vect<T,D> abs (const vect<T,D>& a) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=abs(a[d]);
+  return r;
+}
+
+/** Return the element-wise ceiling.  */
+template<class T,int D>
+inline vect<T,D> ceil (const vect<T,D>& a) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=ceil(a[d]);
+  return r;
+}
+
+/** Return the element-wise floor.  */
+template<class T,int D>
+inline vect<T,D> floor (const vect<T,D>& a) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=floor(a[d]);
+  return r;
+}
+
+/** Return the element-wise maximum of two vectors.  */
+template<class T,int D>
+inline vect<T,D> max (const vect<T,D>& a, const vect<T,D>& b) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=max(a[d],b[d]);
+  return r;
+}
+
+/** Return the element-wise minimum of two vectors.  */
+template<class T,int D>
+inline vect<T,D> min (const vect<T,D>& a, const vect<T,D>& b) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=min(a[d],b[d]);
+  return r;
+}
+
+/** Return the element-wise power of two vectors.  */
+template<class T,class U,int D>
+inline vect<T,D> pow (const vect<T,D>& a, const vect<U,D>& b) {
+  vect<T,D> r;
+  for (int d=0; d<D; ++d) r[d]=pow(a[d],b[d]);
+  return r;
+}
+
+
+
+// Reduction operators
+
+/** Return true iff any of the elements are true (boolean sum).  */
+template<int D>
+inline bool any (const vect<bool,D>& a) {
+  bool r(false);
+  for (int d=0; d<D; ++d) r|=a[d];
+  return r;
+}
+
+/** Return true iff all of the elements are true (boolean product).  */
+template<int D>
+inline bool all (const vect<bool,D>& a) {
+  bool r(true);
+  for (int d=0; d<D; ++d) r&=a[d];
+  return r;
+}
+
+/** Count the number of elements in the vector.  */
+template<class T,int D>
+inline int count (const vect<T,D>& a) {
+  return D;
+}
+
+/** Return the dot product of two vectors.  */
+template<class T,int D>
+inline T dot (const vect<T,D>& a, const vect<T,D>& b) {
+  T r(0);
+  for (int d=0; d<D; ++d) r+=a[d]*b[d];
+  return r;
+}
+
+/** Return the Euklidean length.  */
+template<class T,int D>
+inline T hypot (const vect<T,D>& a) {
+  return sqrt(dot(a,a));
+}
+
+/** Return the maximum element.  */
+template<class T,int D>
+inline T maxval (const vect<T,D>& a) {
+  assert (D>0);
+  T r(a[0]);
+  for (int d=1; d<D; ++d) r=max(r,a[d]);
+  return r;
+}
+
+/** Return the minimum element.  */
+template<class T,int D>
+inline T minval (const vect<T,D>& a) {
+  assert (D>0);
+  T r(a[0]);
+  for (int d=1; d<D; ++d) r=min(r,a[d]);
+  return r;
+}
+
+/** Return the index of the first maximum element.  */
+template<class T,int D>
+inline int maxloc (const vect<T,D>& a) {
+  assert (D>0);
+  int r(0);
+  for (int d=1; d<D; ++d) if (a[d]>a[r]) r=d;
+  return r;
+}
+
+/** Return the index of the first minimum element.  */
+template<class T,int D>
+inline int minloc (const vect<T,D>& a) {
+  assert (D>0);
+  int r(0);
+  for (int d=1; d<D; ++d) if (a[d]<a[r]) r=d;
+  return r;
+}
+
+/** Return the product of the elements.  */
+template<class T,int D>
+inline T prod (const vect<T,D>& a) {
+  T r(1);
+  for (int d=0; d<D; ++d) r*=a[d];
+  return r;
+}
+
+/** Return the size (number of elements) of the vector.  */
+template<class T,int D>
+inline int size (const vect<T,D>& a) {
+  return D;
+}
+
+/** Return the sum of the elements.  */
+template<class T,int D>
+inline T sum (const vect<T,D>& a) {
+  T r(0);
+  for (int d=0; d<D; ++d) r+=a[d];
+  return r;
+}
+
+// Higher order functions
+
+/** Return a new vector where the function func() has been applied to
+    all elements.  */
+template<class T, class U, int D>
+inline vect<U,D> map (U (* const func)(T x), const vect<T,D>& a) {
+  vect<U,D> r;
+  for (int d=0; d<D; ++d) r[d] = func(a[d]);
+  return r;
+}
+  
+/** Return a new vector where the function func() has been used
+    element-wise to combine a and b.  */
+template<class S, class T, class U, int D>
+inline vect<U,D> zip (U (* const func)(S x, T y),
+                      const vect<S,D>& a, const vect<T,D>& b)
+{
+  vect<U,D> r;
+  for (int d=0; d<D; ++d) r[d] = func(a[d], b[d]);
+  return r;
+}
+
+/** Return a scalar where the function func() has been used to reduce
+    the vector a, starting with the scalar value val.  */
+template<class T, class U, int D>
+inline U fold (U (* const func)(U val, T x), U val, const vect<T,D>& a)
+{
+  for (int d=0; d<D; ++d) val = func(val, a[d]);
+  return val;
+}
+  
+/** Return a scalar where the function func() has been used to reduce
+    the vector a, starting with element 0.  */
+template<class T, class U, int D>
+inline U fold1 (U (* const func)(U val, T x), const vect<T,D>& a)
+{
+  assert (D>=1);
+  U val = a[0];
+  for (int d=1; d<D; ++d) val = func(val, a[d]);
+  return val;
+}
+
+/** Return a vector where the function func() has been used to scan
+    the vector a, starting with the scalar value val.  */
+template<class T, class U, int D>
+inline vect<U,D> scan0 (U (* const func)(U val, T x), U val,
+                        const vect<T,D>& a)
+{
+  vect<U,D> r;
+  for (int d=0; d<D; ++d) {
+    r[d] = val;
+    val = func(val, a[d]);
+  }
+  return r;
+}
+
+/** Return a vector where the function func() has been used to scan
+    the vector a, starting with element 0.  */
+template<class T, class U, int D>
+inline vect<U,D> scan1 (U (* const func)(U val, T x), U val,
+                        const vect<T,D>& a)
+{
+  vect<U,D> r;
+  for (int d=0; d<D; ++d) {
+    val = func(val, a[d]);
+    r[d] = val;
+  }
+  return r;
+}
+
+
+
+// Input
+
+/** Read a formatted vector from a stream.  */
+template<class T,int D>
+inline istream& operator>> (istream& is, vect<T,D>& a) {
+  a.input(is);
+  return is;
+}
+
+
+
+// Output
+
+/** Write a vector formatted to a stream.  */
+template<class T,int D>
+inline ostream& operator<< (ostream& os, const vect<T,D>& a) {
+  a.output(os);
+  return os;
+}
+
+
+
+#if 0  
+// Specialise explicit constructors
+
+/** Constructor for 2-element vectors from 2 elements.  */
+template<class T>
+inline vect<T,2>::vect<T,2> (const T x, const T y) {
+  elt[0]=x; elt[1]=y;
+}
+
+/** Constructor for 3-element vectors from 3 elements.  */
+vect (const T x, const T y, const T z) {
+  assert (D==3);
+  elt[0]=x; elt[1]=y; elt[2]=z;
+}
+
+/** Constructor for 4-element vectors from 4 elements.  */
+vect (const T x, const T y, const T z, const T t) {
+  assert (D==4);
+  elt[0]=x; elt[1]=y; elt[2]=z; elt[3]=t;
+}
+#endif
+
+
+
+// Specialise for double
+
+template<>
+inline vect<double,3>& vect<double,3>::operator%=(const vect<double,3>& a) {
+  for (int d=0; d<3; ++d) {
+    elt[d]=fmod(elt[d],a[d]);
+    if (elt[d]>a[d]*double(1.0-1.0e-10)) elt[d]=double(0);
+    if (elt[d]<a[d]*double(    1.0e-10)) elt[d]=double(0);
+  }
+  return *this;
+}
+
+
+
+#endif // VECT_HH