Task: Implement sphericalharmonic.cc for EinsteinAnalysis/Multipole thorn

thorn_name: EinsteinAnalysis/Multipole
src_filename: sphericalharmonic.cc
interface: #interface.ccl for thorn Multipole
implements: multipole
inherits:   Grid 

CCTK_INT FUNCTION IO_TruncateOutputFiles \
  (CCTK_POINTER_TO_CONST IN GH)

REQUIRES FUNCTION IO_TruncateOutputFiles

public:

CCTK_REAL harmonics type=GF timelevels=1
{
  harmonic_re, harmonic_im
} "Spherical harmonics"

CCTK_REAL test_integration_convergence_orders type=SCALAR
{
  test_midpoint_convergence_order,
  test_trapezoidal_convergence_order,
  test_simpson_convergence_order
} "Test integration convergence orders"

CCTK_REAL test_integration_results type=SCALAR
{
  test_midpoint_result_low, test_midpoint_result_high,
  test_trapezoidal_result_low, test_trapezoidal_result_high,
  test_simpson_result_low, test_simpson_result_high
} "Test integration results"


CCTK_REAL test_integration_symmetries type=SCALAR
{
  test_midpoint_pi_symmetry,
  test_trapezoidal_pi_symmetry,
  test_simpson_pi_symmetry,
  test_driscollhealy_pi_symmetry
} "Test integration symmetries"

schedule: #schedule.ccl for thorn Multipole

if (enable_test)
{
  STORAGE: harmonics[1]
  STORAGE: test_integration_convergence_orders
  STORAGE: test_integration_results
  STORAGE: test_integration_symmetries
}

schedule Multipole_Calc at CCTK_ANALYSIS after (calc_np,PsiKadelia,Accelerator_CopyBack)
{
  LANG: C
  OPTIONS: GLOBAL
} "Calculate Multipoles"

if (enable_test)
{
    schedule Multipole_SetHarmonic at CCTK_INITIAL
    {
      LANG: C
    } "Populate grid functions with spherical harmonics"
}

schedule Multipole_ParamCheck at CCTK_PARAMCHECK
{
  LANG: C
  OPTIONS: GLOBAL
} "Check Multipole parameters"

# Tests

if (enable_test)
{
  schedule Multipole_TestIntegrationConvergence at CCTK_PARAMCHECK
  {
    LANG: C
  } "Test convergence of integration"

  schedule Multipole_TestIntegrationSymmetry at CCTK_PARAMCHECK
  {
    LANG: C
  } "Test symmetry of integration"
}

param: #param.ccl for thorn Multipole

shares: IO

USES STRING out_dir

restricted:
#Interpolator params:
CCTK_STRING interpolator_name "Which interpolator should I use"
{
    ".+" :: "Any nonempty string"
} "Hermite polynomial interpolation"

CCTK_STRING interpolator_pars "Parameters for the interpolator"
{
    ".*" :: "Any string that Util_TableSetFromString() will take"
} "order=3 boundary_off_centering_tolerance={0.0 0.0 0.0 0.0 0.0 0.0} boundary_extrapolation_tolerance={0.0 0.0 0.0 0.0 0.0 0.0}"

# The above makes sure that the interpolator doesn't off-centre the
# interpolation stencil if there are insufficient points to
# interpolate, which can happen if there are insufficient ghost-zones
# for the interpolation method used, and can lead to processor-number
# dependent results.

CCTK_STRING coord_system "What is the coord system?"
{
    ".*" :: "Any smart string will do"
} "cart3d"

KEYWORD integration_method "How to do surface integrals" STEERABLE=always
{
  "midpoint"      :: "Midpoint rule (1st order)"
  "Simpson"       :: "Simpson's rule (4th order) [requires even ntheta and nphi]"
  "trapezoidal"   :: "Trapezoidal rule (2nd order)"
  "DriscollHealy" :: "Driscoll & Healy (exponentially convergent) [requires even ntheta]"
} "midpoint"

CCTK_INT out_every "How often to output" \
STEERABLE=recover
{
  0   :: "no output"
  1:* :: "output every to many iterations"
} 1

CCTK_INT out_1d_every "How often to output 1d data" \
STEERABLE=recover
{
  0   :: "no output"
  1:* :: "output every to many iterations"
} 0

#physical params:
CCTK_INT nradii "How many extraction radii?" \
STEERABLE=recover
{
  0:100 :: ""
} 1


CCTK_REAL radius[101] "The radii for extraction" \
STEERABLE=recover
{
  0.0:* :: "Please keep it in the grid"
} 0.0

CCTK_INT ntheta "How many points in the theta direction?" \
STEERABLE=recover
{
  0:* :: "Positive please"
} 50

CCTK_INT nphi "How many points in the phi direction?" \
STEERABLE=recover
{
  1:* :: ""
} 100

CCTK_STRING variables "What variables to decompose"
{
    ".*" :: "A list of variables"
} ""

CCTK_BOOLEAN verbose "Output detailed information about what is happening"
{
} "no"

CCTK_INT l_max "The maximum l mode to extract" STEERABLE=always
{
  0:* :: "l >= 0"
} 2

CCTK_BOOLEAN enable_test "whether to set a spherical harmonic in the 'harmonic' grid functions"
{
} "no"

CCTK_INT test_l "which mode to put into the test variables"
{
  * :: "Any integer"
} 2

CCTK_INT test_m "which mode to put into the test variables"
{
  * :: "Any integer"
} 2

CCTK_INT test_sw "which spin weight to put into the test variables"
{
  * :: "Any integer"
} -2

CCTK_BOOLEAN test_mode_proportional_to_r "whether the test spherical harmonic coefficient is proportional to the radial coordinate"
{
} "no"


# This parameter is deprecated and is no longer used
KEYWORD mode_type "Which type of mode extraction do we have" STEERABLE=always
{
  "all modes"     :: "Extract all modes up to (l_mode, m_mode)."
  "specific mode" :: "Select one specific (l_mode, m_mode) mode"
  "deprecated"    :: "Deprecated"
} "deprecated"

# This parameter is deprecated and is no longer used
CCTK_INT l_min "all modes: above which l mode to calculate/ specific mode: which l mode to extract" STEERABLE=always
{
  -1:* :: "Deprecated"
} -1

# This parameter is deprecated and is only used if set to a nondefault
# value, in which case it is a synonym for l_max.
CCTK_INT l_mode "The maximum l mode to extract" STEERABLE=always
{
  -1:* :: "Deprecated"
} -1

# This parameter is deprecated and is no longer used
CCTK_INT m_mode "all modes: Up to which m mode to calculate/ specific mode: which m mode to extract " STEERABLE=always
{
  -100:* :: "Deprecated"
} -100

CCTK_BOOLEAN output_ascii "Output a simple ASCII file for each mode at each radius"
{
} "yes"

CCTK_BOOLEAN output_hdf5 "Output an HDF5 file for each variable containing one dataset per mode at each radius"
{
} "no"

CCTK_INT hdf5_chunk_size "How many iterations to preallocate in extensible HDF5 datasets"
{
  1:* :: "Any integer"
} 200

configuration: OPTIONAL HDF5
{
}

