Task: Implement mask_allocate.cc for Carpet/CarpetReduce thorn

thorn_name: Carpet/CarpetReduce
src_filename: mask_allocate.cc
interface: # Interface definition for thorn CarpetReduce

IMPLEMENTS: reduce

uses include header: nompi.h

uses include header: defs.hh
uses include header: dh.hh
uses include header: dist.hh
uses include header: vect.hh

uses include header: carpet.hh
uses include header: carpet.h

uses include header: typecase.hh
uses include header: typeprops.hh

uses include header: loopcontrol.h

includes header: bits.h IN CarpetReduce_bits.h



CCTK_INT FUNCTION                           \
    GetBoundarySpecification     \
        (CCTK_INT IN size,                  \
         CCTK_INT OUT ARRAY nboundaryzones, \
         CCTK_INT OUT ARRAY is_internal,    \
         CCTK_INT OUT ARRAY is_staggered,   \
         CCTK_INT OUT ARRAY shiftout)
USES FUNCTION GetBoundarySpecification

CCTK_INT FUNCTION                           \
    MultiPatch_GetBoundarySpecification     \
        (CCTK_INT IN map,                   \
         CCTK_INT IN size,                  \
         CCTK_INT OUT ARRAY nboundaryzones, \
         CCTK_INT OUT ARRAY is_internal,    \
         CCTK_INT OUT ARRAY is_staggered,   \
         CCTK_INT OUT ARRAY shiftout)
USES FUNCTION MultiPatch_GetBoundarySpecification 

CCTK_INT FUNCTION                                                \
    SymmetryTableHandleForGrid (CCTK_POINTER_TO_CONST IN cctkGH)
REQUIRES FUNCTION SymmetryTableHandleForGrid

CCTK_INT FUNCTION                         \
    MultiPatch_GetMaps                    \
        (CCTK_POINTER_TO_CONST IN cctkGH)
USES FUNCTION MultiPatch_GetMaps

CCTK_INT FUNCTION                         \
    MultiPatch_GetMap                     \
        (CCTK_POINTER_TO_CONST IN cctkGH)
USES FUNCTION MultiPatch_GetMap

CCTK_INT FUNCTION                          \
    MultiPatch_GetDomainSpecification      \
        (CCTK_INT IN map,                  \
         CCTK_INT IN size,                 \
         CCTK_REAL OUT ARRAY physical_min, \
         CCTK_REAL OUT ARRAY physical_max, \
         CCTK_REAL OUT ARRAY interior_min, \
         CCTK_REAL OUT ARRAY interior_max, \
         CCTK_REAL OUT ARRAY exterior_min, \
         CCTK_REAL OUT ARRAY exterior_max, \
         CCTK_REAL OUT ARRAY spacing)
USES FUNCTION MultiPatch_GetDomainSpecification

CCTK_INT FUNCTION                          \
    GetDomainSpecification                 \
        (CCTK_INT IN size,                 \
         CCTK_REAL OUT ARRAY physical_min, \
         CCTK_REAL OUT ARRAY physical_max, \
         CCTK_REAL OUT ARRAY interior_min, \
         CCTK_REAL OUT ARRAY interior_max, \
         CCTK_REAL OUT ARRAY exterior_min, \
         CCTK_REAL OUT ARRAY exterior_max, \
         CCTK_REAL OUT ARRAY spacing)
USES FUNCTION GetDomainSpecification

# Get current refinement level
CCTK_INT FUNCTION                         \
    GetRefinementLevel                    \
        (CCTK_POINTER_TO_CONST IN cctkGH)
REQUIRES FUNCTION GetRefinementLevel



INT iweight TYPE=gf TAGS='prolongation="none" InterpNumTimelevels=1 checkpoint="no"' "Integer weight mask, using 2^D bits"

REAL weight TYPE=gf TAGS='prolongation="none" InterpNumTimelevels=1 checkpoint="no"' "Weight function"

REAL one TYPE=gf TAGS='prolongation="none" InterpNumTimelevels=1 checkpoint="no"' "Constant one"

CCTK_REAL excised_cells TYPE=scalar TAGS='checkpoint="no"' "Excised (ignored) volume in the simulation domain, in terms of coarse grid cells"

schedule: # Schedule definitions for thorn CarpetReduce

schedule CarpetReduceStartup at STARTUP
{
  LANG: C
} "Startup routine"



# Should this move to a new thorn MaskBase?
STORAGE: weight
STORAGE: excised_cells



SCHEDULE GROUP MaskBase_SetupMask AT basegrid AFTER (SpatialCoordinates SphericalSurface_Setup)
{
} "Set up the weight function"

SCHEDULE GROUP MaskBase_SetupMask AT postregridinitial AFTER SpatialCoordinates
{
} "Set up the weight function"

SCHEDULE GROUP MaskBase_SetupMask AT postregrid AFTER SpatialCoordinates
{
} "Set up the weight function"

SCHEDULE GROUP MaskBase_SetupMask AT post_recover_variables
{
} "Set up the weight function"



SCHEDULE GROUP MaskBase_SetupMaskAll IN MaskBase_SetupMask
{
  # Note: Storage for iweight and one is managed manually
} "Set up the weight function"



SCHEDULE MaskBase_AllocateMask IN MaskBase_SetupMaskAll
{
  LANG: C
  OPTIONS: global
} "Allocate the weight function"

SCHEDULE MaskBase_InitMask IN MaskBase_SetupMaskAll AFTER MaskBase_AllocateMask
{
  LANG: C
  OPTIONS: global loop-local
} "Initialise the weight function"

SCHEDULE GROUP SetupIMaskInternal IN MaskBase_SetupMaskAll AFTER MaskBase_InitMask
{
} "Set up the integer weight function (schedule other routines in here)"

SCHEDULE GROUP SetupIMask IN MaskBase_SetupMaskAll AFTER SetupIMaskInternal
{
} "Set up the integer weight function (schedule other routines in here)"

SCHEDULE MaskBase_SetMask IN MaskBase_SetupMaskAll AFTER SetupIMask
{
  LANG: C
  OPTIONS: global loop-local
} "Set the weight function"

SCHEDULE GROUP SetupMask IN MaskBase_SetupMaskAll AFTER MaskBase_SetMask
{
} "Set up the real weight function (schedule other routines in here)"

SCHEDULE MaskBase_TestMask IN MaskBase_SetupMaskAll AFTER SetupMask
{
  LANG: C
  OPTIONS: global
} "Test the weight function"



# Should this move to CoordBase?
SCHEDULE CoordBase_SetupMask IN SetupIMaskInternal
{
  LANG: C
  OPTIONS: global loop-local
} "Set up the outer boundaries of the weight function"

# Should this move to CarpetMask?
SCHEDULE CarpetMaskSetup IN SetupIMaskInternal
{
  LANG: C
  OPTIONS: global loop-singlemap
} "Set up the weight function for the restriction regions"

param: # Parameter definitions for thorn CarpetReduce

BOOLEAN verbose "Produce screen output while running" STEERABLE=always
{
} "no"

BOOLEAN debug_iweight "Allow debugging iweight grid function by keeping it allocated" STEERABLE=recover
{
} "no"

BOOLEAN min_max_time_interpolation "Interpolate in time for min/max reductions" STEERABLE=always
{
} "yes"

configuration: # Configuration definitions for thorn CarpetReduce

REQUIRES Carpet CarpetLib MPI

OPTIONAL LoopControl
{
}

context: mask_test.cc:
```
#include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Parameters.h>

#include <carpet.h>

#include <assert.h>
#include <math.h>

extern "C" void MaskBase_TestMask(CCTK_ARGUMENTS) {
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  if (verbose) {
    CCTK_INFO("Testing weight");
  }

  int const sum = CCTK_ReductionHandle("sum");
  assert(sum >= 0);

  int const proc = 0;

  int const weight_var = CCTK_VarIndex("CarpetReduce::weight");
  int const one_var = CCTK_VarIndex("CarpetReduce::one");
  assert(weight_var >= 0);
  assert(one_var >= 0);

  CCTK_REAL sum_weight, all_excised_cells;

  {
    int const ierr = CCTK_Reduce(cctkGH, proc, sum, 1, CCTK_VARIABLE_REAL,
                                 &sum_weight, 1, one_var);
    assert(ierr >= 0);
  }
  {
    int const ierr =
        CCTK_ReduceLocalScalar(cctkGH, proc, sum, excised_cells,
                               &all_excised_cells, CCTK_VARIABLE_REAL);
    assert(ierr >= 0);
    *excised_cells = all_excised_cells;
  }

  if (proc == -1 || CCTK_MyProc(cctkGH) == proc) {

    if (verbose) {
      CCTK_VInfo(CCTK_THORNSTRING, "Reduction weight sum: %.17g",
                 (double)sum_weight);
    }

    CCTK_REAL domain_volume = 0.0;

    int maps = 1;
    if (CCTK_IsFunctionAliased("MultiPatch_GetMaps")) {
      maps = MultiPatch_GetMaps(cctkGH);
    }

    for (int m = 0; m < maps; ++m) {

      CCTK_REAL physical_min[cctk_dim];
      CCTK_REAL physical_max[cctk_dim];
      CCTK_REAL interior_min[cctk_dim];
      CCTK_REAL interior_max[cctk_dim];
      CCTK_REAL exterior_min[cctk_dim];
      CCTK_REAL exterior_max[cctk_dim];
      CCTK_REAL spacing[cctk_dim];

      /* TODO: This requires that the domain was set up via CoordBase, not via
       * grid. Check this, and don't output any warnings if so. */
      if (CCTK_IsFunctionAliased("MultiPatch_GetDomainSpecification")) {
        int const ierr = MultiPatch_GetDomainSpecification(
            m, cctk_dim, physical_min, physical_max, interior_min, interior_max,
            exterior_min, exterior_max, spacing);
        assert(!ierr);
      } else {
        int const ierr = GetDomainSpecification(
            cctk_dim, physical_min, physical_max, interior_min, interior_max,
            exterior_min, exterior_max, spacing);
        assert(!ierr);
      }

      CCTK_REAL map_volume = 1.0;
      for (int d = 0; d < cctk_dim; ++d) {
        map_volume *= (physical_max[d] - physical_min[d]) / spacing[d];
      }

      if (verbose) {
        CCTK_VInfo(CCTK_THORNSTRING, "Volume of map #%d: %.17g", m,
                   (double)map_volume);
      }

      domain_volume += map_volume;

    } /* for m */

    /* Don't count excised regions towards the domain volume */
    domain_volume -= *excised_cells;

    if (verbose) {
      CCTK_VInfo(CCTK_THORNSTRING, "Simulation domain volume:  %.17g",
                 (double)domain_volume);
      CCTK_VInfo(CCTK_THORNSTRING, "Additional excised volume: %.17g",
                 (double)*excised_cells);
    }

    int const there_is_a_problem = fabs(sum_weight - domain_volume) >
                                   1.0e-12 * (sum_weight + domain_volume);

    if (there_is_a_problem) {
      if (!verbose) {
        CCTK_VInfo(CCTK_THORNSTRING, "Simulation domain volume:  %.17g",
                   (double)domain_volume);
        CCTK_VInfo(CCTK_THORNSTRING, "Additional excised volume: %.17g",
                   (double)*excised_cells);
        CCTK_VInfo(CCTK_THORNSTRING, "Reduction weight sum:      %.17g",
                   (double)sum_weight);
      }
      CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                 "Simulation domain volume and reduction weight sum differ");
    }
  }

  if (!debug_iweight) {
    CCTK_DisableGroupStorage(cctkGH, "CarpetReduce::iweight");
    CCTK_DisableGroupStorage(cctkGH, "CarpetReduce::one");
  }
}

```