context: tests.cc:
```
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <assert.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

#include "utils.hh"
#include "integrate.hh"

static CCTK_REAL test_integral(int n, CCTK_REAL (*integration_fn) (const CCTK_REAL *, int, int, CCTK_REAL, CCTK_REAL))
{
  const int nx = n;
  const int ny = n;
  const int array_size=(nx+1)*(ny+1);

  CCTK_REAL *f = new CCTK_REAL[array_size];

  const CCTK_REAL dx = 1./nx;
  const CCTK_REAL dy = 1./ny;

  for (int ix = 0; ix <= nx; ix++)
  {
    for (int iy = 0; iy <= ny; iy++)
    {
      const int i = Multipole_Index(ix, iy, nx);

      const CCTK_REAL x = ix*dx;
      const CCTK_REAL y = iy*dy;
      const CCTK_REAL PI = acos(-1.0);

      f[i] = x*pow(y,2)*pow(cos(2*PI*y),2)*pow(sin(2*PI*x),2);
    }
  }

  const CCTK_REAL result = integration_fn(f, nx, ny, dx, dy);
  delete [] f;
  return result;
}


static CCTK_REAL test_pi_symmetric_sphere_integral(CCTK_REAL (*integration_fn) (const CCTK_REAL *, int, int, CCTK_REAL, CCTK_REAL))
{
  const int n = 100;
  const int nth = n;
  const int nph = n;
  const int array_size=(nth+1)*(nph+1);
  const CCTK_REAL PI = acos(-1.0);

  CCTK_REAL *f = new CCTK_REAL[array_size];

  const CCTK_REAL dth = PI/nth;
  const CCTK_REAL dph = 2*PI/nph;

  for (int ith = 0; ith <= nth; ith++)
  {
    for (int iph = 0; iph <= nph; iph++)
    {
      const int i = Multipole_Index(ith, iph, nth);

      const CCTK_REAL th = ith*dth;
      const CCTK_REAL ph = iph*dph;

      f[i] = -(cos(ph)*sqrt(5/PI)*pow(cos(th/2.),3)*sin(th/2.));
    }
  }

  const CCTK_REAL result = integration_fn(f, nth, nph, dth, dph);
  delete [] f;
  return result;
}

CCTK_REAL integration_convergence_order(CCTK_REAL (*integration_fn) (const CCTK_REAL *, int, int, CCTK_REAL, CCTK_REAL), CCTK_REAL *store_low, CCTK_REAL *store_high)
{
  const int n1 = 100;
  const int n2 = 200;
  const CCTK_REAL PI = acos(-1.0);
  const CCTK_REAL result1 = test_integral(100, integration_fn);
  *store_low = result1;
  const CCTK_REAL result2 = test_integral(200, integration_fn);
  *store_high = result2;
  const CCTK_REAL exact = 1./24 + 1./(64 * pow(PI,2));
  const CCTK_REAL error1 = fabs(result1 - exact);
  const CCTK_REAL error2 = fabs(result2 - exact);
  return log10(error1/error2) / log10((CCTK_REAL) n2/n1);
}

void Multipole_TestIntegrationConvergence(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  *test_simpson_convergence_order = integration_convergence_order(
    &Simpson2DIntegral, test_simpson_result_low, test_simpson_result_high);
  *test_trapezoidal_convergence_order = integration_convergence_order(
    &Trapezoidal2DIntegral, test_trapezoidal_result_low, test_trapezoidal_result_high);
  *test_midpoint_convergence_order = integration_convergence_order(
    &Midpoint2DIntegral, test_midpoint_result_low, test_midpoint_result_high);
}

void Multipole_TestIntegrationSymmetry(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;

  *test_simpson_pi_symmetry = test_pi_symmetric_sphere_integral(&Simpson2DIntegral);
  *test_midpoint_pi_symmetry = test_pi_symmetric_sphere_integral(&Midpoint2DIntegral);
  *test_trapezoidal_pi_symmetry = test_pi_symmetric_sphere_integral(&Trapezoidal2DIntegral);
  *test_driscollhealy_pi_symmetry = test_pi_symmetric_sphere_integral(&DriscollHealy2DIntegral);
  printf("Pi symmetry Simpson integral: %.19g\n", *test_simpson_pi_symmetry);
  printf("Pi symmetry midpoint integral: %.19g\n", *test_midpoint_pi_symmetry);
  printf("Pi symmetry trapezoidal integral: %.19g\n", *test_trapezoidal_pi_symmetry);
  printf("Pi symmetry Driscoll and Healy integral: %.19g\n", *test_driscollhealy_pi_symmetry);
}

// void Multipole_TestIntegrate(CCTK_ARGUMENTS)
// {
//   const int n = 100;

//   const int nth = n;
//   const int nph = n;
//   const int array_size=(nth+1)*(nph+1);

//   CCTK_REAL *f = new CCTK_REAL[array_size];

//   const CCTK_REAL dth = 1/nx;
//   const CCTK_REAL dph = 1/ny;

//   for (int ix = 0; ix <= nx; ix++)
//   {
//     for (int iy = 0; iy <= ny; iy++)
//     {
//       const int i = Multipole_Index(ix, iy, nx);

//       const CCTK_REAL x = ix*dx;
//       const CCTK_REAL y = iy*dy;

//       f[i] = sin(2*PI*x)*cos(2*PI*y);
//     }
//   }




//   CCTK_REAL result = Multipole_Integrate(int array_size, int nthetap,
//                                          CCTK_REAL const array1r[], CCTK_REAL const array1i[],
//                                          CCTK_REAL const array2r[], CCTK_REAL const array2i[],
//                                          CCTK_REAL const th[], CCTK_REAL const ph[], 
//                                          CCTK_REAL *outre, CCTK_REAL *outim)



//   printf("Integration result: %.19g\n", result);
// }

```

multipole.hh:
```
#include "cctk.h"
#include "cctk_Arguments.h"

// Multipole_Calc
//      This is the main scheduling file.  Because we are completely local here
//      and do not use cactus arrays etc, we schedule only one function and then
//      like program like one would in C, C++ with this function taking the 
//      place of int main(void).
//
//      This function calls functions to accomplish 3 things:
//        1) Interpolate psi4 onto a sphere
//        2) Integrate psi4 with the ylm's over that sphere
//        2) Output the mode decomposed psi4
extern "C" void Multipole_Calc(CCTK_ARGUMENTS);


```

interpolate.hh:
```
#include <math.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "util_Table.h"

// Multipole_Interp:
//      This function interpolates psi4 onto the sphere in cartesian 
//      coordinates as created by Multipole_CoordSetup.
void Multipole_Interp(CCTK_ARGUMENTS,
                      CCTK_REAL x[], CCTK_REAL y[], CCTK_REAL z[], 
                      int real_idx, int imag_idx,
                      CCTK_REAL psi4r[], CCTK_REAL psi4i[]);

void Multipole_InterpVar(CCTK_ARGUMENTS,
                         CCTK_REAL x[], CCTK_REAL y[], CCTK_REAL z[], const char *var_name,
                         CCTK_REAL sphere_var[]);

```

utils.hh:
```

#ifndef __utils_h
#define __utils_h

#include "cctk.h"
#include <string>

using namespace std;

enum mp_coord {mp_theta, mp_phi};

void Multipole_OutputArrayToFile(CCTK_ARGUMENTS, const string &name, int array_size,
                                 CCTK_REAL const th[], CCTK_REAL const ph[],
                                 CCTK_REAL const x[], CCTK_REAL const y[], CCTK_REAL const z[],
                                 CCTK_REAL const data[]);

void Multipole_Output1D(CCTK_ARGUMENTS, const string &name, int array_size,
                        CCTK_REAL const th[], CCTK_REAL const ph[], mp_coord coord,
                        CCTK_REAL const data[]);

void Multipole_OutputComplexToFile(CCTK_ARGUMENTS, const string &name, CCTK_REAL redata, CCTK_REAL imdata);

void Multipole_OutputComplexToH5File(CCTK_ARGUMENTS, const string &filename, const string &dataset,
                                     CCTK_REAL redata, CCTK_REAL imdata);

void Multipole_CoordSetup(int ntheta, int nphi, 
                          CCTK_REAL xhat[], CCTK_REAL yhat[], 
                          CCTK_REAL zhat[], CCTK_REAL th[], 
                          CCTK_REAL ph[]);

void Multipole_ScaleCartesian(int ntheta, int nphi, CCTK_REAL r,
                              CCTK_REAL const xhat[], CCTK_REAL const yhat[], CCTK_REAL const zhat[],
                              CCTK_REAL x[], CCTK_REAL y[], CCTK_REAL z[]);

static inline int Multipole_Index(int it, int ip, int ntheta)
{
  return it + (ntheta+1)*ip;
}

void Multipole_Integrate(int array_size, int ntheta,
    CCTK_REAL const array1r[], CCTK_REAL const array1i[],
    CCTK_REAL const array2r[], CCTK_REAL const array2i[],
    CCTK_REAL const th[], CCTK_REAL const pph[], 
    CCTK_REAL out_arrayr[], CCTK_REAL out_arrayi[]);

#endif

```

utils.cc:
```
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <string>
#include <map>
#include <sys/stat.h>
#include <errno.h>
#include <iostream>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

#ifdef HAVE_CAPABILITY_HDF5
// We currently support the HDF5 1.6 API (and when using 1.8 the
// compatibility mode introduced by H5_USE_16_API).  Several machines
// in SimFactory use HDF5 1.6, so we cannot drop support for it.  It
// seems it is hard to support both the 1.6 and 1.8 API
// simultaneously; for example H5Fopen takes a different number of
// arguments in the two versions.
#define H5_USE_16_API
#include <hdf5.h>
#endif

#include "utils.hh"
#include "integrate.hh"

// check return code of HDF5 call abort with an error message if there was an error.
// adapted from CarpetIOHDF5/src/CarpetIOHDF5.hh.
#define HDF5_ERROR(fn_call)                                                   \
        do {                                                                  \
          int _error_code = fn_call;                                          \
                                                                              \
                                                                              \
          if (_error_code < 0)                                                \
          {                                                                   \
            CCTK_VWarn (0, __LINE__, __FILE__, CCTK_THORNSTRING,              \
                        "HDF5 call '%s' returned error code %d",              \
                        #fn_call, _error_code);                               \
          }                                                                   \
        } while (0)


using namespace std;

////////////////////////////////////////////////////////////////////////
// File manipulation
////////////////////////////////////////////////////////////////////////

FILE *Multipole_OpenOutputFile(CCTK_ARGUMENTS, const string &name)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  bool first_time = cctk_iteration == 0;
  const char *mode = first_time ? "w" : "a";

  string output_name(string(out_dir) + "/" + name);

  FILE *fp = fopen(output_name.c_str(), mode);

  if (fp == 0)
  {
    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING, "%s", (string("Could not open output file ") + output_name).c_str());
  }

  return fp;
}

////////////////////////////////////////////////////////////////////////
// Unused
////////////////////////////////////////////////////////////////////////

void Multipole_OutputArray(CCTK_ARGUMENTS, FILE *f, int array_size, 
                           CCTK_REAL const th[], CCTK_REAL const ph[], 
                           CCTK_REAL const xs[], CCTK_REAL const ys[], CCTK_REAL const zs[],
                           CCTK_REAL const data[])
{
  DECLARE_CCTK_PARAMETERS;
  DECLARE_CCTK_ARGUMENTS;

  CCTK_REAL last_ph = ph[0];

  for (int i = 0; i < array_size; i++)
  {
    if (ph[i] != last_ph) // Separate blocks for gnuplot
      fprintf(f, "\n");
    fprintf(f, "%f %f %f %f %f %f %.19g\n", cctk_time, th[i], ph[i], xs[i], ys[i], zs[i], data[i]);
    last_ph = ph[i];
  }
}


void Multipole_OutputArrayToFile(CCTK_ARGUMENTS, const string &name, int array_size,
                                 CCTK_REAL const th[], CCTK_REAL const ph[],
                                 CCTK_REAL const xs[], CCTK_REAL const ys[], CCTK_REAL const zs[],
                                 CCTK_REAL const data[])
{
  DECLARE_CCTK_ARGUMENTS;

  if (FILE *fp = Multipole_OpenOutputFile(CCTK_PASS_CTOC, name))
  {
    Multipole_OutputArray(CCTK_PASS_CTOC, fp, array_size, th, ph, xs, ys, zs, data);
    fclose(fp);
  }
}

////////////////////////////////////////////////////////////////////////
// Misc
////////////////////////////////////////////////////////////////////////

void Multipole_Output1D(CCTK_ARGUMENTS, const string &name, int array_size,
                        CCTK_REAL const th[], CCTK_REAL const ph[], mp_coord coord,
                        CCTK_REAL const data[])
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  if (FILE *f = Multipole_OpenOutputFile(CCTK_PASS_CTOC, name))
  {
    fprintf(f, "\"Time = %.19g\n", cctk_time);

    if (coord == mp_theta)
    {
      for (int i = 0; i <= ntheta; i++)
      {
        int idx = Multipole_Index(i, 0, ntheta);
        fprintf(f, "%f %.19g\n", th[idx], data[idx]);
      }
    }
    else if (coord == mp_phi)
    {
      for (int i = 0; i <= nphi; i++)
      {
        int idx = Multipole_Index(ntheta / 4, i, ntheta);
        fprintf(f, "%f %.19g\n", ph[idx], data[idx]);
      }
    }
    fprintf(f, "\n\n");
    fclose(f);
  }
}

////////////////////////////////////////////////////////////////////////
// Complex IO
////////////////////////////////////////////////////////////////////////

void Multipole_OutputComplex(CCTK_ARGUMENTS, FILE *fp, CCTK_REAL redata, CCTK_REAL imdata)
{
  DECLARE_CCTK_PARAMETERS;
  DECLARE_CCTK_ARGUMENTS;
  fprintf(fp, "%f %.19g %.19g\n", cctk_time, redata, imdata);
}

void Multipole_OutputComplexToFile(CCTK_ARGUMENTS, const string &name, CCTK_REAL redata, CCTK_REAL imdata)
{
  DECLARE_CCTK_ARGUMENTS;

  if (FILE *fp = Multipole_OpenOutputFile(CCTK_PASS_CTOC, name))
  {
    Multipole_OutputComplex(CCTK_PASS_CTOC, fp, redata, imdata);
    fclose(fp);
  }
}

////////////////////////////////////////////////////////////////////////
// HDF5 complex output
////////////////////////////////////////////////////////////////////////

#ifdef HAVE_CAPABILITY_HDF5

static bool file_exists(const string &name)
{
  struct stat sts;
  return !(stat(name.c_str(), &sts) == -1 && errno == ENOENT);
}

bool dataset_exists(hid_t file, const string &dataset_name)
{
  // To test whether a dataset exists, the recommended way in API 1.6
  // is to use H5Gget_objinfo, but this prints an error to stderr if
  // the dataset does not exist.  We explicitly avoid this by wrapping
  // the call in H5E_BEGIN_TRY/H5E_END_TRY statements.  In 1.8,
  // H5Gget_objinfo is deprecated, and H5Lexists does the job.  See
  // http://www.mail-archive.com/hdf-forum@hdfgroup.org/msg00125.html

  #if 1
  bool exists;
  H5E_BEGIN_TRY
  {
    exists = H5Gget_objinfo(file, dataset_name.c_str(), 1, NULL) >= 0;
  }
  H5E_END_TRY;
  return exists;
  #else
  return H5Lexists(file, dataset_name.c_str(), H5P_DEFAULT);
  #endif
}

void Multipole_OutputComplexToH5File(CCTK_ARGUMENTS, const string &basename, const string &datasetname,
                                     CCTK_REAL redata, CCTK_REAL imdata)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  string output_name = out_dir + string("/") + basename;
  static map<string,bool> checked; // Has the given file been checked
                                   // for truncation? map<*,bool>
                                   // defaults to false

  hid_t file;

  if (!file_exists(output_name) || (!checked[output_name] && IO_TruncateOutputFiles(cctkGH)))
  {
    file = H5Fcreate(output_name.c_str(), H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT);
  }
  else
  {
    file = H5Fopen(output_name.c_str(), H5F_ACC_RDWR, H5P_DEFAULT);
  }

  checked[output_name] = true;

  hid_t dataset = -1;

  if (dataset_exists(file, datasetname))
  {
    dataset = H5Dopen(file, datasetname.c_str());
  }
  else
  {
    hsize_t dims[2] = {0,3};
    hsize_t maxdims[2] = {H5S_UNLIMITED, 3};
    hid_t dataspace = H5Screate_simple(2, dims, maxdims);

    hid_t cparms = -1;
    hsize_t chunk_dims[2] = {hsize_t(hdf5_chunk_size),3};
    cparms = H5Pcreate (H5P_DATASET_CREATE);
    HDF5_ERROR(H5Pset_chunk(cparms, 2, chunk_dims));

    dataset = H5Dcreate(file, datasetname.c_str(), H5T_NATIVE_DOUBLE, dataspace, cparms);
    H5Pclose(cparms);
  }

  hid_t filespace = H5Dget_space (dataset);
  hsize_t filedims[2];
  hsize_t maxdims[2];
  HDF5_ERROR(H5Sget_simple_extent_dims(filespace, filedims, maxdims));

  filedims[0] += 1;
  hsize_t size[2] = {filedims[0], filedims[1]};
  HDF5_ERROR(H5Dextend (dataset, size));
  HDF5_ERROR(H5Sclose(filespace));

  /* Select a hyperslab  */
  hsize_t offset[2] = {filedims[0]-1, 0};
  hsize_t dims2[2] = {1,3};
  filespace = H5Dget_space (dataset);
  HDF5_ERROR(H5Sselect_hyperslab (filespace, H5S_SELECT_SET, offset, NULL,
                                  dims2, NULL));

  CCTK_REAL data[] = {cctk_time, redata, imdata};

  hid_t memdataspace = H5Screate_simple(2, dims2, NULL);

  /* Write the data to the hyperslab  */
  HDF5_ERROR(H5Dwrite (dataset, H5T_NATIVE_DOUBLE, memdataspace, filespace,
                       H5P_DEFAULT, data));

  HDF5_ERROR(H5Dclose(dataset));
  HDF5_ERROR(H5Sclose(filespace));
  HDF5_ERROR(H5Sclose(memdataspace));

  HDF5_ERROR(H5Fclose(file));
}

#else

void Multipole_OutputComplexToH5File(CCTK_ARGUMENTS, const string &basename, const string &datasetname,
                                     CCTK_REAL redata, CCTK_REAL imdata)
{
  CCTK_WARN(0,"HDF5 output has been requested but Cactus has been compiled without HDF5 support");
}

#endif

////////////////////////////////////////////////////////////////////////
// Coordinates
////////////////////////////////////////////////////////////////////////

void Multipole_CoordSetup(int ntheta, int nphi, 
                          CCTK_REAL xhat[], CCTK_REAL yhat[], 
                          CCTK_REAL zhat[], CCTK_REAL th[], 
                          CCTK_REAL ph[])
{
  const CCTK_REAL PI = acos(-1.0);

  for (int it = 0; it <= ntheta; it++)
  {
    for (int ip = 0; ip <= nphi; ip++)
    {
      const int i = Multipole_Index(it, ip, ntheta);

      th[i] = it * PI / (ntheta);
      ph[i] = ip * 2 * PI / nphi;
      xhat[i] = cos(ph[i])*sin(th[i]);
      yhat[i] = sin(ph[i])*sin(th[i]);
      zhat[i] = cos(th[i]);
    }
  }
}

void Multipole_ScaleCartesian(int ntheta, int nphi, CCTK_REAL r,
                              CCTK_REAL const xhat[], CCTK_REAL const yhat[], CCTK_REAL const zhat[],
                              CCTK_REAL x[], CCTK_REAL y[], CCTK_REAL z[])
{
  for (int it = 0; it <= ntheta; it++)
  {
    for (int ip = 0; ip <= nphi; ip++)
    {
      const int i = Multipole_Index(it, ip, ntheta);

      x[i] = r * xhat[i];
      y[i] = r * yhat[i];
      z[i] = r * zhat[i];
    }
  }
}

////////////////////////////////////////////////////////////////////////
// Integration
////////////////////////////////////////////////////////////////////////

void Multipole_Integrate(int array_size, int nthetap,
    CCTK_REAL const array1r[], CCTK_REAL const array1i[],
    CCTK_REAL const array2r[], CCTK_REAL const array2i[],
    CCTK_REAL const th[], CCTK_REAL const ph[], 
    CCTK_REAL *outre, CCTK_REAL *outim)
{
  DECLARE_CCTK_PARAMETERS

  int il = Multipole_Index(0,0,ntheta);
  int iu = Multipole_Index(1,0,ntheta);
  CCTK_REAL dth = th[iu] - th[il];
  iu = Multipole_Index(0,1,ntheta);
  CCTK_REAL dph = ph[iu] - ph[il];

  static CCTK_REAL *fr = 0;
  static CCTK_REAL *fi = 0;
  static bool allocated_memory = false;

  // Construct an array for the real integrand
  if (!allocated_memory)
  {
    fr = new CCTK_REAL[array_size];
    fi = new CCTK_REAL[array_size];
    allocated_memory = true;
  }
    
  // the below calculations take the integral of conj(array1)*array2*sin(th)
  for (int i = 0; i < array_size; i++)
  {
    fr[i] = (array1r[i] * array2r[i] + 
             array1i[i] * array2i[i] ) * sin(th[i]);
    fi[i] = (array1r[i] * array2i[i] - 
             array1i[i] * array2r[i] ) * sin(th[i]);
  }
    
  if (CCTK_Equals(integration_method, "midpoint"))
  {
    *outre = Midpoint2DIntegral(fr, ntheta, nphi, dth, dph);
    *outim = Midpoint2DIntegral(fi, ntheta, nphi, dth, dph);
  }
  else if (CCTK_Equals(integration_method, "trapezoidal"))
  {
    *outre = Trapezoidal2DIntegral(fr, ntheta, nphi, dth, dph);
    *outim = Trapezoidal2DIntegral(fi, ntheta, nphi, dth, dph);
  }
  else if (CCTK_Equals(integration_method, "Simpson"))
  {
    if (nphi % 2 != 0 || ntheta % 2 != 0)
    {
      CCTK_WARN (CCTK_WARN_ABORT, "The Simpson integration method requires even ntheta and even nphi");
    }
    *outre = Simpson2DIntegral(fr, ntheta, nphi, dth, dph);
    *outim = Simpson2DIntegral(fi, ntheta, nphi, dth, dph);
  }
  else if (CCTK_Equals(integration_method, "DriscollHealy"))
  {
    if (ntheta % 2 != 0)
    {
      CCTK_WARN (CCTK_WARN_ABORT, "The Driscoll&Healy integration method requires even ntheta");
    }
    *outre = DriscollHealy2DIntegral(fr, ntheta, nphi, dth, dph);
    *outim = DriscollHealy2DIntegral(fi, ntheta, nphi, dth, dph);
  }
  else
  {
    CCTK_WARN(CCTK_WARN_ABORT, "internal error");
  }
} 

```