mask_set.cc:
```
#include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Parameters.h>

#include <loopcontrol.h>

#include "bits.h"

extern "C" void MaskBase_SetMask(CCTK_ARGUMENTS) {
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  if (verbose) {
    int const reflevel = GetRefinementLevel(cctkGH);
    CCTK_VInfo(CCTK_THORNSTRING, "Finalise the weight on level %d", reflevel);
  }

  unsigned const bits = BMSK(cctk_dim);
  CCTK_REAL const factor = 1.0 / bits;
#pragma omp parallel
  CCTK_LOOP3_ALL(MaskBase_SetMask, cctkGH, i, j, k) {
    int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
    weight[ind] = factor * BCNT(iweight[ind]);
    one[ind] = 1.0;
  }
  CCTK_ENDLOOP3_ALL(MaskBase_SetMask);
}

```

mask_carpet.cc:
```
#include <cassert>
#include <istream>
#include <sstream>

#include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Parameters.h>

#include <dh.hh>

#include <carpet.hh>

#include <loopcontrol.h>

#include "bits.h"

namespace CarpetMask {

using namespace std;
using namespace Carpet;

/**
 * Reduce the weight on the current and the next coarser level to
 * make things consistent. Set the weight to 0 inside the active
 * region of the next coarser level, maybe to 1/2 near the boundary
 * of that region, and also to 1/2 near the prolongation boundary of
 * this level.
 */

extern "C" {
void CarpetMaskSetup(CCTK_ARGUMENTS);
}

void CarpetMaskSetup(CCTK_ARGUMENTS) {
  DECLARE_CCTK_PARAMETERS;

  if (not is_singlemap_mode()) {
    CCTK_ERROR("This routine may only be called in singlemap mode");
  }

  dh const &dd = *vdd.AT(Carpet::map);

  if (reflevel > 0) {
    ivect const reffact =
        spacereffacts.AT(reflevel) / spacereffacts.AT(reflevel - 1);
    assert(all(reffact == 2));
  }

  // Set prolongation boundaries and restricted region of this level
  BEGIN_LOCAL_COMPONENT_LOOP(cctkGH, CCTK_GF) {
    DECLARE_CCTK_ARGUMENTS;

    // Set the weight in the interior of the not_active and the
    // fine_active regions to zero, and set the weight on the
    // boundary of the not_active and fine_active regions to 1/2.

    // All regions and boundaries are masking out convex shapes, i.e.
    // the remaining grid points from a concave shape. That is, each
    // masking step removes 1/8, 1/4, or 1/2 of a cell (in three
    // dimensions).

    dh::local_dboxes const &local_box =
        dd.local_boxes.AT(mglevel).AT(reflevel).AT(local_component);

    for (int neighbour = 0; neighbour < ipow(3, dim); ++neighbour) {
      ivect shift;
      {
        int itmp = neighbour;
        for (int d = 0; d < dim; ++d) {
          shift[d] = itmp % 3 - 1; // [-1 ... +1]
          itmp /= 3;
        }
        assert(itmp == 0);
      }

      ibset const &boxes = local_box.prolongation_boundary.AT(neighbour);
      ibset const &cfboxes = local_box.restriction_boundary.AT(neighbour);

      // Set up a bit mask that keeps the lower (when dir[d]=-1) or
      // upper (when dir[d]=+1) half of the bits in each direction d
      unsigned const bits = BMSK(dim);
      unsigned bmask = 0;
      for (int d = 0; d < dim; ++d) {
        for (unsigned b = 0; b < bits; ++b) {
          if ((shift[d] == -1 and BGET(b, d) == 0) or
              (shift[d] == +1 and BGET(b, d) != 0)) {
            bmask = BSET(bmask, b);
          }
        }
      }

      // Handle prolongation region (region that is prolongated from
      // the next coarser level)

      if (verbose) {
        ostringstream buf;
        buf << "Setting boundary " << shift << ": level " << reflevel
            << " prolongation region " << boxes << " to bmask 0x" << hex
            << bmask << dec;
        CCTK_INFO(buf.str().c_str());
      }

      LOOP_OVER_BSET(cctkGH, boxes, box, imin, imax) {
        if (verbose) {
          ostringstream buf;
          buf << "  Setting prolongation box " << imin << ":"
              << imax - ivect(1);
          CCTK_INFO(buf.str().c_str());
        }
#pragma omp parallel
        CCTK_LOOP3(CarpetMaskSetup_prolongation, i, j, k, imin[0], imin[1],
                   imin[2], imax[0], imax[1], imax[2], cctk_ash[0], cctk_ash[1],
                   cctk_ash[2]) {
          int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
          iweight[ind] &= bmask;
        }
        CCTK_ENDLOOP3(CarpetMaskSetup_prolongation);
      }
      END_LOOP_OVER_BSET;

      // Handle restriction region (region that is restricted from the
      // next finer level)

      if (verbose) {
        ostringstream buf;
        buf << "Setting boundary " << shift << ": level " << reflevel
            << " restriction region " << cfboxes << " to bmask 0x" << hex
            << bmask << dec;
        CCTK_INFO(buf.str().c_str());
      }

      LOOP_OVER_BSET(cctkGH, cfboxes, box, imin, imax) {
        if (verbose) {
          ostringstream buf;
          buf << "  Setting restriction box " << imin << ":" << imax - ivect(1);
          CCTK_INFO(buf.str().c_str());
        }
#pragma omp parallel
        CCTK_LOOP3(CarpetMaskSetup_restriction, i, j, k, imin[0], imin[1],
                   imin[2], imax[0], imax[1], imax[2], cctk_ash[0], cctk_ash[1],
                   cctk_ash[2]) {
          int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
          iweight[ind] &= bmask;
        }
        CCTK_ENDLOOP3(CarpetMaskSetup_restriction);
      }
      END_LOOP_OVER_BSET;

    } // for neighbours
  }
  END_LOCAL_COMPONENT_LOOP;
}

} // namespace CarpetMask

```

reduce.hh:
```
#ifndef CARPETREDUCE_HH
#define CARPETREDUCE_HH

#include "reduce.h"

#endif // !defined(CARPETREDUCE_HH)

```

make.code.defn:
```
# Main make.code.defn file for thorn CarpetReduce

# Source files in this directory
SRCS = mask_allocate.cc mask_init.cc mask_set.cc mask_test.cc mask_carpet.cc mask_coords.cc reduce.cc

# Subdirectories containing source files
SUBDIRS =

```

mask_init.cc:
```
#include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Parameters.h>

#include <loopcontrol.h>

#include "bits.h"

extern "C" void MaskBase_InitMask(CCTK_ARGUMENTS) {
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  /* Initialise the weight to 1 everywhere */
  if (verbose) {
    int const reflevel = GetRefinementLevel(cctkGH);
    CCTK_VInfo(CCTK_THORNSTRING, "Initialising weight to 1 on level %d",
               reflevel);
  }

  unsigned const bits = BMSK(cctk_dim);
  unsigned const allbits = BMSK(bits) - 1;
#pragma omp parallel
  CCTK_LOOP3_ALL(MaskBase_InitMask, cctkGH, i, j, k) {
    int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
    iweight[ind] = allbits;
  }
  CCTK_ENDLOOP3_ALL(MaskBase_InitMask);
}

```

reduce.h:
```
#ifndef CARPETREDUCE_H
#define CARPETREDUCE_H

#ifdef __cplusplus
namespace CarpetReduce {
extern "C" {
#endif

/* Scheduled functions */
int CarpetReduceStartup(void);

#ifdef __cplusplus
} /* extern "C" */
} /* namespace CarpetReduce */
#endif

#endif /* !defined(CARPETREDUCE_H) */

```