interpolate.cc:
```
#include <stdio.h>

#include "interpolate.hh"

static
void report_interp_error(int ierr)
{
  if (ierr < 0)
  {
    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
        "CCTK_InterpGridArrays returned error code %d",ierr);
  }
}
  
void Multipole_Interp(CCTK_ARGUMENTS,
                      CCTK_REAL xs[], CCTK_REAL ys[], CCTK_REAL zs[],
                      int real_idx, int imag_idx,
                      CCTK_REAL sphere_real[], CCTK_REAL sphere_imag[])
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  // Need parameters for the following:
  // ntheta (dtheta = pi/(ntheta) 
  // nphi (dphi = 2pi/(nphi)
  // r (radius of sphere)
  // NOTE: depending on the interval of integration, denominator above may
  // need to be modified to avoid double counting


  CCTK_INT num_input_arrays  = imag_idx == -1 ? 1 : 2;
  CCTK_INT num_output_arrays = imag_idx == -1 ? 1 : 2;
  const CCTK_INT num_dims = 3;
  int ierr = -1;

  const void* interp_coords[num_dims] 
    = { (const void *) xs,
        (const void *) ys,
        (const void *) zs };

  const CCTK_INT input_array_indices[2]
    = { real_idx,
        imag_idx };

  const CCTK_INT output_array_types[2]
    = { CCTK_VARIABLE_REAL,
        CCTK_VARIABLE_REAL };

  void * output_arrays[2]
    = { (void *) sphere_real,
        (void *) sphere_imag };

  const int operator_handle = CCTK_InterpHandle(interpolator_name);

  int param_table_handle = Util_TableCreate(UTIL_TABLE_FLAGS_DEFAULT);
  ierr = Util_TableSetFromString(param_table_handle, interpolator_pars);

  const int coord_system_handle = CCTK_CoordSystemHandle(coord_system);

  ierr = CCTK_InterpGridArrays(
      cctkGH,
      num_dims,
      operator_handle,
      param_table_handle,
      coord_system_handle,
      CCTK_MyProc(cctkGH) == 0 ? (ntheta+1)*(nphi+1) : 0, // Only the 0 processor needs the points
      CCTK_VARIABLE_REAL,
      interp_coords,
      num_input_arrays,
      input_array_indices,
      num_output_arrays,
      output_array_types,
      output_arrays);

  report_interp_error(ierr);

  if (imag_idx == -1)
  {
    for (int i = 0; i < (ntheta+1)*(nphi+1); i++)
    {
      sphere_imag[i] = 0;
    }
  }

  Util_TableDestroy(param_table_handle);
}

// // Debugging routine
// void Multipole_InterpVar(CCTK_ARGUMENTS,
//                          CCTK_REAL x[], CCTK_REAL y[], CCTK_REAL z[], const char *var_name,
//                          CCTK_REAL sphere_var[])
// {
//   DECLARE_CCTK_ARGUMENTS;
//   DECLARE_CCTK_PARAMETERS;

//   // Need parameters for the following:
//   // ntheta (dtheta = pi/(ntheta) 
//   // nphi (dphi = 2pi/(nphi)
//   // r (radius of sphere)
//   // NOTE: depending on the interval of integration, denominator above may
//   // need to be modified to avoid double counting

//   const CCTK_INT num_input_arrays = 1;
//   const CCTK_INT num_output_arrays = 1;
//   const CCTK_INT num_dims = 3;
//   int ierr = -1;

//   const void* interp_coords[num_dims] 
//     = { (const void *) x,
//         (const void *) y,
//         (const void *) z };

//   const CCTK_INT input_array_indices[num_input_arrays]
//     = { CCTK_VarIndex(var_name) };

//   const CCTK_INT output_array_types[num_output_arrays]
//     = { CCTK_VARIABLE_REAL };

//   void * output_arrays[num_output_arrays]
//     = { (void *) sphere_var };

//   const int operator_handle = CCTK_InterpHandle(interpolator_name);

//   int param_table_handle = Util_TableCreate(UTIL_TABLE_FLAGS_DEFAULT);
//   ierr = Util_TableSetFromString(param_table_handle, interpolator_pars);

//   const int coord_system_handle = CCTK_CoordSystemHandle(coord_system);

//   ierr = CCTK_InterpGridArrays(
//       cctkGH,
//       num_dims,
//       operator_handle,
//       param_table_handle,
//       coord_system_handle,
//       (ntheta+1)*(nphi+1),
//       CCTK_VARIABLE_REAL,
//       interp_coords,
//       num_input_arrays,
//       input_array_indices,
//       num_output_arrays,
//       output_array_types,
//       output_arrays);
//   report_interp_error(ierr);
// }

```

multipole.cc:
```
#include <stdio.h>
#include <string.h>
#include <assert.h>
#include <iomanip>
#include <sstream>
#include <string>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "multipole.hh"
#include "interpolate.hh"
#include "utils.hh"
#include "sphericalharmonic.hh"

using namespace std;

static const int var_name_length = 30;
static const int max_vars = 10;

static const int max_spin_weights = 10;
static const int max_l_modes = 10;
static const int max_m_modes = 2 * max_l_modes + 1;

typedef struct
{
  int index;
  int imag_index;
  CCTK_INT spin_weight;
  string name;
}
variable_desc;

typedef struct
{
  int n_vars;
  variable_desc *vars;
}
variables_desc;

static void fill_variable(int idx, const char *optstring, void *callback_arg)
{
  assert(idx >= 0);
  assert(callback_arg != 0);

  variables_desc *vs = (variables_desc * ) callback_arg;

  assert(vs->n_vars < max_vars); // Too many variables in the variables list
  variable_desc *v = &vs->vars[vs->n_vars];

  v->index = idx;

  // Default values if there is no option string or if the options are
  // not present
  v->imag_index = -1;
  v->spin_weight = 0;
  v->name = string(CCTK_VarName(v->index));

  if (optstring != 0)
  {
    int table = Util_TableCreateFromString(optstring);

    if (table >= 0)
    {
      const int buffer_length = 256;
      char buffer[buffer_length];
      
      Util_TableGetInt(table, &v->spin_weight , "sw");
      if (Util_TableGetString(table, buffer_length, buffer , "cmplx") >= 0)
      {
        v->imag_index = CCTK_VarIndex(buffer);
      }
      Util_TableGetString(table, buffer_length, buffer , "name");
      v->name = string(buffer);

      const int ierr = Util_TableDestroy(table);
      if (ierr)
      {
        CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
                    "Could not destroy table: %d", ierr);
      }
    }
  }
  vs->n_vars++;
}

static void parse_variables_string(const string &var_string, variable_desc v[max_vars], int *n_variables)
{
  variables_desc  vars;

  vars.n_vars = 0;
  vars.vars = v;

  int ierr = CCTK_TraverseString(var_string.c_str(), fill_variable, &vars, CCTK_GROUP_OR_VAR);
  assert(ierr >= 0);

  *n_variables = vars.n_vars;
}

static void output_mode(CCTK_ARGUMENTS, const variable_desc *v, CCTK_REAL rad, 
                     CCTK_REAL real_lm, CCTK_REAL imag_lm, int l, int m)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  if (output_ascii)
  {
    if (CCTK_MyProc(cctkGH) == 0)
    {
      ostringstream name;
      name << "mp_" << v->name << "_l" << l << "_m" << m <<
        "_r" << setiosflags(ios::fixed) << setprecision(2) <<  rad << ".asc";
      Multipole_OutputComplexToFile(CCTK_PASS_CTOC, name.str(), real_lm, imag_lm);
    }
  }
  if (output_hdf5)
  {
    if (CCTK_MyProc(cctkGH) == 0)
    {
      ostringstream h5datasetname;
      h5datasetname << "l" << l << "_m" << m << "_r" << setiosflags(ios::fixed) << setprecision(2) << rad;
      Multipole_OutputComplexToH5File(CCTK_PASS_CTOC, "mp_" + v->name + ".h5", h5datasetname.str(),
                                      real_lm, imag_lm);
    }
  }
}

static void output_1D(CCTK_ARGUMENTS, const variable_desc *v, CCTK_REAL rad, 
                      CCTK_REAL *th, CCTK_REAL *ph,
                      CCTK_REAL *real, CCTK_REAL *imag, int array_size)
{
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS

  if (CCTK_MyProc(cctkGH) == 0 && output_ascii)
  {
    if (out_1d_every != 0 && cctk_iteration % out_1d_every == 0)
    {
      ostringstream real_base;
      real_base << "mp_" << string(CCTK_VarName(v->index)) << "_r" << setiosflags(ios::fixed) << setprecision(2) << rad;
      Multipole_Output1D(CCTK_PASS_CTOC, real_base.str()+string(".th.asc"), array_size, th, ph, mp_theta, real);
      Multipole_Output1D(CCTK_PASS_CTOC, real_base.str()+string(".ph.asc"), array_size, th, ph, mp_phi, real);

      if (v->imag_index != -1)
      {
        ostringstream imag_base;
        imag_base << "mp_" << string(CCTK_VarName(v->imag_index)) << "_r" << setiosflags(ios::fixed) << setprecision(2) << rad;
        Multipole_Output1D(CCTK_PASS_CTOC, imag_base.str()+string(".th.asc"), array_size, th, ph, mp_theta, imag);
        Multipole_Output1D(CCTK_PASS_CTOC, imag_base.str()+string(".ph.asc"), array_size, th, ph, mp_phi, imag);
      }
    }
  }
}

bool int_in_array(int a, const int array[], int len)
{
  for (int i = 0; i < len; i++)
  {
    if (array[i] == a)
      return true;
  }
  return false;
}

int find_int_in_array(int a, const int array[], int len)
{
  for (int i = 0; i < len; i++)
  {
    if (array[i] == a)
      return i;
  }
  return -1;
}


static
void get_spin_weights(variable_desc vars[], int n_vars, int spin_weights[max_spin_weights], int *n_weights)
{
  int n_spin_weights = 0;

  for (int i = 0; i < n_vars; i++)
  {
    if (!int_in_array(vars[i].spin_weight, spin_weights, n_spin_weights))
    {
      assert(n_spin_weights < max_spin_weights);
      spin_weights[n_spin_weights] = vars[i].spin_weight;
      n_spin_weights++;
    }
  }
  *n_weights = n_spin_weights;
}

// For backward compatibility we allow the user to set l_mode instead
// of l_max, but if it is left at the default of -1, l_max is used.
static int get_l_max()
{
  DECLARE_CCTK_PARAMETERS;
  return l_mode == -1 ? l_max : l_mode;
}

static
void setup_harmonics(const int spin_weights[max_spin_weights],
                     int n_spin_weights, int lmax,
                     CCTK_REAL th[], CCTK_REAL ph[], int array_size,
                     CCTK_REAL *reY[max_spin_weights][max_l_modes][max_m_modes],
                     CCTK_REAL *imY[max_spin_weights][max_l_modes][max_m_modes])
{
  for (int si = 0; si < max_spin_weights; si++)
  {
    for (int l = 0; l < max_l_modes; l++)
    {
      for (int mi = 0; mi < max_m_modes; mi++)
      {
        reY[si][l][mi] = 0;
        imY[si][l][mi] = 0;
      }
    }
  }
  for (int si = 0; si < n_spin_weights; si++)
  {
    int sw = spin_weights[si];

    for (int l=0; l <= lmax; l++)
    {
      for (int m=-l; m <= l; m++)
      {
        reY[si][l][m+l] = new CCTK_REAL[array_size];
        imY[si][l][m+l] = new CCTK_REAL[array_size];

        Multipole_HarmonicSetup(sw, l, m, array_size, th, ph,
                                reY[si][l][m+l], imY[si][l][m+l]);
      }
    }
  } 
}

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

  if (l_mode != -1)
  {
    CCTK_WARN(CCTK_WARN_ALERT, "The parameter l_mode is deprecated. Use l_max instead.  For compatibility, l_max = l_mode is being used.");
  }

  if (!CCTK_Equals(mode_type, "deprecated"))
  {
    CCTK_WARN(CCTK_WARN_ALERT, "The parameter mode_type is deprecated and is no longer used.  All modes will be computed.");
  }

  if (l_min != -1)
  {
    CCTK_WARN(CCTK_WARN_ALERT, "The parameter l_min is deprecated and is no longer used.  Modes from l = 0 will be computed.");
  }

  if (m_mode != -100)
  {
    CCTK_WARN(CCTK_WARN_ALERT, "The parameter m_mode is deprecated. All m modes will be computed.");
  }
}

extern "C" void Multipole_Calc(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS

  static CCTK_REAL *xs, *ys, *zs;
  static CCTK_REAL *xhat, *yhat, *zhat;
  static CCTK_REAL *th, *ph;
  static CCTK_REAL *real = 0, *imag = 0;
  static CCTK_REAL *reY[max_spin_weights][max_l_modes][max_m_modes];
  static CCTK_REAL *imY[max_spin_weights][max_l_modes][max_m_modes];
  static variable_desc   vars[max_vars];
  static int n_variables = 0;
  static int spin_weights[max_spin_weights];
  static int n_spin_weights = 0;

  static bool initialized = false;

  int i, array_size=(ntheta+1)*(nphi+1);
  CCTK_REAL real_lm = 0.0, imag_lm = 0.0;

  if (out_every == 0 || cctk_iteration % out_every != 0)
    return;

  int lmax = get_l_max();

  assert(lmax + 1 <= max_l_modes);

  if (!initialized)
  {
    real = new CCTK_REAL[array_size];
    imag = new CCTK_REAL[array_size];
    th = new CCTK_REAL[array_size];  
    ph = new CCTK_REAL[array_size];
    xs = new CCTK_REAL[array_size];
    ys = new CCTK_REAL[array_size];
    zs = new CCTK_REAL[array_size];
    xhat = new CCTK_REAL[array_size];
    yhat = new CCTK_REAL[array_size];
    zhat = new CCTK_REAL[array_size];
  
    parse_variables_string(string(variables), vars, &n_variables);
    get_spin_weights(vars, n_variables, spin_weights, &n_spin_weights);
    Multipole_CoordSetup(ntheta, nphi, xhat, yhat, zhat, th, ph);
    setup_harmonics(spin_weights, n_spin_weights, lmax, th, ph,
                    array_size, reY, imY);
    initialized = true;
  }

  for (int v = 0; v < n_variables; v++)
  {
    //assert(vars[v].spin_weight == -2);

    int si = find_int_in_array(vars[v].spin_weight, spin_weights, n_spin_weights);
    assert(si != -1);

    for(i=0; i<nradii; i++)
    {
      // Compute x^i = r * \hat x^i
      Multipole_ScaleCartesian(ntheta, nphi, radius[i], xhat, yhat, zhat, xs, ys, zs);
      
      // Interpolate Psi4r and Psi4i
      Multipole_Interp(CCTK_PASS_CTOC, xs, ys, zs, vars[v].index, vars[v].imag_index, 
                       real, imag);
      for (int l=0; l <= lmax; l++)
      {
        for (int m=-l; m <= l; m++)
        {
          // Integrate sYlm (real + i imag) over the sphere at radius r
          Multipole_Integrate(array_size, ntheta,
                              reY[si][l][m+l], imY[si][l][m+l],
                              real, imag, th, ph,
                              &real_lm, &imag_lm);
    
          output_mode(CCTK_PASS_CTOC, &vars[v], radius[i], real_lm, imag_lm, l, m);
        }//loop over m
      }//loop over l
      output_1D(CCTK_PASS_CTOC, &vars[v], radius[i], th, ph, real, imag, array_size);
    }//loop over radii
  }//loop over variables
}

```