mask_coords.cc:
```
#include <assert.h>
#include <stdlib.h>

#include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Functions.h>
#include <cctk_Parameters.h>

#include <loopcontrol.h>

#include "bits.h"

extern "C" void CoordBase_SetupMask(CCTK_ARGUMENTS) {
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  CCTK_INT nboundaryzones[2 * cctk_dim];
  CCTK_INT is_internal[2 * cctk_dim];
  CCTK_INT is_staggered[2 * cctk_dim];
  CCTK_INT shiftout[2 * cctk_dim];
  CCTK_INT is_periodic[2 * cctk_dim];

  int bnd_points[2 * cctk_dim]; /* points outside the domain */
  int int_points[cctk_dim];     /* global interior points */

  int gmin[cctk_dim], gmax[cctk_dim]; /* global domain extent */
  int imin[cctk_dim], imax[cctk_dim]; /* domain extent */
  int bmin[cctk_dim], bmax[cctk_dim]; /* boundary extent */

  int ierr;

  int const reflevel = GetRefinementLevel(cctkGH);

  if (CCTK_IsFunctionAliased("MultiPatch_GetBoundarySpecification")) {
    int const m = MultiPatch_GetMap(cctkGH);
    assert(m >= 0);
    ierr = MultiPatch_GetBoundarySpecification(
        m, 2 * cctk_dim, nboundaryzones, is_internal, is_staggered, shiftout);
  } else {
    ierr = GetBoundarySpecification(2 * cctk_dim, nboundaryzones, is_internal,
                                    is_staggered, shiftout);
  }
  if (ierr != 0) {
    CCTK_ERROR("Could not get boundary specification");
  }

  for (int d = 0; d < cctk_dim; ++d) {
    for (int f = 0; f < 2; ++f) {
      is_periodic[2 * d + f] = 0;
    }
  }
  CCTK_INT const *const periodic = static_cast<CCTK_INT const *>(
      CCTK_ParameterGet("periodic", "PeriodicCarpet", NULL));
  CCTK_INT const *const periodic_x = static_cast<CCTK_INT const *>(
      CCTK_ParameterGet("periodic_x", "PeriodicCarpet", NULL));
  CCTK_INT const *const periodic_y = static_cast<CCTK_INT const *>(
      CCTK_ParameterGet("periodic_x", "PeriodicCarpet", NULL));
  CCTK_INT const *const periodic_z = static_cast<CCTK_INT const *>(
      CCTK_ParameterGet("periodic_x", "PeriodicCarpet", NULL));
  is_periodic[0] = is_periodic[1] =
      (periodic && *periodic) || (periodic_x && *periodic_x);
  is_periodic[2] = is_periodic[3] =
      (periodic && *periodic) || (periodic_y && *periodic_y);
  is_periodic[4] = is_periodic[5] =
      (periodic && *periodic) || (periodic_z && *periodic_z);

  /* Calculate the number of boundary points. This excludes points
     that are directly on the boundary. */
  for (int d = 0; d < cctk_dim; ++d) {
    for (int f = 0; f < 2; ++f) {

      if (is_internal[2 * d + f]) {
        /* The boundary extends inwards */
        bnd_points[2 * d + f] = shiftout[2 * d + f];
      } else {
        /* The boundary extends outwards */
        if (is_periodic[2 * d + f]) {
          bnd_points[2 * d + f] = nboundaryzones[2 * d + f];
        } else {
          bnd_points[2 * d + f] = nboundaryzones[2 * d + f] +
                                  shiftout[2 * d + f] +
                                  is_staggered[2 * d + f] - 1;
        }
      }
    }
  }

  /* Calculate the global extent of the domain */
  for (int d = 0; d < cctk_dim; ++d) {
    gmin[d] = 0;
    gmax[d] = cctk_gsh[d];
  }

  /* Ensure that the domain specification is consistent */
  for (int d = 0; d < cctk_dim; ++d) {
    int_points[d] =
        (gmax[d] - bnd_points[2 * d + 1]) - (gmin[d] + bnd_points[2 * d]);
    if (int_points[d] < 0) {
      CCTK_ERROR("Number of internal grid points is negative");
    }
  }

  /* Loop over all dimensions and faces */
  for (int d = 0; d < cctk_dim; ++d) {
    for (int f = 0; f < 2; ++f) {

      /* If this processor has the outer boundary */
      if (cctk_bbox[2 * d + f]) {

        if (bnd_points[2 * d + f] < 0 || bnd_points[2 * d + f] > cctk_lsh[d]) {
          CCTK_ERROR("Illegal number of boundary points");
        }

        /* Calculate the extent of the local part of the domain */
        for (int dd = 0; dd < cctk_dim; ++dd) {
          imin[dd] = 0;
          imax[dd] = cctk_lsh[dd];
        }

        /* Calculate the extent of the boundary */
        for (int dd = 0; dd < cctk_dim; ++dd) {
          bmin[dd] = imin[dd];
          bmax[dd] = imax[dd];
        }
        if (f == 0) {
          /* lower face */
          bmax[d] = imin[d] + bnd_points[2 * d + f];
        } else {
          /* upper face */
          bmin[d] = imax[d] - bnd_points[2 * d + f];
        }

        /* Loop over the boundary */
        if (verbose) {
          CCTK_VInfo(CCTK_THORNSTRING, "Setting boundary points in direction "
                                       "%d face %d to weight 0 on level %d",
                     d, f, reflevel);
        }
#pragma omp parallel
        CCTK_LOOP3(CoordBase_SetupMask_boundary, i, j, k, bmin[0], bmin[1],
                   bmin[2], bmax[0], bmax[1], bmax[2], cctk_ash[0], cctk_ash[1],
                   cctk_ash[2]) {
          int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
          iweight[ind] = 0;
        }
        CCTK_ENDLOOP3(CoordBase_SetupMask_boundary);

        /* When the boundary is neither staggered nor periodic, then
           give the points directly on the boundary the weight 1/2 */
        if (!is_staggered[2 * d + f] && !is_periodic[2 * d + f]) {

          /* Since we are going to cut off 1/2 at each boundary, the
             domain size must be at least 1 to begin with */
          assert(int_points[d] >= 1);

          /* Check whether the domain is empty */
          if (int_points[d] == 1) {

            /* The domain is empty. The correct thing to do would be
               to set the weights to 0. But this is boring, because
               then there are no interior points left, and all
               reductions become trivial. Instead, leave the
               non-staggered boundary points alone, and assume that
               the user wants to perform a reduction in one fewer
               dimensions. */
            /* do nothing */

          } else {

            /* Adapt the extent of the boundary */
            if (f == 0) {
              /* lower face */
              bmin[d] = bmax[d];
              bmax[d] = bmin[d] + 1;
            } else {
              /* upper face */
              bmax[d] = bmin[d];
              bmin[d] = bmax[d] - 1;
            }

            /* Loop over the points next to boundary */
            /* Set up a bit mask that keeps the upper (f==0) or lower (f==1)
               half of the bits in each direction d */
            unsigned const bits = BMSK(cctk_dim);
            unsigned bmask = 0;
            for (unsigned b = 0; b < bits; ++b) {
              if (BGET(b, d) == !f) {
                bmask = BSET(bmask, b);
              }
            }
            assert(BCNT(bmask) == bits / 2);
            if (verbose) {
              CCTK_VInfo(CCTK_THORNSTRING, "Setting non-staggered boundary "
                                           "points on level %d in direction %d "
                                           "face %d to bmask 0x%x",
                         reflevel, d, f, bmask);
            }
#pragma omp parallel
            CCTK_LOOP3(CoordBase_SetupMask_boundary2, i, j, k, bmin[0], bmin[1],
                       bmin[2], bmax[0], bmax[1], bmax[2], cctk_ash[0],
                       cctk_ash[1], cctk_ash[2]) {
              int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
              iweight[ind] &= bmask;
            }
            CCTK_ENDLOOP3(CoordBase_SetupMask_boundary2);

          } /* if the domain is not empty */

        } /* if the boundary is not staggered */

      } else { /* if this is a ghost boundary */

        /* Calculate the extent of the local part of the domain */
        for (int dd = 0; dd < cctk_dim; ++dd) {
          imin[dd] = 0;
          imax[dd] = cctk_lsh[dd];
        }

        /* Calculate the extent of the boundary */
        for (int dd = 0; dd < cctk_dim; ++dd) {
          bmin[dd] = imin[dd];
          bmax[dd] = imax[dd];
        }
        if (f == 0) {
          /* lower face */
          bmax[d] = imin[d] + cctk_nghostzones[d];
        } else {
          /* upper face */
          bmin[d] = imax[d] - cctk_nghostzones[d];
        }

        /* Loop over the boundary */
        if (verbose) {
          CCTK_VInfo(CCTK_THORNSTRING, "Setting ghost points in direction %d "
                                       "face %d to weight 0 on level %d",
                     d, f, reflevel);
        }
#pragma omp parallel
        CCTK_LOOP3(CoordBase_SetupMask_ghost, i, j, k, bmin[0], bmin[1],
                   bmin[2], bmax[0], bmax[1], bmax[2], cctk_ash[0], cctk_ash[1],
                   cctk_ash[2]) {
          int const ind = CCTK_GFINDEX3D(cctkGH, i, j, k);
          iweight[ind] = 0;
        }
        CCTK_ENDLOOP3(CoordBase_SetupMask_ghost);

      } /* if this is a ghost boundary */

    } /* loop over faces */
  }   /* loop over directions */
}

```

reduce.cc:
```
#include <cctk.h>
#include <cctk_Parameters.h>
#include <util_ErrorCodes.h>
#include <util_Table.h>

#include <algorithm>
#include <cassert>
#include <cfloat>
#include <climits>
#include <cmath>
#include <complex>
#include <cstdio>
#include <cstdlib>
#include <cstring>
#include <limits>
#include <vector>

#ifdef CCTK_MPI
#include <mpi.h>
#else
#include "nompi.h"
#endif
#ifdef _OPENMP
#include <omp.h>
#endif

#include <defs.hh>
#include <dist.hh>
#include <vect.hh>

#include <carpet.hh>

#include "reduce.hh"

namespace CarpetReduce {

using namespace std;
using namespace Carpet;

// Helper functions and types

// The minimum of two values
template <typename T> static inline T mymin(const T x, const T y) {
  return min(x, y);
}

// The maximum of two values
template <typename T> static inline T mymax(const T x, const T y) {
  return max(x, y);
}

template <typename T> static inline T mysqr(const T x) { return x * x; }

template <typename T> static inline T mysqrabs(const T x) { return x * x; }

template <typename T> static inline T mysqrt(const T x) { return sqrt(x); }

// Properties of numeric types
template <typename T> struct my_numeric_limits {

  // The smallest possible value
  static T min() {
    // numeric_limits<T>::min() is the smallest number (that can be
    // represented) only for integer types.  For real types, it is
    // only the smallest _positive_ number.  However, we need the
    // true minimum.

    // For two's complement integers, it is min < - max, and for
    // floating point numbers, it is min = - max.  The expression
    // below does the right thing in both cases.
    return CarpetReduce::mymin(numeric_limits<T>::min(),
                               -numeric_limits<T>::max());
  }

  // The largest possible value
  static T max() {
    // numeric_limits<T>::max() is always the largest number that
    // can be represented.
    return numeric_limits<T>::max();
  }
};

// Provide for each Cactus type a "good" type, translating between
// CCTK_COMPLEX* and complex<CCTK_REAL*>
template <typename T> struct typeconv {
  typedef T goodtype;
  typedef T badtype;
};

// Overload the above helper functions and types for integer values
// The C++ compiler should supply these, but some old ones do not,
// e.g. our beloved workhorse Intel 7.1.  Self is the man.
#ifdef HAVE_CCTK_BYTE
template <> inline CCTK_BYTE mysqr(CCTK_BYTE const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_BYTE mysqrabs(CCTK_BYTE const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_BYTE mysqrt(CCTK_BYTE const x) {
  // return static_cast<CCTK_BYTE> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

#ifdef HAVE_CCTK_INT1
template <> inline CCTK_INT1 mysqr(CCTK_INT1 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT1 mysqrabs(CCTK_INT1 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT1 mysqrt(CCTK_INT1 const x) {
  // return static_cast<CCTK_INT1> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

#ifdef HAVE_CCTK_INT2
template <> inline CCTK_INT2 mysqr(CCTK_INT2 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT2 mysqrabs(CCTK_INT2 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT2 mysqrt(CCTK_INT2 const x) {
  // return static_cast<CCTK_INT2> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

#ifdef HAVE_CCTK_INT4
template <> inline CCTK_INT4 mysqr(CCTK_INT4 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT4 mysqrabs(CCTK_INT4 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT4 mysqrt(CCTK_INT4 const x) {
  // return static_cast<CCTK_INT4> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

#ifdef HAVE_CCTK_INT8
template <> inline CCTK_INT8 mysqr(CCTK_INT8 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT8 mysqrabs(CCTK_INT8 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT8 mysqrt(CCTK_INT8 const x) {
  // return static_cast<CCTK_INT8> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

#ifdef HAVE_CCTK_INT16
template <> inline CCTK_INT16 mysqr(CCTK_INT16 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT16 mysqrabs(CCTK_INT16 const x) {
  // prevent overflow
  return 0;
}

template <> inline CCTK_INT16 mysqrt(CCTK_INT16 const x) {
  // return static_cast<CCTK_INT16> (sqrt (static_cast<CCTK_REAL> (x)));
  return 0;
}
#endif

// Overload the above helper functions and types for complex values

#ifdef HAVE_CCTK_REAL4

template <>
inline complex<CCTK_REAL4> mymin(const complex<CCTK_REAL4> x,
                                 const complex<CCTK_REAL4> y) {
  return complex<CCTK_REAL4>(CarpetReduce::mymin(x.real(), y.real()),
                             CarpetReduce::mymin(x.imag(), y.imag()));
}

template <>
inline complex<CCTK_REAL4> mymax(const complex<CCTK_REAL4> x,
                                 const complex<CCTK_REAL4> y) {
  return complex<CCTK_REAL4>(CarpetReduce::mymax(x.real(), y.real()),
                             CarpetReduce::mymax(x.imag(), y.imag()));
}

template <> inline complex<CCTK_REAL4> mysqrabs(const complex<CCTK_REAL4> x) {
  return mysqr(abs(x));
}

template <> struct my_numeric_limits<complex<CCTK_REAL4> > {
  static complex<CCTK_REAL4> min() {
    return complex<CCTK_REAL4>(my_numeric_limits<CCTK_REAL4>::min(),
                               my_numeric_limits<CCTK_REAL4>::min());
  }
  static complex<CCTK_REAL4> max() {
    return complex<CCTK_REAL4>(my_numeric_limits<CCTK_REAL4>::max(),
                               my_numeric_limits<CCTK_REAL4>::max());
  }
};

template <> struct typeconv<CCTK_COMPLEX8> {
  typedef complex<CCTK_REAL4> goodtype;
  typedef CCTK_COMPLEX8 badtype;
};

#endif

#ifdef HAVE_CCTK_REAL8

template <>
inline complex<CCTK_REAL8> mymin(const complex<CCTK_REAL8> x,
                                 const complex<CCTK_REAL8> y) {
  return complex<CCTK_REAL8>(CarpetReduce::mymin(x.real(), y.real()),
                             CarpetReduce::mymin(x.imag(), y.imag()));
}

template <>
inline complex<CCTK_REAL8> mymax(const complex<CCTK_REAL8> x,
                                 const complex<CCTK_REAL8> y) {
  return complex<CCTK_REAL8>(CarpetReduce::mymax(x.real(), y.real()),
                             CarpetReduce::mymax(x.imag(), y.imag()));
}

template <> inline complex<CCTK_REAL8> mysqrabs(const complex<CCTK_REAL8> x) {
  return mysqr(abs(x));
}

template <> struct my_numeric_limits<complex<CCTK_REAL8> > {
  static complex<CCTK_REAL8> min() {
    return complex<CCTK_REAL8>(my_numeric_limits<CCTK_REAL8>::min(),
                               my_numeric_limits<CCTK_REAL8>::min());
  }
  static complex<CCTK_REAL8> max() {
    return complex<CCTK_REAL8>(my_numeric_limits<CCTK_REAL8>::max(),
                               my_numeric_limits<CCTK_REAL8>::max());
  }
};

template <> struct typeconv<CCTK_COMPLEX16> {
  typedef complex<CCTK_REAL8> goodtype;
  typedef CCTK_COMPLEX16 badtype;
};

#endif

#ifdef HAVE_CCTK_REAL16

template <>
inline complex<CCTK_REAL16> mymin(const complex<CCTK_REAL16> x,
                                  const complex<CCTK_REAL16> y) {
  return complex<CCTK_REAL16>(CarpetReduce::mymin(x.real(), y.real()),
                              CarpetReduce::mymin(x.imag(), y.imag()));
}

template <>
inline complex<CCTK_REAL16> mymax(const complex<CCTK_REAL16> x,
                                  const complex<CCTK_REAL16> y) {
  return complex<CCTK_REAL16>(CarpetReduce::mymax(x.real(), y.real()),
                              CarpetReduce::mymax(x.imag(), y.imag()));
}

template <> inline complex<CCTK_REAL16> mysqrabs(const complex<CCTK_REAL16> x) {
  return mysqr(abs(x));
}

template <> struct my_numeric_limits<complex<CCTK_REAL16> > {
  static complex<CCTK_REAL16> min() {
    return complex<CCTK_REAL16>(my_numeric_limits<CCTK_REAL16>::min(),
                                my_numeric_limits<CCTK_REAL16>::min());
  }
  static complex<CCTK_REAL16> max() {
    return complex<CCTK_REAL16>(my_numeric_limits<CCTK_REAL16>::max(),
                                my_numeric_limits<CCTK_REAL16>::max());
  }
};

template <> struct typeconv<CCTK_COMPLEX32> {
  typedef complex<CCTK_REAL16> goodtype;
  typedef CCTK_COMPLEX32 badtype;
};

#endif

// Poor man's RTTI
enum ared {
  do_count,
  do_minimum,
  do_maximum,
  do_product,
  do_sum,
  do_sum_abs,
  do_sum_squared,
  do_sum_abs_squared,
  do_average,
  do_norm1,
  do_norm2,
  do_norm_inf
};

struct reduction {
  virtual ared thered() const = 0;
  virtual bool uses_cnt() const = 0;
  virtual MPI_Op mpi_op() const = 0;
};

// count: count the number of grid points
struct count : reduction {
  count() {}
  ared thered() const { return do_count; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      accum += T(weight);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct minimum : reduction {
  minimum() {}
  ared thered() const { return do_minimum; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = my_numeric_limits<T>::max();
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum = CarpetReduce::mymin(accum, val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum = CarpetReduce::mymin(accum, accum2);
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_min; }
};

struct maximum : reduction {
  maximum() {}
  ared thered() const { return do_maximum; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = my_numeric_limits<T>::min();
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum = CarpetReduce::mymax(accum, val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum = CarpetReduce::mymax(accum, accum2);
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_max; }
};

struct product : reduction {
  product() {}
  ared thered() const { return do_product; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(1);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum *= weight == 1 ? val : pow(val, weight);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum *= accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_prod; }
};

struct sum : reduction {
  sum() {}
  ared thered() const { return do_sum; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * val;
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct sum_abs : reduction {
  sum_abs() {}
  ared thered() const { return do_sum_abs; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * abs(val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct sum_squared : reduction {
  sum_squared() {}
  ared thered() const { return do_sum_squared; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * CarpetReduce::mysqr(val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct sum_abs_squared : reduction {
  sum_abs_squared() {}
  ared thered() const { return do_sum_abs_squared; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * CarpetReduce::mysqrabs(val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct average : reduction {
  average() {}
  ared thered() const { return do_average; }
  bool uses_cnt() const { return true; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * val;
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {
      if (cnt != T(0))
        accum /= cnt;
    }
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct norm1 : reduction {
  norm1() {}
  ared thered() const { return do_norm1; }
  bool uses_cnt() const { return true; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * abs(val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {
      if (cnt != T(0))
        accum /= cnt;
    }
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct norm2 : reduction {
  norm2() {}
  ared thered() const { return do_norm2; }
  bool uses_cnt() const { return true; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum += weight * CarpetReduce::mysqrabs(val);
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum += accum2;
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {
      if (cnt != T(0))
        accum = CarpetReduce::mysqrt(accum / cnt);
    }
  };
  MPI_Op mpi_op() const { return dist::mpi_sum; }
};

struct norm_inf : reduction {
  norm_inf() {}
  ared thered() const { return do_norm_inf; }
  bool uses_cnt() const { return false; }
  template <class T> struct op {
    static inline void initialise(T &accum, T &cnt) {
      accum = T(0);
      cnt = T(0);
    }
    static inline void reduce(T &accum, T &cnt, const T &val,
                              const CCTK_REAL weight) {
      if (weight != 0)
        accum = CarpetReduce::mymax(accum, T(abs(val)));
      cnt += T(weight);
    }
    static inline void combine(T &accum, T &cnt, const T &accum2,
                               const T &cnt2) {
      accum = CarpetReduce::mymax(accum, accum2);
      cnt += cnt2;
    }
    static inline void finalise(T &accum, const T &cnt) {}
  };
  MPI_Op mpi_op() const { return dist::mpi_max; }
};

template <class T, class OP>
void initialise(void *const outval, void *const cnt) {
  OP::initialise(*(T *)outval, *(T *)cnt);
}

template <class T, class OP>
void reduce(const int *const lsh, const int *const ash, const int *const bbox,
            const int *const nghostzones, vector<const void *> const &inarrays,
            vector<CCTK_REAL> const &tfacs, void *const outval, void *const cnt,
            const CCTK_REAL *const weight, const CCTK_REAL levfac) {
  for (size_t tl = 0; tl < inarrays.size(); ++tl) {
    assert(inarrays.AT(tl));
  }
  assert(tfacs.size() == inarrays.size());
  T &myoutval = *static_cast<T *>(outval);
  T &mycnt = *static_cast<T *>(cnt);
  vect<int, dim> imin, imax;
  for (int d = 0; d < dim; ++d) {
    imin[d] = (bbox[2 * d] ? 0 : nghostzones[d]);
    imax[d] = lsh[d] - (bbox[2 * d + 1] ? 0 : nghostzones[d]);
  }

#if !(defined(__PGI) && (__PGIC__ > 9))
// Regular case

#pragma omp parallel
  {
    T myoutval_local;
    T mycnt_local;
    OP::initialise(myoutval_local, mycnt_local);
#pragma omp for nowait
#if CARPET_DIM == 3
    for (int k = imin[2]; k < imax[2]; ++k) {
      for (int j = imin[1]; j < imax[1]; ++j) {
        for (int i = imin[0]; i < imax[0]; ++i) {
          const int index = i + ash[0] * (j + ash[1] * k);
          CCTK_REAL const w = weight ? weight[index] * levfac : levfac;
          T myinval = T(0);
          for (size_t tl = 0; tl < inarrays.size(); ++tl) {
            myinval +=
                static_cast<const T *>(inarrays.AT(tl))[index] * tfacs.AT(tl);
          }
          OP::reduce(myoutval_local, mycnt_local, myinval, w);
        }
      }
    }
#elif CARPET_DIM == 4
    for (int l = imin[3]; l < imax[3]; ++l) {
      for (int k = imin[2]; k < imax[2]; ++k) {
        for (int j = imin[1]; j < imax[1]; ++j) {
          for (int i = imin[0]; i < imax[0]; ++i) {
            const int index = i + ash[0] * (j + ash[1] * (k + ash[2] * l));
            CCTK_REAL const w = weight ? weight[index] * levfac : levfac;
            T myinval = T(0);
            for (size_t tl = 0; tl < inarrays.size(); ++tl) {
              myinval +=
                  static_cast<const T *>(inarrays.AT(tl))[index] * tfacs.AT(tl);
            }
            OP::reduce(myoutval_local, mycnt_local, myinval, w);
          }
        }
      }
    }
#else
#error "Value of CARPET_DIM is not supported"
#endif
#pragma omp critical
    { OP::combine(myoutval, mycnt, myoutval_local, mycnt_local); }
  } // end omp parallel

#else
  // Special case for PGI 10 and later

  int const num_threads = dist::num_threads();
  T myoutval_locals[num_threads];
  T mycnt_locals[num_threads];
  // This is probably not worthwhile:
  // #pragma omp parallel
  for (int n = 0; n < num_threads; ++n) {
    T &myoutval_local = myoutval_locals[n];
    T &mycnt_local = mycnt_locals[n];
    OP::initialise(myoutval_local, mycnt_local);
  }
#if CARPET_DIM == 3
#pragma omp parallel for
  for (int k = imin[2]; k < imax[2]; ++k) {
    int const n = omp_get_thread_num();
    T &myoutval_local = myoutval_locals[n];
    T &mycnt_local = mycnt_locals[n];
    for (int j = imin[1]; j < imax[1]; ++j) {
      for (int i = imin[0]; i < imax[0]; ++i) {
        const int index = i + ash[0] * (j + ash[1] * k);
        CCTK_REAL const w = weight ? weight[index] * levfac : levfac;
        T myinval = T(0);
        for (size_t tl = 0; tl < inarrays.size(); ++tl) {
          myinval +=
              static_cast<const T *>(inarrays.AT(tl))[index] * tfacs.AT(tl);
        }
        OP::reduce(myoutval_local, mycnt_local, myinval, w);
      }
    }
  }
#elif CARPET_DIM == 4
#pragma omp parallel for
  for (int l = imin[3]; l < imax[3]; ++l) {
    int const n = omp_get_thread_num();
    T &myoutval_local = myoutval_locals[n];
    T &mycnt_local = mycnt_locals[n];
    for (int k = imin[2]; k < imax[2]; ++k) {
      for (int j = imin[1]; j < imax[1]; ++j) {
        for (int i = imin[0]; i < imax[0]; ++i) {
          const int index = i + ash[0] * (j + ash[1] * (k + ash[2] * l));
          CCTK_REAL const w = weight ? weight[index] * levfac : levfac;
          T myinval = T(0);
          for (size_t tl = 0; tl < inarrays.size(); ++tl) {
            myinval +=
                static_cast<const T *>(inarrays.AT(tl))[index] * tfacs.AT(tl);
          }
          OP::reduce(myoutval_local, mycnt_local, myinval, w);
        }
      }
    }
  }
#else
#error "Value of CARPET_DIM is not supported"
#endif
  // This loop is not parallel
  for (int n = 0; n < num_threads; ++n) {
    T const &myoutval_local = myoutval_locals[n];
    T const &mycnt_local = mycnt_locals[n];
    OP::combine(myoutval, mycnt, myoutval_local, mycnt_local);
  }

#endif
}

template <class T, class OP>
void finalise(void *const outval, const void *const cnt) {
  OP::finalise(*(T *)outval, *(const T *)cnt);
}

void Initialise(const cGH *const cgh, const int proc, const int num_outvals,
                void *const myoutvals, const int outtype, void *const mycounts,
                const reduction *const red) {
  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(num_outvals >= 0);

  const int vartypesize = CCTK_VarTypeSize(outtype);
  assert(vartypesize >= 0);

  assert(num_outvals == 0 or myoutvals);
  assert(num_outvals == 0 or mycounts);

  assert(red);

  for (int n = 0; n < num_outvals; ++n) {

    switch (specific_cactus_type(outtype)) {
#define INITIALISE(OP, S)                                                      \
  case do_##OP: {                                                              \
    typedef typeconv<S>::goodtype T;                                           \
    initialise<T, OP::op<T> >(&((char *)myoutvals)[vartypesize * n],           \
                              &((char *)mycounts)[vartypesize * n]);           \
    break;                                                                     \
  }
#define TYPECASE(N, T)                                                         \
  case N: {                                                                    \
    switch (red->thered()) {                                                   \
      INITIALISE(count, T);                                                    \
      INITIALISE(minimum, T);                                                  \
      INITIALISE(maximum, T);                                                  \
      INITIALISE(product, T);                                                  \
      INITIALISE(sum, T);                                                      \
      INITIALISE(sum_abs, T);                                                  \
      INITIALISE(sum_squared, T);                                              \
      INITIALISE(sum_abs_squared, T);                                          \
      INITIALISE(average, T);                                                  \
      INITIALISE(norm1, T);                                                    \
      INITIALISE(norm2, T);                                                    \
      INITIALISE(norm_inf, T);                                                 \
    default:                                                                   \
      assert(0);                                                               \
    }                                                                          \
    break;                                                                     \
  }
#include "typecase.hh"
#undef TYPECASE
#undef INITIALISE
    default:
      assert(0);
    }

  } // for n
}

void Copy(const cGH *const cgh, const int proc, const int lsize,
          const int num_inarrays, const void *const *const inarrays,
          const int intype, const int num_outvals, void *const myoutvals,
          const int outtype, void *const mycounts) {
  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(lsize >= 0);
  assert(num_outvals >= 0);

  assert(num_inarrays >= 0);
  assert(num_inarrays * lsize == num_outvals);
  assert(inarrays);
  for (int n = 0; n < num_inarrays; ++n) {
    assert(inarrays[n]);
  }

  assert(num_outvals == 0 or myoutvals);
  assert(num_outvals == 0 or mycounts);

  assert(outtype == intype);

  for (int m = 0; m < num_inarrays; ++m) {
    for (int n = 0; n < lsize; ++n) {

      switch (specific_cactus_type(outtype)) {
#define COPY(S)                                                                \
  {                                                                            \
    typedef typeconv<S>::goodtype T;                                           \
    ((T *)myoutvals)[n + lsize * m] = ((const T *)inarrays[m])[n];             \
    ((T *)mycounts)[n + lsize * m] = T(1);                                     \
  }
#define TYPECASE(N, T)                                                         \
  case N: {                                                                    \
    COPY(T);                                                                   \
    break;                                                                     \
  }
#include "typecase.hh"
#undef TYPECASE
#undef COPY
      default:
        assert(0);
      }

    } // for
  }   // for
}

void Reduce(const cGH *const cgh, const int proc, const int *const mylsh,
            const int *const myash, const int *const mybbox,
            const int *const mynghostzones, const int num_inarrays,
            vector<const void *const *> const &inarrays,
            vector<CCTK_REAL> const &tfacs, const int intype,
            const int num_outvals, void *const myoutvals, const int outtype,
            void *const mycounts, const reduction *const red,
            CCTK_REAL const *const weight, CCTK_REAL const levfac) {
  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(num_outvals >= 0);

  assert(num_inarrays >= 0);
  assert(num_inarrays == num_outvals);
  for (size_t tl = 0; tl < inarrays.size(); ++tl) {
    assert(inarrays.AT(tl));
    for (int n = 0; n < num_inarrays; ++n) {
      assert(inarrays.AT(tl)[n]);
    }
  }
  assert(tfacs.size() == inarrays.size());

  for (int d = 0; d < dim; ++d) {
    assert(mylsh[d] >= 0);
    assert(myash[d] >= mylsh[d]);
    assert(mynghostzones[d] >= 0);
    int const nb = !mybbox[2 * d] + !mybbox[2 * d + 1];
    assert(nb * mynghostzones[d] <= mylsh[d]);
  }

  const int vartypesize = CCTK_VarTypeSize(outtype);
  assert(vartypesize >= 0);

  assert(myoutvals);
  assert(mycounts);

  assert(outtype == intype);

  vector<const void *> myinarrays(inarrays.size());

  for (int n = 0; n < num_outvals; ++n) {

    for (size_t tl = 0; tl < inarrays.size(); ++tl) {
      myinarrays.AT(tl) = inarrays.AT(tl)[n];
    }

    switch (specific_cactus_type(outtype)) {
#define REDUCE(OP, S)                                                          \
  case do_##OP: {                                                              \
    typedef typeconv<S>::goodtype T;                                           \
    reduce<T, OP::op<T> >(mylsh, myash, mybbox, mynghostzones, myinarrays,     \
                          tfacs, &((char *)myoutvals)[vartypesize * n],        \
                          &((char *)mycounts)[vartypesize * n], weight,        \
                          levfac);                                             \
    break;                                                                     \
  }
#define TYPECASE(N, T)                                                         \
  case N: {                                                                    \
    switch (red->thered()) {                                                   \
      REDUCE(count, T);                                                        \
      REDUCE(minimum, T);                                                      \
      REDUCE(maximum, T);                                                      \
      REDUCE(product, T);                                                      \
      REDUCE(sum, T);                                                          \
      REDUCE(sum_abs, T);                                                      \
      REDUCE(sum_squared, T);                                                  \
      REDUCE(sum_abs_squared, T);                                              \
      REDUCE(average, T);                                                      \
      REDUCE(norm1, T);                                                        \
      REDUCE(norm2, T);                                                        \
      REDUCE(norm_inf, T);                                                     \
    default:                                                                   \
      assert(0);                                                               \
    }                                                                          \
    break;                                                                     \
  }
#include "typecase.hh"
#undef TYPECASE
#undef REDUCE
    default:
      assert(0);
    }

  } // for n
}

void Finalise(const cGH *const cgh, const int proc, const int num_outvals,
              void *const outvals, const int outtype,
              const void *const myoutvals, const void *const mycounts,
              const reduction *const red) {
  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(num_outvals >= 0);
  assert(outvals or (proc != -1 and proc != CCTK_MyProc(cgh)));

  assert(num_outvals == 0 or myoutvals);
  assert(num_outvals == 0 or mycounts);

  const int vartypesize = CCTK_VarTypeSize(outtype);
  assert(vartypesize >= 0);

  char *const sendbuf = static_cast<char *>(const_cast<void *>(myoutvals));
  const int bufsize = num_outvals * vartypesize;
  const int mpicount = num_outvals * (1 + red->uses_cnt());
  if (red->uses_cnt()) {
    if (not(sendbuf + bufsize == static_cast<const char *>(mycounts))) {
      cerr << "sendbuf=" << (void *)sendbuf << endl
           << "bufsize=" << bufsize << endl
           << "mycounts=" << mycounts << endl
           << "num_outvals=" << num_outvals << endl
           << "outtype=" << outtype << endl
           << "vartypesize=" << vartypesize << endl
           << "mpicount=" << mpicount << endl;
    }
    assert(sendbuf + bufsize == static_cast<const char *>(mycounts));
    assert(red->mpi_op() == dist::mpi_sum);
  }

  char *recvbuf = static_cast<char *>(outvals);
  vector<char> buffer;
  if (proc == -1 or proc == CCTK_MyProc(cgh)) {
    if (red->uses_cnt()) {
      buffer.resize(2 * bufsize);
      recvbuf = &buffer[0];
    }
  }

  const MPI_Datatype mpitype = CarpetMPIDatatype(outtype);
  if (proc == -1) {
    MPI_Allreduce(sendbuf, recvbuf, mpicount, mpitype, red->mpi_op(),
                  CarpetMPIComm());
  } else {
    MPI_Reduce(sendbuf, recvbuf, mpicount, mpitype, red->mpi_op(), proc,
               CarpetMPIComm());
  }

  if (proc == -1 or proc == CCTK_MyProc(cgh)) {

    assert(outvals);
    char *counts = NULL;
    if (red->uses_cnt()) {
      memcpy(outvals, recvbuf, bufsize);
      counts = recvbuf + bufsize;
    }

    for (int n = 0; n < num_outvals; ++n) {

      switch (specific_cactus_type(outtype)) {
#define FINALISE(OP, S)                                                        \
  case do_##OP: {                                                              \
    typedef typeconv<S>::goodtype T;                                           \
    void *const outval = &((char *)outvals)[vartypesize * n];                  \
    T dummy;                                                                   \
    void *const cnt =                                                          \
        red->uses_cnt() ? (void *)&counts[vartypesize * n] : (void *)&dummy;   \
    finalise<T, OP::op<T> >(outval, cnt);                                      \
    break;                                                                     \
  }
#define TYPECASE(N, T)                                                         \
  case N: {                                                                    \
    switch (red->thered()) {                                                   \
      FINALISE(count, T);                                                      \
      FINALISE(minimum, T);                                                    \
      FINALISE(maximum, T);                                                    \
      FINALISE(product, T);                                                    \
      FINALISE(sum, T);                                                        \
      FINALISE(sum_abs, T);                                                    \
      FINALISE(sum_squared, T);                                                \
      FINALISE(sum_abs_squared, T);                                            \
      FINALISE(average, T);                                                    \
      FINALISE(norm1, T);                                                      \
      FINALISE(norm2, T);                                                      \
      FINALISE(norm_inf, T);                                                   \
    default:                                                                   \
      assert(0);                                                               \
    }                                                                          \
    break;                                                                     \
  }
#include "typecase.hh"
#undef TYPECASE
#undef FINALISE
      default:
        assert(0);
      }

    } // for n

  } // if
}

int ReduceArrays(const cGH *const cgh, const int proc, const int num_dims,
                 const int *const dims, const int num_inarrays,
                 const void *const *const inarrays, const int intype,
                 const int num_outvals, void *const outvals, const int outtype,
                 const reduction *const red, const int igrid) {
  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(num_outvals >= 0);
  assert(outvals or (proc != -1 and proc != CCTK_MyProc(cgh)));

  assert(num_inarrays >= 0);
  assert(inarrays);
  for (int n = 0; n < num_inarrays; ++n) {
    assert(inarrays[n]);
  }

  if (intype != outtype) {
    char const *const intypename = CCTK_VarTypeName(intype);
    char const *const outtypename = CCTK_VarTypeName(outtype);
    CCTK_VWarn(CCTK_WARN_COMPLAIN, __LINE__, __FILE__, CCTK_THORNSTRING,
               "The input type must be the same as the output type.  Requested "
               "were intype=%s, outtype=%s.",
               intypename, outtypename);
    return -1;
  }

  assert(num_dims >= 0 and num_dims <= dim);
  for (int d = 0; d < num_dims; ++d) {
    assert(dims[d] >= 0);
  }

  int lsize = 1;
  for (int d = 0; d < num_dims; ++d) {
    lsize *= dims[d];
  }

  const bool do_local_reduction = num_outvals == 1;

  if (not do_local_reduction) {
    assert(num_outvals == lsize);
  }

  vect<int, dim> mylsh, myash, mynghostzones;
  vect<vect<int, 2>, dim> mybbox;
  for (int d = 0; d < num_dims; ++d) {
    mylsh[d] = dims[d];
    myash[d] = dims[d]; // could also be passed in
    mybbox[d][0] = 0;
    mybbox[d][1] = 0;
    mynghostzones[d] = 0;
  }
  for (int d = num_dims; d < dim; ++d) {
    mylsh[d] = 1;
    myash[d] = 1;
    mybbox[d][0] = 0;
    mybbox[d][1] = 0;
    mynghostzones[d] = 0;
  }

  vector<const void *const *> myinarrays(1);
  vector<CCTK_REAL> tfacs(1);
  myinarrays.AT(0) = inarrays;
  tfacs.AT(0) = 1.0;

  const int vartypesize = CCTK_VarTypeSize(outtype);
  assert(vartypesize >= 0);

  // local mode may be trouble
  if (is_local_mode()) {
    assert(mc_grouptype >= 0);
    if (mc_grouptype == CCTK_GF) {
      int mynlc = 0;
      for (int m = 0; m < maps; ++m) {
        mynlc += vhh.AT(m)->local_components(reflevel);
      }
      int nlc = mynlc;
      MPI_Bcast(&nlc, 1, MPI_INT, 0, dist::comm());
      if (nlc == mynlc) {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_DEBUG, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in local mode may lead to deadlock (if different "
                   "processes own different numbers of components). Called "
                   "from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      } else {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in local mode will lead to deadlock if different "
                   "processes own different numbers of components. Called from "
                   "'%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      }
    }
  }

  // singlemap mode may also be trouble
  if (is_singlemap_mode()) {
    assert(mc_grouptype >= 0);
    if (mc_grouptype == CCTK_GF) {
      int mynlm = 0;
      for (int m = 0; m < maps; ++m) {
        if (vhh.AT(m)->local_components(reflevel) > 0) {
          ++mynlm;
        };
      }
      int nlm = mynlm;
      MPI_Bcast(&nlm, 1, MPI_INT, 0, dist::comm());
      if (nlm == mynlm) {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_PICKY, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in singlemap mode may lead to deadlock (if "
                   "different processes own components on different numbers of "
                   "maps). Called from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      } else {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in singlemap mode will lead to deadlock if "
                   "different processes own components on different numbers of "
                   "maps. Called from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      }
    }
  }

  // keep local outvals and counts in a single buffer
  // to save a copy operation in the Finalise() step
  vector<char> buffer(2 * vartypesize * num_inarrays * num_outvals);
  char *const myoutvals = &buffer[0];
  char *const mycounts = &buffer[vartypesize * num_inarrays * num_outvals];

  Initialise(cgh, proc, num_inarrays * num_outvals, myoutvals, outtype,
             mycounts, red);
  if (do_local_reduction) {
    Reduce(cgh, proc, &mylsh[0], &myash[0], &mybbox[0][0], &mynghostzones[0],
           num_inarrays, myinarrays, tfacs, intype, num_inarrays * num_outvals,
           myoutvals, outtype, mycounts, red, NULL, 1.0);
  } else {
    Copy(cgh, proc, lsize, num_inarrays, inarrays, intype,
         num_inarrays * num_outvals, myoutvals, outtype, mycounts);
  }
  Finalise(cgh, proc, num_inarrays * num_outvals, outvals, outtype, myoutvals,
           mycounts, red);

  return 0;
}

int ReduceGVs(const cGH *const cgh, const int proc, const int num_outvals,
              const int outtype, void *const outvals, const int num_invars,
              const int *const invars, const reduction *const red,
              const int igrid) {
  DECLARE_CCTK_PARAMETERS;

  assert(cgh);

  int ierr;

  assert(proc == -1 or (proc >= 0 and proc < CCTK_nProcs(cgh)));

  assert(num_outvals >= 0);
  assert(num_outvals == 1);
  assert(outvals or (proc != -1 and proc != CCTK_MyProc(cgh)));

  assert(num_invars >= 0);
  assert(invars);
  for (int n = 0; n < num_invars; ++n) {
    assert(invars[n] >= 0 and invars[n] < CCTK_NumVars());
  }

  if (num_invars == 0)
    return 0;

  assert(num_invars > 0);
  const int vi = invars[0];
  assert(vi >= 0 and vi < CCTK_NumVars());

  const int grpdim = CCTK_GroupDimFromVarI(vi);
  assert(grpdim >= 0 and grpdim <= dim);
  for (int n = 0; n < num_invars; ++n) {
    assert(CCTK_GroupDimFromVarI(invars[n]) == grpdim);
  }

  const int intype = CCTK_VarTypeI(vi);
  for (int n = 0; n < num_invars; ++n) {
    assert(CCTK_VarTypeI(invars[n]) == intype);
  }

  const int vartypesize = CCTK_VarTypeSize(outtype);
  assert(vartypesize >= 0);

  // can't have meta mode
  if (is_meta_mode()) {
    CCTK_ERROR("Grid variable reductions are not possible in meta mode");
  }

  // local mode may be trouble
  if (is_local_mode()) {
    assert(mc_grouptype >= 0);
    if (mc_grouptype == CCTK_GF) {
      int mynlc = 0;
      for (int m = 0; m < maps; ++m) {
        mynlc += vhh.AT(m)->local_components(reflevel);
      }
      int nlc = mynlc;
      MPI_Bcast(&nlc, 1, MPI_INT, 0, dist::comm());
      if (nlc == mynlc) {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_DEBUG, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in local mode may lead to deadlock (if different "
                   "processes own different numbers of components). Called "
                   "from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      } else {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in local mode will lead to deadlock if different "
                   "processes own different numbers of components. Called from "
                   "'%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      }
    }
  }

  // singlemap mode may also be trouble
  if (is_singlemap_mode()) {
    assert(mc_grouptype >= 0);
    if (mc_grouptype == CCTK_GF) {
      int mynlm = 0;
      for (int m = 0; m < maps; ++m) {
        if (vhh.AT(m)->local_components(reflevel) > 0) {
          ++mynlm;
        };
      }
      int nlm = mynlm;
      MPI_Bcast(&nlm, 1, MPI_INT, 0, dist::comm());
      if (nlm == mynlm) {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_PICKY, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in singlemap mode may lead to deadlock (if "
                   "different processes own components on different numbers of "
                   "maps). Called from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      } else {
        const cFunctionData *calling_function =
            CCTK_ScheduleQueryCurrentFunction(cgh);
        CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Reduction in singlemap mode will lead to deadlock if "
                   "different processes own components on different numbers of "
                   "maps. Called from '%s::%s' AT %s.",
                   calling_function ? calling_function->thorn : "unknown",
                   calling_function ? calling_function->routine : "unknown",
                   calling_function ? calling_function->where : "unknown");
      }
    }
  }

  bool const reduce_arrays = CCTK_GroupTypeFromVarI(vi) != CCTK_GF;
  bool const want_global_mode = is_global_mode() and not reduce_arrays;
  bool const want_level_mode = is_level_mode() and not reduce_arrays;

  for (int n = 0; n < num_invars; ++n) {
    if ((CCTK_GroupTypeFromVarI(invars[n]) != CCTK_GF) != reduce_arrays) {
      CCTK_ERROR("Cannot (yet) reduce grid functions and grid arrays/scalars "
                 "at the same time");
    }
  }

  // Ensure that all maps have the same number of refinement levels
  for (int m = 0; m < (int)vhh.size(); ++m) {
    assert(vhh.AT(m)->reflevels() == vhh.AT(0)->reflevels());
  }
  int const minrl = reduce_arrays ? 0 : want_global_mode ? 0 : reflevel;
  int const maxrl = reduce_arrays ? 1 : want_global_mode
                                            ? vhh.AT(0)->reflevels()
                                            : reflevel + 1;
  int const minm =
      reduce_arrays ? 0 : want_global_mode or want_level_mode ? 0 : Carpet::map;
  int const maxm = reduce_arrays ? 1 : want_global_mode or want_level_mode
                                           ? maps
                                           : Carpet::map + 1;

  // Find the time interpolation order
  int partype;
  void const *const parptr =
      CCTK_ParameterGet("prolongation_order_time", "Carpet", &partype);
  assert(parptr);
  assert(partype == PARAMETER_INTEGER);
  int const prolongation_order_time = *(CCTK_INT const *)parptr;

  CCTK_REAL const current_time = cgh->cctk_time;

  // keep local outvals and counts in a single buffer
  // to save a copy operation in the Finalise() step
  vector<char> buffer(2 * vartypesize * num_invars * num_outvals);
  char *const myoutvals = &buffer[0];
  char *const mycounts = &buffer[vartypesize * num_invars * num_outvals];

  Initialise(cgh, proc, num_invars * num_outvals, myoutvals, outtype, mycounts,
             red);

  BEGIN_GLOBAL_MODE(cgh) {
    for (int rl = minrl; rl < maxrl; ++rl) {
      ENTER_LEVEL_MODE(cgh, rl) {

        // Number of necessary time levels
        CCTK_REAL const level_time = cgh->cctk_time;
        bool need_time_interp =
            ((min_max_time_interpolation or
              (red->thered() != do_minimum and red->thered() != do_maximum)) and
             not reduce_arrays and
             (fabs(current_time - level_time) >
              1e-12 * (fabs(level_time) + fabs(current_time) +
                       fabs(cgh->cctk_delta_time))));
        assert(not(not want_global_mode and need_time_interp));
        assert(not(reduce_arrays and need_time_interp));

        int num_tl;
        if (need_time_interp) {

          int const gi = CCTK_GroupIndexFromVarI(vi);
          assert(gi >= 0);
          int const table = CCTK_GroupTagsTableI(gi);
          assert(table >= 0);
          CCTK_INT interp_num_time_levels;
          int const ilen = Util_TableGetInt(table, &interp_num_time_levels,
                                            "InterpNumTimelevels");
          if (ilen == UTIL_ERROR_TABLE_NO_SUCH_KEY) {
            num_tl = prolongation_order_time + 1;
          } else if (ilen >= 0) {
            assert(interp_num_time_levels > 0);
            num_tl =
                min(prolongation_order_time + 1, (int)interp_num_time_levels);
          } else {
            assert(0);
          }
          assert(num_tl >= 1);

          if (num_tl == 1) {
            // One time level does not count as interpolation
            need_time_interp = false;
          } else {
            // Are there enough time levels?
            int const active_tl = CCTK_ActiveTimeLevelsVI(cgh, vi);
            if (active_tl < num_tl) {
              int const max_tl = CCTK_MaxActiveTimeLevelsVI(cgh, vi);
              if (max_tl == 1 and active_tl == 1) {
                static vector<bool> have_warned;
                if (have_warned.empty()) {
                  have_warned.resize(CCTK_NumVars(), false);
                }
                if (not have_warned.AT(vi)) {
                  char *const fullname = CCTK_FullName(vi);
                  CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__,
                             CCTK_THORNSTRING, "Grid function \"%s\" has only "
                                               "%d time levels on refinement "
                                               "level %d; this is not enough "
                                               "for time interpolation",
                             fullname, max_tl, reflevel);
                  free(fullname);
                  have_warned.AT(vi) = true;
                }
                // fall back to no time interpolation
                num_tl = 1;
                need_time_interp = false;
              } else {
                char *const fullname = CCTK_FullName(vi);
                CCTK_VWarn(
                    CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                    "Grid function \"%s\" has only %d active time levels out "
                    "of %d maximum time levels on refinement level %d; this is "
                    "not enough for time interpolation",
                    fullname, active_tl, max_tl, reflevel);
                if (not do_allow_past_timelevels) {
                  CCTK_WARN(CCTK_WARN_ALERT,
                            "(Note: access to past time levels is disabled at "
                            "this point, probably because of the schedule bin "
                            "from which this code is called.)");
                }
                free(fullname);
                return 1; // error
              }
            }
          }

        } else {

          // no time interpolation
          num_tl = 1;

          // Are there enough time levels?
          int const active_tl = CCTK_ActiveTimeLevelsVI(cgh, vi);
          if (active_tl < num_tl) {
            char *const fullname = CCTK_FullName(vi);
            CCTK_VWarn(CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
                       "Grid function \"%s\" has no active time levels on "
                       "refinement level %d",
                       fullname, reflevel);
            free(fullname);
            return 1; // error
          }
        }

        assert(not need_time_interp or num_tl > 1);

        vector<CCTK_REAL> tfacs(num_tl);

        // Interpolate in time, if necessary
        if (need_time_interp) {

          // Get interpolation times
          CCTK_REAL const time = current_time;
          vector<CCTK_REAL> times(num_tl);
          for (int tl = 0; tl < num_tl; ++tl) {
            times.AT(tl) = tt->get_time(mglevel, reflevel, tl);
          }

          // Calculate interpolation weights
          if (num_tl == 1) {
            assert(fabs((time - times.AT(0)) /
                        fabs(time + times.AT(0) + cgh->cctk_delta_time)) <
                   1e-12);
          }
          for (int tl = 0; tl < num_tl; ++tl) {
            CCTK_REAL tmp = 1.0;
            for (int n = 0; n < num_tl; ++n) {
              // Lagrange polynomial interpolation
              if (n != tl) {
                tmp *= (time - times.AT(n)) / (times.AT(tl) - times.AT(n));
              }
            }
            tfacs.AT(tl) = tmp;
          }

        } else { // if not need_time_interp

          assert(num_tl == 1);
          tfacs.AT(0) = 1;

        } // if not need_time_interp

        int const grouptype = reduce_arrays ? CCTK_ARRAY : CCTK_GF;
        for (int m = minm; m < maxm; ++m) {
          int const maxlc =
              grouptype == CCTK_GF ? vhh.AT(m)->local_components(reflevel) : 1;
          if (maxlc > 0) {
            ENTER_SINGLEMAP_MODE(cgh, m, grouptype) {
              BEGIN_LOCAL_COMPONENT_LOOP(cgh, grouptype) {

                assert(grpdim <= dim);
                int lsh[dim], ash[dim], bbox[2 * dim], nghostzones[dim];
                ierr = CCTK_GrouplshVI(cgh, grpdim, lsh, vi);
                assert(not ierr);
                ierr = CCTK_GroupashVI(cgh, grpdim, ash, vi);
                assert(not ierr);
                ierr = CCTK_GroupbboxVI(cgh, 2 * grpdim, bbox, vi);
                assert(not ierr);
                ierr = CCTK_GroupnghostzonesVI(cgh, grpdim, nghostzones, vi);
                assert(not ierr);
                for (int d = 0; d < grpdim; ++d) {
                  assert(lsh[d] >= 0);
                  assert(ash[d] >= lsh[d]);
                  assert(nghostzones[d] >= 0);
                  int const nb = !bbox[2 * d] + !bbox[2 * d + 1];
                  assert(nb * nghostzones[d] <= lsh[d]);
                }

                vect<int, dim> mylsh, myash, mynghostzones;
                vect<vect<int, 2>, dim> mybbox;
                for (int d = 0; d < grpdim; ++d) {
                  mylsh[d] = lsh[d];
                  myash[d] = ash[d];
                  mybbox[d][0] = bbox[2 * d];
                  mybbox[d][1] = bbox[2 * d + 1];
                  mynghostzones[d] = nghostzones[d];
                }
                for (int d = grpdim; d < dim; ++d) {
                  mylsh[d] = 1;
                  myash[d] = 1;
                  mybbox[d][0] = 0;
                  mybbox[d][1] = 0;
                  mynghostzones[d] = 0;
                }

                CCTK_REAL const *weight;
                CCTK_REAL levfac;
                if (want_global_mode or want_level_mode) {
                  static int iweight = -1;
                  if (iweight == -1) {
                    iweight = CCTK_VarIndex("CarpetReduce::weight");
                    assert(iweight >= 0);
                  }
                  weight = (static_cast<CCTK_REAL const *>(
                      CCTK_VarDataPtrI(cgh, 0, iweight)));
                  assert(weight);
                  CCTK_REAL const levfac1 =
                      1.0 / prod(rvect(spacereflevelfact));
                  levfac = want_level_mode or igrid ? 1.0 : levfac1;
                } else {
                  weight = NULL;
                  levfac = 1.0;
                }

                vector<vector<const void *> > myinarrays(num_tl);
                vector<const void *const *> inarrays(num_tl);
                for (int tl = 0; tl < num_tl; ++tl) {
                  myinarrays.AT(tl).resize(num_invars);
                  for (int n = 0; n < num_invars; ++n) {
#if 0
                      myinarrays.AT(tl).AT(n)
                        = CCTK_VarDataPtrI(cgh, tl, invars[n]);
#else
                    int const vi1 = invars[n];
                    int const gi = CCTK_GroupIndexFromVarI(vi1);
                    int const vi0 = CCTK_FirstVarIndexI(gi);
                    ggf const *const ff =
                        arrdata.AT(gi).AT(Carpet::map).data.AT(vi1 - vi0);
                    void const *const ptr =
                        ff->data_pointer(tl, reflevel, local_component, mglevel)
                            ->storage();
                    myinarrays.AT(tl).AT(n) = ptr;
#endif
                    assert(myinarrays.AT(tl).AT(n));
                  }
                  inarrays.AT(tl) = &myinarrays.AT(tl).AT(0);
                }

                Reduce(cgh, proc, &mylsh[0], &myash[0], &mybbox[0][0],
                       &mynghostzones[0], num_invars, inarrays, tfacs, intype,
                       num_invars * num_outvals, myoutvals, outtype, mycounts,
                       red, weight, levfac);
              }
              END_LOCAL_COMPONENT_LOOP;
            }
            LEAVE_SINGLEMAP_MODE;
          } // if maxlc > 0
        }   // for m
      }
      LEAVE_LEVEL_MODE;
    } // for rl
  }
  END_GLOBAL_MODE;

  Finalise(cgh, proc, num_invars * num_outvals, outvals, outtype, myoutvals,
           mycounts, red);

  return 0;
}

// IGRID specifies whether the operator acts on grid points or cell
// volumes
#define REDUCTION(OPNAME, OP, IGRID)                                           \
  int OPNAME##_arrays(                                                         \
      const cGH *const cgh, const int proc, const int num_dims,                \
      const int *const dims, const int num_inarrays,                           \
      const void *const *const inarrays, const int intype,                     \
      const int num_outvals, void *const outvals, const int outtype) {         \
    const OP red;                                                              \
    return ReduceArrays(cgh, proc, num_dims, dims, num_inarrays, inarrays,     \
                        intype, num_outvals, outvals, outtype, &red, IGRID);   \
  }                                                                            \
                                                                               \
  int OPNAME##_GVs(const cGH *const cgh, const int proc,                       \
                   const int num_outvals, const int outtype,                   \
                   void *const outvals, const int num_invars,                  \
                   const int *const invars) {                                  \
    const OP red;                                                              \
    return ReduceGVs(cgh, proc, num_outvals, outtype, outvals, num_invars,     \
                     invars, &red, IGRID);                                     \
  }

REDUCTION(count, count, 0);
REDUCTION(minimum, minimum, 0);
REDUCTION(maximum, maximum, 0);
REDUCTION(product, product, 0);
REDUCTION(sum, sum, 0);
REDUCTION(sum_abs, sum_abs, 0);
REDUCTION(sum_squared, sum_squared, 0);
REDUCTION(sum_abs_squared, sum_abs_squared, 0);
REDUCTION(average, average, 0);
REDUCTION(norm1, norm1, 0);
REDUCTION(norm2, norm2, 0);
REDUCTION(norm_inf, norm_inf, 0);

REDUCTION(icount, count, 1);
REDUCTION(iminimum, minimum, 1);
REDUCTION(imaximum, maximum, 1);
REDUCTION(iproduct, product, 1);
REDUCTION(isum, sum, 1);
REDUCTION(isum_abs, sum_abs, 1);
REDUCTION(isum_squared, sum_squared, 1);
REDUCTION(isum_abs_squared, sum_abs_squared, 1);
REDUCTION(iaverage, average, 1);
REDUCTION(inorm1, norm1, 1);
REDUCTION(inorm2, norm2, 1);
REDUCTION(inorm_inf, norm_inf, 1);

#undef REDUCTION

int CarpetReduceStartup() {
  CCTK_RegisterReductionOperator(count_GVs, "count");
  CCTK_RegisterReductionOperator(minimum_GVs, "minimum");
  CCTK_RegisterReductionOperator(maximum_GVs, "maximum");
  CCTK_RegisterReductionOperator(product_GVs, "product");
  CCTK_RegisterReductionOperator(sum_GVs, "sum");
  CCTK_RegisterReductionOperator(sum_abs_GVs, "sum_abs");
  CCTK_RegisterReductionOperator(sum_squared_GVs, "sum_squared");
  CCTK_RegisterReductionOperator(sum_abs_squared_GVs, "sum_abs_squared");
  CCTK_RegisterReductionOperator(average_GVs, "average");
  CCTK_RegisterReductionOperator(norm1_GVs, "norm1");
  CCTK_RegisterReductionOperator(norm2_GVs, "norm2");
  CCTK_RegisterReductionOperator(norm_inf_GVs, "norm_inf");

  CCTK_RegisterReductionOperator(icount_GVs, "icount");
  CCTK_RegisterReductionOperator(iminimum_GVs, "iminimum");
  CCTK_RegisterReductionOperator(imaximum_GVs, "imaximum");
  CCTK_RegisterReductionOperator(iproduct_GVs, "iproduct");
  CCTK_RegisterReductionOperator(isum_GVs, "isum");
  CCTK_RegisterReductionOperator(isum_abs_GVs, "isum_abs");
  CCTK_RegisterReductionOperator(isum_squared_GVs, "isum_squared");
  CCTK_RegisterReductionOperator(isum_abs_squared_GVs, "isum_abs_squared");
  CCTK_RegisterReductionOperator(iaverage_GVs, "iaverage");
  CCTK_RegisterReductionOperator(inorm1_GVs, "inorm1");
  CCTK_RegisterReductionOperator(inorm2_GVs, "inorm2");
  CCTK_RegisterReductionOperator(inorm_inf_GVs, "inorm_inf");

  CCTK_RegisterReductionArrayOperator(count_arrays, "count");
  CCTK_RegisterReductionArrayOperator(minimum_arrays, "minimum");
  CCTK_RegisterReductionArrayOperator(maximum_arrays, "maximum");
  CCTK_RegisterReductionArrayOperator(product_arrays, "product");
  CCTK_RegisterReductionArrayOperator(sum_arrays, "sum");
  CCTK_RegisterReductionArrayOperator(sum_abs_arrays, "sum_abs");
  CCTK_RegisterReductionArrayOperator(sum_squared_arrays, "sum_squared");
  CCTK_RegisterReductionArrayOperator(sum_abs_squared_arrays,
                                      "sum_abs_squared");
  CCTK_RegisterReductionArrayOperator(average_arrays, "average");
  CCTK_RegisterReductionArrayOperator(norm1_arrays, "norm1");
  CCTK_RegisterReductionArrayOperator(norm2_arrays, "norm2");
  CCTK_RegisterReductionArrayOperator(norm_inf_arrays, "norm_inf");

  CCTK_RegisterReductionArrayOperator(icount_arrays, "icount");
  CCTK_RegisterReductionArrayOperator(iminimum_arrays, "iminimum");
  CCTK_RegisterReductionArrayOperator(imaximum_arrays, "imaximum");
  CCTK_RegisterReductionArrayOperator(iproduct_arrays, "iproduct");
  CCTK_RegisterReductionArrayOperator(isum_arrays, "isum");
  CCTK_RegisterReductionArrayOperator(isum_abs_arrays, "isum_abs");
  CCTK_RegisterReductionArrayOperator(isum_squared_arrays, "isum_squared");
  CCTK_RegisterReductionArrayOperator(isum_abs_squared_arrays,
                                      "isum_abs_squared");
  CCTK_RegisterReductionArrayOperator(iaverage_arrays, "iaverage");
  CCTK_RegisterReductionArrayOperator(inorm1_arrays, "inorm1");
  CCTK_RegisterReductionArrayOperator(inorm2_arrays, "inorm2");
  CCTK_RegisterReductionArrayOperator(inorm_inf_arrays, "inorm_inf");

  return 0;
}

} // namespace CarpetReduce

```