make.code.defn:
```
SRCS=interpolate.cc multipole.cc utils.cc sphericalharmonic.cc integrate.cc tests.cc

```

integrate.cc:
```
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <assert.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

/*

We will want to integrate functions F(th,ph) from th = 0 to pi, ph = 0
to 2 pi with a weighting function sin(th).  Alternatively, we might
want to use u = cos(th) as the variable, in which case we will go from
u = -1 to 1 and ph = 0 to 2 pi.  For simplicity, we implement an
integration routine with a weight function of 1, and require the user
to multiply the integrand by their own weight function.  We divide the
interval [a,b] into nx subintervals of spacing h = (b-a)/nx.  These
have coordinates [x_i-1, xi] where x_i = x_0 + i h. So i runs from 0
to nx.  We require the function to integrate at the points F[x_i,
y_i].  We have x_0 = a and x_n = b.  Check: x_n = x_0 + n (b-a)/n = a
+ b - a = b.  Good.  

If we are given these points in an array, we also need the width and
height of the array.  To get an actual integral, we also need the grid
spacing hx and hy, but these are just multiplied by the result to give
the integral.

*/



#define idx(xx,yy) (assert((xx) <= nx), assert((xx) >= 0), assert((yy) <= ny), assert((yy) >= 0), ((xx) + (yy) * (nx+1)))

// Hard coded 2D integrals

CCTK_REAL Midpoint2DIntegral(CCTK_REAL const *f, int nx, int ny, CCTK_REAL hx, CCTK_REAL hy)
{
  CCTK_REAL integrand_sum = 0.0;
  int ix = 0, iy = 0;

  assert(nx > 0); assert(ny > 0); assert (f);

  // This sum should probably exclude the upper end points.  As
  // currently implemented, it does not naturally map to the "sum of
  // areas" definition of the integral, as there is an additional
  // contribution from the last term in the sum.  This introduces an
  // additional first order error to a method which is already only
  // first order.

  for (iy = 0; iy <= ny; iy++)
    for (ix = 0; ix <= nx; ix++)
      integrand_sum += f[idx(ix,iy)];

  return hx * hy * integrand_sum;
}

CCTK_REAL Trapezoidal2DIntegral(CCTK_REAL const *f, int nx, int ny, CCTK_REAL hx, CCTK_REAL hy)
{
  CCTK_REAL integrand_sum = 0.0;
  int ix = 0, iy = 0;

  assert(nx > 0); assert(ny > 0); assert (f);

  // Corners
  integrand_sum += f[idx(0,0)] + f[idx(nx,0)] + f[idx(0,ny)] + f[idx(nx,ny)];

  // Edges
  for (ix = 1; ix <= nx-1; ix++)
    integrand_sum += 2 * f[idx(ix,0)] + 2 * f[idx(ix,ny)];

  for (iy = 1; iy <= ny-1; iy++)
    integrand_sum += 2 * f[idx(0,iy)] + 2 * f[idx(nx,iy)];

  // Interior
  for (iy = 1; iy <= ny-1; iy++)
    for (ix = 1; ix <= nx-1; ix++)
      integrand_sum += 4 * f[idx(ix,iy)];

  return (double) 1 / (double) 4 * hx * hy * integrand_sum;
}

CCTK_REAL Simpson2DIntegral(CCTK_REAL const *f, int nx, int ny, CCTK_REAL hx, CCTK_REAL hy)
{
  CCTK_REAL integrand_sum = 0;
  int ix = 0, iy = 0;

  assert(nx > 0); assert(ny > 0); assert (f);
  assert(nx % 2 == 0);
  assert(ny % 2 == 0);

  int px = nx / 2;
  int py = ny / 2;

  // Corners
  integrand_sum += f[idx(0,0)] + f[idx(nx,0)] + f[idx(0,ny)] + f[idx(nx,ny)];

  // Edges
  for (iy = 1; iy <= py; iy++)
    integrand_sum += 4 * f[idx(0,2*iy-1)] + 4 * f[idx(nx,2*iy-1)];

  for (iy = 1; iy <= py-1; iy++)
    integrand_sum += 2 * f[idx(0,2*iy)] + 2 * f[idx(nx,2*iy)];

  for (ix = 1; ix <= px; ix++)
    integrand_sum += 4 * f[idx(2*ix-1,0)] + 4 * f[idx(2*ix-1,ny)];

  for (ix = 1; ix <= px-1; ix++)
    integrand_sum += 2 * f[idx(2*ix,0)] + 2 * f[idx(2*ix,ny)];

  // Interior
  for (iy = 1; iy <= py; iy++)
    for (ix = 1; ix <= px; ix++)
      integrand_sum += 16 * f[idx(2*ix-1,2*iy-1)];

  for (iy = 1; iy <= py-1; iy++)
    for (ix = 1; ix <= px; ix++)
      integrand_sum += 8 * f[idx(2*ix-1,2*iy)];

  for (iy = 1; iy <= py; iy++)
    for (ix = 1; ix <= px-1; ix++)
      integrand_sum += 8 * f[idx(2*ix,2*iy-1)];

  for (iy = 1; iy <= py-1; iy++)
    for (ix = 1; ix <= px-1; ix++)
      integrand_sum += 4 * f[idx(2*ix,2*iy)];

  return ((double) 1 / (double) 9) * hx * hy * integrand_sum;
}

// See: J.R. Driscoll and D.M. Healy Jr., Computing Fourier transforms
// and convolutions on the 2-sphere. Advances in Applied Mathematics,
// 15(2):202–250, 1994.
CCTK_REAL DriscollHealy2DIntegral(CCTK_REAL const *const f,
                                  int const nx, int const ny,
                                  CCTK_REAL const hx, CCTK_REAL const hy)
{
  assert(f);
  assert(nx >= 0);
  assert(ny >= 0);
  assert(nx % 2 == 0);
  
  CCTK_REAL integrand_sum = 0.0;
  
  // Skip the poles (ix=0 and ix=nx), since the weight there is zero
  // anyway
#pragma omp parallel for reduction(+: integrand_sum)
  for (int ix = 1; ix < nx; ++ ix)
  {
    
    // These weights lead to an almost spectral convergence
    CCTK_REAL const theta = M_PI * ix / nx;
    CCTK_REAL weight = 0.0;
    for (int l = 0; l < nx/2; ++ l)
    {
      weight += sin((2*l+1)*theta)/(2*l+1);
    }
    weight *= 4.0 / M_PI;
    
    CCTK_REAL local_sum = 0.0;
    // Skip the last point (iy=ny), since we assume periodicity and
    // therefor it has the same value as the first point. We don't use
    // weights in this direction, which leads to spectral convergence.
    // (Yay periodicity!)
    for (int iy = 0; iy < ny; ++ iy)
    {
      local_sum += f[idx(ix,iy)];
    }
    
    integrand_sum += weight * local_sum;
    
  }
  
  return hx * hy * integrand_sum;
}

// 1D integrals

static CCTK_REAL Simpson1DIntegral(CCTK_REAL const *f, int n, CCTK_REAL h)
{
  CCTK_REAL integrand_sum = 0;
  int i = 0;

  assert(f);
  assert(n > 0);
  assert(n % 2 == 0);

  int p = n / 2;

  integrand_sum += f[0] + f[n];

  for (i = 1; i <= p-1; i++)
    integrand_sum += 4 * f[2*i-1] + 2 * f[2*i];

  integrand_sum += 4 * f[2*p-1];

  return 1.0/3.0 * h * integrand_sum;
}

// 2D integral built up from 1D

static CCTK_REAL Composite2DIntegral(CCTK_REAL const *f, int nx, int ny, CCTK_REAL hx, CCTK_REAL hy)
{
  CCTK_REAL integrand_sum = 0;

  assert(nx > 0); assert(ny > 0); assert (f);
  assert(nx % 2 == 0);
  assert(ny % 2 == 0);

  CCTK_REAL *g = new CCTK_REAL[ny+1];

  for (int i = 0; i <= ny; i++)
  {
    g[i] = Simpson1DIntegral(&f[idx(0,i)], nx, hx);
  }

  integrand_sum = Simpson1DIntegral(g, ny, hy);
  delete [] g;
  return integrand_sum;
}

```

integrate.hh:
```

#ifndef __integrate_h
#define __integrate_h
#include "cctk.h"

CCTK_REAL Midpoint2DIntegral(CCTK_REAL const *f, int nx, int ny,
                             CCTK_REAL hx, CCTK_REAL hy);

CCTK_REAL Trapezoidal2DIntegral(CCTK_REAL const *f, int nx, int ny, CCTK_REAL hx, CCTK_REAL hy);

CCTK_REAL Simpson2DIntegral(CCTK_REAL const *f, int nx, int ny, 
                            CCTK_REAL hx, CCTK_REAL hy);

CCTK_REAL DriscollHealy2DIntegral(CCTK_REAL const *f, int nx, int ny,
                                  CCTK_REAL hx, CCTK_REAL hy);

#endif

```

sphericalharmonic.hh:
```

#ifndef __sphericalharmonic_h
#define __sphericalharmonic_h
#include "cctk.h"

void Multipole_HarmonicSetup(int s, int l, int m,
                             int array_size, CCTK_REAL const th[], CCTK_REAL const ph[],
                             CCTK_REAL reY[], CCTK_REAL imY[]);


#endif

```


combined_doc_context: ## README (README):
```

=========
Multipole
=========

=============    ==============================================================================================
Authors          Ian Hinder and Andrew Knapp
Maintainer       Ian Hinder
Licence          GNU GPL version 2
Documentation    http://einsteintoolkit.org/documentation/ThornGuide/ThornGuidech133.html#x149-2383000O9
Download         svn checkout https://svn.einsteintoolkit.org/cactus/EinsteinAnalysis/Multipole/trunk Multipole
=============    ==============================================================================================

---------------------
Purpose of This Thorn
---------------------

The Multipole thorn performs spherical harmonic mode decomposition of
Cactus grid functions on coordinate spheres.  It can decompose
multiple grid functions with any spin-weight on multiple spheres.
This thorn uses the interpolator interface to access grid functions,
so works with mesh-refinement and multi-patch.

---------------
Required thorns
---------------

* An interpolator, e.g. AEILocalInterp

--------------
Related thorns
--------------

* WeylScal4 can be used to compute the Weyl scalars, which can then be
  decomposed into modes on coordinate spheres by Multipole.

------------
Publications
------------

Multipole has been used in the following publications:

---------
Copyright
---------

This thorn is copyright (C) 2007-2011 (C) by Ian Hinder and Andrew
Knapp.

This thorn is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This thorn is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this thorn (see the file COPYING in this directory);
if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA

```

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