bits.h:
```
#ifndef BITS_H
#define BITS_H

/* a mask with exactly bit n set */
inline unsigned BMSK(unsigned n) { return 1U << n; }

/* whether bit n in value v is set */
inline unsigned BGET(unsigned v, unsigned n) { return !!(v & BMSK(n)); }

/* set, clear, or invert bit n in value v */
inline unsigned BSET(unsigned v, unsigned n) { return v | BMSK(n); }
inline unsigned BCLR(unsigned v, unsigned n) { return v & ~BMSK(n); }
inline unsigned BINV(unsigned v, unsigned n) { return v ^ BMSK(n); }

/* set bit n in value v to b */
inline unsigned BCPY(unsigned v, unsigned n, unsigned b) {
  return BCLR(v, n) | (-!!b & BMSK(n));
}

/* count the number of set bits */
inline unsigned BCNT(unsigned v) {
  v = (v & 0x55555555U) + ((v >> 1) & 0x55555555U);
  v = (v & 0x33333333U) + ((v >> 2) & 0x33333333U);
  v = (v + (v >> 4)) & 0x0f0f0f0fU;
  v = v + (v >> 8);
  v = v + (v >> 16);
  return v & 0xff;
}

#endif /* #ifndef BITS_H */

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn CarpetReduce
Author(s)    : Erik Schnetter <schnetter@cct.lsu.edu>
Maintainer(s): Erik Schnetter <schnetter@cct.lsu.edu>
Licence      : GPLv2+
--------------------------------------------------------------------------

1. Purpose

This thorn provides parallel reduction operators for Carpet.



This thorn now uses a weight function.  This makes it possible to
perform physically meaningful spatial reduction operations.  The
weight is 1 for all "normal" grid points.

The weight is set to 0 on symmetry and possible the outer boundary,
and it might be set to 1/2 on the edge of the boundary.  Setting this
depends on the coordinate thorn, and currently works only when the
coordinates are defined via CoordBase.

The weight is also reduced or set to 0 on coarser grids that are
overlaid by finer grid.

The weight should also be reduced or set to 0 near and in excised
regions.  This should happen in conjunction with an excision boundary
thorn.

This weigth function should probably be extracted into its own thorn
MaskBase, so that many thorns can easily operate on it.

```

## Documentation (.tex files):
Files: documentation.tex

```tex
=== documentation.tex ===
% *======================================================================*
%  Cactus Thorn template for ThornGuide documentation
%  Author: Ian Kelley
%  Date: Sun Jun 02, 2002
%
%  Thorn documentation in the latex file doc/documentation.tex 
%  will be included in ThornGuides built with the Cactus make system.
%  The scripts employed by the make system automatically include 
%  pages about variables, parameters and scheduling parsed from the 
%  relevent thorn CCL files.
%  
%  This template contains guidelines which help to assure that your     
%  documentation will be correctly added to ThornGuides. More 
%  information is available in the Cactus UsersGuide.
%                                                    
%  Guidelines:
%   - Do not change anything before the line
%       % START CACTUS THORNGUIDE",
%     except for filling in the title, author, date etc. fields.
%        - Each of these fields should only be on ONE line.
%        - Author names should be sparated with a \\ or a comma
%   - You can define your own macros, but they must appear after
%     the START CACTUS THORNGUIDE line, and must not redefine standard 
%     latex commands.
%   - To avoid name clashes with other thorns, 'labels', 'citations', 
%     'references', and 'image' names should conform to the following 
%     convention:          
%       ARRANGEMENT_THORN_LABEL
%     For example, an image wave.eps in the arrangement CactusWave and 
%     thorn WaveToyC should be renamed to CactusWave_WaveToyC_wave.eps
%   - Graphics should only be included using the graphix package. 
%     More specifically, with the "includegraphics" command. Do
%     not specify any graphic file extensions in your .tex file. This 
%     will allow us (later) to create a PDF version of the ThornGuide
%     via pdflatex. |
%   - References should be included with the latex "bibitem" command. 
%   - Use \begin{abstract}...\end{abstract} instead of \abstract{...}
%   - Do not use \appendix, instead include any appendices you need as 
%     standard sections. 
%   - For the benefit of our Perl scripts, and for future extensions, 
%     please use simple latex.     
%
% *======================================================================* 
% 
% Example of including a graphic image:
%    \begin{figure}[ht]
% 	\begin{center}
%    	   \includegraphics[width=6cm]{MyArrangement_MyThorn_MyFigure}
% 	\end{center}
% 	\caption{Illustration of this and that}
% 	\label{MyArrangement_MyThorn_MyLabel}
%    \end{figure}
%
% Example of using a label:
%   \label{MyArrangement_MyThorn_MyLabel}
%
% Example of a citation:
%    \cite{MyArrangement_MyThorn_Author99}
%
% Example of including a reference
%   \bibitem{MyArrangement_MyThorn_Author99}
%   {J. Author, {\em The Title of the Book, Journal, or periodical}, 1 (1999), 
%   1--16. {\tt http://www.nowhere.com/}}
%
% *======================================================================* 

\documentclass{article}

% Use the Cactus ThornGuide style file
% (Automatically used from Cactus distribution, if you have a 
%  thorn without the Cactus Flesh download this from the Cactus
%  homepage at www.cactuscode.org)
\usepackage{../../../../doc/latex/cactus}

\begin{document}

% The author of the documentation
\author{Erik Schnetter \textless schnetter@uni-tuebingen.de\textgreater}

% The title of the document (not necessarily the name of the Thorn)
\title{CarpetReduce}

% the date your document was last changed, if your document is in CVS, 
% please use:
\date{April 29, 2003}

\maketitle

% Do not delete next line
% START CACTUS THORNGUIDE

% Add all definitions used in this documentation here 
%   \def\mydef etc

% Add an abstract for this thorn's documentation
\begin{abstract}

\end{abstract}

% The following sections are suggestive only.
% Remove them or add your own.

\section{Introduction}

\section{Physical System}

\section{Numerical Implementation}

\section{Using This Thorn}

\subsection{Obtaining This Thorn}

\subsection{Basic Usage}

\subsection{Special Behaviour}

\subsection{Interaction With Other Thorns}

\subsection{Examples}

\subsection{Support and Feedback}

\section{History}

\subsection{Thorn Source Code}

\subsection{Thorn Documentation}

\subsection{Acknowledgements}


\begin{thebibliography}{9}

\end{thebibliography}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference solution:
src_code: #include <cctk.h>
#include <cctk_Arguments.h>
#include <cctk_Parameters.h>

extern "C" void MaskBase_AllocateMask(CCTK_ARGUMENTS) {
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  /* Allocate helpers for the weight function */
  if (verbose) {
    CCTK_INFO("Allocating weight function helpers");
  }

  CCTK_EnableGroupStorage(cctkGH, "CarpetReduce::iweight");
  CCTK_EnableGroupStorage(cctkGH, "CarpetReduce::one");

  /* Initialise excised cell count */
  *excised_cells = 0.0;
}