```tex
=== documentation.tex ===
\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{Ian Hinder}

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

% the date your document was last changed, if your document is in CVS,
% please use:
%    \date{$ $Date: 2004-01-07 14:12:39 -0600 (Wed, 07 Jan 2004) $ $}
\date{01 Jun 2010}

\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}
The Multipole thorn performs spherical harmonic mode decomposition
of Cactus grid functions on coordinate spheres.
\end{abstract}

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

\section{Introduction}
This thorn allows the user to compute the coefficients of the
spherical harmonic expansion of a field stored in a Cactus grid
function on coordinate spheres of given radii.  A set of radii for
these spheres, as well as the number of angular points to use, can be
specified.  Complex fields can be used, but they must be stored in
pairs of real Cactus grid functions (the \verb|CCTK_COMPLEX| type is
not supported).

\section{Physical System}
The angular dependence of a field $u(t, r, \theta, \varphi)$ can be
expanded in spin-weight $s$ spherical harmonics
\cite{Goldberg:1966uu}:

\begin{eqnarray}
  u(t, r, \theta, \varphi) = \sum_{l=0}^\infty \sum_{m=-l}^l C^{lm}(t,r) {}_s Y_{lm}(\theta,\varphi)
\end{eqnarray}

where the coefficients $C^{lm}(t,r)$ are given by

\begin{eqnarray}
C^{lm}(t, r) = \int {}_s Y_{lm}^* u(t, r, \theta, \varphi) r^2 d \Omega \label{eqn:clmint}
\end{eqnarray}

At any given time, $t$, this thorn can compute $C^{lm}(t,r)$ for a
number of grid functions on several coordinate spheres with radii $r_i$.
The coordinate system of the Cactus grids must be Cartesian and the
coordinates $r$, $\theta$, $\varphi$ are related to $x$, $y$ and $z$
by the usual transformation between Cartesian and spherical polar
coordinates ($\theta$ is the polar angle and $\varphi$ is the
azimuthal angle).

The spin-weighted spherical harmonics are computed using Eq.~3.1 in
Ref.~\cite{Goldberg:1966uu}.

\section{Numerical Implementation}

The coordinate sphere on which the multipolar decomposition is
performed is represented internally as a 2-dimensional grid evenly
spaced in $\theta$ and $\varphi$ with coordinates

\begin{eqnarray}
\theta_k &=& \frac{\pi k}{n_\theta} \quad k = 0, 1, ..., n_\theta \\
\varphi_k &=& \frac{2\pi k}{n_\varphi} \quad k = 0, 1, ..., n_\varphi,
\end{eqnarray}

so $n_\theta$ and $n_\varphi$ count the number of cells (not the
number of points).  The gridfunction to be decomposed, $u$, is first
interpolated from the 3D Cactus grid onto this 2D grid at a given
radius, $r_i$, and the $C^{lm}$ are computed by evaluating the integral
in Eq.~\ref{eqn:clmint} for different values of $l$ and $m$.  The
interpolation is performed using the Cactus interpolation interface,
so any Cactus interpolator can be used.  The numerical method used for
interpolation should be specified in the documentation for the thorn
which provides it.  One such thorn is AEILocalInterp.  The integration
is performed using either the midpoint rule, yielding a result which
is first order accurate in the angular spacings $\Delta \theta =
\pi/n_\theta$ and $\Delta \varphi = 2\pi/n_\theta$, or Simpson's rule,
which is fourth order accurate.

\section{Using This Thorn}

\subsection{Obtaining This Thorn}

This thorn is available as part of the Einstein Toolkit via:

{\tt svn checkout https://svn.einsteintoolkit.org/cactus/EinsteinAnalysis/Multipole/trunk Multipole}

or by using the Einstein Toolkit \verb|GetComponents| script and thornguide.

\subsection{Basic Usage}

Suppose that you have a real grid function, $u$, for which you want to
compute the spherical harmonic coefficients $C^{lm}$.  Start by
including Multipole and an interpolator (for example AEILocalInterp)
in the ActiveThorns line of your parameter file (for interpolation
thorns other than AEILocalInterp, you will need to modify the
\verb|interpolator| and \verb|interpolator_options| accoording to the
documentation of the interpolation thorn).  Next decide the number and
radii of the coordinate spheres on which you want to decompose.  Set
the number of spheres with the \verb|nradii| parameter, and the radii
themselves with the \verb|radius[i]| parameters (the indices $i$ are
zero-based).  For example,

\begin{verbatim}
ActiveThorns = ".... AEILocalInterp Multipole"

Multipole::nradii       = 3
Multipole::radius[0]    = 10
Multipole::radius[1]    = 20
Multipole::radius[2]    = 30
Multipole::variables    = "MyThorn::u"
\end{verbatim}

The default parameters will compute all $l = 2$ modes assuming a
spin-weight $s = 0$ on every iteration of your simulation.  The
coefficients $C^{lm}$ will be output in the files with names of the
form \verb|mp_<var>_l<lmode>_m<mmode>_r<rad>.asc|, for example

\begin{verbatim}
mp_u_l2_m2_r10.00.asc
mp_u_l2_m-1_r20.00.asc
\end{verbatim}

For the filename, the radius is converted to a string with two decimal
places, which should be sufficient.  These are ASCII files where each
line has columns

$t$, $\mathrm{Re} \, C^{lm}$, $\mathrm{Im} \, C^{lm}$.

\subsection{Special Behaviour}
Often it will be necessary to go beyond the basic usage described in the
previous section.

\subsubsection{Higher modes}
By default, Multipole computes only $l = 2$ modes.  You can choose
whether to extract a single mode, or all modes from $l = $
\verb|l_min| to $l = $ \verb|l_mode|, with $|m| \le $ \verb|m_mode|.
This is controlled by the \verb|mode_type| parameter, which can be set
to \verb|"all_modes"| or \verb|"specific_mode"|.  The parameters
\verb|l_min| and \verb|l_mode| specify the lowest and highest modes to
compute.  The parameter \verb|m_mode| specifies up to which value of
$m$ to compute.  When using \verb|mode_type| = \verb|"specific_mode"|,
the mode $l$ and $m$ are given by \verb|l_mode| and \verb|m_mode|
respectively.

\subsubsection{Variable options}
Several variable-specific options can be listed as {\em tags} in the
\verb|variables| parameter:
\begin{verbatim}
Multipole::variables = "<imp>::<var>{<tagname> = <tagvalue> ... } ..."
\end{verbatim}
Valid tags are:

\begin{tabular}{lp{0.9\columnwidth}}
  cmplx & A string giving the fully qualified variable name for the imaginary part of a complex field, assuming that \verb|<imp>::<var>| is the real part. \\
  name & A string giving an alias to use for the decomposed variable in the output filename, for use in the case of complex variable when otherwise the name of the real part would be used, which might be confusing. \\
  sw & The integer spin-weight of the spherical harmonic decomposition to use.
\end{tabular}

Strings should be enclosed in single quotes within the list of tags.

\subsubsection{Complex variables}
In order to decompose a complex quantity, Multipole currently requires
that the field is stored in two separate \verb|CCTK_REAL| grid
functions, one for the real and one for the imaginary part.  Suppose
the complex function $u$ is stored in two gridfunctions \verb|u_re|
and \verb|u_im|.  In order to correctly decompose $u$, specify the
real variable in the variables parameter, and use the tag \verb|cmplx|
to specify the name of its imaginary companion:
\begin{verbatim}
Multipole::variables = "MyThorn::u_re{cmplx = 'MyThorn::u_im'}"
\end{verbatim}

\subsubsection{Renaming variables}
In some cases, you might want the name of the variable in the output
filename to be different to the name of the grid function.  This can
be done by setting the \verb|name| tag of the variable:
\begin{verbatim}
Multipole::variables = "MyThorn::u{name = 'myfunction'}"
\end{verbatim}
For example, in the case of a complex variable where the output file
contains the name of the real part, you can rename it as follows:
\begin{verbatim}
Multipole::variables = "MyThorn::u_re{cmplx = 'MyThorn::u_im' name = 'u'}"
\end{verbatim}

\subsubsection{Spin weight}
Depending on the nature of the field to be decomposed, a 
spin-weight other than 0 might be required in the spherical harmonic basis.  Use
the tag \verb|sw| for this
\begin{verbatim}
Multipole::variables = "MyThorn::u_re{cmplx = 'MyThorn::u_im' name = 'u' sw = -2}"
\end{verbatim}

\subsubsection{Interpolator options}
The interpolator to be used can be specified in the
\verb|interpolator_name| parameter, and a string containing
interpolator parameters can be specified in the
\verb|interpolator_pars| parameter.  See the interpolator (for example
AEIThorns/AEILocalInterp) documentation for details of interpolators
available and their options.

\subsubsection{Output}
When used with mesh-refinement, it is common to require mode
decomposition less frequently than every iteration.  The parameter
\verb|out_every| can be used to control this.  1D and 2D output of the
coordinate spheres can be enabled using \verb|out_1d_every| and
\verb|out_2d_every|.

\subsection{Interaction With Other Thorns}

This thorn obtains grid function data via the standard Cactus
interpolator interface.  To use this, one needs the parallel driver
(for example PUGHInterp or CarpetInterp) as well as the low-level
interpolator (e.g. AEILocalInterp).

\subsection{Examples}

To use this thorn with WeylScal4 to compute modes of the complex
$\Psi_4$ variable, one could use the following example:

\begin{verbatim}
ActiveThorns = ".... WeylScal4 CarpetInterp AEILocalInterp Multipole"

Multipole::nradii    = 3
Multipole::radius[0] = 10
Multipole::radius[1] = 20
Multipole::radius[2] = 30
Multipole::variables = "WeylScal4::Psi4r{sw=-2 cmplx='WeylScal4::Psi4i'}"
Multipole::l_mode    = 4
Multipole::m_mode    = 4
\end{verbatim}

\section{History}

This thorn was developed in the Penn State Numerical Relativity group
and contributed to the Einstein Toolkit.

\subsection{Acknowledgements}

This thorn was written by Ian Hinder and Andrew Knapp, with
contributions from Eloisa Bentivegna and Shaun Wood.

%\bibliography{multipole}
%\bibliographystyle{plain}

\begin{thebibliography}{1}
\bibitem{Goldberg:1966uu}
J.~N. Goldberg, A.~J. MacFarlane, E.~T. Newman, F.~Rohrlich, and E.~C.~G.
  Sudarshan.
\newblock {Spin s spherical harmonics and edth}.
\newblock {\em J. Math. Phys.}, 8:2155, 1967.
\end{thebibliography}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference solution:
src_code: #include <math.h>
#include <assert.h>
#include <iostream>

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"

static const CCTK_REAL PI = acos(-1.0);

static double factorial(int n)
{
  double returnval = 1;
  for (int i = n; i >= 1; i--)
  {
    returnval *= i;
  }
  return returnval;
}

static inline double combination(int n, int m)
{
  // Binomial coefficient is undefined if these conditions do not hold
  assert(n >= 0);
  assert(m >= 0);
  assert(m <= n);

  return factorial(n) / (factorial(m) * factorial(n-m));
}

static inline int imin(int a, int b)
{
  return a < b ? a : b;
}

static inline int imax(int a, int b)
{
  return a > b ? a : b;
}

static
void Multipole_SphericalHarmonic(int s, int l, int m, 
                                 CCTK_REAL th, CCTK_REAL ph,
                                 CCTK_REAL *reY, CCTK_REAL *imY)
{
//  assert(s == -2 && l == 2 && m == 2);
//  *reY = 1.0/2.0 * sqrt(5/PI) * pow(cos(th/2), 4) * cos(2*ph);
//  *imY = 1.0/2.0 * sqrt(5/PI) * pow(cos(th/2), 4) * sin(2*ph);
  double all_coeff = 0, sum = 0;
  all_coeff = pow(-1.0, m);
  all_coeff *= sqrt(factorial(l+m)*factorial(l-m)*(2*l+1) / (4.*PI*factorial(l+s)*factorial(l-s)));
  sum = 0.;
  for (int i = imax(m - s, 0); i <= imin(l + m, l - s); i++)
  {
    double sum_coeff = combination(l-s, i) * combination(l+s, i+s-m);
    sum += sum_coeff * pow(-1.0, l-i-s) * pow(cos(th/2.), 2 * i + s - m) * 
      pow(sin(th/2.), 2*(l-i)+m-s);
  }
  *reY = all_coeff*sum*cos(m*ph);
  *imY = all_coeff*sum*sin(m*ph);
}

void Multipole_HarmonicSetup(int s, int l, int m,
                             int array_size, CCTK_REAL const th[], CCTK_REAL const ph[],
                             CCTK_REAL reY[], CCTK_REAL imY[])
{
  for (int i = 0; i < array_size; i++)
  {
    Multipole_SphericalHarmonic(s,l,m,th[i],ph[i],&reY[i], &imY[i]);
  }
}


// Fill a grid function with a given spherical harmonic
extern "C" void Multipole_SetHarmonic(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS

  for (int k = 0; k < cctk_lsh[2]; k++)
  {
    for (int j = 0; j < cctk_lsh[1]; j++)
    {
      for (int i = 0; i < cctk_lsh[0]; i++)
      {
        int index = CCTK_GFINDEX3D(cctkGH,i,j,k) ;

        CCTK_REAL theta = acos(z[index]/r[index]);
        CCTK_REAL phi = atan2(y[index],x[index]);

        CCTK_REAL re = 0;
        CCTK_REAL im = 0;

        Multipole_SphericalHarmonic(test_sw,test_l,test_m,theta,phi,
                                    &re, &im);

        CCTK_REAL fac = test_mode_proportional_to_r ? r[index] : 1.0;

        harmonic_re[index] = re * fac;
        harmonic_im[index] = im * fac;
      }
    }
  }
  return;
}