Task: Implement jtutil/test_array.cc for EinsteinAnalysis/AHFinderDirect thorn

thorn_name: EinsteinAnalysis/AHFinderDirect
src_filename: jtutil/test_array.cc
interface: # Interface definition for thorn AHFinderDirect
# $Header$

implements: AHFinderDirect
inherits: Grid ADMBase StaticConformal SpaceMask SphericalSurface IO

# include file provided by SpaceMask
USES INCLUDE: SpaceMask.h

################################################################################

# we use a mask in order to find out whether we interpolate from the excised
# region.  (we need 3 time levels because Carpet might need to interpolate
# in time.)

REAL ahmask TYPE=gf TIMELEVELS=3 TAGS='tensortypealias="Scalar" Prolongation="None"'

################################################################################

# we use an aliased function maybe provided by DriftCorrect
SUBROUTINE SetDriftCorrectPosition					\
   (CCTK_POINTER_TO_CONST IN GH,					\
    CCTK_REAL IN x, CCTK_REAL IN y, CCTK_REAL IN z)
USES FUNCTION SetDriftCorrectPosition

################################################################################

#
# This thorn provides an aliased-function interface which other thorns
# can use to find out about the horizons.  Each function returns a status
# code which is >= 0 for ok, or < 0 for an error.
#

########################################

#
# This function returns the local coordinate origin for a given horizon.
#
CCTK_INT FUNCTION HorizonLocalCoordinateOrigin				\
   (CCTK_INT IN horizon_number,						\
    CCTK_REAL OUT origin_x, CCTK_REAL OUT origin_y, CCTK_REAL OUT origin_z)

#
# The following function queries whether or not the specified horizon
# was found the most recent time AHFinderDirect searched for it.
# The return value is:
#  1 if the horizon was found
#  0 if the horizon was not found
#  negative for an error
#
CCTK_INT FUNCTION HorizonWasFound(CCTK_INT IN horizon_number)

#
# The following function queries whether or not the specified horizon
# was found the most recent time AHFinderDirect searched for it, and
# if it was, returns the horizon centroid.  The returned value is the
# same as that of  HorizonWasFound()  (above), i.e.
#  1 if the horizon was found; in this case  centroid_[xyz]  are set
#    to the centroid position
#  0 if the horizon was not found; in this case  centroid_[xyz]  are
#    set to zeros
#  negative for an error
#
CCTK_INT FUNCTION HorizonCentroid					\
  (CCTK_INT IN horizon_number,						\
   CCTK_REAL OUT centroid_x, CCTK_REAL OUT centroid_y, CCTK_REAL OUT centroid_z)

#
# The following function computes the horizon radius in the direction
# of each (x,y,z) point, or -1.0 if this horizon wasn't found the most
# recent time AHFinderDirect searched for it.  More precisely, for each
# (x,y,z), consider the ray from the local coordinate origin through
# (x,y,z).  This function computes the Euclidean distance between the
# local coordinate origin and this ray's intersection with the horizon,
# or -1.0 if this horizon wasn't found the most recent time AHFinderDirect
# searched for it.  
#
CCTK_INT FUNCTION HorizonRadiusInDirection				\
   (CCTK_INT IN horizon_number,						\
    CCTK_INT IN N_points,						\
    CCTK_REAL IN ARRAY x, CCTK_REAL IN ARRAY y, CCTK_REAL IN ARRAY z,	\
    CCTK_REAL OUT ARRAY radius)

########################################

# all these functions are in src/driver/aliased_functions.cc
PROVIDES FUNCTION HorizonLocalCoordinateOrigin				\
	WITH AHFinderDirect_local_coordinate_origin			\
	LANGUAGE C
PROVIDES FUNCTION HorizonWasFound					\
	WITH AHFinderDirect_horizon_was_found				\
	LANGUAGE C
PROVIDES FUNCTION HorizonCentroid					\
	WITH AHFinderDirect_horizon_centroid				\
	LANGUAGE C
PROVIDES FUNCTION HorizonRadiusInDirection				\
	WITH AHFinderDirect_radius_in_direction				\
	LANGUAGE C

################################################################################

# Grid arrays to store the horizon shape, for easy output and checkpointing.
# These are similar and equivalent to SphericalSurface.
# Note that the horizons are numbered [0...N_horizon-1].

CCTK_REAL ah_radius[N_horizons] TYPE=array DIM=3 SIZE=max_N_zones_per_right_angle+1,max_N_zones_per_right_angle+1,6 DISTRIB=constant

CCTK_REAL ah_origin[N_horizons] TYPE=scalar
{
  ah_origin_x ah_origin_y ah_origin_z
}

CCTK_REAL ah_centroid[N_horizons] TYPE=scalar
{
  ah_centroid_x ah_centroid_y ah_centroid_z ah_centroid_t
  ah_centroid_x_p ah_centroid_y_p ah_centroid_z_p ah_centroid_t_p
}

CCTK_INT ah_flags[N_horizons] TYPE=scalar
{
  ah_initial_find_flag
  ah_really_initial_find_flag
  ah_search_flag
  ah_found_flag
  ah_centroid_valid
  ah_centroid_valid_p
  ah_centroid_iteration
  ah_centroid_iteration_p
}

################################################################################

# This IOUtil function is used to determine whether the diagnostics file
# should be truncated or appended (as in a recovery run )

CCTK_INT FUNCTION IO_TruncateOutputFiles \
  (CCTK_POINTER_TO_CONST IN GH)
USES FUNCTION IO_TruncateOutputFiles

################################################################################

# translate SphericalSurface name into ID
CCTK_INT \
FUNCTION sf_IdFromName (CCTK_INT IN id, CCTK_POINTER_TO_CONST IN name)
USES FUNCTION sf_IdFromName

################################################################################

schedule: # Schedule definitions for thorn AHFinderDirect
# $Header$

storage: ah_radius ah_origin ah_centroid ah_flags

if (metric_timelevels == 1)
{
  storage: ahmask[1]
}
else if (metric_timelevels == 2)
{
  storage: ahmask[2]
}
else if (metric_timelevels == 3)
{
  storage: ahmask[3]
}

#
# setup
#
schedule AHFinderDirect_setup at CCTK_BASEGRID        \
   after SpatialCoordinates
   {
   lang: C
   options: global
   } "setup data structures"

#
# checkpoint/recover support
#
schedule AHFinderDirect_recover at CCTK_POST_RECOVER_VARIABLES
   {
   lang: C
   options: global
   } "import horizon data from Cactus variables"

#
# find horizons
#
if (run_at_CCTK_ANALYSIS != 0)
  {
  schedule AHFinderDirect_find_horizons at CCTK_ANALYSIS
     {
     lang: C
     options: global-early
     } "find apparent horizon(s) after this time step"
  }
if (run_at_CCTK_POSTSTEP != 0)
  {
  schedule AHFinderDirect_find_horizons at CCTK_POSTSTEP
     {
     lang: C
     options: global-early
     } "find apparent horizon(s) after this time step"
  }
if (run_at_CCTK_POSTINITIAL != 0)
  {
  schedule AHFinderDirect_find_horizons at CCTK_POSTINITIAL
     {
     lang: C
     options: global-early
     } "find apparent horizon(s) after this time step"
  }
if (run_at_CCTK_POSTPOSTINITIAL != 0)
  {
  schedule AHFinderDirect_find_horizons at CCTK_POSTPOSTINITIAL
     {
     lang: C
     options: global-early
     } "find apparent horizon(s) after this time step"
  }
if (run_at_CCTK_POST_RECOVER_VARIABLES != 0)
  {
  schedule AHFinderDirect_find_horizons at CCTK_POST_RECOVER_VARIABLES \
           after MoL_PostStep
     {
     lang: C
     options: global-early
     } "find apparent horizon(s) after this time step"
  }

#
# find horizons, set excision mask, maybe announce centroid to other thorns
#
# FIXME: the name  AHFinderDirect_maybe_do_masks  is archaic,
#        AHFinderDirect_do_masks  would be more apt
#
# We use two Cactus Groups here:
#  group_for_mask_stuff
#    group_where_mask_is_set
#      AHFinderDirect_maybe_do_masks
# this way other thorns can schedule routines which need to run immediately
# before/after we set the mask in group_for_mask_stuff before/after
# group_where_mask_is_set, without having to know in what higher-level
# Cactus schedule bins/groups this thorn runs.
#
if (run_at_CCTK_ANALYSIS != 0)
  {
  schedule AHFinderDirect_import_mask at CCTK_ANALYSIS \
     before AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early loop-local
     } "import the excision mask"

  schedule AHFinderDirect_store at CCTK_ANALYSIS \
     after AHFinderDirect_find_horizons \
     before SphericalSurface_HasBeenSet
     {
     lang: C
     options: global-early
     } "store apparent horizon(s) into spherical surface(s)"

  schedule AHFinderDirect_save at CCTK_ANALYSIS \
     after AHFinderDirect_find_horizons \
     {
     lang: C
     options: global-early
     } "save apparent horizon(s) into Cactus variables"

  if (which_horizon_to_announce_centroid != 0)
    {
    schedule AHFinderDirect_announce at CCTK_ANALYSIS \
       before DriftCorrect \
       after AHFinderDirect_find_horizons
       {
       lang: C
       options: global-early
       } "announce horizon position(s) to other thorns"
    }

  schedule AHFinderDirect_maybe_do_masks at CCTK_ANALYSIS \
     after AHFinderDirect_find_horizons
     {
     lang: C
     } "set mask(s) based on apparent horizon position(s)"
  }
if (run_at_CCTK_POSTSTEP != 0)
  {
  schedule AHFinderDirect_import_mask at CCTK_POSTSTEP \
     before AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early loop-local
     } "import the excision mask"

  schedule AHFinderDirect_store at CCTK_POSTSTEP \
     after AHFinderDirect_find_horizons \
     before SphericalSurface_HasBeenSet
     {
     lang: C
     options: global-early
     } "store apparent horizon(s) into spherical surface(s)"

  schedule AHFinderDirect_save at CCTK_POSTSTEP \
     after AHFinderDirect_find_horizons \
     {
     lang: C
     options: global-early
     } "save apparent horizon(s) into Cactus variables"

  if (which_horizon_to_announce_centroid != 0)
    {
    schedule AHFinderDirect_announce at CCTK_POSTSTEP \
       before DriftCorrect \
       after AHFinderDirect_find_horizons
       {
       lang: C
       options: global-early
       } "announce horizon position(s) to other thorns"
    }

  schedule AHFinderDirect_maybe_do_masks at CCTK_POSTSTEP \
     after AHFinderDirect_find_horizons
     {
     lang: C
     } "set mask(s) based on apparent horizon position(s)"
  }
if (run_at_CCTK_POSTINITIAL != 0)
  {
  schedule AHFinderDirect_import_mask at CCTK_POSTINITIAL \
     before AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early loop-local
     } "import the excision mask"

  schedule AHFinderDirect_store at CCTK_POSTINITIAL \
     after AHFinderDirect_find_horizons \
     before SphericalSurface_HasBeenSet
     {
     lang: C
     options: global-early
     } "store apparent horizon(s) into spherical surface(s)"

  schedule AHFinderDirect_save at CCTK_POSTINITIAL \
     after AHFinderDirect_find_horizons \
     {
     lang: C
     options: global-early
     } "save apparent horizon(s) into Cactus variables"

  if (which_horizon_to_announce_centroid != 0)
    {
    schedule AHFinderDirect_announce at CCTK_POSTINITIAL \
       before DriftCorrect \
       after AHFinderDirect_find_horizons
       {
       lang: C
       options: global-early
       } "announce horizon position(s) to other thorns"
    }

  schedule AHFinderDirect_maybe_do_masks at CCTK_POSTINITIAL \
     after AHFinderDirect_find_horizons
     {
     lang: C
     } "set mask(s) based on apparent horizon position(s)"
  }
if (run_at_CCTK_POSTPOSTINITIAL != 0)
  {
  schedule AHFinderDirect_import_mask at CCTK_POSTPOSTINITIAL \
     before AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early loop-local
     } "import the excision mask"

  schedule AHFinderDirect_store at CCTK_POSTPOSTINITIAL \
     after AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early
     } "store apparent horizon(s) into spherical surface(s)"

  schedule AHFinderDirect_save at CCTK_POSTPOSTINITIAL \
     after AHFinderDirect_find_horizons \
     {
     lang: C
     options: global-early
     } "save apparent horizon(s) into Cactus variables"

  if (which_horizon_to_announce_centroid != 0)
    {
    schedule AHFinderDirect_announce at CCTK_POSTPOSTINITIAL \
       before DriftCorrect \
       after AHFinderDirect_find_horizons
       {
       lang: C
       options: global-early
       } "announce horizon position(s) to other thorns"
    }

  schedule AHFinderDirect_maybe_do_masks at CCTK_POSTPOSTINITIAL \
     after AHFinderDirect_find_horizons
     {
     lang: C
     } "set mask(s) based on apparent horizon position(s)"
  }
if (run_at_CCTK_POST_RECOVER_VARIABLES != 0)
  {
  schedule AHFinderDirect_import_mask at CCTK_POST_RECOVER_VARIABLES \
     before AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early loop-local
     } "import the excision mask"

  schedule AHFinderDirect_store at CCTK_POST_RECOVER_VARIABLES \
     after AHFinderDirect_find_horizons \
     before SphericalSurface_HasBeenSet
     {
     lang: C
     options: global-early
     } "store apparent horizon(s) into spherical surface(s)"

  schedule AHFinderDirect_save at CCTK_POST_RECOVER_VARIABLES \
     after AHFinderDirect_find_horizons
     {
     lang: C
     options: global-early
     } "save apparent horizon(s) into Cactus variables"

  if (which_horizon_to_announce_centroid != 0)
    {
    schedule AHFinderDirect_announce at CCTK_POST_RECOVER_VARIABLES \
       before DriftCorrect \
       after AHFinderDirect_find_horizons
       {
       lang: C
       options: global-early
       } "announce horizon position(s) to other thorns"
    }

  schedule AHFinderDirect_maybe_do_masks at CCTK_POST_RECOVER_VARIABLES \
     after AHFinderDirect_find_horizons
     {
     lang: C
     } "set mask(s) based on apparent horizon position(s)"
  }

# TODO: Don't call this, since no horizon has been found yet
schedule AHFinderDirect_maybe_do_masks at CCTK_POSTREGRIDINITIAL \
   after (MaskOne MaskZero)
   {
   lang: C
   } "set mask(s) based on apparent horizon position(s)"

schedule AHFinderDirect_maybe_do_masks at CCTK_POSTREGRID \
   after (MaskOne MaskZero)
   {
   lang: C
   } "set mask(s) based on apparent horizon position(s)"

########################################

##
## uncomment this if you want to use the test driver
##  src/util/test_patch_system.cc
##
##schedule test_patch_system at CCTK_POSTINITIAL
##{
##LANG: C
##OPTIONS: global
##} "test driver to verify that src/util/ and src/jtutil/ code works properly"

param: # Parameter definitions for thorn AHFinderDirect
# $Header$

################################################################################

#
# ***** interface to the rest of Cactus *****
#

# we may need to look at some grid:: parameters to choose our patch system type
# note our access is read-only
shares: grid
USES KEYWORD domain
USES KEYWORD bitant_plane
USES KEYWORD quadrant_direction
USES KEYWORD rotation_axis

# we need to look at ADMBase::metric_type and StaticConformal::conformal_state
# to check physical/conformal metric
# note our access is read-only
shares: ADMBase
USES KEYWORD metric_type
USES CCTK_INT metric_timelevels

# we need to look at SpaceMask::use_mask in order to find out about the
# excision region
shares: SpaceMask
USES BOOLEAN use_mask

# we need to look at IO::out_dir to set the default for our own
# output directory parameters
shares: IO
USES STRING out_dir

# we want to know how many surfaces there are, so that we don't access
# a non-existing one
shares: SphericalSurface
USES INT nsurfaces
USES INT maxntheta
USES INT maxnphi

# all remaining parameters are private to this thorn
private:

################################################################################

#
# ***** overall parameters *****
#

# set this to (try to) find apparent horizons at every time step
int find_every "how often should we try to find apparent horizons?" STEERABLE=always
{
0   :: "don't find AHs at all (this thorn is a no-op)"
1:* :: "any integer >= 1"
} 1

# set this to (try to) find individual apparent horizons at every time step
int find_every_individual[101] "how often should we try to find individual apparent horizons?  (overrides find_every)" STEERABLE=always
{
-1  :: "use the value of find_every"
0   :: "don't find this AH at all"
1:* :: "any integer >= 1"
} -1

# set this to (try to) find individual apparent horizons after a time step
int find_after_individual[101] "when should we start to find individual apparent horizons?" STEERABLE=always
{
0:* :: "after this iteration (inclusively)"
} 0

int dont_find_after_individual[101] "when should we stop finding individual apparent horizons?" STEERABLE=always
{
0:* :: "after this iteration (exclusively)"
-1  :: "do not use this parameter"
} -1

# set this to (try to) find individual apparent horizons after a certain time
real find_after_individual_time[101] "when should we start to find individual apparent horizons?" STEERABLE=always
{
*:* :: "after this time (inclusively)"
} 0.0

real dont_find_after_individual_time[101] "when should we stop finding individual apparent horizons?" STEERABLE=always
{
*:* :: "after this time (exclusively); ignore this value if it is less than or equal to find_after_individual_time"
} 0.0

# set this to disable finding individual horizons
boolean disable_horizon[101] "should this horizon be disabled?" STEERABLE=always
{
} "false"

#
# These parameters control which schedule bin (or even bins, if you
# want) AHFinderDirect runs in.  Historically, Erik's branch of
# AHFinderDirect has run at CCTK_POSTSTEP.  However, for some purposes
# it's more convenient to run at CCTK_ANALYSIS and/or CCTK_POSTINITIAL.
#
# In general we need to run at CCTK_POST_RECOVER_VARIABLES, since
# (a) parameters may have been steered at recovery, so we may need
#     to find a new horizon or horizons, and
# (b) we need to set the mask again to make sure it's correct
#     right away (since our next regular horizon-finding may not
#     be until some time steps later)
# Therefore the  run_at_CCTK_POST_RECOVER_VARIABLES  parameter should
# probably be left at its default setting of  true .
#
Boolean run_at_CCTK_ANALYSIS "should we run at CCTK_ANALYSIS?"
{
} false
Boolean run_at_CCTK_POSTSTEP "should we run at CCTK_POSTSTEP?"
{
} true
Boolean run_at_CCTK_POSTINITIAL "should we run at CCTK_POSTINITIAL?"
{
} false
Boolean run_at_CCTK_POSTPOSTINITIAL "should we run at CCTK_POSTPOSTINITIAL?"
{
} false
Boolean run_at_CCTK_POST_RECOVER_VARIABLES				\
  "should we run at CCTK_POST_RECOVER_VARIABLES?"
{
} false

keyword method "what should this thorn do for each apparent horizon?" \
  STEERABLE=recover
{
# these options are mostly for testing/debugging
# ... in a multiprocessor Cactus run, the horizons are done sequentually
#     on processor #0; the other processors do dummy computations
"evaluate expansions"	  :: "evaluate the LHS function Theta(h)"

# ... in a multiprocessor Cactus run, the Jacobian is computed on
#     processor #0; the other processors do dummy computations
"test expansion Jacobians" :: \
  "compute/print horizon 1's J[Theta(h)] Jacobian matrix (possibly in \
   multiple ways, depending on the  test_all_Jacobian_methods  parameter)"

# this is for normal apparent horizon finding
# ... in a multiprocessor Cactus run, the horizons are done in parallel
#     across processors; see src/driver/README.parallel for details
"find horizons"		  :: "find the apparent horizon"
} "find horizons"

#
# We support searching for up to N_horizons distinct apparent horizons
# (some of which may be nested inside others) in a slice.
# ***** IMPORTANT *****: The horizons are numbered 1 to N_horizons.
# Since Cactus arrays are 0-origin, we make the arrays be of size
# N_horizons+1, and don't use the [0] array elements.
#
# To change the N_horizons limit, just change the upper limit for
# N_horizons itself, change all the [N_horizons+1] array sizes in this
# paramter file, change the upper limit for which_horizon_to_announce_centroid,
# and recompile your configuration.  No changes are needed to the source code.
#
int N_horizons "number of apparent horizons to search for" \
  STEERABLE=recover
{
0     :: "turn this thorn into a fancy no-op :)"
1:100 :: "search for this many apparent horizons"
} 1

#
# This parameter controls whether or not (assuming we have found a
# horizon or horizons), we announce a selected horizon centroid to
# some other thorn.  In practice the other thorn will be DriftCorrect,
# which will use this information to adjust the coordinates to try to
# keep the horizon centroid at a constant coordinate position.
#
int which_horizon_to_announce_centroid \
  "for which horizon should we announce the centroid?" \
  STEERABLE=recover
{
0     :: "don't announce any centroid(s)"
1:100 :: "announce this horizon's centroid each time we find it"
} 0

#
# This parameter controls whether and (if) into which surface the horizon
# information will be stored.
#
int which_surface_to_store_info[101] \
  "into which surface should we store the info?" \
  STEERABLE=recover
{
-1  :: "don't store info"
0:* :: "store info into the corresponding surface"
} -1

string which_surface_to_store_info_by_name[101] \
  "into which surface should we store the info?" \
  STEERABLE=recover
{
""   :: "use which_surface_to_store_info"
".*" :: "any string"
} ""

#
# This parameter controls how verbose this thorn is in printing
# informational (non-error) messages describing what it's doing.
#
keyword verbose_level \
  "controls which (how many) messages to print describing AH finding" \
  STEERABLE=recover
{
# 1 line each time step giving number of horizons found and their masses
# ... this doesn't work yet :(
"physics highlights"   :: "just a few physics messages"

# 1 line for each horizon giving position/mass/area, + a summary line or two
"physics details"      :: "more detailed physics messages"

# 1 line giving Theta(h) norms at each Newton iteration
"algorithm highlights" :: \
  "physics details + a few messages about the AH-finding algorithm"

# lots of details tracing what the code is doing
"algorithm details"    :: \
  "physics details + lots of messages about the AH-finding algorithm"

# even more details tracing what the code is doing :)
"algorithm debug"    :: \
  "physics details + lots and lots of messages about the AH-finding algorithm"
} "physics details"

# n.b. printing timing stats is independent of  verbose_level
boolean print_timing_stats \
  "should we print timing stats for the whole apparent-horizon-finding process?" \
  STEERABLE=recover
{
} "false"

# Do we want the gradients of the surface expansion?
# (Increases run time)
boolean want_expansion_gradients "should we print the gradients of the expansions?" \
  STEERABLE=recover
{
} "false"

# By default, we find apparent horizons or CE surfaces.
# This parameter allows the equation to be change so that other surfaces
# are found instead.
keyword surface_definition[101] "search for what kind of surface?" STEERABLE=recover
{
"expansion"         :: "Theta_(l) (apparent horizons etc.)"
"inner expansion"   :: "Theta_(n) (expansion of ingoing null normal)"
"mean curvature"    :: "for CMC surfaces"
"expansion product" :: "Theta_(l) Theta_(n) (product of the expansions)"
} "expansion"

# By default, we find surfaces as defined above.
# This parameter allows the definition to be modified.
keyword surface_modification[101] "how to modify the surface definition" STEERABLE=recover
{
"none"         :: "no modification"
"radius"       :: "multiply with the coordinate radius"
"radius^2"     :: "multiply with the square of the coordinate radius"
"mean radius"  :: "multiply with the mean coordinate radius"
"areal radius" :: "multiply with the areal radius (does not converge nicely, because the Jacobian is only approximate)"
} "none"

# By default, we find apparent horizons by looking for a specified expansion.
# This parameter allows looking for a specified areal radius etc. instead.
keyword surface_selection[101] "search for a surface with this areal radius" STEERABLE=recover
{
"definition"                             :: "look for a surface as defined by 'surface_definition'"
"mean coordinate radius"                 :: "look for a surface with a certain mean coordinate radius (not covariant, but fast)"
"areal radius"                           :: "look for a surface with a certain areal radius"
"expansion times mean coordinate radius" :: "look for a surface with a certain product of expansion and mean coordiante radius"
"expansion times areal radius"           :: "look for a surface with a certain product of expansion and areal radius"
} "definition"

# By default, we find apparent horizons by solving the equation
#  Theta(h) = 0
# This parameter allows the RHS to be set to any specified constant,
# to find a surface of constant expansion.
real desired_value[101] "search for a surface with this (constant) value" STEERABLE=recover
{
*:* :: "any real number"
} 0.0



# By default, we just find apparent horizons.  This parameter uses
# pretracking to search for outermost apparent horizons instead.
boolean use_pretracking[101] "search for an outermost apparent horizon" STEERABLE=recover
{
} "no"

int pretracking_max_iterations[101] "maximum number of pretracking iterations" STEERABLE=recover
{
  0:* :: ""
} 100

real pretracking_value[101] "initial pretracking value" STEERABLE=recover
{
  *:* :: ""
} 1.0

real pretracking_minimum_value[101] "minimum pretracking value" STEERABLE=recover
{
  *:* :: ""
} 0.0

real pretracking_maximum_value[101] "maximum pretracking value (should be near the outer boundary)" STEERABLE=recover
{
  *:* :: ""
} 10.0

real pretracking_delta[101] "step size for value" STEERABLE=recover
{
  (0.0:* :: ""
} 1.0

real pretracking_minimum_delta[101] "minimum step size for value" STEERABLE=recover
{
  (0.0:* :: ""
} 1.0e-4

real pretracking_maximum_delta[101] "maximum step size for value" STEERABLE=recover
{
  (0.0:* :: ""
} 1.0

# Horizons can depend on other (usually pretracked) horizons
int depends_on[101] "the other horizon that this horizon depends on" STEERABLE=recover
{
  0     :: "the horizon is independent"
  1:100 :: "horizon index"
} 0

real desired_value_factor[101] "factor between this horizon's and the other horizon's desired value, applied before the offset" STEERABLE=recover
{
  *:* :: ""
} 1.0

real desired_value_offset[101] "difference between this horizon's and the other horizon's desired value, applied after the factor" STEERABLE=recover
{
  *:* :: ""
} 0.0



# By default, we keep the surface from the last time (if so desired).
# We can also modify it before each finding to try make it find inner
# or outer horizons.
real shiftout_factor[101] "enlarge the surface initial guess before finding" STEERABLE=recover
{
  (0:* :: "choose 1 for doing nothing, larger for enlarging, smaller for shrinking"
} 1.0

real smoothing_factor[101] "smoothen (remove higher multipole moments) the surface initial guess before finding" STEERABLE=recover
{
  *:* :: "choose 0 for no smoothing, 1 for complete smoothing, larger for over-smoothing, negative for roughening"
} 0.0

################################################################################

#
# ***** parameters for the initial guess for each apparent horizon shape *****
#

#
# (Note that if at any time we fail to find the (an) apparent horizon,
# then we reset our trial horizon surface to this initial guess before
# next attempting to find this horizon.)
#

keyword initial_guess_method[101] \
  "method used to set up initial guess for apparent horizon shape" \
  STEERABLE=recover
{
"read from named file"	:: "read from explicitly-named input file"
"read from h file"	:: \
  "read from input file named the same as the (later) h output file"
"Kerr/Kerr"		:: \
  "set to the (analytical) horizon of Kerr spacetime in Kerr coordinates \
   (n.b. Schwarzschild/EF is the special case spin=0 of this)"
"Kerr/Kerr-Schild"	:: \
  "set to the (analytical) horizon of Kerr spacetime in Kerr-Schild coordinates"
"coordinate sphere"	:: "set to a coordinate sphere"
"coordinate ellipsoid"	:: "set to a coordinate ellipsoid"
} "coordinate sphere"

# if a horizon could not be found, do we want to reset the horizon shape,
# or do we want to continue with the last shape?
boolean reset_horizon_after_not_finding[101] \
  "reset the horizon shape to the initial data if a horizon was not found" \
  STEERABLE=recover
{
} "yes"

# parameters for initial_guess_method = "read from named file"
string initial_guess__read_from_named_file__file_name[101] \
  "file name to read initial guess from" \
  STEERABLE=recover
{
".+" :: "file name to read initial guess from"
} "h.gp"

# parameters for initial_guess_method = "Kerr/Kerr"
real initial_guess__Kerr_Kerr__x_posn[101] "x coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_Kerr__y_posn[101] "y coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_Kerr__z_posn[101] "z coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_Kerr__mass[101] "mass of Kerr BH" STEERABLE=recover
{
(0.0:*		:: "BH mass = any real number > 0"
} 1.0
# n.b. my convention is that a=J/m^2 is dimensionless,
#      while MTW take a=J/m=m * (my a)
real initial_guess__Kerr_Kerr__spin[101] "dimensionless spin a=J/m^2 of Kerr BH" STEERABLE=recover
{
(-1.0:1.0)	:: \
  "dimensionless BH spin = J/m^2 = any real number with absolute value < 1"
} 0.6

# parameters for initial_guess_method = "Kerr/Kerr-Schild"
real initial_guess__Kerr_KerrSchild__x_posn[101] "x coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_KerrSchild__y_posn[101] "y coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_KerrSchild__z_posn[101] "z coordinate of Kerr BH" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__Kerr_KerrSchild__mass[101] "mass of Kerr BH" STEERABLE=recover
{
(0.0:*		:: "BH mass = any real number > 0"
} 1.0
# n.b. my convention is that a=J/m^2 is dimensionless,
#      while MTW take a=J/m=m * (my a)
real initial_guess__Kerr_KerrSchild__spin[101] "dimensionless spin a=J/m^2 of Kerr BH" STEERABLE=recover
{
(-1.0:1.0)	:: \
  "dimensionless BH spin = J/m^2 = any real number with absolute value < 1"
} 0.6

# parameters for initial_guess_method = "sphere"
real initial_guess__coord_sphere__x_center[101] "x coordinate of sphere center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_sphere__y_center[101] "y coordinate of sphere center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_sphere__z_center[101] "z coordinate of sphere center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_sphere__radius[101] "radius of sphere" STEERABLE=recover
{
(0.0:* :: "any real number > 0.0"
} 2.0

# parameters for initial_guess_method = "ellipsoid"
real initial_guess__coord_ellipsoid__x_center[101] \
  "x coordinate of ellipsoid center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_ellipsoid__y_center[101] \
  "y coordinate of ellipsoid center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_ellipsoid__z_center[101] \
  "z coordinate of ellipsoid center" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real initial_guess__coord_ellipsoid__x_radius[101] "x radius of ellipsoid" STEERABLE=recover
{
(0.0:* :: "any real number > 0.0"
} 2.0
real initial_guess__coord_ellipsoid__y_radius[101] "y radius of ellipsoid" STEERABLE=recover
{
(0.0:* :: "any real number > 0.0"
} 2.0
real initial_guess__coord_ellipsoid__z_radius[101] "z radius of ellipsoid" STEERABLE=recover
{
(0.0:* :: "any real number > 0.0"
} 2.0

################################################################################

#
# ***** I/O parameters *****
#

########################################

#
# parameters for BH diagnostics
#

#
# The file format is currently hard-wired to a simple ASCII format:
# - there is one file per AH
# - after some header comments (starting with '#'),
#   there is one line per successful-AH-finding
#   (there is *no* line if we fail to find an AH)
# - each line contains various tab-separated fields, as described by
#   the header comment
#
boolean output_BH_diagnostics \
  "should we output BH diagnostics to a data file for each AH found?" \
  STEERABLE=always
{
} "true"

#
# These file names are actually just "base" file names, with the full
# file names being given by a printf() format "%s/%s.ah%d.%s",
# where
# - the first %s is the BH diagnostics directory as set by the
#   BH_diagnostics_directory  parameter; this is automagically created
#   if it doesn't already exist
# - the second %s is the base file name,
# - the %d is the global Cactus time iteration number cctk_iteration,
# - the third %s is the file name extension as set by the
#   BH_diagnostics_file_name_extension  parameter
#
string BH_diagnostics_directory "directory for BH diagnostics output file(s)" \
  STEERABLE=always
{
".+" :: "any nonempty string"
"^$" :: "an empty string to default to IO::out_dir"
} ""
string BH_diagnostics_base_file_name \
  "base file name for BH diagnostics output file(s)" STEERABLE=always
{
".+" :: "any nonempty string"
} "BH_diagnostics"

string BH_diagnostics_file_name_extension \
  "extension for BH diagnostics data files" STEERABLE=always
{
".+" :: "any nonempty string"
} "gp"

########################################

#
# parameters for horizon-shape and other similar data files
#

# this parameter controls how often we write apparent-horizon-shape
# output files (format controlled by  horizon_file_format ); we still
# *find* apparent horizons at each time step, and compute BH diagnostics
# and (if desired) write them to the one-per-horizon BH diagnostics
# output files, but this parameter may be used to reduce the number
# of one-file-per-horizon-per-time-step apparent-horizon-shape output
# files
int output_h_every \
  "how often (in Cactus time steps) should we output h (0 to disable)?" \
  STEERABLE=always
{
0   :: "don't output h at all"
1:* :: "any integer >= 1"
} 1

# setting this > 0 is probably only of interest if the Newton iteration
# fails to converge, or if you're debugging AHFinderDirect internals
int output_Theta_every \
  "how often (in Cactus time steps) should we output the Theta(h) functions?" \
  STEERABLE=always
{
0   :: "don't output Theta(h) at all"
1:* :: "any integer >= 1"
} 0

int output_mean_curvature_every \
  "how often (in Cactus time steps) should we output the mean_curvature(h) functions?" \
  STEERABLE=always
{
0   :: "don't output mean_curvature(h) at all"
1:* :: "any integer >= 1"
} 0

boolean output_ASCII_files "output h and Theta(h) as ASCII files" STEERABLE=always
{
} "yes"

boolean output_HDF5_files "output h and Theta(h) as HDF5 files" STEERABLE=always
{
} "no"

# n.b. this refers to the patch system (angular) interpatch ghost zones,
#      *not* the Cactus interprocessor ghost zones
boolean output_ghost_zones_for_h \
  "should we include the patch system (angular) interpatch ghost zones \
   in h data files?" STEERABLE=always
{
} "false"

# n.b. making this "gnuplot" probably isn't a good idea,
#      since it could create confusion with gnuplot command files
string ASCII_gnuplot_file_name_extension \
  "extension for ASCII (gnuplot) data files" STEERABLE=always
{
".+" :: "any nonempty string"
} "gp"
string HDF5_file_name_extension "extension for HDF5 data files" STEERABLE=always
{
".+" :: "any nonempty string"
} "h5"

#
# These file names are actually just "base" file names, with the full
# file names being given by a printf() format "%s/%s.t%d.ah%d[.it%d].%s",
# where
# - the first %s is the output directory as set by the  h_directory
#   parameter (this same directory is used for all of these files);
#   this is automagically created if it doesn't already exist
# - the second %s is the base file name,
# - the first %d is the global Cactus time iteration number cctk_iteration,
# - the second %d is the apparent horizon number,
# - the optional third %d is the horizon finder iteration number
# - the third %s is the file name extension
#   {ASCII,HDF5}_data_file_name_extension
#
string h_directory \
  "directory for horizon shape and other similar output (or input) file(s)" \
   STEERABLE=always
{
".+" :: "any nonempty string"
"^$" :: "an empty string to default to IO::out_dir"
} ""

string h_base_file_name \
  "base file name for horizon shape h input/output file(s)" \
  STEERABLE=always
{
".+" :: "any nonempty string"
} "h"

string Theta_base_file_name "base file name for Theta(h) output file(s)" \
  STEERABLE=always
{
".+" :: "any nonempty string"
} "Theta"

string mean_curvature_base_file_name "base file name for mean_curvature(h) output file(s)" \
  STEERABLE=always
{
".+" :: "any nonempty string"
} "mean_curvature"

string Delta_h_base_file_name \
  "base file name for horizon-shape-update Delta_h output file(s)" \
  STEERABLE=always
{
".+" :: "any nonempty string"
} "Delta_h"

int h_min_digits \
  "minimum number of digits for the iteration number in the file name" STEERABLE=always
{
0:* :: ""
} 0

#
# Thomas Radke has written a set of OpenDX macros to read AHFinderDirect
# ASCII (gnuplot) format files.  These macros require a "control file"
# for each patch to specify some of the patch metadata.
#
# If we write them, the control file names are given by a printf() format
# "%s/%s.ah%d.%s", where
# - the first %s is the output directory as set by the  h_directory
#   parameter (this same directory is used for all of these files);
#   this is automagically created if it doesn't already exist
# - the second %s is h_base_file_name
# - the %d is the apparent horizon number
# - the third %s is the file name extension OpenDX_control_file_name_extension
#
boolean output_OpenDX_control_files \
  "should we output OpenDX control files to allow reading of AHFinderDirect \
   'ASCII (gnuplot)' format data files?" STEERABLE=always
{
} "true"
string OpenDX_control_file_name_extension \
  "file name extension for OpenDX control files" STEERABLE=always
{
".+" :: "any nonempty string"
} "dx"

########################################

#
# parameters mainly for debugging
#

# this is mainly useful for debugging purposes
boolean output_initial_guess \
  "should we output the initial guess back to the h data file?" \
  STEERABLE=always
{
} "false"

# for debugging convergence failures, we can optionally output
# h, Theta, and delta_h at each Newton iteration
# (the file names are the usual ones with ".it%d" appended)
boolean debugging_output_at_each_Newton_iteration \
  "should we output {h, Theta, delta_h} at each Newton iteration?" \
  STEERABLE=recover
{
} "false"

string Jacobian_base_file_name "base file name for Jacobian output file(s)" \
  STEERABLE=always
{
".+" :: "any valid file name"
} "Jacobian.dat"

################################################################################

#
# ***** parameters for setting a mask grid function ***
# ***** based on each apparent horizon shape *****
#

boolean set_mask_for_all_horizons \
  "should we set a mask grid function (or functions) for all horizons?" \
  STEERABLE=recover
{
} "false"

boolean set_mask_for_individual_horizon[101] \
  "should we set a mask grid function (or functions) for *this* horizon?" \
  STEERABLE=recover
{
} "false"

#
# If we set a mask, we do so based on partitioning the Cactus grid into
# 3 regions, an "inside", a "buffer", and an "outside" (typically the inside
# region is excised).  For a grid point a distance r[i] from horizon i's
# local coordinate origin, with horizon i's radius in this same direction
# (again, measured from its local coordinate origin) being r_horizon[i],
# the regions are defined as follows:
#	r[i] <= r_inner[i] for some i				==> inside
#	r[i] >  r_inner[i] for all i
#		and r[i] <= r_outer[i] for some i		==> buffer
#	r[i] >  r_outer[i] for all i				==> outside
# where
#	r_inner = mask_radius_multiplier * r_horizon
#		  +  mask_radius_offset * Delta_x
#	r_outer = r_innter  +  mask_buffer_thickness * Delta_x
# and where  Delta_x  is the Cactus base grid spacing (more precisely,
# the geometric mean of the base grid's x, y, and z Cactus grid spacings)
# (The "base grid" part here only matters if you're doing mesh refinement.)
#
real mask_radius_multiplier \
  "radius multiplier to define the 'inside' mask region" \
  STEERABLE=recover
{
(0:*) :: \
  "any positive real number; typically this will be slightly less than 1.0"
} 0.8
real mask_radius_offset \
  "radius offset (in Cactus base grid spacings) to define the 'inside' mask region" \
  STEERABLE=recover
{
*:* :: "any real number; typically this will be negative"
} -5.0
real mask_buffer_thickness \
  "thickness (in Cactus base grid spacings) of the 'buffer' mask region" \
  STEERABLE=recover
{
*:* :: "any real number; typically this will be positive"
} 5.0

#
# If this parameter is set to true, then we prevent the inside & buffer
#    regions from ever shrinking, i.e. if a point is ever set to the inside
#    value then we leave at that value forever, and if it's ever set to
#    the buffer value then we leave at that value or the inside value forever.
# If this parameter is set to false, then we set the inside/buffer/outside
#    values independently at each time step, so all three regions can grow
#    or shrink depending on the horizon positions/shapes.
#
boolean mask_is_noshrink \
  "should we prevent the inside & buffer regions from ever shrinking?" \
  STEERABLE=recover
{
} "true"

#
# If we're using mesh refinement (eg Carpet) it's possible to find a
# horizon on a fine grid, and then set a mask on a coarser grid where
# the masked-off region is only a few grid points across.  This then
# confuses various other thorns (eg LegoExcision) which require excised
# regions to be "not too small".
#
# So...  This parameter may be used to specify that the mask not be set
# for a given horizon (just as if that horizon wasn't found) on any grid
# where the inner mask radius  r_inner  is < this many grid spacings.
# More precisely, we skip masking for any horizon where
#	r_inner,min < min_horizon_radius_points_for_mask * Delta_x_current,max
# where
#	r_inner,min = the minimum over all angles of the inner mask radius
#		      r_inner
#	Delta_x_current,max = the maximum of the x,y,and z grid spacings
#			      in the *current* Cactus grid
#
# Note that since r_inner can be negative (if  mask_radius_offset < 0 ),
# the default setting for this parameter is effectively -infinity, to
# excise any horizon.
#
real min_horizon_radius_points_for_mask \
  "only set mask if min r_inner >= this number of local grid spacings" \
  STEERABLE=recover
{
*:* :: "any real number"
} -1.0e10

#
# This thorn supports two types of mask grid functions:
# * the "old" style is that defined by CactusEinstein/AHFinder:
#   the mask is a CCTK_REAL grid function, which is set to specified
#   (CCTK_REAL) values inside/outside the (adjusted) horizon
# * the "new" style is that defined by CactusEinstein/SpaceMask:
#   the mask is a CCTK_INT grid function, with a specified bit field
#   set to specified values inside/outside the (adjusted) horizon
#	[N.b. AHFinderDirect doesn't set up the bit fields --
#	you must arrange for some other thorn to do this.  At
#	present AHFinderDirect converts the names specified here
#	to integer bit masks only once, in its setup routine;
#	this may change to do this conversion each time AHFinderDirect
#	does horizon finding.]
# You can choose to set either (or even both!) of these.
#
boolean set_old_style_mask \
  "if we're setting a mask, should we set an old-style (CCTK_REAL) mask gridfn?" STEERABLE=recover
{
} "true"
boolean set_new_style_mask \
  "if we're setting a mask, should we set an new-style (CCTK_INT) mask gridfn?" STEERABLE=recover
{
} "false"

#
# mask info for  mask_type = "old-style (CCTK_REAL)"
# defaults match CactusEinstein/AHFinder
#
string old_style_mask_gridfn_name "name of the old-style mask grid function" STEERABLE=recover
{
".+" :: "any valid Cactus grid function name"
} "SpaceMask::emask"
real old_style_mask_inside_value \
  "set the old-style mask to this value in the 'inside' region" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real old_style_mask_buffer_value \
  "set the old-style mask to this value in the 'buffer' region" STEERABLE=recover
{
*:* :: "any real number"
} 0.5
real old_style_mask_outside_value \
  "set the old-style mask to this value in the 'outside' region" STEERABLE=recover
{
*:* :: "any real number"
} 1.0

#
# mask info for  mask_type = "new-style (CCTK_INT)"
#
string new_style_mask_gridfn_name "name of the new-style mask grid function" STEERABLE=recover
{
".+" :: "any valid Cactus grid function name"
} "SpaceMask::space_mask"
string new_style_mask_bitfield_name \
  "name of the new-style mask bit field ('type') as registered with SpaceMask" STEERABLE=recover
{
".+" :: "any valid bit field ('type') name registered with the SpaceMask thorn"
} "mask"
string new_style_mask_inside_value \
  "set the specified bit field of the new-style mask to this named state \
   at grid points in the 'inside' region" STEERABLE=recover
{
".+" :: "any state name registered with the SpaceMask thorn"
} "inside"
string new_style_mask_buffer_value \
  "set the specified bit field of the new-style mask to this named state \
   at grid points in the 'buffer' region" STEERABLE=recover
{
".+" :: "any state name registered with the SpaceMask thorn"
} "buffer"
string new_style_mask_outside_value \
  "set the specified bit field of the new-style mask to this named state \
   at grid points in the 'outside' region" STEERABLE=recover
{
".+" :: "any state name registered with the SpaceMask thorn"
} "outside"

################################################################################

#
# ***** parameters controlling how we handle errors/warnings *****
#

#
# We currently "handle" the following errors/warnings by CCTK_VWarn();
# these parameters give the warning levels (in the sense of the -W flag
# to Cactus, and the first argument to CCTK_VWarn()) for various conditions:
#

# point outside (or too close to boundary of) Cactus grid,
# i.e. geometry interpolator returns CCTK_ERROR_INTERP_POINT_OUTSIDE
# ... warning level if error occurs on first Newton iteration,
#     i.e. when evaluating expansion/Jacobian for initial guess
# ... this may mean that  driver::ghost_size  is too small, especially
#     if any horizon crosses a symmetry boundary
#     ==> visible message by default
int warn_level__point_outside__initial \
  "warning level for point outside (or too close to boundary of) Cactus grid \
   (error occurs on first Newton iteration)" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 1
# ... warning level if error occurs on a subsequent Newton iteration
# ... this probably "just" means there's no horizon in the grid
#     ==> no visible message by default
int warn_level__point_outside__subsequent \
  "warning level for point outside (or too close to boundary of) Cactus grid \
   (error occurs on subsequent Newton iteration)" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 2

# the Cactus configure process didn't find a finite() function,
# so we're skipping the "check that the geometry is finite" tests
# even though the user set  check_that_geometry_is_finite = "true"
int warn_level__skipping_finite_check \
  "warning level if the user sets  check_that_geometry_is_finite \
   but the Cactus configure process doesn't find a  finite()  function \
   so we have to skip the finite-geometry check" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 3

# infinity and/or NaN in interpolated {g_ij, partial_k g_ij, K_ij}
int warn_level__nonfinite_geometry \
  "warning level if we find infinity and/or NaN in the interpolated geometry \
   values {g_ij, partial_k g_ij, K_ij}" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 1

# interpolated g_{ij} isn't positive definite
# (usually this means we're too close to a singularity)
# ... warning level if error occurs on first Newton iteration,
#     i.e. when evaluating expansion/Jacobian for initial guess
int warn_level__gij_not_positive_definite__initial \
  "warning level if the interpolated g_{ij} isn't positive definite \
   (usually this means we're too close to a singularity) \
   (error occurs on first Newton iteration)" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 2
# ... warning level if error occurs on a subsequent Newton iteration
int warn_level__gij_not_positive_definite__subsequent \
  "warning level if the interpolated g_{ij} isn't positive definite \
   (usually this means we're too close to a singularity) \
   (error occurs on subsequent Newton iteration)" STEERABLE=recover
{
-1:* :: "any valid Cactus warning level"
} 2

################################################################################

#
# ***** parameters for the Newton's-method solution of Theta(h) = 0 *****
#

#
# The first time we (try to) find a given horizon, our initial guess
# is likely to be rather inaccurate, so we may need a larger number of
# iterations.  But if we've found this horizon before, then we have its
# previous position as an initial guess, so (assuming that we've been
# scheduled at each time step) we shouldn't need as many iterations.
#
int max_Newton_iterations__initial \
  "maximum number of Newton iterations before giving up \
   when initially finding a given horizon" STEERABLE=recover
{
(0:* :: "any positive integer"
} 20
int max_Newton_iterations__subsequent \
  "maximum number of Newton iterations before giving up \
   when re-finding a given horizon after finding it before" STEERABLE=recover
{
(0:* :: "any positive integer"
} 10

#
# To avoid the Newton iteration diverging if there is no horizon present
# or if the initial guess is bad, we limit the distance the horizon may
# move in any single Newton iteration (i.e. the infinity-norm of Delta_h)
# to <= this fraction of the mean horizon radius
#
real max_allowable_Delta_h_over_h \
  "don't let horizon move > this fraction of mean radius in a Newton iteration" STEERABLE=recover
{
(0.0:* :: "any positive real number"
} 0.1

#
# To avoid the Newton iteration diverging (or more accurately, to detect
# this divergence faster) if there is no horizon present or if the initial
# guess is bad, we also deem any horizon with a mean radius (measured around
# its local coordinate origin) larger than this to be "not found".  The
# default is effectively "no limit"; AHFinderDirect will be more efficient
# if you (re)set this (for each horizon) to the coordinate radius of a
# sphere a bit larger than you expect the horizon to be (eg a sphere with
# areal radius 4m or so, where m is the ADM mass of the slice).
#
real max_allowable_horizon_radius[101] \
  "max mean-coordinate-radius allowed for any trial surface \
   before we give up and say we can't find this horizon" STEERABLE=recover
{
(0.0:* :: "any positive real number"
} 1.0e10

#
# convergence tolerance for the Newton iteration
#
real Theta_norm_for_convergence \
  "we declare the horizon to be found if ||Theta||_infinity <= this" STEERABLE=recover
{
(0.0:* :: "any positive real number"
} 1.0e-8

#
# To detect some divergence cases faster, we also deem any horizon where
# the infinity-norm of Theta exceeds this parameter, to be "not found".
# The default is effectively "no limit".
#
real max_allowable_Theta \
  "max ||Theta||_infinity allowed for any trial surface \
   before we give up and say we can't find this horizon" STEERABLE=recover
{
(0.0:* :: "any positive real number"
} 1.0e10

#
# To detect some divergence cases faster, we also do not allow the Theta
# norm to grow for more than a certain number of iterations.
#
int max_allowable_Theta_growth_iterations \
  "max number of consecutive iterations during which ||Theta||_infinity \
   is allowed to grow before we give up and say we can't find this horizon" STEERABLE=recover
{
0   :: "infinitly many"
1:* :: "that many"
} 0

#
# To detect some divergence cases faster, we also do not allow the Theta
# norm to oscillate without shrinking for more than a certain number of
# iterations.
#
int max_allowable_Theta_nonshrink_iterations \
  "max number of consecutive iterations during which ||Theta||_infinity \
   is allowed to oscillate without shrinking before we give up and say \
   we can't find this horizon" STEERABLE=recover
{
0   :: "infinitly many"
1:* :: "that many"
} 0

################################################################################

#
# ***** parameters to define the patch system(s) *****
#

#
# For each apparent horizon, you need to set these parameters to the
# Cactus xyz coordinates of a "local origin point" inside the horizon,
# which will serve as the origin for the apparent horizon finder's
# local angular coordinate system.
#
# The apparent horizon surface (and in fact all the trial surfaces the
# apparent horizon finder generates while iteratively solving the apparent
# horizon equation) is restricted to being a Strahlkoerper ("star-shaped
# region") about the origin point.  That is, each surface must be of
# the form r = h(angle) with h a single-valued function.
#
# If the origin point is too far from the actual horizon centroid, i.e.
# if it's too close to the horizon surface itself, then the apparent
# horizon finder's Newton iteration won't converge as quickly or robustly.
# However, in practice the tolerances on this are quite loose -- 1/4
# of the horizon radius is no problem, and even 1/2 the horizon radius
# only slows the convergence by an extra iteration or two.
#
real origin_x[101] "global x coordinate of patch system origin" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real origin_y[101] "global y coordinate of patch system origin" STEERABLE=recover
{
*:* :: "any real number"
} 0.0
real origin_z[101] "global z coordinate of patch system origin" STEERABLE=recover
{
*:* :: "any real number"
} 0.0

boolean move_origins "move the origins with the horizons" STEERABLE=recover
{
} "no"

boolean reshape_while_moving "reshape the horizons when moving them" STEERABLE=recover
{
} "no"

boolean predict_origin_movement "predict origin movement when moving the origins" STEERABLE=recover
{
} "no"

boolean track_origin_from_grid_scalar[101] "track horizon origin from given grid scalars" STEERABLE=recover
{
} "no"
string track_origin_source_x[101] "grid scalar containing the x component of the origin estimate" STEERABLE=recover
{
  "" :: "don't use this feature"
  "[a-zA-Z_][a-zA-Z0-9_]*[:][:][a-zA-Z_][a-zA-Z0-9_]*(\[0-9+\])" :: "name of a grid scalar"
} ""
string track_origin_source_y[101] "grid scalar containing the x component of the origin estimate" STEERABLE=recover
{
  "" :: "don't use this feature"
  "[a-zA-Z_][a-zA-Z0-9_]*[:][:][a-zA-Z_][a-zA-Z0-9_]*(\[0-9+\])" :: "name of a grid scalar"
} ""
string track_origin_source_z[101] "grid scalar containing the x component of the origin estimate" STEERABLE=recover
{
  "" :: "don't use this feature"
  "[a-zA-Z_][a-zA-Z0-9_]*[:][:][a-zA-Z_][a-zA-Z0-9_]*(\[0-9+\])" :: "name of a grid scalar"
} ""

#
# The "(rotating)" patch system types are ok for evaluating Theta(h),
# but alas they don't work yet for apparent horizon finding
# (the Jacobian computation doesn't yet grok the nonlocal rotation BCs).
#
keyword patch_system_type[101] "what type of patch system should we use?"
{
# choose this for normal use
"match Cactus grid symmetry" :: \
  "choose automagically based on grid symmetries and the patch system's origin"

"full sphere"	:: "full sphere, no symmetries"
"+z hemisphere"	:: "mirror symmetry across z=0 plane"

"+xy quadrant (rotating)" :: "90 degree periodic rotation symmetry about z axis"
"+xy quadrant (mirrored)" :: "mirror symmetry across x=0 and y=0 planes"

"+xz quadrant (mirrored)" :: "mirror symmetry across x=0 and z=0 planes"
"+xz quadrant (rotating)" :: \
  "180 degree periodic rotation symmetry about z axis \
   and mirror symmetry across z=0 plane"

"+xyz octant (rotating)"  :: \
  "90 degree periodic rotation symmetry about z axis \
   and mirror symmetry across z=0 plane"
"+xyz octant (mirrored)"  :: "mirror symmetry across x=0 and y=0 and z=0 planes"
} "match Cactus grid symmetry"

#
# This parameter sets the angular resolution of each patch systems:
# the angular grid spacing in degrees is 90.0/N_zones_per_right_angle.
#
# In practice the error in the horizon position is usually dominated
# by the errors from interpolating the Cactus gij and Kij to the horizon
# position, not by the angular finite differencing or interpatch interpolation
# errors.  Thus this parameter can be made fairly small (low resolution)
# for better performance, without seriously affecting the accuracy
# with which we can locate the horizon.
#
# *** IMPORTANT
# *** For any patch system type other than "full sphere", there are
# *** patches with 45 degree widths, so this parameter must be even.
#
# Normally we use Simpson's rule (in a variant which doesn't require the
# number of zones to be even) for angular integrations over the patch
# system.  However, if the number of angular zones in a patch is very
# small and odd (i.e. 3 or 5), then we have to use the trapezoid rule
# instead, so the integrations are less accurate.  This occurs for
# N_zones_per_right_angle = 3 or 5 for a full sphere patch system,
# or N_zones_per_right_angle = 6 or 10 for any other patch system type.
#
# For large values of this parameter, this thorn takes CPU time which
# scales roughly as the ...
# ... 6th power of this parameter
#     if Jacobian_store_solve_method = "dense matrix/LAPACK"
# ... 3rd power of this parameter
#     if Jacobian_store_solve_method = "row-oriented sparse matrix/ILUCG"
#
#int N_zones_per_right_angle[101] "sets angular resolution of patch systems" ACCUMULATOR-BASE max_N_zones_per_right_angle
int N_zones_per_right_angle[101] "sets angular resolution of patch systems"
{
1:* :: "any integer >= 1; must be even for patch systems other than full-sphere"
} 18

# Default parameter values do not trigger accumulator expressions.
# Therefore the default values here must be large enough for the default
# horizon shape.
#int max_N_zones_per_right_angle "the maximum of all N_zones_per_right_angle -- calculated automatically; do not set this parameter directly" ACCUMULATOR=((x>y)*x+!(x>y)*y)
int max_N_zones_per_right_angle "the maximum of all N_zones_per_right_angle"
{
1:* :: "must be at least the maximum of all N_zones_per_right_angle"
} 18

#
# This parameter sets the width of the interpatch ghost zones in the
# patch system.  Note that this thorn uses the terminology "ghost zone"
# for any of what Cactus in general now calls a "boundary zone" or a
# "symmetry zone" or a "patch zone".
#
# This parameter must be at least
# ... 2 if FINITE_DIFF_ORDER is set to 4 in "src/include/config.hh"
# ... 1 if FINITE_DIFF_ORDER is set to 2 in "src/include/config.hh"
# The code checks for this being too small, and reports a fatal error if so.
#
int ghost_zone_width "number of ghost zones on each side of a patch"
{
0:* :: "any integer >= 0"
} 2

#
# Our code that computes surface integrals over patches (used for
# computing BH diagnostics like centroids, areas, masses, etc) silently
# assumes that this parameter is == 1, so you should probably leave
# it at that setting.
#
int patch_overlap_width \
  "number of grid points that nominally-just-touching patches should overlap"
{
1:*:2 :: "any integer >= 0; current implementation requires that it be odd"
} 1

################################################################################

#
# ***** parameters for the Jacobian matrix *****
#

keyword Jacobian_compute_method "how do we compute the Jacobian matrix?" STEERABLE=recover
{
# for debugging only"
"numerical perturbation"    :: "n.b. this is *very* slow"

# use this for normal apparent horizon finding
"symbolic differentiation with finite diff d/dr" :: \
  "fast, tricky programming, uses only gij, dx gij, Kij"

# alas, this isn't implemented yet :(
"symbolic differentiation"  :: \
  "fast, tricky programming, uses gij, dx gij, dxx gij, Kij, dx Kij"
} "symbolic differentiation with finite diff d/dr"

########################################

#
# This parameter lists all known methods for storing the Jacobian and
# solving linear systems with the Jacobian as the LHS matrix.  See
# "src/include/config.hh" for which of these are actually compiled in at
# the moment.  N.b. each compiled-in method requires linking with the
# corresponding linear-solver library; see "src/make.configuration.defn"
# for details on these libraries.
#
keyword Jacobian_store_solve_method \
  "how do we store/linear-solve the Jacobian matrix?" STEERABLE=recover
{
# good for debugging, but very slow for large  N_zones_per_right_angle
"dense matrix/LAPACK"	:: \
  "store as (Fortran) dense matrix, solve with LAPACK routines"
# use this for normal runs
"row-oriented sparse matrix/ILUCG" :: \
  "store as sparse matrix (row-oriented storage format), \
   solve with ILUCG (incomplete LU decomposition - conjugate gradient) method"
# this will probably replace ILUCG, but it's not ready yet :(
"row-oriented sparse matrix/UMFPACK" :: \
  "store as sparse matrix (row-oriented storage format), \
   solve with UMFPACK (sparse LU decomposition) method"
} "row-oriented sparse matrix/UMFPACK"

#
# Extra parameters for individual linear solvers
#

# extra parameters for
#   Jacobian_store_solve_method == "row-oriented sparse matrix/ILUCG"
real ILUCG__error_tolerance "error tolerance for conjugate gradient iteration" STEERABLE=recover
{
(*:0.0)	:: \
  "negative ==> scale the absolute value by the floating point roundoff \
                threshold, e.g. -256.0 means to allow the last 8 bits of \
                the solution to be in error"
(0.0:*)	:: \
  "positive ==> error tolerance"
} 1.0e-10
boolean ILUCG__limit_CG_iterations \
  "should we limit the maximum number of conjugate gradient iterations allowed?" STEERABLE=recover
{
"false"	:: "no limit on CG iterations"
"true"	:: "limit to Neqns CG iterations"
} "true"

# extra parameters for
#   Jacobian_store_solve_method == "row-oriented sparse matrix/UMFPACK"
int UMFPACK__N_II_iterations \
  "number of iterative-improvement iterations to do inside UMFPACK \
   after the sparse LU decompose/solve, each time we solve a linear system" STEERABLE=recover
{
-1	:: "use the UMFPACK default"
0	:: "don't do iterative improvement"
1:*	:: "any positive integer \
	    (in practice a few iterations give almost all the benefit)"
} 0

########################################

#
# This parameter controls two different sorts of one-sided finite
# differencing:
# - numerical-perturbation Jacobian computations
# - the finite differencing part of the "symbolic differentiation
#   with finite diff d/dr" Jacobian computation
#
# Notes on this parameter:
# - don't set it too small or roundoff errors will become large
# - don't set it too large or finite differencing errors will become large
# In practice the default value should be fine
#
real Jacobian_perturbation_amplitude \
  "perturbation amplitude for 1-sided finite differencing for Jacobians" STEERABLE=recover
{
(0.0:* :: "any real number > 0"
} 1.0e-6

# if AHFinderDirect::method = "test Jacobian", should we test all
# known methods for computing the Jacobian, or just the numerical perturbation
# method (the latter may be useful of some other methods are broken)
boolean test_all_Jacobian_compute_methods \
  "should we test all Jacobian computation methods, or just NP?" STEERABLE=recover
{
} "true"

################################################################################

#
# ***** parameters for how we compute the slice's geometry *****
# ***** (gij, Kij, partial_k gij) *****
#

########################################

#
# parameters for geometry interpolation
#
# This 3D interpolator is used to interpolate gij and Kij from the
# Cactus grid to the position of each trial horizon surface, giving
# gij, Kij, and partial_x gij as outputs.  This interpolator must have
# the following properties:
# - It must support taking at least 1st derivatives as part of the
#   interpolation.
# - It should give at least $C^1$ interpolants for smooth data, otherwise
#   the Theta(h) function will have "spikes" and the Newton iteration may
#   fail to converge all the way down to tight error tolerances.  $C^2$
#   would be even better, but in practice a ($C^1$) Hermite interpolant
#   works well.
# In practice the default values for these parameters should work fine
# (with the AEIThorns/AEILocalInterp local interpolator).
#

string coordinate_system_name \
  "name under which the coordinate system is registered in Cactus" STEERABLE=recover
{
".+" :: "any nonempty string"
} "cart3d"

string geometry_interpolator_name \
  "name under which the geometry interpolation operator is registered in Cactus" STEERABLE=recover
{
".+" :: "any nonempty string"
} "Hermite polynomial interpolation"

#
# The defaults here are set up for 2nd order Hermite interpolation,
# which requires driver::ghost_size >= 2.
#
string geometry_interpolator_pars \
  "parameters for the geometry interpolator" STEERABLE=recover
{
".*" :: \
  "any string acceptable to Util_TableSetFromString() and to the interpolator"
} "order=2 \
   boundary_off_centering_tolerance={1.0e-10 1.0e-10 1.0e-10 1.0e-10 1.0e-10 1.0e-10} \
   boundary_extrapolation_tolerance={0.0 0.0 0.0 0.0 0.0 0.0}"

########################################

#
# for testing/debugging purposes, instead of interpolating the geometry
# from the Cactus grid, we can instead hardwire it to an Eddington-Finkelstein
# slice of Schwarzschild spacetime
#
boolean hardwire_Schwarzschild_EF_geometry \
  "should we hard-wire the geometry to Schwarzschild/EF instead of \
   interpolating from the Cactus grid?"
{
} "false"

real geometry__Schwarzschild_EF__mass "mass of Schwarzschild BH"
{
(0.0:*		:: "BH mass = any real number > 0"
} 1.0

real geometry__Schwarzschild_EF__x_posn "x coordinate of Schwarzschild BH"
{
*:* :: "any real number"
} 0.0
real geometry__Schwarzschild_EF__y_posn "y coordinate of Schwarzschild BH"
{
*:* :: "any real number"
} 0.0
real geometry__Schwarzschild_EF__z_posn "z coordinate of Schwarzschild BH"
{
*:* :: "any real number"
} 0.0

# some of the Schwarzschild/EF formulas have 0/0 limits on the z axis;
# this parameter controls where we switch from the generic formulas to
# the L'Hopital's-rule z axis limits
# - don't set this parameter too small or roundoff errors will be excessive
# - don't set this parameter too large or finite differencing errors will
#   be excessive
# in practice the default value should be fine
# n.b. this is used for centered finite differencing, unlike the Jacobian
real geometry__Schwarzschild_EF__epsilon \
  "threshold for sin^2 theta = (x^2+y^2)/r^2 below which we use z axis limits"
{
(0.0:*	:: "this should be somewhat above the floating-point roundoff level"
} 1.0e-9

# we compute partial_k g_ij by numerical finite differencing of the exact
# analytical g_ij values; this parameter sets the "grid spacing" for this
# - don't set this parameter too small or roundoff errors will be excessive
# - don't set this parameter too large or finite differencing errors will
#   be excessive
# in practice the default value should be fine
# ... n.b. this finite differencing is *centered*, unlike that in the
#          Jacobian computation
real geometry__Schwarzschild_EF__Delta_xyz \
  "finite diff pseuo-grid spacing for computing partial_k g_ij"
{
(0.0:* :: "any real number > 0"
} 1.0e-6

########################################

#
# These parameters control whether we check that various angular gridfns
# are finite (neither NaN nor infinity) at various points in evaluating
# the Theta(h) function.  These are pretty cheap tests, and they're quite
# useful in catching assorted wierdness, so it's probably worth leaving
# them enabled unless you're trying to squeeze every last nanosecond...
#
boolean check_that_h_is_finite \
  "should we check that horizon shape function h is finite?" \
  STEERABLE=recover
{
} "true"
boolean check_that_geometry_is_finite \
  "should we check the interpolated geometry variables are finite?" \
  STEERABLE=recover
{
} "true"

################################################################################

#
# ***** parameters for the interpatch interpolation *****
#

#
# This 1D local interpolator is used to interpolate the h function between
# angular patches.  Because any given patch boundary only interpolates
# from a single neighboring patch (this is to simplify the bookkeeping),
# near the patch corners this interpolator will have to be used off-centered.
# Thus it's desirable to use an interpolator which retains reasonable
# accuracy right up to the edge of the data range.  In practice a Lagrange
# polynomial interpolant works well.
#

string interpatch_interpolator_name \
  "name under which the interpatch interpolation operator is registered in Cactus" STEERABLE=recover
{
".+" :: "any string (in practice it should be nonempty)"
} "Lagrange polynomial interpolation"

string interpatch_interpolator_pars \
  "parameters for the interpatch interpolator" STEERABLE=recover
{
".*" :: \
  "any string acceptable to Util_TableSetFromString() and to the interpolator"
} "order=5"

################################################################################

#
# ***** parameters for the surface interpolation *****
#

#
# This 2D local interpolator is used to interpolate the horizon radius
# arbitrary angular coordinate, to find out whether a given xyz point is
# inside or outside the horizon.
#
# At present this interpolator is used only if  set_horizon_mask  is true.
# Otherwise, these parameters may both be set to empty strings.
#

string surface_interpolator_name \
  "name under which the surface interpolation operator is registered in Cactus" STEERABLE=recover
{
"^$" :: "the empty string if this interpolator isn't going to be used"
".+" :: "any string (in practice it should be nonempty)"
} "Lagrange polynomial interpolation"

string surface_interpolator_pars \
  "parameters for the surface interpolator" STEERABLE=recover
{
".*" :: \
  "any string acceptable to Util_TableSetFromString() and to the interpolator"
} "order=2 \
   boundary_off_centering_tolerance={1.0e-10 1.0e-10 1.0e-10 1.0e-10} \
   boundary_extrapolation_tolerance={0.0 0.0 0.0 0.0}"

################################################################################

#
# ***** parameters for computing line/surface integrals over the horizon *****
#

#
# In the descriptions, N is the number of grid zones in a patch
# in either the rho or the sigma direction, i.e. it's 45 or 90 degrees
# divided by delta_drho_dsigma.
#
keyword integral_method "how do we compute integrals over the horizon?" STEERABLE=recover
{
"trapezoid"		:: "alternate name for trapezoid rule"
"trapezoid rule"	:: "trapezoid rule (2nd order for smooth functions)"
"Simpson"		:: "alternate name for Simpson's rule"
"Simpson's rule"	:: \
  "Simpson's rule (4th order for smooth fns, requires N to be even)"
"Simpson (variant)"	:: "alternate name for Simpson's rule variant"
"Simpson's rule (variant)":: \
  "Simpson's rule variant (4th order for smooth fns, requires N >= 7)"

# choose this for normal use (assuming FINITE_DIFF_ORDER is set to 4
# in "src/include/config.hh")
"automatic choice"	:: \
  "choose Simpson's rule or variant if applicable, otherwise trapezoid rule"
} "automatic choice"

################################################################################

###
### ***** parameters for the test driver "src/patch/test_patch_system.cc" *****
###
### By default this test driver isn't compiled into the cactus executable,
### and these parameters are ignored.  To compile this test driver into
### the cactus executable (and have these parameters used),
### - edit the list of "source files in this directory" in
###   "src/patch/make.code.defn" to add  test_patch_system.cc
### - comment out the list of "subdirectories containing source files" in
###   "src/make.code.defn", and uncomment the alternate list which is
###   normally commented out there (this omits the higher-level directories
###   src/elliptic/, src/gr/, and src/driver/)
###
##keyword which_test "which test should we do?"
##{
##"gridfn"	:: "set up test fn(x,y,z), print it"
##"read gridfn"	:: "read in ghosted test fn(x,y,z), print it"
##"synchronize"	:: "set up test fn(x,y,z), synchronize it, print errors"
##"ghost zone Jacobian":: \
##  "set up test fn(x,y,z), compute Jacobian of gz.synchronize(), compare with NP"
##"derivatives"	:: "set up test fn(rho,sigma), take derivs, print errors"
##} "gridfn"
##
##int which_derivs "bit flags to specify which derivatives to test"
##{
##0:63 :: "any set of bit flags"
##} 63
##
### true ==> gives a more thorough test of the Jacobian,
###          but makes the test run much slower
### false ==> gives a slightly less thorough test, but runs faster
##boolean NP_Jacobian__perturb_all_y_patch_points \
##  "should we perturb at *all* points in the y patch, or just those with the \
##   iperp which is (supposedly) involved in the interpatch interpolation?"
##{
##} "true"
##
##################################################################################

configuration: REQUIRES THORNS: SpaceMask

OPTIONAL HDF5
{
}

context: make.configuration.defn:
```
# make.configuration.defn file for thorn AHFinderDirect

ALL_UTILS += AH2xdmf.py

```

make.configuration.deps:
```
# Copy python scripts

$(UTIL_DIR)/%.py: $(PACKAGE_DIR)/EinsteinAnalysis/AHFinderDirect/src/util/%.py
	@echo "Copying $* from $< to $(UTIL_DIR)"
	-$(MKDIR) $(MKDIRFLAGS) $(UTIL_DIR) 2> /dev/null
	cp $< $@


```

README:
```
This is the top-level source directory for the AHFinderDirect thorn.
See ../doc/ for further documentation.


Files in this directory:
CODESTYLE	documents some general programming conventions I have
		used in this thorn
make.code.defn	usual Cactus definition of subdirectories


Subdirectories which are *not* used directly in compiling this thorn
within Cactus:
misc/		contains misc source code that's not part of the Cactus
		executable, including the 'mpp' Maple preprocessor used
		by the Maple code in other directories
maple/		contains Maple code to generate C/C++ from complicated
		expressions
cctest/		contains small test programs for checking what features
		various C++ compilers support


Subdirectories which *are* used directly in compiling this thorn
within Cactus; these are listed in top-down order (no code depends
on, or includes header files from, higher-level code):
driver/		contains high-level driver routines to solve the
		Theta(h) = 0 equations and interface to the rest of Cactus
		(all the aliased-function stuff to interface with other
		thorns also lives here)
gr/		contains relativity code; all knowledge of the actual
		apparent horizon equation lives in the code in this directory
gr.cg/		contains Maple-generated C code (generated from Maple
		code in  gr/  subdirectory) to compute the Theta(h)
		function and its Jacobian coefficients
elliptic/	contains code to solve elliptic equations on the multipatch
		$S^2$
sparse-matrix/	constains sparse-matrix libraries imported from outside
		this thorn
patch/		contains the basic multipatch infrastructure for storing
		and finite differencing gridfns in angular coordinates
		on the surface of a 2-sphere
jtutil/		contains various low-level utility routines for things
		like integer <--> floating-point linear maps, fuzzy
		floating-point comparisons, N-dimensional arrays, etc;
		this is the only directory containing C++ templates
include/	contains common header files which don't live in any other
		source directory; all compile-time options for this thorn
		are configured here

All the code in the directories
  driver/
  gr/
  gr.cg/
  elliptic/
  patch/
is in namespace AHFinderDirect.  All the code in the directories
  jtutil/
is in namespace jtutil.

```

make.code.defn:
```
# Cactus specification of where source code lives for this thorn
# $Header$

# Source files in this directory
SRCS = 

# Subdirectories containing source files (normal compilation)
# ... directories are listed in bottom-up order
SUBDIRS = jtutil patch \
          sparse-matrix/ilucg sparse-matrix/umfpack \
          elliptic gr driver

## Subdirectories containing source files (using src/patch/test_patch_system.cc)
##SUBDIRS = jtutil patch

```

CODESTYLE:
```
AHFinderDirect Code Style
=========================
$Header: /usr/local/svn/cvs-repositories/numrelcvs/AEIThorns/AHFinderDirect/src/CODESTYLE,v 1.6 2003-08-18 10:01:01 jthorn Exp $

This file documents some general programming conventions used in this
thorn.

File Naming
===========
*.c, *.h	C code, headers
*.cc, *.hh	C++ code, headers

At least as of version 7, Maple doesn't have a usable preprocessor,
so I've written my own (in Perl); it lives in misc/mpp.

*.maple		Maple code (input to my Maple preprocessor)
*.minc		Maple headers to be @included by my Maple preprocessor
*.mm		Maple code (output from my Maple preprocessr)

None of my header files ever #includes another file, so in theory there's
no problem with multiple inclusion.  However, to work around C++ compiler
problems, some header files are still explicitly protected against multiple
inclusion with the standard #ifndef trick; see "C++ Templates" below for
details.


Configuration
=============

Only a few options are configured at compile-time; these use #defines
in src/include/config.h.


Code Layout/Indentation
========================

Most comments are C++-style //-to-end-of-line comments.  In C files,
or in header files which have to be C-compatible, I use C-style
/* comments */.

I like to make the two branches of an if-else statement look symmetrical:
so I use
  #define then   /* empty */
with usage as shown below.

A lot of the code uses the generic floating-point data type
  typedef CCTK_REAL fp;

Almost (but not quite) all the code fits into 80 columns.

The indentation style is a bit unusual, and is best described by the
following examples.  Roughly speaking, indentation depth reflects execution
frequency.  Normal indentation is 1 tab stop = 8 spaces.  Sometimes a
block of code is "outdented" back towards the left margin if it's too
deeply indented to fit easily in an 80-column window.

Examples:

<surrounding code>
if (condition #1)
   then <if-condition-#1-true code>
   else <if-condition-#1-false code>
if (condition #2)
   then {
	<if-condition-#2-true code>
	<if-condition-#2-true code>
	}
   else {
	<if-condition-false code>
	<if-condition-false code>
	}

<surrounding code>
	while (condition)
	{
	<loop body>
	<loop body>
	}

<surrounding code>
	for (int i = 0 ; i < N ; ++i)
	{
	<loop body>
	<loop body>
	}

// if there are multiple for-loops in the same scope using the same
// loop variable, I add extra (redundant) { } around the loops so the
// code will compile unchanged under both the archaic and the modern
// for-loop declaration scope rules
<surrounding code>
	  {
	for (int i = 0 ; i < N ; ++i)
	{
	<loop #1 body>
	<loop #1 body>
	}
	  }
	  {
	for (int i = 0 ; i < N ; ++i)
	{
	<loop #2 body>
	<loop #2 body>
	}
	  }


All switch statements should have a  default:  case (which often just
does an  error_exit()).

<surrounding code>
switch	(expression)
	{
case 42:
	<code for this case>
	<code for this case>
	break;
case 69:
	<code for this case>
	<code for this case>
	break;
case 105:
	<code for this case>
	<code for this case>
	break;
default:
	<code for this case>
	<code for this case>
	break;
	}

//
// block comment describing function
//
int foo(fp x, int bar, int baz)
{
<body of function>
<body of function>
}

All code should be fully type-secure: there is no aliasing of different
data types.  const qualifiers are used wherever possible, and all code
should be const-correct.

Most casts are new-style  const_cast<...>(...)  or  static_cast<...>(...) .
There are no  reinterpret_cast<...>(...)  or  dynamic_cast<...>(...) .
There are no C-style casts  (type) value .  The only function-style
casts   type(value)  are to cast numeric datatypes to int/double for
printf()-style printing, eg

	//
	// we don't know at compile-time whether the type  fp  is
	// C float or double
	//
	void print_x(fp x)
	{
	printf("x=%g\n", double(x));
	}


Error Handling
==============

For historical reasons, the code uses two slightly different mechanisms
for "print an error message and abort the Cactus run" error handling:
* Lower-level code (in src/{jtutil,patch,gr,elliptic}/) uses error_exit()
  (defined in src/include/stdc.h):
	if (user input was very bad)
	   then error_exit(ERROR_EXIT,
"***** function_name(): user input was really bad\n"
"                       printf(3)-style string and following arguments\n"
"                       to describe what went wrong"
			   ,
			   foo, var, double(baz));		/*NOTREACHED*/
  Here the first argument is ERROR_EXIT for "bad user input" errors,
  or PANIC_EXIT for "this should never happen" failure of internal
  consistency checks.  For this thorn, error_exit() is implemented as
  a call to...
* Higher-level code (in src/{driver,elliptic,gr}) uses the standard
  Cactus CCTK_VWarn(), generally giving FATAL_ERROR (defined in
  src/include/config.h) as the warning level.

The code uses the standard Cactus CCTK_VInfo() to print informational
messages describing what it's doing.


C++ Classes and Libraries
=========================

All the main data structures are C++ classes, but there are also plenty
of C-style structs.  struct foo  is for "dumb data", and has at most
contructors.

class foo  is for full-fledged C++ classes; these have no public data
members.  data members are always declared at the end of the class, and
have names with a trailing underscore; no other identifiers in this thorn
have such names.

Most "large" classes are non-copyable and non-assignable.  Right now
I write this explicitly in each class; once compilers improve a bit more
and boost becomes more widely deployed it would be cleaner to convert this
to inheriting from boost::noncopyable.

In the same genre, once compilers improve a *lot* more :), most/all
of the raw new[]-array references should probably be converted to
boost::array, and my jtutil::array[1234]d<> classes should be converted
to boost::multi_array.


C++ Templates
=============

I use C++ templates, but not for anything fancy, just simple containers.
I instantiate all templates explicitly.

Some C++ compilers offer "automatic" template instantiation.  In practice
this often causes compilation to fail when the compiler can't find .cc
files in other directories, so I highly recommend turning *off* all
automatic template instantiation "features" when compiling this thorn.

When using the DEC/Compaq/HP/whatever-their-corporate-name-is-this-week
C++ compiler (version 6.3.6.8) under Alpha Linux, even with automatic
template instiation disabled, the compiler *still* seems to include some
header files multiple times.  To avoid duplicate-definition errors caused
by this, I have protected all the header files in the subdirectories
   include/
   jtutil/
   elliptic/
against multiple inclusion with the standard #ifndef trick.


Miscellaneous
=============

All I/O is done using C stdio (printf() and friends); the C++ iostreams
system isn't used.

Some Cactus parameter names, and some C++ enumeration and function 
names, contain the substring "__" (two consecutive underscores).
According to the C++ standard, such names are reserved to the [compiler]
implementation, so this code isn't strictly legal.  In practice, so
far I haven't had any problems...

Each .cc source file should begin with a "table of comments" block
comment listing all the functions defined in the file.  Functions with
a "///" comment (or "**" for C) are local to the file; functions with
a "//" comment (or "*" for C) are visible to the linker.

```

PORTING.OUTSIDE.CACTUS:
```
Porting AHFinderDirect to a non-Cactus Numerical Relativity Code
================================================================
$Header$

As you almost certainly already know if you're reading this file,
AHFinderDirect is currently implemented as a thorn in the Cactus
computational toolkit.  However, AHFinderDirect is actually only
weakly coupled to the rest of Cactus, so it wouldn't be that hard
to port it to another (non-Cactus) numerical relativity code.  The
main requirements for such a port would be as follows:
* A Fortran 77 compiler, a C compiler, and a fairly modern
  (i.e. standards-compliant) C++ compiler.    
* A suitable geometry interpolator to do 3-D Hermite interpolation
  (across multiple processors if the new code is to be
  multiprocessor-capable).
* A suitable interpatch interpolator to do processor-local 1-D
  interpolation.  This interpolator must also be able to provide the
  Jacobian of the interpolation (i.e. the interpolation coefficients).
* If the new code is to be multiprocessor-capable, the routines used to
  broadcast status information to all processors, and to broadcast AH
  shapes to all processors for setting an excision mask, would need to
  be re-implemented.
* A few generic datatypes and low-level routines (for formatting and
  printing warning/error messages) would need to be re-implemented.

```

misc/ah.movie:
```
#!/usr/bin/perl -w
# $Header: /usr/local/svn/cvs-repositories/numrelcvs/AEIThorns/AHFinderDirect/src/misc/ah.movie,v 1.1 2002-11-27 16:09:15 jthorn Exp $

################################################################################

# global constants
my $true  = 1;
my $false = 0;
my $infinity = 9e99;

# defaults
my $help_flag  = $false;
my $setup_flag = $false;
my $prefix  = undef();
my $pattern = 'h/h.t*.ah*.gp';
my $t_start = -$infinity;
my $t_stop  = +$infinity;
my $using   = 'using 4:5:6';

################################################################################

my $help_msg = <<"EOF";
Usage:
   ah.movie   [ --setup ]
              [ --prefix  prefix_file_name ]
              [ --pattern shell_pattern ]
              [ --t-start t_start ]   [ --t-stop t_stop ]
              [ --using   using ]
or
   ah.movie   --help

This prints a list of gnuplot commands to 'splot' all the apparent horizon
data files matching the pattern, optionally restricted to the specified
range (the closed interval [t_start, t_stop]) of times (integer iteration
numbers).

If --setup is specified, only the gnuplot command for the starting frame
of the movie is printed.

If specified, the --prefix-file option specifies the name of a file of
gnuplot commands which should be loaded at the start of the movie.

If specified, the --using option specifies the gnuplot 'using' string
for plotting each file.

The defaults are
   --prefix  (none)
   --pattern '${pattern}'
   --using   '${using}'
EOF

################################################################################

use strict;
use English;
use Getopt::Long;
##use File::Glob;

$Getopt::Long::autoabbrev = $false;     # forbid abbreviations
$Getopt::Long::getopt_compat = $false;  # forbid starting options with "+"
GetOptions(
   'help'	=> \$help_flag,
   'setup'	=> \$setup_flag,
   'prefix=s'	=> \$prefix,
   'pattern=s'	=> \$pattern,
   't-start=i'	=> \$t_start,
   't-stop=i'	=> \$t_stop,
   'using=s'	=> \$using,
	  )
	|| die($help_msg);

if ($help_flag)
	{ print $help_msg; exit; }

# compute sprintf() format for forming file names
my $h_format = $pattern;
$h_format =~ s/\*/%d/g;
##print "using h_format \"${h_format}\"\n";

# list of all file names matching pattern
# they're sorted alphabetically, but that's useless here,
# so as far as we're concerned, they're in "random" order :(
my @h_list = glob($pattern);

# parse the file names to get times and horizon numbers,
# check that times are within [start,stop] range,
# keep track of actual min/max times encountered, and
# build hash table with key   = time,
#			value = anonymous list of all horizon numbers
my %hn_table = ();
	foreach my $h (@h_list)
	{
	##print $h, "\n";
	if ($h !~ /^.*\.t(\d+)\.ah(\d+).*$/)
		{ die "\"${h}\" not matched\n"; }
	my ($t,$hn) = ($1,$2);
	##print "\"$h\" ==> t=$t hn=$hn\n";
	if (($t < $t_start) || ($t > $t_stop))
		{ next; }
	push @{ $hn_table{$t} }, $hn;
	}

# generate a list of all the times in numerical order
my @t_list = sort {$a <=> $b} keys(%hn_table);
##print "got times ", join("\n", @t_list);

# generate the gnuplot commands
if (defined($prefix))
	{ print "load '${prefix}'\n"; }
	foreach my $t (@t_list)
	{
	my @hn_list = @{ $hn_table{$t} };
	my $N_horizons = scalar(@hn_list);
		for (my $hni = 0 ; $hni < $N_horizons ; ++$hni)
		{
		my $first_flag = ($hni == 0);
		my  $last_flag = ($hni == $N_horizons-1);
		my $hn = $hn_list[$hni];

		if ($first_flag)
			{ print 'splot '; }
		   else { print '      '; }

		print '\'', sprintf($h_format, $t, $hn), '\'';
		print " ${using}";
		print " with lines ${hn}";

		if (! $last_flag)
			{ print ', \\'; }
		print "\n";
		}
	if ($setup_flag) { last; }
	}

```

misc/README:
```
This directory contains miscellaneous source code that doesn't fit
anywher else.

h.movie
	This is a Perl script to generate gnuplot commands to show
	a movie of the patch shapes in an evolution.  To use it,
	type the gnuplot commands
		load '<h.movie --setup'
	then set the xyz ranges and any other options.  Then
		load '<h.movie'
	will play the movie.

mpp
	This is the Maple preprocessor used to provide #include-like
	and #ifdef-like functionality for the Maple code in this thorn.

select.patch
	This is a Perl script to extract a selected patch from a
	gridfn output file.

```

misc/select.plane:
```
#!/usr/bin/perl -w
use strict;
my $true  = 1;
my $false = 0;

########################################

my $usage_msg = <<'EOF';
Usage:
	select.plane	[ xy | xz | yz ]

This script reads an AHFinderDirect horizon-shape data file from
standard input, with file format
	dpx	dpy	radius		x	y	z
selects the subset of the data which lies in the specified plane,
and writes that to standard output.
EOF

########################################

if (scalar(@ARGV) != 1)
	{ die $usage_msg; }

my $xy_plane_flag = $false;
my $xz_plane_flag = $false;
my $yz_plane_flag = $false;
if    ($ARGV[0] eq 'xy') { $xy_plane_flag = $true; }
elsif ($ARGV[0] eq 'xz') { $xz_plane_flag = $true; }
elsif ($ARGV[0] eq 'yz') { $yz_plane_flag = $true; }
else	{ die $usage_msg; }


	while (my $line = <STDIN>)
	{
	chomp($line);

	# echo blank or comment lines
	if (($line =~ /^$/) || ($line =~ /^#/))
		{
		print $line, "\n";
		next;					# *** LOOP CONTROL ***
		}

	my ($dpx,$dpy,$radius,$x,$y,$z) = split(/\s+/, $line);

	if (    ($xy_plane_flag && (abs($z) <= 1.0e-10))
	     || ($xz_plane_flag && (abs($y) <= 1.0e-10))
	     || ($yz_plane_flag && (abs($x) <= 1.0e-10))    )
		{ print $line, "\n"; }
	}

```

misc/select.patch:
```
#!/usr/local/bin/perl -w
# $Header$

#
# Usage:
#	select.patch patch.name <file.adat >file.patch.adat
#
# This filter prints that part of standard input starting with a
# line of the form (eg)
#	## +z patch
# and continuing up to and including two consecutive newlines.
#

use strict;

if (scalar(@ARGV) != 1)
	{ die "usage: select.patch patch.name <data >data-for-that-patch\n"; }
my $patch_name = $ARGV[0];

my $in_selected_patch = 0;
my $newline_count = 0;
	while (my $line = <STDIN>)
	{
	if ($line =~ /^### \Q${patch_name}/o)
		{ $in_selected_patch = 1; }
	if ($line =~ /^\n/)
		{ ++$newline_count; }
	   else { $newline_count = 0; }

	if ($in_selected_patch)
		{
		print $line;
		if ($newline_count == 2)
			{ last; }
		}
	}

```

misc/mpp:
```
#!/usr/local/bin/perl -w
# $Header: /usr/local/svn/cvs-repositories/numrelcvs/AEIThorns/AHFinderDirect/src/misc/mpp,v 1.2 2002-09-16 14:17:44 jthorn Exp $

my $help_msg = <<'EOF';
Usage:
   mpp  [ -Dfoo -DBAR ... ]  [ --debug ]  <input.maple  >output.mm
or
   mpp  --help

This program is a preprocessor for Maple source code.  It's modeled
after a subset of the C preprocessor (cpp), but with a Maple-flavored
syntax: preprocessor directives use @ as the marker character, instead
of cpp's #.  The @include, @ifdef, @ifndef, @else, and @endif directives
are supported with the same syntax and semantics as the corresponding
cpp directives, except that
   @include "filename" optional_text
prints   optional_text   (if present) on a separate line following the
contents of the include file.

There may be white space on a line before the '@' which introduces a
preprocessor directive, but no white space between '@' and the directive
name.

Command line arguments of the form  -Dname  define macros, whose
existence may be tested with @ifdef, @ifndef, @else, and/or @endif as
usual.  For example, one might write
	@ifdef MAPLE_V_RELEASE_3
	  words(0):
	  gc(0):
	@else
	  kernelopts(printbytes=false);
	@endif
to disable Maple's printing of 'bytes used' messages.
EOF

###############################################################################

#
# ***** copyright notice and licensing terms *****
#

#
# Copyright (C) 2000, Jonathan Thornburg <jthorn@thp.univie.ac.at>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
#

###############################################################################

#
# ***** table of contents *****
#

#
# <<<help message>>>
# <<<copyright notice and licensing terms>>>
# <<<this table of contents>>>
# <<<global data structures>>>
# main - driver
# process - recursive function to copy a named file to standard output
#
# dirname - find directory part of file name
#

###############################################################################

#
# ***** global data structures *****
#

#
# This hash table records macros:
#    key = macro name
#    value = macro definition
#
my %macro_table = ();

###############################################################################

#
# ***** main program *****
#

use strict;
use integer;
use FileHandle;

#
# constants
#

# arguments for process()
my $true = 1;
my $false = 0;

# arguments for process()
my $read_to_endif = 0;
my $read_to_else_or_endif = 1;
my $read_to_eof = -1;

# results from process()
my $got_endif = 0;
my $got_else = 1;
my $got_eof = -1;

#
# command line handling
#

my $debug = 0;

if ((scalar(@ARGV) == 1) && ($ARGV[0] eq '--help'))
	{ print $help_msg; exit(0); }

	while (my $arg = shift(@ARGV))
	{
	if    ($arg eq '--debug')
		{ $debug = 1 }
	elsif ($arg =~ /^-D(.*)$/)
		{
		my $macro_name = $1;
		if ($debug)
			{ print "defining macro :$macro_name:\n"; }
		$macro_table{$1} = 1;
		}
	else
		{ die("mpp: bad argument \"$arg\"!\n"); }
	}

process(new FileHandle('< -'), '(standard input)', 1,
	$true, $read_to_eof);
exit;

###############################################################################

#
# This (recursive) function reads input lines from a FileHandle, and
# interprets preprocessor directives (making recursive calls for each
# @include or @ifdef).  It either prints non-preprocessor lines or
# discards them, depending on a flag argument.  This function returns
# when it either reaches end of file on the FileHandle, or sees an
# @else or @endif line.
#
# Arguments:
# $fh = The FileHandle from which to copy data.
# $file_name = The file name corresponding to $fh.  This is (only) used
#	       for formatting error messages.  An empty string denotes
#	       standard input.
# $line_number = The line number within $file_name at which $fh is positioned.
#		 This is (only) used for formatting error messages.
# $print_flag = A Boolean flag:
#		$true  ==> Print non--preprocessor-directive input lines.
#		$false ==> Ignore non--preprocessor-directive input lines.
# $how_to_finish = A flag specifying how we finish our processing:
#	$read_to_endif         ==> We expect to finish by seeing an @endif.
#	$read_to_else_or_endif ==> We expect to finish by seeing either an
#				   @else or an @endif.
#	$read_to_eof           ==> We expect to finish by reaching
#				   end-of-file on the input.
#	In any case, we  die(...)  if we finish due to a wrong reason.
#
# Results:
# This function returns a 2-element list
#	($final_line_number, $how_finished)
# where
#	$final_line_number = The value of $line_number for the last input
#			     line read
#	$how_finished = Describes which termination condition actually
#			caused us to finish:
#			$got_endif ==> We saw an @ifdef
#			$got_else  ==> We saw an @else
#			$got_eof   ==> We reached end-of-file on the input
#
sub process
{
my ($fh, $file_name, $line_number, $print_flag, $how_to_finish) = @_;

# special-case standard input
my $stdin_flag = ($file_name eq '');
if ($file_name eq '')
	{ $file_name = '(standard input)'; }

if ($debug)
	{
	print
  "process(\"${file_name}\", line ${line_number}):\n",
  "        print_flag = :${print_flag}:   how_to_finish = :${how_to_finish}:\n";
	}

# main data loop
	for ( ; my $line = <$fh> ; ++$line_number)
	{
	# not an @ directive
	if    ($line !~ /^\s*@/)
		{
		if ($print_flag)
			{ print $line; }
		next;					# *** LOOP CONTROL ***
		}

	# @include
	elsif ($line =~ /^\s*\@\s*include\s+"([^"]+)"(.*)$/)
		{
		my $include_file_name = $1;
		my $suffix = $2;
		if ($debug)
			{
			print "got \@include :$include_file_name:",
			      "   suffix = :$suffix:\n";
			}

		if ($print_flag)	# if we're discarding lines, we can
					# skip processing the @include file,
					# since @ifdef ... @endif directives
					# are (assumed to be) always properly
					# nested with respect to @include
			{
			# open the @include file
			# ... first look for it in (relative to) current dir,
			#     failing that, try directory of file containing
			#     @include
			my $include_fh = new FileHandle("< $include_file_name");
			if ((! defined $include_fh) && (! $stdin_flag))
				{
				my $dir = dirname($file_name);
				my $include_fh
					= new FileHandle(
					      "< $dir/$include_file_name"
							);
				}
			if (! defined $include_fh)
				{
				die(
	   "***** mpp: unable to open \@include file \"$include_file_name\"\n",
	   "           at input file \"$file_name\", line $line_number\n"
				   );
				}

			# recursive call to process @include file
			process($include_fh, $include_file_name, 1,
				$true, $read_to_eof);
			$include_fh->close();

			# print any suffix
			print "$suffix\n";
			}
		}

	# @ifdef
	elsif ($line =~ /^\s*\@\s*if(n?)def\s+(\S+)/)
		{
		my $negate_flag = ($1 eq 'n');
		my $macro_name = $2;
		if ($debug)
			{
			print "got \@ifdef/\@ifndef:",
			      "   macro_name = :${macro_name}:",
			      "   negate_flag = :${negate_flag}:\n";
			}
		my $macro_is_defined = (exists $macro_table{$macro_name});
		my $doit_flag = $negate_flag ? (! $macro_is_defined)
					     : $macro_is_defined;
		if ($debug)
			{
			print "==> macro_is_defined = :${macro_is_defined}:",
			      "   doit_flag = :${doit_flag}:\n";
			}

		# recursive call to process body of @ifdef
		my ($final_line_number, $how_finished)
			= process($fh, $file_name, $line_number+1,
				  $print_flag && $doit_flag,
				  $read_to_else_or_endif);
		$line_number = $final_line_number;
		if ($how_finished == $got_else)
			{
			# recursive call to skip @else text
			($final_line_number, $how_finished)
				= process($fh, $file_name, $line_number+1,
					  $print_flag && !$doit_flag,
					  $read_to_endif);
			$line_number = $final_line_number;
			}
		}

	# @endif
	elsif ($line =~ /^\s*\@\s*endif/)
		{
		if (    ($how_to_finish == $read_to_endif)
		     || ($how_to_finish == $read_to_else_or_endif)    )
			{
			return ($line_number, $got_endif);# *** EARLY RETURN ***
			}
		   else {
			die(
   "***** mpp: \@endif when not within the scope of an \@ifdef\n",
   "           at input file \"$file_name\", line $line_number\n"
			   );
			}
		}

	# @else
	elsif ($line =~ /^\s*\@\s*else/)
		{
		if ($how_to_finish == $read_to_else_or_endif)
			{
			return ($line_number, $got_else); # *** EARLY RETURN ***
			}
		   else {
			die(
   "***** mpp: \@else when not within the scope of an \@ifdef\n",
   "           at input file \"$file_name\", line $line_number\n"
			   );
			}
		}

	else	{
		die(
   "***** mpp: unknown @-directive \"$line\"!\n",
   "           at input file \"$file_name\", line $line_number\n"
		   );
		}
	}

if ($how_to_finish != $read_to_eof)
	{
	die(
   "***** mpp: unexpected end-of-file (i.e. unterminated \@ifdef)\n",
   "           at input file \"$file_name\", line $line_number\n"
	   );
	}
return -1;
}

###############################################################################
###############################################################################
###############################################################################

#
# This function computes the directory part of a file name.
# It is (should be) identical in effect to the  dirname(1)  program.
#
sub dirname
{
my ($file_name) = @_;

# strip off reundant trailing /
if (($file_name =~ /\/$/) && ($file_name ne '/'))
	{ $file_name = substr($file_name, 0, length($file_name)-1); }

if (index($file_name, '/') >= 0)
	{
	# $file_name contains a /
	$file_name =~ s:/[^/]+$::;
	if ($file_name eq '')
		{ $file_name = '/'; }
	}
   else {
	# $file name doesn't contain a /
	$file_name = '.';
	}

return $file_name;
}

```

jtutil/array.cc:
```
// array.cc -- array template classes
// $Header$
//
// jtutil::array1d::array1d - 1D array template constructor
// jtutil::array1d::~array1d - 1D array template destructor
//
// jtutil::array2d::array2d - 2D array template constructor
// jtutil::array2d::~array2d - 2D array template destructor
//
// jtutil::array3d::array3d - 3D array template constructor
// jtutil::array3d::~array3d - 3D array template destructor
//
#ifdef NOT_USED
// jtutil::array4d::array4d - 4D array template constructor
// jtutil::array4d::~array4d - 4D array template destructor
#endif
//
// ***** template instantiations *****
//

#include <assert.h>
#include <stddef.h>	// NULL
#include <stdlib.h>	// size_t

// we want to instantiate templates with CCTK_* types
#ifdef STANDALONE_TEST
  #include "fake_cctk.h"
#else
  #include "cctk.h"
#endif

#include "stdc.h"
#include "util.hh"
#include "array.hh"

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function constructs an  array1d  object.
//
namespace jtutil
	  {
template <typename T>
array1d<T>::array1d(int min_i_in, int max_i_in,
		    T *array_in /* = NULL */,
		    int stride_i_in /* = 0 */)
	: array_(array_in),
	  offset_(0),		// temp value, changed below
	  stride_i_(stride_i_in),
	  min_i_(min_i_in), max_i_(max_i_in),
	  we_own_array_(array_in == NULL)
{
if (stride_i_ == 0)
   then stride_i_ = 1;

// must use unchecked subscripting here since setup isn't done yet
offset_ = - subscript_unchecked(min_i_);		// RHS uses offset_ = 0
assert( subscript_unchecked(min_i_) == 0 );
max_subscript_ = subscript_unchecked(max_i_);

if (we_own_array_)
   then {
	// allocate it
	const int N_allocate = N_i();
	array_ = new T[N_allocate];
	}

// explicitly initialize array (new[] *doesn't* do this automagically)
	for (int i = min_i() ; i <= max_i() ; ++i)
	{
	operator()(i) = T(0);
	}
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function destroys an  array1d  object.
//
namespace jtutil
	  {
template <typename T>
array1d<T>::~array1d()
{
if (we_own_array_)
   then delete[] array_;
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function constructs an  array2d  object.
//
namespace jtutil
	  {
template <typename T>
array2d<T>::array2d(int min_i_in, int max_i_in,
		    int min_j_in, int max_j_in,
		    T *array_in /* = NULL */,
		    int stride_i_in /* = 0 */, int stride_j_in /* = 0 */)
	: array_(array_in),
	  offset_(0),		// temp value, changed below
	  stride_i_(stride_i_in), stride_j_(stride_j_in),
	  min_i_(min_i_in), max_i_(max_i_in),
	  min_j_(min_j_in), max_j_(max_j_in),
	  we_own_array_(array_in == NULL)
{
if (stride_j_ == 0)
   then stride_j_ = 1;
if (stride_i_ == 0)
   then stride_i_ = N_j();

// must use unchecked subscripting here since setup isn't done yet
offset_ = - subscript_unchecked(min_i_,min_j_);		// RHS uses offset_ = 0
assert( subscript_unchecked(min_i_,min_j_) == 0 );
max_subscript_ = subscript_unchecked(max_i_,max_j_);

if (we_own_array_)
   then {
	// allocate it
	const int N_allocate = N_i() * N_j();
	array_ = new T[N_allocate];
	}

// explicitly initialize array (new[] *doesn't* do this automagically)
	for (int i = min_i() ; i <= max_i() ; ++i)
	{
	for (int j = min_j() ; j <= max_j() ; ++j)
	{
	operator()(i,j) = T(0);
	}
	}
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function destroys an  array2d  object.
//
namespace jtutil
	  {
template <typename T>
array2d<T>::~array2d()
{
if (we_own_array_)
   then delete[] array_;
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function constructs an  array3d  object.
//
namespace jtutil
	  {
template <typename T>
array3d<T>::array3d(int min_i_in, int max_i_in,
		    int min_j_in, int max_j_in,
		    int min_k_in, int max_k_in,
		    T *array_in /* = NULL */,
		    int stride_i_in /* = 0 */, int stride_j_in /* = 0 */,
		    int stride_k_in /* = 0 */)
	: array_(array_in),
	  offset_(0),		// temp value, changed below
	  stride_i_(stride_i_in), stride_j_(stride_j_in),
	  stride_k_(stride_k_in),
	  min_i_(min_i_in), max_i_(max_i_in),
	  min_j_(min_j_in), max_j_(max_j_in),
	  min_k_(min_k_in), max_k_(max_k_in),
	  we_own_array_(array_in == NULL)
{
if (stride_k_ == 0)
   then stride_k_ = 1;
if (stride_j_ == 0)
   then stride_j_ = N_k();
if (stride_i_ == 0)
   then stride_i_ = N_j()*N_k();

// must use unchecked subscripting here since setup isn't done yet
offset_ = - subscript_unchecked(min_i_,min_j_,min_k_);	// RHS uses offset_ = 0
assert( subscript_unchecked(min_i_,min_j_,min_k_) == 0 );
max_subscript_ = subscript_unchecked(max_i_,max_j_,max_k_);

if (we_own_array_)
   then {
	// allocate it
	const int N_allocate = N_i() * N_j() * N_k();
	array_ = new T[N_allocate];
	}

// explicitly initialize array (new[] *doesn't* do this automagically)
	for (int i = min_i() ; i <= max_i() ; ++i)
	{
	for (int j = min_j() ; j <= max_j() ; ++j)
	{
	for (int k = min_k() ; k <= max_k() ; ++k)
	{
	operator()(i,j,k) = T(0);
	}
	}
	}
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function destroys an  array3d  object.
//
namespace jtutil
	  {
template <typename T>
array3d<T>::~array3d()
{
if (we_own_array_)
   then delete[] array_;
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef NOT_USED
//
// This function constructs an  array4d  object.
//
namespace jtutil
	  {
template <typename T>
array4d<T>::array4d(int min_i_in, int max_i_in,
		    int min_j_in, int max_j_in,
		    int min_k_in, int max_k_in,
		    int min_l_in, int max_l_in,
		    T *array_in /* = NULL */,
		    int stride_i_in /* = 0 */, int stride_j_in /* = 0 */,
		    int stride_k_in /* = 0 */, int stride_l_in /* = 0 */)
	: array_(array_in),
	  offset_(0),		// temp value, changed below
	  stride_i_(stride_i_in), stride_j_(stride_j_in),
	  stride_k_(stride_k_in), stride_l_(stride_l_in),
	  min_i_(min_i_in), max_i_(max_i_in),
	  min_j_(min_j_in), max_j_(max_j_in),
	  min_k_(min_k_in), max_k_(max_k_in),
	  min_l_(min_l_in), max_l_(max_l_in),
	  we_own_array_(array_in == NULL)
{
if (stride_l_ == 0)
   then stride_l_ = 1;
if (stride_k_ == 0)
   then stride_k_ = N_l();
if (stride_j_ == 0)
   then stride_j_ = N_k()*N_l();
if (stride_i_ == 0)
   then stride_i_ = N_j()*N_k()*N_l();

// must use unchecked subscripting here since setup isn't done yet
offset_ = - subscript_unchecked(min_i_,min_j_,
				min_k_,min_l_);		// RHS uses offset_ = 0
assert( subscript_unchecked(min_i_,min_j_,min_k_,min_l_) == 0 );
max_subscript_ = subscript_unchecked(max_i_,max_j_,max_k_,max_l_);

if (we_own_array_)
   then {
	// allocate it
	const int N_allocate = N_i() * N_j() * N_k() * N_l();
	array_ = new T[N_allocate];
	}

// explicitly initialize array (new[] *doesn't* do this automagically)
	for (int i = min_i() ; i <= max_i() ; ++i)
	{
	for (int j = min_j() ; j <= max_j() ; ++j)
	{
	for (int k = min_k() ; k <= max_k() ; ++k)
	{
	for (int l = min_l() ; l <= max_l() ; ++l)
	{
	operator()(i,j,k,l) = T(0);
	}
	}
	}
	}
}
	  }	// namespace jtutil::
#endif	/* NOT_USED */

//******************************************************************************

#ifdef NOT_USED
//
// This function destroys an  array4d  object.
//
namespace jtutil
	  {
template <typename T>
array4d<T>::~array4d()
{
if (we_own_array_)
   then delete[] array_;
}
	  }	// namespace jtutil::
#endif	/* NOT_USED */

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations *****
//

template class jtutil::array1d<int>;
template class jtutil::array1d<long>;

// FIXME: we shouldn't have to instantiate these both, the const one
//	  is actually trivially derivable from the non-const one. :(
template class jtutil::array1d<      void *>;
template class jtutil::array1d<const void *>;

#ifdef STANDALONE_TEST
  template class jtutil::array1d<float>;
  template class jtutil::array2d<float>;
  template class jtutil::array3d<float>;
  #ifdef NOT_USED
  template class jtutil::array4d<float>;
  #endif

  template class jtutil::array1d<double>;
  template class jtutil::array2d<double>;
  template class jtutil::array3d<double>;
  #ifdef NOT_USED
  template class jtutil::array4d<double>;
  #endif
#else
  // full-fledged Cactus thorn
  template class jtutil::array1d<CCTK_REAL>;

  template class jtutil::array2d<CCTK_INT>;
  template class jtutil::array2d<CCTK_REAL>;

  template class jtutil::array3d<CCTK_REAL>;
#endif

```

jtutil/test_array2.cc:
```
// test_array2.cc -- test driver for array.hh classes
// $Header$

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

#include "stdc.h"
#include "util.hh"
#include "array.hh"

void  print(      jtutil::array2d<double>& Aref);
void cprint(const jtutil::array2d<double>& Aref);

int main()
{
const int imin = 3, imax = 7, jmin = 10, jmax = 12;
jtutil::array2d<double> A(imin,imax, jmin,jmax);

	  {
	for (int i = imin ; i <= imax ; ++i)
	{
	for (int j = jmin ; j <= jmax ; ++j)
	{
	A(i,j) = i*j;
	}
	}
	  }

 print(A);
cprint(A);
}

void print(jtutil::array2d<double>& Aref)
{
printf("=== nonconst ===\n");
	  {
	for (int i = Aref.min_i() ; i <= Aref.max_i() ; ++i)
	{
	for (int j = Aref.min_j() ; j <= Aref.max_j() ; ++j)
	{
	printf("Aref(%d,%d) = %g at address %p\n",
	       i, j, Aref(i,j), &Aref(i,j));
	}
	}
	  }
}

void cprint(const jtutil::array2d<double>& Aref)
{
printf("=== const ===\n");
	  {
	for (int i = Aref.min_i() ; i <= Aref.max_i() ; ++i)
	{
	for (int j = Aref.min_j() ; j <= Aref.max_j() ; ++j)
	{
	printf("Aref(%d,%d) = %g at address %p\n",
	       i, j, Aref(i,j), &Aref(i,j));
	}
	}
	  }
}

```

jtutil/test_linear_map.cc:
```
// test_linear_map.cc -- test driver for linear_map class
// $Header$

#include <assert.h>
#include <stdio.h>

#include "stdc.h"
#include "util.hh"
#include "linear_map.hh"
using jtutil::fuzzy;
using jtutil::linear_map;

//******************************************************************************

//
// Usage:
//	test_linear_map
// If an argument is supplied (it doesn't matter what it is), then
// the array indices will be printed as they're tested.
//
int main(int argc, const char *const argv[])
{
const int min_int = 4;		const int max_int = 14;
const int middle_int = (min_int + max_int) / 2;
const int min_widen = 13;	const int max_widen = 9;
const double min_fp = 9.0;
const double delta_fp = 0.1;
const double max_fp = 10.0;
const double middle_fp = (min_fp + max_fp) / 2.0;

printf("constructing linear_map<double>...\n");
linear_map<double> lm_wide(min_int-min_widen, max_int+max_widen,
			   min_fp-min_widen*delta_fp,
			   delta_fp,
			   max_fp+max_widen*delta_fp);
linear_map<double> lm = *new linear_map<double>(lm_wide, min_int, max_int);

printf("checking bounds and range info...\n");
assert(lm.min_int() == min_int);
assert(lm.max_int() == max_int);
assert(lm.N_points() == jtutil::how_many_in_range(min_int,max_int));

assert(   lm.is_in_range(min_int)   );
assert(   lm.is_in_range(max_int)   );
assert( ! lm.is_in_range(min_int-1) );
assert( ! lm.is_in_range(max_int+1) );

assert( lm.clamp(min_int-100) == min_int    );
assert( lm.clamp(min_int-1  ) == min_int    );
assert( lm.clamp(min_int    ) == min_int    );
assert( lm.clamp(min_int+1  ) == min_int+1  );
assert( lm.clamp(middle_int ) == middle_int );
assert( lm.clamp(max_int-1  ) == max_int-1  );
assert( lm.clamp(max_int    ) == max_int    );
assert( lm.clamp(max_int+1  ) == max_int    );
assert( lm.clamp(max_int+100) == max_int    );

assert( fuzzy<double>::EQ(lm.origin(), lm.fp_of_int_unchecked(0)) );
assert( fuzzy<double>::EQ(lm.delta_fp(), delta_fp) );
assert( fuzzy<double>::EQ(lm.inverse_delta_fp(), 1.0/delta_fp) );
assert( fuzzy<double>::EQ(lm.min_fp(), min_fp) );
assert( fuzzy<double>::EQ(lm.max_fp(), max_fp) );

assert(   lm.is_in_range(min_fp)         );
assert(   lm.is_in_range(max_fp)         );
assert( ! lm.is_in_range(min_fp-1.0e-10) );
assert( ! lm.is_in_range(max_fp+1.0e-10) );

assert( fuzzy<double>::EQ(lm.clamp(min_fp - 100.0*delta_fp), min_fp) );
assert( fuzzy<double>::EQ(lm.clamp(min_fp -   0.4*delta_fp), min_fp) );
assert( fuzzy<double>::EQ(lm.clamp(min_fp), min_fp) );
assert( fuzzy<double>::EQ(lm.clamp(min_fp + 0.4*delta_fp),
				   min_fp + 0.4*delta_fp) );
assert( fuzzy<double>::EQ(lm.clamp(middle_fp), middle_fp) );
assert( fuzzy<double>::EQ(lm.clamp(max_fp - 0.4*delta_fp),
				   max_fp - 0.4*delta_fp) );
assert( fuzzy<double>::EQ(lm.clamp(max_fp), max_fp) );
assert( fuzzy<double>::EQ(lm.clamp(max_fp +   0.4*delta_fp), max_fp) );
assert( fuzzy<double>::EQ(lm.clamp(max_fp + 100.0*delta_fp), max_fp) );

printf("checking delta roundings...\n");
      {
    for (int i = 1 ; i <= 3 ; ++i)
    {
    printf("   testing i = %d...\n", i);
    assert( fuzzy<double>::EQ( lm.delta_fp_of_delta_int(i), i*delta_fp ) );
    assert( lm.delta_int_of_delta_fp(i*delta_fp) == i );
    double di = double(i);

    // test silent roundings
    assert( lm.delta_int_of_delta_fp((di-0.49)*delta_fp, lm.nia_round) == i );
    assert( lm.delta_int_of_delta_fp((di+0.49)*delta_fp, lm.nia_round) == i );

    // test floor/ceiling
    assert( lm.delta_int_of_delta_fp((di-0.01)*delta_fp, lm.nia_floor  ) == i-1 );
    assert( lm.delta_int_of_delta_fp((di-0.01)*delta_fp, lm.nia_ceiling) == i   );
    assert( lm.delta_int_of_delta_fp((di+0.01)*delta_fp, lm.nia_round  ) == i   );
    assert( lm.delta_int_of_delta_fp((di+0.01)*delta_fp, lm.nia_ceiling) == i+1 );
    }
      }

printf("this should produce a pair of warning messages...\n");
assert( lm.delta_int_of_delta_fp(2.99*delta_fp, lm.nia_warning) == 3 );
assert( lm.delta_int_of_delta_fp(3.01*delta_fp, lm.nia_warning) == 3 );

printf("checking mappings...\n");
  {
int i;		// must declare these outside loop
double x;	// because we have *two* loop variables!
	for (i = min_int, x = min_fp ;
	     i <= max_int ;
	     ++i, x += delta_fp)
	{
	printf("   testing i = %d of [%d,%d]...\n", i, min_int, max_int);
	// test normal int <--> fp conversions
	assert( fuzzy<double>::EQ( lm.fp_of_int(i), x) );
	assert( lm.int_of_fp(x) == i );

	// test fp --> int returning result as fp
	if (i > min_int)
		assert(
		   fuzzy<double>::EQ(
		      lm.fp_int_of_fp(x - 0.5*delta_fp), double(i) - 0.5
				    )
		      );
	if (i < max_int)
		assert(
		   fuzzy<double>::EQ(
		      lm.fp_int_of_fp(x + 0.5*delta_fp), double(i) + 0.5
				    )
		      );

	// test silent rounding
	if (i > min_int)
		assert( lm.int_of_fp(x - 0.49*delta_fp, lm.nia_round) == i );
	if (i < max_int)
		assert( lm.int_of_fp(x + 0.49*delta_fp, lm.nia_round) == i );

	// test floor/ceiling
	if (i > min_int)
		assert( lm.int_of_fp(x - 0.01*delta_fp, lm.nia_floor) == i-1 );
	if (i < max_int)
		assert( lm.int_of_fp(x + 0.01*delta_fp, lm.nia_ceiling) == i+1 );

	// test zero-origin conversions
	assert( lm.zero_origin_int(i) == i - min_int );
	assert( lm.map_int(lm.zero_origin_int(i)) == i );
	}
  }

printf("this should produce a pair of warning messages...\n");
assert( lm.int_of_fp(min_fp + 0.01*delta_fp,
		     linear_map<double>::nia_warning) == min_int );
assert( lm.int_of_fp(max_fp - 0.01*delta_fp,
		     linear_map<double>::nia_warning) == max_int );

printf("this should produce an error message...\n");
#ifdef TEST_RANGE
assert( lm.int_of_fp(min_fp - 0.01*delta_fp) == min_int );
#else
assert( lm.int_of_fp(min_fp + 0.01*delta_fp) == min_int );
#endif

return 0;
}

```

jtutil/miscfp.cc:
```
// miscfp.cc -- misc floating-point functions

//
// jtutil::signum - sign of a floating point number
// jtutil::hypot3 - 3D Euclidean distance
// jtutil::arctan_xy - 4-quadrant arc tangent
// jtutil::modulo_reduce - reduce an angle modulo 2*pi radians (360 degrees)
// jtutil::zero_C_array - set a C-style array to all zeros
//
// ***** template instantiations *****
//

#include <math.h>
#include <stdlib.h>

// we want to instantiate templates with CCTK_* types
#ifdef STANDALONE_TEST
  #include "fake_cctk.h"
#else
  #include "cctk.h"
#endif

#include "stdc.h"
#include "util.hh"

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function computes the floating point "signum" function (as in APL),
// signum(x) = -1.0, 0.0, or +1.0, according to the sign of x.
//
namespace jtutil
	  {
double signum(double x)
{
if (x == 0.0)
   then return 0.0;
   else return (x > 0.0) ? 1.0 : -1.0;
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function computes the 3-dimensional Euclidean distance,
// analogously to the standard math library function  hypot(2) .
//
// Arguments:
// (x,y,z) = (in) The rectangular coordinates of a point in $\Re^3$.
//
// Result:
// The function returns the Euclidean distance of (x,y,z) from the origin.
//
// Bugs:
// Unlike  hypot(2), this function takes no special care to avoid
// unwarranted IEEE exceptions if any of |x|, |y|, or |z| is close to
// the overflow and/or underflow threshold.
//
namespace jtutil
	  {
double hypot3(double x, double y, double z)
{
return sqrt(x*x + y*y + z*z);
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function computes a four-quadrant arctangent, using what I think
// is the "right" ordering of the arguments, and returning 0.0 if both
// arguments are 0.0.
//
// Arguments:
// (x,y) = (in) The rectangular coordinates of a point in $\Re^2$.
//
// Result:
// The function returns a value $\theta$ such that $x + iy = R e^{i\theta}$ for
// some real $R$, i.e. it returns the angle between the positive $x$ axis and
// the line joining the origin and the point $(x,y)$.
//
namespace jtutil
	  {
double arctan_xy(double x, double y)
{
// note reversed argument order (y,x) in std::atan2() function
return ((x == 0.0) && (y == 0.0)) ? 0.0 : atan2(y,x);
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function reduces  x  modulo  xmod  to be (fuzzily) in the range
//  [xmin, xmax] , or does an  error_exit()  if no such value exists.
//
namespace jtutil
	  {
double modulo_reduce(double x, double xmod, double xmin, double xmax)
{
double xx = x;

	while (fuzzy<double>::LT(xx, xmin))
	{
	xx += xmod;
	}

	while (fuzzy<double>::GT(xx, xmax))
	{
	xx -= xmod;
	}

if (! (fuzzy<double>::GE(xx, xmin) && fuzzy<double>::LE(xx, xmax)) )
   then jtutil::error_exit(ERROR_EXIT,
"***** modulo_reduce(): no modulo value is fuzzily within specified range!\n"
"                       x = %g   xmod = %g\n"
"                       [xmin,xmax] = [%g,%g]\n"
"                       ==> xx = %g\n"
,
			   x, xmod,
			   xmin, xmax,
			   xx);					/*NOTREACHED*/

return xx;
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function sets a C-style array to all zeros.
//
namespace jtutil
	  {
template <typename fp_t>
  void zero_C_array(int N, fp_t array[])
{
	for (int i = 0 ; i < N ; ++i)
	{
	array[i] = 0;
	}
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations *****
//

namespace jtutil
	  {
template void zero_C_array<CCTK_REAL>(int, CCTK_REAL[]);
	  }	// namespace jtutil::

```

jtutil/cpm_map.hh:
```
// cpm_map.hh -- "integer +/-" mapping  i --> j = const +/- i
// $Header$
//
// cpm_map - "integer +/-" mapping
//

#ifndef AHFINDERDIRECT__CPM_MAP_HH
#define AHFINDERDIRECT__CPM_MAP_HH

//
// prerequisites
//	<assert.h>
//	"stdc.h"
//	"util.hh"		// for jtutil::how_many_in_range()
//

//
// This class represents a unit-slope linear integer mapping
//	i --> j = const +/- i
//

#ifndef NDEBUG
//
// Full bounds checking is done on the mapping in both directions.
//
#endif

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
class	cpm_map
	{
public:
	// bounds info -- domain
	int min_i() const { return min_i_; }
	int max_i() const { return max_i_; }
	int N_points() const
		{ return jtutil::how_many_in_range(min_i_,max_i_); }
	bool in_domain(int i) const { return (i >= min_i_) && (i <= max_i_); }

	// is the mapping + or - ?
	bool is_plus() const { return map_is_plus_; }
	bool is_minus() const { return !map_is_plus_; }
	int sign() const { return map_is_plus_ ? +1 : -1; }
	fp_t fp_sign() const { return map_is_plus_ ? +1.0 : -1.0; }

	// the mapping itself
	int map_unchecked(int i) const
		{
		return map_is_plus_ ? offset_ + i
				    : offset_ - i;
		}
	int inv_map_unchecked(int j) const
		{
		return map_is_plus_ ? j - offset_
				    : offset_ - j;
		}
	int map(int i) const
		{
		assert(in_domain(i));
		return map_unchecked(i);
		}
	int inv_map(int j) const
		{
		int i = inv_map_unchecked(j);
		assert(in_domain(i));
		return i;
		}

	// bounds info -- range
	// ... we use the unchecked map here in case the domain is empty
	int min_j() const
		{
		return map_is_plus_ ? map_unchecked(min_i_)
				    : map_unchecked(max_i_);
		}
	int max_j() const
		{
		return map_is_plus_ ? map_unchecked(max_i_)
				    : map_unchecked(min_i_);
		}
	bool in_range(int j) const { return in_domain(inv_map_unchecked(j)); }

	//
	// constructors
	//

	// "mirror" map: i --> const - i
	// ... map specified by fixed point (must be integer or half-integer)
	// ... fixed point need not be in domain/range
	cpm_map(int min_i_in, int max_i_in,
		fp_t fixed_point);

	// "shift" map: i --> const + i
	// ... map specified by shift amount
	// ... default is identity map
	cpm_map(int min_i_in, int max_i_in,
		int shift_amount = 0)
		: min_i_(min_i_in), max_i_(max_i_in),
		  offset_(shift_amount), map_is_plus_(true)
		{ }

	// generic map: i --> const +/- i
	// ... map specified by sample point sample_i --> sample_j
	//     and by sign (one of  {plus,minus}_map )
	// ... sample point need not be in domain/range
	cpm_map(int min_i_in, int max_i_in,
		int sample_i, int sample_j,
		bool map_is_plus_in);

	// generic map: i --> const +/- i
	// ... map specified by *fp* sample point sample_i --> sample_j
	//     (must specify an integer --> integer mapping)
	//     and by sign (one of  {plus,minus}_map )
	// ... hence if sign is -1, then sample_i and sample_j
	//     must both be half-integral
	// ... sample point need *not* be in domain/range
	cpm_map(int min_i_in, int max_i_in,
		fp_t sample_i, fp_t sample_j,
		bool map_is_plus_in);

	// no need for explicit destructor, compiler-generated no-op is ok
	// ditto for copy constructor and assignment operator

private:
	// bounds (inclusive)
	int min_i_, max_i_;

	// these define the actual mapping
	int offset_;
	bool map_is_plus_;
	};
	  }	// namespace jtutil::

//******************************************************************************

#endif	/* AHFINDERDIRECT__CPM_MAP_HH */

```

jtutil/round.cc:
```
// round.hh -- template for rounding floating point values
// $Header$
//
// *** Implementation Notes ***
// jtutil::round::to_integer
// jtutil::round::floor
// jtutil::round::ceiling
//
// ***** template instantiations *****
//

#include <stdlib.h>

#include "stdc.h"
#include "util.hh"

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// *** Implementation Notes ***
//
// We assume throughout this code that C++'s "built-in" conversion
// from <fp_t> to integer takes the floor, at least for zero or positive
// values.
//

//******************************************************************************

// round to nearest integer, up for exact tie
namespace jtutil
	  {
template <typename fp_t>
int round<fp_t>::to_integer(fp_t x)
{
return (x >= 0.0)
       ? int(x + 0.5)		// eg 3.6 --> int(4.1) = 4
       : - int( (-x) + 0.5 );	// eg -3.6 --> - int(4.1) = -4
}
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
int round<fp_t>::floor(fp_t x)
{
return (x >= 0.0)
       ? int(x)
       : - ceiling(-x);
}
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
int round<fp_t>::ceiling(fp_t x)
{
return (x >= 0.0)
       ? int(x) + (x != fp_t(int(x)))
       : - floor(-x);
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations *****
//

template class jtutil::round<float>;
template class jtutil::round<double>;

```

jtutil/cpm_map.cc:
```
// cpm_map.cc -- "integer +/-" mapping  i --> j = const +/- i
// $Header$
//
// jtutil::cpm_map::cpm_map  # mirror map, specified by fixed point
// jtutil::cpm_map::cpm_map  # generic map specified by sample point & sign
// jtutil::cpm_map::cpm_map  # generic map specified by *fp* sample point & sign
//
// ***** template instantiations *****
//

#include <assert.h>
#include <stdio.h>

#include "stdc.h"
#include "util.hh"
#include "cpm_map.hh"
using jtutil::error_exit;

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function constructs a  cpm_map  object with a "-" sign and a
// specified fixed point (must be integer or half-integer) and domain.
// The sample point need not be in the map's domain/range.
//
namespace jtutil
	  {
template <typename fp_t>
cpm_map<fp_t>::cpm_map(int min_i_in, int max_i_in,
		       fp_t fixed_point)
	: min_i_(min_i_in), max_i_(max_i_in),
	  map_is_plus_(false)
{
const fp_t d_offset = 2.0 * fixed_point;
if (! fuzzy<fp_t>::is_integer(d_offset))
   then error_exit(ERROR_EXIT,
"***** cpm_map::cpm_map (mirror):\n"
"        fixed_point=%g isn't (fuzzily) integral or half-integral!\n"
,
		   double(fixed_point));			/*NOTREACHED*/

offset_ = round<fp_t>::to_integer(d_offset);

// verify that we have setup correct
assert(
   map_unchecked(fuzzy<fp_t>::floor  (fixed_point))
   ==
		 fuzzy<fp_t>::ceiling(fixed_point)
      );
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function constructs a generic  cpm_map  object, with the mapping
// specified by a sample point  sample_i --> sample_j  and by sign.
// The sample point need not be in the map's domain/range.
//
namespace jtutil
	  {
template <typename fp_t>
cpm_map<fp_t>::cpm_map(int min_i_in, int max_i_in,
		       int sample_i, int sample_j,
		       bool map_is_plus_in)
	: min_i_(min_i_in), max_i_(max_i_in),
	  offset_(map_is_plus_in ? sample_j - sample_i
			  : sample_j + sample_i),
	  map_is_plus_(map_is_plus_in)
{
// verify that we have setup correct
assert( map_unchecked(sample_i) == sample_j );
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function constructs a generic  cpm_map  object, with the mapping
// specified by a *fp* sample point  sample_i --> sample_j  (which
// must specify an  integer --> integer  mapping, i.e.  4.2 --> 4.2  is
// ok for a + map, and 4.5 --> 4.5 is ok for a minus map, but  4.2 --> 4.7
// is never ok) and by sign.  The sample point need not be in the map's
// domain/range.
//
namespace jtutil
	  {
template <typename fp_t>
cpm_map<fp_t>::cpm_map(int min_i_in, int max_i_in,
		       fp_t sample_i, fp_t sample_j,
		       bool map_is_plus_in)
	: min_i_(min_i_in), max_i_(max_i_in),
	  map_is_plus_(map_is_plus_in)
{
const fp_t fp_offset = map_is_plus_in ? sample_j - sample_i
				    : sample_j + sample_i;
if (! fuzzy<fp_t>::is_integer(fp_offset))
   then error_exit(ERROR_EXIT,
"***** cpm_map::cpm_map (generic via fp sample point):\n"
"        fp_offset=%g isn't fuzzily integral!\n"
"        ==> sample_i=%g --> sample_j=%g\n"
"            doesn't fuzzily specify an  integer --> integer  mapping!\n"
,
		   double(fp_offset),
		   double(sample_i), double(sample_j));		/*NOTREACHED*/

offset_ = round<fp_t>::to_integer(fp_offset);

// verify that we have setup correct
assert(
   map_unchecked(      fuzzy<fp_t>::floor(sample_i))
   ==
   (map_is_plus_in ? fuzzy<fp_t>::floor  (sample_j)
		   : fuzzy<fp_t>::ceiling(sample_j)) );
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations *****
//

template class jtutil::cpm_map<float>;
template class jtutil::cpm_map<double>;

```

jtutil/test_fuzzy.cc:
```
// test_fuzzy.cc -- test driver for fuzzy<float> and fuzzy<double>
// $Header$
//
// main
// check<fp_t>
// check_binary<fp_t>
// check_unary<fp_t>
// *** template instantiations

#include <stdio.h>
#include <assert.h>

#include "stdc.h"
#include "util.hh"
using jtutil::error_exit;
using jtutil::fuzzy;

// prototypes
template <typename fp_t>
  void check(const char* print_string,
	     fp_t x, fp_t y,
	     char xy_relation,
	     bool unary_flag,
	     bool x_is_fuzzy_integer,
	     int fuzzy_floor_of_x,
	     int fuzzy_ceiling_of_x);
template <typename fp_t>
  void check_binary(fp_t x, fp_t y,
		    char xy_relation);
template <typename fp_t>
  void check_unary(fp_t x,
		   bool x_is_fuzzy_integer,
		   int fuzzy_floor_of_x,
		   int fuzzy_ceiling_of_x);

//******************************************************************************

int main(int argc, const char* const argv[])
{
const bool print_flag = (argc > 1);
const char* double_str = print_flag ? "<double>" : NULL;
const char* float_str  = print_flag ? "<float>" : NULL;

	for (int ii = -10 ; ii <= +10 ; ++ii)
	{
	bool unary_flag = ((ii % 2) == 0);	// the "correct answers"
						// for the unary tests
						// assume f and d are integral

	float f = 0.5*float(ii);
	double d = 0.5*double(ii);
	int i = ii / 2;

	printf("testing %+-4g +/- various things...\n", d);


	//                        x        y  relation  do unary  is_integer  floor  ceiling
	//                                     (x,y)     tests?      (x)       (x)     (x)
	check<double>(double_str, d - 0.49 , d,   '<',   unary_flag,  false,     i-1,    i  );
	check<double>(double_str, d - 0.01 , d,   '<',   unary_flag,  false,     i-1,    i  );
	check<double>(double_str, d - 1e-6 , d,   '<',   unary_flag,  false,     i-1,    i  );
	check<double>(double_str, d - 1e-10, d,   '<',   unary_flag,  false,     i-1,    i  );
	// ... distinct floating point numbers, but within tolerance
	assert( d - 1e-14 != d );
	check<double>(double_str, d - 1e-14, d,   '=',   unary_flag,  true ,     i  ,    i  );
	check<double>(double_str, d        , d,   '=',   unary_flag,  true ,     i  ,    i  );
	// ... distinct floating point numbers, but within tolerance
	assert( d + 1e-14 != d );
	check<double>(double_str, d + 1e-14, d,   '=',   unary_flag,  true ,     i  ,    i  );
	check<double>(double_str, d + 1e-10, d,   '>',   unary_flag,  false,     i  ,    i+1);
	check<double>(double_str, d + 1e-6 , d,   '>',   unary_flag,  false,     i  ,    i+1);
	check<double>(double_str, d + 0.01 , d,   '>',   unary_flag,  false,     i  ,    i+1);
	check<double>(double_str, d + 0.49 , d,   '>',   unary_flag,  false,     i  ,    i+1);

	//                        x        y  relation  do unary  is_integer  floor  ceiling
	//                                     (x,y)     tests?      (x)       (x)     (x)
	check<float> (float_str , f - 0.49 , f,   '<',   unary_flag,  false,     i-1,    i  );
	check<float> (float_str , f - 0.01 , f,   '<',   unary_flag,  false,     i-1,    i  );
	check<float> (float_str , f - 1e-4 , f,   '<',   unary_flag,  false,     i-1,    i  );
	// ... distinct floating point numbers, but within tolerance
	assert( f - 1e-6 != f );
	check<float> (float_str , f - 1e-6 , f,   '=',   unary_flag,  true ,     i  ,    i  );
	// ... not enough precision to see as noninteger
	check<float> (float_str , f - 1e-10, f,   '=',   unary_flag,  true ,     i  ,    i  );
	check<float> (float_str , f        , f,   '=',   unary_flag,  true ,     i  ,    i  );
	// ... not enough precision to see as noninteger
	check<float> (float_str , f + 1e-10, f,   '=',   unary_flag,  true ,     i  ,    i  );
	// ... distinct floating point numbers, but within tolerance
	assert( f + 1e-6 != f );
	check<float> (float_str , f + 1e-6 , f,   '=',   unary_flag,  true ,     i  ,    i  );
	check<float> (float_str , f + 0.01 , f,   '>',   unary_flag,  false,     i  ,    i+1);
	check<float> (float_str , f + 1e-4 , f,   '>',   unary_flag,  false,     i  ,    i+1);
	check<float> (float_str , f + 0.49 , f,   '>',   unary_flag,  false,     i  ,    i+1);

	if (print_flag)
	   then printf("\n");
	}

printf("everything looks ok!\n");
return 0;
}

//******************************************************************************

//
// This function template is a driver to do all the tests for a single
// argument or pair of arguments.  It calls  check_binary<fp_t>()  to do
// the binary-function tests, and optionally calls  check_unary<fp_t>()
// to do the unary-function tests.
//
template <typename fp_t>
  void check(const char* print_string,
	     fp_t x, fp_t y,
	     char xy_relation,
	     bool unary_flag,
	     bool x_is_fuzzy_integer, int fuzzy_floor_of_x,
				      int fuzzy_ceiling_of_x)
{
if (print_string != NULL)
   then printf("   testing %s %s: x=%.15f y=%.15f\n",
	       print_string,
	       unary_flag ? "op(x,y) + op(x)" : "op(x,y) only   ",
	       double(x), double(y));

check_binary<fp_t>(x, y, xy_relation);

if (unary_flag)
   then check_unary(x,
		    x_is_fuzzy_integer, fuzzy_floor_of_x, fuzzy_ceiling_of_x);
}

//******************************************************************************

//
// This function template tests the binary relations
//	fuzzy<fp_t>::EQ()
//	fuzzy<fp_t>::NE()
//	fuzzy<fp_t>::LT()
//	fuzzy<fp_t>::GT()
//	fuzzy<fp_t>::LE()
//	fuzzy<fp_t>::GE()
// for a single argument.
//
// The  xy_relation  argument must be one of '<', '=', or '>', indicating
// the desired fuzzy relationship between the two arguments.  The function
// infers the correct values of the binary functions from this.
//
template <typename fp_t>
  void check_binary(fp_t x, fp_t y,
		    char xy_relation)
{
//
// basic properties which should always hold
//

// trichotomy (we have exactly one of <, =, >
assert( fuzzy<fp_t>::LT(x,y) + fuzzy<fp_t>::EQ(x,y) + fuzzy<fp_t>::GT(x,y)
	== 1 );

// consistency of EQ() with NE()
assert( fuzzy<fp_t>::NE(x,y) == ! fuzzy<fp_t>::EQ(x,y) );

// consistency of LE() with LT() and EQ(), GE() with GT() and EQ()
assert( fuzzy<fp_t>::LE(x,y)
	== (fuzzy<fp_t>::LT(x,y) || fuzzy<fp_t>::EQ(x,y)) );
assert( fuzzy<fp_t>::GE(x,y)
	== (fuzzy<fp_t>::GT(x,y) || fuzzy<fp_t>::EQ(x,y)) );


//
// now check desired ordering relation
// ... by virtue of the previous tests, we need only check LT(), EQ(), and GT()
// ... in fact, by virtue of trichotomy (already tested), we really
//     only need to assert() the true one for each case, but the slight
//     redundancy of checking all of them seems nicer in this context
//
switch	(xy_relation)
	{
case '<':
	assert( fuzzy<fp_t>::LT(x,y) == true  );
	assert( fuzzy<fp_t>::EQ(x,y) == false );
	assert( fuzzy<fp_t>::GT(x,y) == false );
	break;
case '=':
	assert( fuzzy<fp_t>::LT(x,y) == false );
	assert( fuzzy<fp_t>::EQ(x,y) == true  );
	assert( fuzzy<fp_t>::GT(x,y) == false );
	break;
case '>':
	assert( fuzzy<fp_t>::LT(x,y) == false );
	assert( fuzzy<fp_t>::EQ(x,y) == false );
	assert( fuzzy<fp_t>::GT(x,y) == true  );
	break;
default:
	error_exit(PANIC_EXIT,
"***** check_binary<fp_t>: bad xy_relation=(int)'%c'\n"
"                          (this should never happen!)\n"
,
		   int(xy_relation));				/*NOTREACHED*/
	}
}

//******************************************************************************

//
// This function template tests the unary functions
//	fuzzy<fp_t>::is_integer()
//	fuzzy<fp_t>::floor()
//	fuzzy<fp_t>::ceiling()
// for a single argument.
//
template <typename fp_t>
  void check_unary(fp_t x,
		   // remaining arguments are the correct results of...
		   bool x_is_fuzzy_integer,	// fuzzy<fp_t>::is_integer(x)
		   int fuzzy_floor_of_x,	// fuzzy<fp_t>::floor(x)
		   int fuzzy_ceiling_of_x)	// fuzzy<fp_t>::ceiling(x)
{
assert( fuzzy<fp_t>::is_integer(x) == x_is_fuzzy_integer );
assert( fuzzy<fp_t>::floor(x) == fuzzy_floor_of_x );
assert( fuzzy<fp_t>::ceiling(x) == fuzzy_ceiling_of_x );
}

//******************************************************************************

//
// template instantiations for <float> and <double>
//

template void check<float>(const char*,
			   float, float,
			   char, bool, bool, int, int);
template void check<double>(const char*,
			    double, double,
			    char, bool, bool, int, int);

template void check_binary<float>(float, float, char);
template void check_binary<double>(double, double, char);

template void check_unary<float>(float, bool, int, int);
template void check_unary<double>(double, bool, int, int);

```

jtutil/test_error_exit.cc:
```
// test_error_exit.cc -- test driver for  error_exit()  function
// $Header$

#include <stdio.h>

#include "stdc.h"
using jtutil::error_exit;

int main()
{
error_exit(ERROR_EXIT, "two+two=%.3f", 4.0);			/*NOTREACHED*/
return 0;
}

```

jtutil/test_cpm_map.cc:
```
// test_cpm_map.cc -- test driver for cpm_map class
// $Header$

#include <assert.h>
#include <stdio.h>

#include "stdc.h"
#include "util.hh"
#include "cpm_map.hh"
using jtutil::cpm_map;

//******************************************************************************

// prototypes

void test_shift_map(int min_i, int sample_i, int max_i,
		    int min_j, int sample_j, int max_j);
void test_mirror_map(int min_i, int sample_i, int max_i,
		     int min_j, int sample_i, int max_j,
		     double fixed_point);

void verify_shift_map(const cpm_map<double> sm,
		      const int min_i, const int sample_i, const int max_i,
		      const int min_j, const int sample_j, const int max_j);
void verify_mirror_map(const cpm_map<double> mm,
		       const int min_i, const int sample_i, const int max_i,
		       const int min_j, const int sample_j, const int max_j,
		       const double fixed_point);

//******************************************************************************
//******************************************************************************
//******************************************************************************

int main()
{
test_shift_map(4 , 10, 14,
	       42, 48, 52);

test_mirror_map(4 , 10, 14,
		16, 20, 26,
		15.0);
test_mirror_map(4 , 10, 14,
		17, 21, 27,
		15.5);

return 0;
}

//******************************************************************************

//
// this function tests a shift map
//
void test_shift_map(const int min_i, const int sample_i, const int max_i,
		    const int min_j, const int sample_j, const int max_j)
{
printf("testing shift_map [%d,%d,%d] --> [%d,%d,%d]...\n",
       min_i, sample_i, max_i,
       min_j, sample_j, max_j);
cpm_map<double> sm(min_i, max_i,
		   sample_j - sample_i);
verify_shift_map(sm,
		 min_i, sample_i, max_i,
		 min_j, sample_j, max_j);

  {
printf("testing generic_map (+) [%d,%d,%d] --> [%d,%d,%d]...\n",
       min_i, sample_i, max_i,
       min_j, sample_j, max_j);
cpm_map<double> gm(min_i, max_i,
		   sample_i, sample_j,
		   true);
verify_shift_map(gm,
		 min_i, sample_i, max_i,
		 min_j, sample_j, max_j);
  }

  {
const double delta = 0.42;
const double d_sample_i = double(sample_i) + delta;
const double d_sample_j = double(sample_j) + delta;
printf("testing generic_map (+) [%d,%g,%d] --> [%d,%g,%d]...\n",
       min_i, d_sample_i, max_i,
       min_j, d_sample_j, max_j);
cpm_map<double> gm(min_i, max_i,
		   d_sample_i, d_sample_j,
		   true);
verify_shift_map(gm,
		 min_i, sample_i, max_i,
		 min_j, sample_j, max_j);
  }
}

//******************************************************************************

//
// this function tests a mirror map
//
void test_mirror_map(const int min_i, const int sample_i, const int max_i,
		     const int min_j, const int sample_j, const int max_j,
		     const double fixed_point)
{
  {
printf("testing mirror_map [%d,%d,%d] --> [%d,%d,%d] with fixed point %g\n",
       min_i, sample_i, max_i,
       min_j, sample_j, max_j,
       fixed_point);
cpm_map<double> mm(min_i, max_i,
		   fixed_point);
verify_mirror_map(mm,
		  min_i, sample_i, max_i,
		  min_j, sample_j, max_j,
		  fixed_point);
  }

  {
printf("testing generic_map (-) [%d,%d,%d] --> [%d,%d,%d]...\n",
       min_i, sample_i, max_i,
       min_j, sample_j, max_j);
cpm_map<double> gm(min_i, max_i,
		   sample_i, sample_j,
		   false);
verify_mirror_map(gm,
		  min_i, sample_i, max_i,
		  min_j, sample_j, max_j,
		  fixed_point);
  }

  {
const double delta = 0.5;
const double d_sample_i = double(sample_i) + delta;
const double d_sample_j = double(sample_j) - delta;
printf("testing generic_map (-) [%d,%g,%d] --> [%d,%g,%d]...\n",
       min_i, d_sample_i, max_i,
       min_j, d_sample_j, max_j);
cpm_map<double> gm(min_i, max_i,
		   d_sample_i, d_sample_j,
		   false);
verify_mirror_map(gm,
		  min_i, sample_i, max_i,
		  min_j, sample_j, max_j,
		  fixed_point);
  }
}

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// this function verifies that a shift map is correct
//
void verify_shift_map(const cpm_map<double> sm,
		      const int min_i, const int sample_i, const int max_i,
		      const int min_j, const int sample_j, const int max_j)
{
assert(sm.min_i() == min_i);		assert(sm.min_j() == min_j);
assert(sm.max_i() == max_i);		assert(sm.max_j() == max_j);
assert(sm.N_points() == jtutil::how_many_in_range(min_i, max_i));

assert(! sm.in_domain(min_i-1));	assert(! sm.in_range(min_j-1));
assert(  sm.in_domain(min_i  ));	assert(  sm.in_range(min_j  ));
assert(  sm.in_domain(min_i+1));	assert(  sm.in_range(min_j+1));
assert(  sm.in_domain(max_i-1));	assert(  sm.in_range(max_j-1));
assert(  sm.in_domain(max_i  ));	assert(  sm.in_range(max_j  ));
assert(! sm.in_domain(max_i+1));	assert(! sm.in_range(max_j+1));

assert(sm.is_plus());
assert(! sm.is_minus());
assert(sm.sign() == +1);
assert(sm.fp_sign() == +1.0);

assert(sm.map(min_i) == min_j);
assert(sm.map(max_i) == max_j);
assert(sm.map(sample_i) == sample_j);

assert(sm.inv_map(min_j) == min_i);
assert(sm.inv_map(max_j) == max_i);
assert(sm.inv_map(sample_j) == sample_i);

printf("==> all ok!\n");
}

//******************************************************************************

//
// this function verifies that a mirror map is correct
//
void verify_mirror_map(const cpm_map<double> mm,
		       const int min_i, const int sample_i, const int max_i,
		       const int min_j, const int sample_j, const int max_j,
		       const double fixed_point)
{
assert(mm.min_i() == min_i);		assert(mm.min_j() == min_j);
assert(mm.max_i() == max_i);		assert(mm.max_j() == max_j);
assert(mm.N_points() == jtutil::how_many_in_range(min_i, max_i));

assert(! mm.in_domain(min_i-1));	assert(! mm.in_range(min_j-1));
assert(  mm.in_domain(min_i  ));	assert(  mm.in_range(min_j  ));
assert(  mm.in_domain(min_i+1));	assert(  mm.in_range(min_j+1));
assert(  mm.in_domain(max_i-1));	assert(  mm.in_range(max_j-1));
assert(  mm.in_domain(max_i  ));	assert(  mm.in_range(max_j  ));
assert(! mm.in_domain(max_i+1));	assert(! mm.in_range(max_j+1));

assert(! mm.is_plus());
assert(mm.is_minus());
assert(mm.sign() == -1);
assert(mm.fp_sign() == -1.0);

assert(mm.map(min_i) == max_j);
assert(mm.map(max_i) == min_j);
assert(mm.map(sample_i) == sample_j);

assert(mm.inv_map(min_j) == max_i);
assert(mm.inv_map(max_j) == min_i);
assert(mm.inv_map(sample_j) == sample_i);

printf("==> all ok!\n");
}

```

jtutil/array.hh:
```
// array.hh -- array template classes
// $Header$
//
// array1d - 1D array template
// array2d - 2D array template
// array3d - 3D array template
#ifdef NOT_USED
// array4d - 4D array template
#endif
//

#ifndef AHFINDERDIRECT__ARRAY_HH
#define AHFINDERDIRECT__ARRAY_HH

//
// prerequisites:
//    <assert.h>
//    <stddef.h>	// for NULL
//    "stdc.h"
//    "util.hh"		// for jtutil::how_many_in_range()
//

//
// The templates defined in this file represent n-dimensional row-major
// contiguous arrays, parameterized by the data type (most commonly float
// or double, but could also be bool, int, long double, ...).  The
// underlying storage can be either supplied by the caller, or allocated
// by new[].  In the latter case, arbitrary strides are also possible.
// Unfortunately, allowing arbitrary strides makes subscripting a bit
// more expensive. :(
//
// These arrays cannot be copied or passed to functions by value; use
// pass by reference instead.  (This is a feature, not a bug: passing
// large arrays by value would be ++slow, so we don't want to run the
// risk of this happening accidentally.)
//

//
// Stroustrup ("The C++ Programming Language", 3rd edition, appendix C.7)
// suggests the use of STL vectors of STL vectors to provide multidimensional
// arrays.  However, those "arrays" aren't contiguous in memory, so the
// compiler can't do strength reduction on any but the last subscript
// when the arrays are accessed in a loop.  In contrast, the arrays
// defined here are contiguous, and all subscripts can (should, if the
// compiler is good) be strength-reduced.
//
// The STL valarray templates offer a superset of the functionality of
// these templates, but they've only recently been provided with gcc;
// at some time in the future I may migrate these classes to become
// valarray wrappers.
//
// Or, even better, boost (http://www.boost.org) is working on a
// multi_array<> template, which looks very nice, abeit complicated.
// See
//   http://groups.yahoo.com/group/boost/message/10230
// for the development discussions for this.
//

#ifndef NDEBUG
//
// Full bounds checking is done on all array accesses.
//
#endif

//******************************************************************************

namespace jtutil
	  {
template <typename T>
class	array1d
	{
public:
	// array info
	int min_i() const { return min_i_; }
	int max_i() const { return max_i_; }
	int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); }
	bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); }

	// subscripting functions
	// (low-level, dangerous, use with caution!)
	// FIXME: should we also provide the reverse mapping, i.e.
	//        subscript --> (i) ?
	int subscript_unchecked(int i) const
		{ return offset_ + stride_i_*i; }
	int subscript(int i) const
		{
		// n.b. we want each assert() here to be on a separate
		//	source line, so an assert() failure message can
		//	pinpoint *which* index is bad
		assert( is_valid_i(i) );
		const int posn = subscript_unchecked(i);
		assert(posn >= 0);
		assert(posn <= max_subscript_);
		return posn;
		}
	int subscript_offset() const { return offset_; }
	int subscript_stride_i() const { return stride_i_; }
		

	// normal-use access functions
	// ... rvalue
	const T& operator()(int i) const { return array_[ subscript(i) ]; }
	// ... lvalue
	      T& operator()(int i)       { return array_[ subscript(i) ]; }

	// get access to internal 0-origin 1D storage array
	// (low-level, dangerous, use with caution!)
	// ... semantics of N_array() may not be what you want
	//     if strides specify noncontiguous storage
	int N_array() const { return max_subscript_+stride_i_; }
	const T* data_array() const { return const_cast<const T*>(array_); }
	      T* data_array()       { return array_; }

	// constructor, destructor
	// ... constructor initializes all array elements to T(0.0)
	// ... omitted strides default to C storage order
	array1d(int min_i_in, int max_i_in,
		T *array_in = NULL,	// caller-provided storage array
					// if non-NULL
		int stride_i_in = 0);
	~array1d();

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	array1d(const array1d<T>& rhs);
	array1d<T>& operator=(const array1d<T>& rhs);

private:
	// n.b. we declare the array pointer first in the class
	// ==> it's probably at 0 offset
	// ==> we may get slightly faster array access
	T* array_;		// --> new-allocated 1D storage array

	// subscripting info
	// n.b. put this next in class so it should be in the same
	//	cpu cache line as  array_  ==> faster array access
	int offset_, stride_i_;

	// min/max array bounds
	const int min_i_, max_i_;
	int max_subscript_;

	// n.b. put this at end of class since performance doesn't matter
	bool we_own_array_;	// true ==> array_ --> new[] array which we own
				// false ==> array_ --> client-owned storage
	};
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename T>
class	array2d
	{
public:
	// array info
	int min_i() const { return min_i_; }
	int max_i() const { return max_i_; }
	int min_j() const { return min_j_; }
	int max_j() const { return max_j_; }
	int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); }
	int N_j() const { return jtutil::how_many_in_range(min_j_, max_j_); }
	bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); }
	bool is_valid_j(int j) const { return (j >= min_j_) && (j <= max_j_); }
	bool is_valid_ij(int i, int j) const
		{ return is_valid_i(i) && is_valid_j(j); }

	// subscripting functions
	// (low-level, dangerous, use with caution!)
	// FIXME: should we also provide the reverse mapping, i.e.
	//        subscript --> (i,j) ?
	int subscript_unchecked(int i, int j) const
		{ return offset_ + stride_i_*i + stride_j_*j; }
	int subscript(int i, int j) const
		{
		// n.b. we want each assert() here to be on a separate
		//	source line, so an assert() failure message can
		//	pinpoint *which* index is bad
		assert( is_valid_i(i) );
		assert( is_valid_j(j) );
		const int posn = subscript_unchecked(i,j);
		assert(posn >= 0);
		assert(posn <= max_subscript_);
		return posn;
		}
	int subscript_offset() const { return offset_; }
	int subscript_stride_i() const { return stride_i_; }
	int subscript_stride_j() const { return stride_j_; }

	// normal-use access functions
	// ... rvalue
	const T& operator()(int i, int j) const
		{ return array_[ subscript(i,j) ]; }
	// ... lvalue
	      T& operator()(int i, int j)
		{ return array_[ subscript(i,j) ]; }

	// get access to internal 0-origin 1D storage array
	// (low-level, dangerous, use with caution!)
	// ... semantics of N_array() may not be what you want
	//     if strides specify noncontiguous storage
	int N_array() const { return max_subscript_+stride_j_; }
	const T* data_array() const { return const_cast<const T*>(array_); }
	      T* data_array()       { return array_; }

	// constructor, destructor
	// ... constructor initializes all array elements to T(0.0)
	// ... omitted strides default to C storage order
	array2d(int min_i_in, int max_i_in,
		int min_j_in, int max_j_in,
		T *array_in = NULL,	// caller-provided storage array
					// if non-NULL
		int stride_i_in = 0, int stride_j_in = 0);
	~array2d();

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	array2d(const array2d<T>& rhs);
	array2d<T>& operator=(const array2d<T>& rhs);

private:
	// n.b. we declare the array pointer first in the class
	// ==> it's probably at 0 offset
	// ==> we may get slightly faster array access
	T* array_;		// --> new-allocated 1D storage array

	// subscripting info
	// n.b. put this next in class so it should be in the same
	//	cpu cache line as  array_  ==> faster array access
	int offset_, stride_i_, stride_j_;

	// min/max array bounds
	const int min_i_, max_i_;
	const int min_j_, max_j_;
	int max_subscript_;

	// n.b. put this at end of class since performance doesn't matter
	bool we_own_array_;	// true ==> array_ --> new[] array which we own
				// false ==> array_ --> client-owned storage
	};
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename T>
class	array3d
	{
public:
	// array info
	int min_i() const { return min_i_; }
	int max_i() const { return max_i_; }
	int min_j() const { return min_j_; }
	int max_j() const { return max_j_; }
	int min_k() const { return min_k_; }
	int max_k() const { return max_k_; }
	int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); }
	int N_j() const { return jtutil::how_many_in_range(min_j_, max_j_); }
	int N_k() const { return jtutil::how_many_in_range(min_k_, max_k_); }
	bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); }
	bool is_valid_j(int j) const { return (j >= min_j_) && (j <= max_j_); }
	bool is_valid_k(int k) const { return (k >= min_k_) && (k <= max_k_); }
	bool is_valid_ijk(int i, int j, int k) const
		{ return is_valid_i(i) && is_valid_j(j) && is_valid_k(k); }

	// subscripting functions
	// (low-level, dangerous, use with caution!)
	// FIXME: should we also provide the reverse mapping, i.e.
	//        subscript --> (i,j,k) ?
	int subscript_unchecked(int i, int j, int k) const
		{ return offset_ + stride_i_*i + stride_j_*j + stride_k_*k; }
	int subscript(int i, int j, int k) const
		{
		// n.b. we want each assert() here to be on a separate
		//	source line, so an assert() failure message can
		//	pinpoint *which* index is bad
		assert( is_valid_i(i) );
		assert( is_valid_j(j) );
		assert( is_valid_k(k) );
		const int posn = subscript_unchecked(i,j,k);
		assert(posn >= 0);
		assert(posn <= max_subscript_);
		return posn;
		}
	int subscript_offset() const { return offset_; }
	int subscript_stride_i() const { return stride_i_; }
	int subscript_stride_j() const { return stride_j_; }
	int subscript_stride_k() const { return stride_k_; }

	// normal-use access functions
	// ... rvalue
	const T& operator()(int i, int j, int k) const
		{ return array_[ subscript(i,j,k) ]; }
	// ... lvalue
	      T& operator()(int i, int j, int k)
		{ return array_[ subscript(i,j,k) ]; }

	// get access to internal 0-origin 1D storage array
	// (low-level, dangerous, use with caution!)
	// ... semantics of N_array() may not be what you want
	//     if strides specify noncontiguous storage
	int N_array() const { return max_subscript_+stride_k_; }
	const T* data_array() const { return const_cast<const T*>(array_); }
	      T* data_array()       { return array_; }

	// constructor, destructor
	// ... constructor initializes all array elements to T(0.0)
	// ... omitted strides default to C storage order
	array3d(int min_i_in, int max_i_in,
		int min_j_in, int max_j_in,
		int min_k_in, int max_k_in,
		T *array_in = NULL,	// caller-provided storage array
					// if non-NULL
		int stride_i_in = 0, int stride_j_in = 0, int stride_k_in = 0);
	~array3d();

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	array3d(const array3d<T>& rhs);
	array3d<T>& operator=(const array3d<T>& rhs);

private:
	// n.b. we declare the array pointer first in the class
	// ==> it's probably at 0 offset
	// ==> we may get slightly faster array access
	T* array_;		// --> new-allocated 1D storage array

	// subscripting info
	// n.b. put this next in class so it should be in the same
	//	cpu cache line as  array_  ==> faster array access
	int offset_, stride_i_, stride_j_, stride_k_;

	// min/max array bounds
	const int min_i_, max_i_;
	const int min_j_, max_j_;
	const int min_k_, max_k_;
	int max_subscript_;

	// n.b. put this at end of class since performance doesn't matter
	bool we_own_array_;	// true ==> array_ --> new[] array which we own
				// false ==> array_ --> client-owned storage
	};
	  }	// namespace jtutil::

//******************************************************************************

#ifdef NOT_USED
namespace jtutil
	  {
template <typename T>
class	array4d
	{
public:
	// array info
	int min_i() const { return min_i_; }
	int max_i() const { return max_i_; }
	int min_j() const { return min_j_; }
	int max_j() const { return max_j_; }
	int min_k() const { return min_k_; }
	int max_k() const { return max_k_; }
	int min_l() const { return min_l_; }
	int max_l() const { return max_l_; }
	int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); }
	int N_j() const { return jtutil::how_many_in_range(min_j_, max_j_); }
	int N_k() const { return jtutil::how_many_in_range(min_k_, max_k_); }
	int N_l() const { return jtutil::how_many_in_range(min_l_, max_l_); }
	bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); }
	bool is_valid_j(int j) const { return (j >= min_j_) && (j <= max_j_); }
	bool is_valid_k(int k) const { return (k >= min_k_) && (k <= max_k_); }
	bool is_valid_l(int l) const { return (l >= min_l_) && (l <= max_l_); }
	bool is_valid_ijkl(int i, int j, int k, int l) const
		{
		return    is_valid_i(i) && is_valid_j(j)
		       && is_valid_k(k) && is_valid_l(l);
		}

	// subscripting functions
	// (low-level, dangerous, use with caution!)
	// FIXME: should we also provide the reverse mapping, i.e.
	//        subscript --> (i,j,k,l) ?
	int subscript_unchecked(int i, int j, int k, int l) const
		{
		return offset_ + stride_i_*i + stride_j_*j
			       + stride_k_*k + stride_l_*l;
		}
	int subscript(int i, int j, int k, int l) const
		{
		// n.b. we want each assert() here to be on a separate
		//	source line, so an assert() failure message can
		//	pinpoint *which* index is bad
		assert( is_valid_i(i) );
		assert( is_valid_j(j) );
		assert( is_valid_k(k) );
		assert( is_valid_l(l) );
		const int posn = subscript_unchecked(i,j,k,l);
		assert(posn >= 0);
		assert(posn <= max_subscript_);
		return posn;
		}
	int subscript_offset() const { return offset_; }
	int subscript_stride_i() const { return stride_i_; }
	int subscript_stride_j() const { return stride_j_; }
	int subscript_stride_k() const { return stride_k_; }
	int subscript_stride_l() const { return stride_l_; }

	// normal-use access functions
	// ... rvalue
	const T& operator()(int i, int j, int k, int l) const
		{ return array_[ subscript(i,j,k,l) ]; }
	// ... lvalue
	      T& operator()(int i, int j, int k, int l)
		{ return array_[ subscript(i,j,k,l) ]; }

	// get access to internal 0-origin 1D storage array
	// (low-level, dangerous, use with caution!)
	// ... semantics of N_array() may not be what you want
	//     if strides specify noncontiguous storage
	int N_array() const { return max_subscript_+stride_l_; }
	const T* data_array() const { return const_cast<const T*>(array_); }
	      T* data_array()       { return array_; }

	// constructor, destructor
	// ... constructor initializes all array elements to T(0.0)
	// ... omitted strides default to C storage order
	array4d(int min_i_in, int max_i_in,
		int min_j_in, int max_j_in,
		int min_k_in, int max_k_in,
		int min_l_in, int max_l_in,
		T *array_in = NULL,	// caller-provided storage array
					// if non-NULL
		int stride_i_in = 0, int stride_j_in = 0,
		int stride_k_in = 0, int stride_l_in = 0);
	~array4d();

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	array4d(const array4d<T>& rhs);
	array4d<T>& operator=(const array4d<T>& rhs);

private:
	// n.b. we declare the array pointer first in the class
	// ==> it's probably at 0 offset
	// ==> we may get slightly faster array access
	T* array_;		// --> new-allocated 1D storage array

	// subscripting info
	// n.b. put this next in class so it should be in the same
	//	cpu cache line as  array_  ==> faster array access
	int offset_, stride_i_, stride_j_, stride_k_, stride_l_;

	// min/max array bounds
	const int min_i_, max_i_;
	const int min_j_, max_j_;
	const int min_k_, max_k_;
	const int min_l_, max_l_;
	int max_subscript_;

	// n.b. put this at end of class since performance doesn't matter
	bool we_own_array_;	// true ==> array_ --> new[] array which we own
				// false ==> array_ --> client-owned storage
	};
	  }	// namespace jtutil::
#endif	/* NOT_USED */

//******************************************************************************

#endif	/* AHFINDERDIRECT__ARRAY_HH */

```

jtutil/README:
```
This directory holds low-level utility code in the C++ namespace jtutil::.
This code is not specific to this project -- it's things like min/max
templates, multidimensional array classes, fuzzy arithmetic routines, etc.

array<fp>
	is a template class (templated on the integer or floating-point
	type of the array elements) providing multidimensional arrays.
	At present these are stored directly in C++ \code{new[]}-allocated
	storage, but sometime soon I'll add an option to use Cactus
	grid functions or local arrays.

linear_map<fp>
	is a template class (templated on the floating-point type)
	representing a linear map between a contiguous interval of
	integers, and floating-point numbers.

cpm_map<fp>
	is a template class (templated on the floating-point type)
	representing a mapping from the integers to the integers,
	of the form  i --> constant +/- i .  (The name abbreviates
	"Constant Plus or Minus MAP".)

fuzzy<fp>
	(declarations in "util.hh")
	is a template class (templated on the floating-point type)
	providing fuzzy arithmetic, to try to paper over some of the
	effects of floating-point rounding errors.  For example,
	one can write
		for (fp x = 0.0 ; fuzzy<fp>::LE(x,1.0) ; x += 0.1)
		{
		// ...
		}
	and have the loop execute as one would naievly expect,
	even if rounding errors cause the final value of \code{x}
	to be 0.9999999999999999 or 1.000000000000001 or suchlike.

round<fp>
	(declarations in "util.hh")
	is a template class (templated on the floating-point type)
	to do machine-independent rounding of floating point values

norm<fp>
	(declarations in "util.hh")
	is a template class (templated on the floating-point type)
	to the compute 2-, rms-, and/or infinity-norms of a set of
	numbers

miscfp.cc
	(declarations in "util.hh")
	contains various misc floating-point routines

There are also a number of test drivers in the files  test_*.cc .

```

jtutil/error_exit.cc:
```
// error_exit.cc -- print an error message and exit (= CCTK_VWarn() wrapper)
// $Header$
//
// error_exit -- print an error message and exit (= CCTK_VWarn() wrapper)
//

#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#include <string.h>

#ifdef STANDALONE_TEST
  #include "fake_cctk.h"
#else
  #include "cctk.h"
#endif

#include "config.h"
#include "stdc.h"

//******************************************************************************

//
// This function prints an error message (formatted via vfprintf(3S)),
// then exits.  It does *not* return to its caller.
#ifdef STANDALONE_TEST
// The exit is done via either  exit()  (for ERROR_EXIT)  or  abort()
// (for PANIC_EXIT).
#else
// The exit is done via  CCTK_VWarn()  with the caller-supplied
// "message level" argument; if this is one of
//	ERROR_EXIT
//	PANIC_EXIT
// defined in "stdc.h", then the  CCTK_VWarn()  call itself will terminate
// the Cactus run; if not we do an  abort() .
#endif
//
// Despite not actually returning, this function is declared as returning
// an  int , so it may be easily used in conditional expressions like
//      foo = bar_ok ? baz(bar) : error_exit(...);
//
// Usage:
//	error_exit(exit_code, message, args...)
//
// Arguments:
// msg_level = (in) The "message level" for  CCTK_VWarn() .
// format = (in) vprintf(3S) format string for error message to be printed.
// args... = (in) Any additional arguments are (presumably) used in formatting
//		  the error message string.
//
namespace jtutil
	  {
extern "C"
/*VARARGS*/
int error_exit(int msg_level, const char *format, ...)
{
const int N_buffer = 2000;
char buffer[N_buffer];

va_list ap;
va_start(ap, format);
// FIXME: We should really do something if msg was truncated due to
//        overflowing the buffer.  But what to do?
vsnprintf(buffer, N_buffer, format, ap);
va_end(ap);

// delete trailing '\n' if present, since CCTK_VWarn() doesn't like this
const int len = strlen(buffer);
if ((len > 0) && (buffer[len-1] == '\n'))
   then buffer[len-1] = '\0';

#ifdef STANDALONE_TEST
  fprintf(stderr, "%s\n", buffer);
  if (msg_level == PANIC_EXIT)
     then abort();
     else exit(msg_level);
#else
  CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING, "%s", buffer);
#endif

// if we got here, evidently  msg_level  wasn't drastic enough
abort();							/*NOTREACHED*/
}
	  }	// namespace jtutil::

```

jtutil/norm.cc:
```
// norm.cc -- compute norms
// $Header$

//
// jtutil::norm::data
// jtutil::norm::mean
// jtutil::norm::two_norm
// jtutil::norm::rms_norm
//
// ***** template instantiations *****
//

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

#include "util.hh"

//*****************************************************************************
//*****************************************************************************
//*****************************************************************************

//
// This function constructs a  norm  object.
//
namespace jtutil
	  {
template <typename fp_t>
  norm<fp_t>::norm()
	: N_(0L),
	  sum_(0.0), sum2_(0.0),
	  max_abs_value_(0.0), min_abs_value_(0.0),
	  max_value_(0.0), min_value_(0.0)
{ }
	  }

//*****************************************************************************

//
// This function resets a  norm  object to its initial state
//
namespace jtutil
	  {
template <typename fp_t>
  void norm<fp_t>::reset()
{
N_ = 0L;
sum_ = 0.0;
sum2_ = 0.0;
max_abs_value_ = 0.0;
min_abs_value_ = 0.0;
max_value_ = 0.0;
min_value_ = 0.0;
}
	  }

//*****************************************************************************

//
// This function updates the norms with a new data point  x .
//
namespace jtutil
	  {
template <typename fp_t>
  void norm<fp_t>::data(fp_t x)
{
sum_  += x;
sum2_ += x*x;

const fp_t abs_x = jtutil::abs<fp_t>(x);
max_abs_value_ = jtutil::max(max_abs_value_, abs_x);
min_abs_value_ = (N_ == 0) ? abs_x : jtutil::min(min_abs_value_, abs_x);

min_value_ = (N_ == 0) ? x : jtutil::min(min_value_, x);
max_value_ = (N_ == 0) ? x : jtutil::max(max_value_, x);

++N_;
}
	  }	// namespace jtutil::

//******************************************************************************

//
// these functions compute the corresponding norms
//
namespace jtutil
	  {
template<typename fp_t>
  fp_t norm<fp_t>::mean() const { return sum_/fp_t(N_); }
template<typename fp_t>
  fp_t norm<fp_t>::std_dev() const
        {
        if (is_empty()) return fp_t(0);
        return sqrt(jtutil::max(fp_t(0),fp_t(N_)*sum2_-sum_*sum_))/fp_t(N_);
        }
template<typename fp_t>
  fp_t norm<fp_t>::two_norm() const { return sqrt(sum2_); }
template<typename fp_t>
  fp_t norm<fp_t>::rms_norm() const
	{ assert(is_nonempty()); return sqrt(sum2_/fp_t(N_)); }
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations *****
//

template class jtutil::norm<float>;
template class jtutil::norm<double>;

```

jtutil/Makefile.standalone:
```
# Makefile for standalone test drivers in this directory
# $Header$
#
#	CC, CXX = C and C++ compilers.  Defaults are gcc and g++ if
#		  variables aren't set from command line or environment.
#	CC_FLAGS, CXX_FLAGS = C++ compiler flags.  Defaults are
#				$(STD_GCC_FLAGS) -I.. -g
#			      and
#				$(STD_GXX_FLAGS) -I.. -g
#			      if variables aren't set from command line or
#			      environment.
#
# Targets:
# test		==> build test programs
# clean		==> delete object files, test drivers
#
# Bugs:
# - Dependencies on *.hh are omitted.
#

CXX      := g++
CFLAGS   := $(STD_GCC_FLAGS) -I../include -DSTANDALONE_TEST -g
CXXFLAGS := $(STD_GXX_FLAGS) -I../include -DSTANDALONE_TEST -g

ALL_TESTS := test_array test_array2 \
             test_cpm_map test_linear_map \
             test_fuzzy test_round \
             test_modulo test_norm \
             test_error_exit

################################################################################

test	: $(ALL_TESTS)

test_array	: test_array.o array.o \
                  fuzzy.o round.o -lm
	$(CXX) $(CXXFLAGS) -o $@ $?
test_array2	: test_array2.o array.o
	$(CXX) $(CXXFLAGS) -o $@ $?
test_cpm_map	: test_cpm_map.o cpm_map.o \
                  fuzzy.o round.o error_exit.o -lm
	$(CXX) $(CXXFLAGS) -o $@ $?
test_linear_map	: test_linear_map.o linear_map.o \
                  fuzzy.o round.o error_exit.o -lm
	$(CXX) $(CXXFLAGS) -o $@ $?
test_fuzzy	: test_fuzzy.o fuzzy.o \
                  round.o error_exit.o
	$(CXX) $(CXXFLAGS) -o $@ $?
test_round	: test_round.o round.o
	$(CXX) $(CXXFLAGS) -o $@ $?
test_modulo	: test_modulo.o miscfp.o \
                  fuzzy.o round.o error_exit.o -lm
	$(CXX) $(CXXFLAGS) -o $@ $?
test_norm	: test_norm.o norm.o \
                  fuzzy.o round.o -lm
	$(CXX) $(CXXFLAGS) -o $@ $?
test_error_exit	: test_error_exit.o error_exit.o
	$(CXX) $(CXXFLAGS) -o $@ $?

.PHONY	: clean
clean	:
	-rm -f *.o
	-rm -f $(ALL_TESTS)

```

jtutil/make.code.defn:
```
# Cactus specification of things to be compiled in this directory
# $Header$

# Source files in this directory
SRCS = array.cc cpm_map.cc fuzzy.cc linear_map.cc norm.cc round.cc \
       miscfp.cc error_exit.cc

# Subdirectories containing source files
SUBDIRS = 

```

jtutil/linear_map.hh:
```
// linear_map.hh -- linear mapping from integers <--> floating point values
// $Header$
//
// jtutil::linear_map - linear mapping from integers <--> floating point values
//

#ifndef AHFINDERDIRECT__LINEAR_MAP_HH
#define AHFINDERDIRECT__LINEAR_MAP_HH

//
// prerequisites
//    <assert.h>
//    "stdc.h"
//    "util.hh"		// for jtutil::how_many_in_range() and fuzzy::
//

//
// The template defined in this file represents a linear mapping between
// a contiguous range of integers, and an arithmetic progression of
// floating point values, parameterized by the floating point data type.
//

#ifndef NDEBUG
//
// Full bounds checking is done on the mapping in both directions
//
#endif

//*****************************************************************************

namespace jtutil
	  {
template <typename fp_t>
class	linear_map
	{
public:
	// integer bounds info
	int min_int() const { return min_int_; }
	int max_int() const { return max_int_; }
	int N_points() const
		{ return jtutil::how_many_in_range(min_int_,max_int_); }
	bool is_in_range(int i) const
		{ return (i >= min_int()) && (i <= max_int()); }
	int clamp(int i) const
		{
		if	(i < min_int())
		   then return min_int();
		else if (i > max_int())
		   then return max_int();
		else	return i;
		}

	// convert int --> fp
	fp_t fp_of_int_unchecked(int i) const
		{ return origin_ + delta_*i; }
	fp_t fp_of_int(int i) const
		{
		assert(is_in_range(i));
		return fp_of_int_unchecked(i);
		}

	// converg delta_int --> delta_fp
	fp_t delta_fp_of_delta_int(int delta_i) const
		{ return delta_ * delta_i; }

	// fp bounds info
	fp_t origin() const { return origin_; }
	fp_t delta_fp() const { return delta_; }
	fp_t inverse_delta_fp() const { return inverse_delta_; }
	fp_t min_fp() const { return fp_of_int_unchecked(min_int_); }
	fp_t max_fp() const { return fp_of_int_unchecked(max_int_); }
	bool is_in_range(fp_t x) const
		{
		return    fuzzy<fp_t>::GE(x,min_fp())
		       && fuzzy<fp_t>::LE(x,max_fp());
		}
	fp_t clamp(fp_t x) const
		{
		if	(x < min_fp())
		   then return min_fp();
		else if (x > max_fp())
		   then return max_fp();
		else	return x;
		}

	// convert linear map indices <--> C-style 0-origin indices
	int zero_origin_int(int i) const { return i - min_int(); }
	int map_int(int zero_origin_i) { return zero_origin_i + min_int(); }

	// convert fp --> int coordinate, but return result as fp
	// (which need not be fuzzily integral)
	fp_t fp_int_of_fp(fp_t x) const;

	// convert fp --> int, check being fuzzily integral
	enum	noninteger_action	// what to do if "int"
					// isn't fuzzily integral?
		{
		nia_error,		// jtutil::error_exit(...)
		nia_warning,		// print warning msg,
					// then round to nearest
		nia_round,		// (silently) round to nearest
		nia_floor,		// (silently) round to -infinity
		nia_ceiling		// (silently) round to +infinity
		};
	int int_of_fp(fp_t x, noninteger_action nia = nia_error) const;

	// convert delta_fp --> delta_int, check being fuzzily integral
	int delta_int_of_delta_fp(fp_t delta_x,
				  noninteger_action nia = nia_error)
		const;

	// constructors
	linear_map(int min_int_in, int max_int_in,
		   fp_t min_fp_in, fp_t delta_fp_in, fp_t max_fp_in);
	// ... construct with subrange of existing linear_map
	linear_map(const linear_map<fp_t> &lm_in,
		   int min_int_in, int max_int_in);

	// no need for explicit destructor, compiler-generated no-op is ok

	// no need for copy constructor or assignment operator,
	// compiler-generated defaults are ok

private:
	// common code (argument validation & setup) for all constructors
	// assumes min_int_, max_int_, delta_ already initialized,
	//         other class members *not* initialized
	void constructor_common(fp_t min_fp_in, fp_t max_fp_in);

	// these define the actual mapping
	// via the  fp_of_int()  function (above)
	fp_t origin_, delta_;

	// cache of 1.0/delta_
	// ==> avoids fp divide in inverse_delta_fp()
	// ==> also makes fp --> int conversions slightly faster
	fp_t inverse_delta_;

	// bounds (inclusive)
	const int min_int_, max_int_;
	};
	  }	// namespace jtutil::

//******************************************************************************

#endif	/* AHFINDERDIRECT__LINEAR_MAP_HH */

```

jtutil/test_norm.cc:
```
// test_norm -- quick-n-dirty test of norm template class
// $Header$

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

#include "stdc.h"
#include "util.hh"
using jtutil::norm;
using jtutil::fuzzy;

int main()
{
norm<double> foo;
assert(  foo.is_empty()   );
assert(! foo.is_nonempty());
foo.data(3.0);
assert(! foo.is_empty()   );
assert(  foo.is_nonempty());
foo.data(-3.0);
foo.data(3.0);
foo.data(-3.0);
foo.data(-3.0);
assert( fuzzy<double>::EQ(foo.two_norm(), sqrt(45.0)) );
assert( fuzzy<double>::EQ(foo.rms_norm(), 3.0) );
assert( fuzzy<double>::EQ(foo.infinity_norm(), 3.0) );
assert( fuzzy<double>::EQ(foo.max_abs_value(), 3.0) );
assert( fuzzy<double>::EQ(foo.min_abs_value(), 3.0) );
assert( fuzzy<double>::EQ(foo.min_value(), -3.0) );
assert( fuzzy<double>::EQ(foo.max_value(), +3.0) );

foo.reset();
assert(  foo.is_empty() );
assert(! foo.is_nonempty());

foo.data(-3.0);
assert(! foo.is_empty() );
assert(  foo.is_nonempty());
foo.data(1.0);
foo.data(-4.0);
foo.data(1.0);
foo.data(-5.0);
assert( fuzzy<double>::EQ(foo.two_norm(), sqrt(52.0)) );
assert( fuzzy<double>::EQ(foo.rms_norm(), sqrt(10.4)) );
assert( fuzzy<double>::EQ(foo.infinity_norm(), 5.0) );
assert( fuzzy<double>::EQ(foo.max_abs_value(), 5.0) );
assert( fuzzy<double>::EQ(foo.min_abs_value(), 1.0) );
assert( fuzzy<double>::EQ(foo.min_value(), -5.0) );
assert( fuzzy<double>::EQ(foo.max_value(), +1.0) );

printf("everything ok!\n");
return 0;
}

```

jtutil/fuzzy.cc:
```
// fuzzy.cc -- template for fuzzy comparisons et al on floating point values
// $Header$
//
// jtutil::fuzzy::tolerance - comparison tolerance
// jtutil::fuzzy::EQ
// jtutil::fuzzy::is_integer
// jtutil::fuzzy::floor
// jtutil::fuzzy::ceiling
//
// ***** template instantiations and specializations *****
//

#include <stdlib.h>

#include "stdc.h"
#include "util.hh"

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
bool fuzzy<fp_t>::EQ(fp_t x, fp_t y)
{
fp_t max_abs = jtutil::max(jtutil::abs(x), jtutil::abs(y));
fp_t epsilon = jtutil::max(tolerance_, tolerance_*max_abs);

return jtutil::abs(x-y) <= epsilon;
}
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
bool fuzzy<fp_t>::is_integer(fp_t x)
{
int i = round<fp_t>::to_integer(x);
return EQ(x, fp_t(i));
}
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
int fuzzy<fp_t>::floor(fp_t x)
{
return fuzzy<fp_t>::is_integer(x)
       ? round<fp_t>::to_integer(x)
       : round<fp_t>::floor(x);
}
	  }	// namespace jtutil::

//******************************************************************************

namespace jtutil
	  {
template <typename fp_t>
int fuzzy<fp_t>::ceiling(fp_t x)
{
return fuzzy<fp_t>::is_integer(x)
       ? round<fp_t>::to_integer(x)
       : round<fp_t>::ceiling(x);
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiations and specializations *****
//

//
// Thanks to Thomas Mang <a9804814@unet.univie.ac.at> for helping
// me figure out the correct syntax here!
//

namespace jtutil
	  {
// initializations of fuzzy::tolerance for each instantation we're going to make
template <>
  float fuzzy<float>::tolerance_ = 1.0e-5;	// about 100 * FLT_EPSILON

template <>
  double fuzzy<double>::tolerance_ = 1.0e-12;	// about 1e4 * DBL_EPSILON

// template instantiations
template class fuzzy<float>;
template class fuzzy<double>;
	  }	// namespace jtutil::

```

jtutil/test_round.cc:
```
// test_round.cc -- test driver for round<float> and round<double>
// $Header$

#include <stdio.h>
#include <assert.h>

#include "stdc.h"
#include "util.hh"
using jtutil::round;

//
// Usage:
//	test_round x
//
int main(int argc, const char* const argv[])
{
	for (int i = -10 ; i <= +10 ; ++i)
	{
	printf("testing %d +/- various things...\n", i);

	float f = float(i);
	double d = double(i);


	//
	// round<fp_t>::to_integer()
	//

	assert( round<double>::to_integer(d - 0.49) == i );
	assert( round<double>::to_integer(d - 0.01) == i );
	assert( round<double>::to_integer(d - 1e-4) == i );
	assert( round<double>::to_integer(d - 1e-10) == i );
	assert( round<double>::to_integer(d        ) == i );
	assert( round<double>::to_integer(d + 1e-10) == i );
	assert( round<double>::to_integer(d + 1e-4) == i );
	assert( round<double>::to_integer(d + 0.01) == i );
	assert( round<double>::to_integer(d + 0.49) == i );

	assert( round<float>::to_integer(f - 0.49) == i );
	assert( round<float>::to_integer(f - 0.01) == i );
	assert( round<float>::to_integer(f - 1e-4) == i );
	assert( round<float>::to_integer(f - 1e-10) == i );
	assert( round<float>::to_integer(f        ) == i );
	assert( round<float>::to_integer(f + 1e-10) == i );
	assert( round<float>::to_integer(f + 1e-4) == i );
	assert( round<float>::to_integer(f + 0.01) == i );
	assert( round<float>::to_integer(f + 0.49) == i );


	//
	// round<fp_t>::floor()
	//

	assert( round<double>::floor(d - 0.49) == i-1 );
	assert( round<double>::floor(d - 0.01) == i-1);
	assert( round<double>::floor(d - 1e-4) == i-1 );
	assert( round<double>::floor(d - 1e-10) == i-1 );
	assert( round<double>::floor(d        ) == i );
	assert( round<double>::floor(d + 1e-10) == i );
	assert( round<double>::floor(d + 1e-4) == i );
	assert( round<double>::floor(d + 0.01) == i );
	assert( round<double>::floor(d + 0.49) == i );

	assert( round<float>::floor(f - 0.49) == i-1 );
	assert( round<float>::floor(f - 0.01) == i-1 );
	assert( round<float>::floor(f - 1e-4) == i-1 );
	assert( round<float>::floor(f - 1e-10) == ((i == 0) ? i-1 : i) );
					// i != 0 ==> not enough precision
					//            to see as noninteger
	assert( round<float>::floor(f        ) == i );
	assert( round<float>::floor(f + 1e-10) == i );
	assert( round<float>::floor(f + 1e-4) == i );
	assert( round<float>::floor(f + 0.01) == i );
	assert( round<float>::floor(f + 0.49) == i );


	//
	// round<fp_t>::ceiling()
	//

	assert( round<double>::ceiling(d - 0.49) == i );
	assert( round<double>::ceiling(d - 0.01) == i);
	assert( round<double>::ceiling(d - 1e-4) == i );
	assert( round<double>::ceiling(d - 1e-10) == i );
	assert( round<double>::ceiling(d        ) == i );
	assert( round<double>::ceiling(d + 1e-10) == i+1 );
	assert( round<double>::ceiling(d + 1e-4) == i+1 );
	assert( round<double>::ceiling(d + 0.01) == i+1 );
	assert( round<double>::ceiling(d + 0.49) == i+1 );

	assert( round<float>::ceiling(f - 0.49) == i );
	assert( round<float>::ceiling(f - 0.01) == i);
	assert( round<float>::ceiling(f - 1e-4) == i );
	assert( round<float>::ceiling(f - 1e-10) == i );
	assert( round<float>::ceiling(f        ) == i );
	assert( round<float>::ceiling(f + 1e-10) == ((i == 0) ? i+1 : i) );
					// i != 0 ==> not enough precision
					//            to see as noninteger
	assert( round<float>::ceiling(f + 1e-4) == i+1 );
	assert( round<float>::ceiling(f + 0.01) == i+1 );
	assert( round<float>::ceiling(f + 0.49) == i+1 );
	}

printf("everything looks ok!\n");
return 0;
}

```

jtutil/test_modulo.cc:
```
// test_modulo -- quick-n-dirty test of modulo_reduce()
// $Header$

#include <stdio.h>
#include <assert.h>

#include "stdc.h"
#include "util.hh"
using jtutil::error_exit;
using jtutil::fuzzy;

// prototypes
void tryit(double x, double xmod, double xmin, double xmax, double correct);

//******************************************************************************

int main()
{
//        x    xmod    xmin   xmax  correct
tryit(   0.5,   1.0,   0.0,   1.0,   0.5);
tryit(   0.0,   1.0,   0.0,   1.0,   0.0);
tryit(   1.0,   1.0,   0.0,   1.0,   1.0);
tryit(   2.0,   1.0,   0.0,   1.0,   1.0);
tryit(   1.5,   1.0,   0.0,   1.0,   0.5);
tryit(  -0.6,   1.0,   0.0,   1.0,   0.4);
tryit(  -3.6,   1.0,   0.0,   1.0,   0.4);

tryit(-145.0, 360.0, 180.0, 270.0, 215.0);

printf("all ok!\n");
}

//******************************************************************************

void tryit(double x, double xmod, double xmin, double xmax, double correct)
{
printf("trying %g mod %g [%g,%g] ==> ",
       x, xmod, xmin, xmax);

double got = jtutil::modulo_reduce(x, xmod, xmin, xmax);

if (fuzzy<double>::EQ(got, correct))
   then printf("ok\n");
   else {
	error_exit(ERROR_EXIT,
		   "no: got %g, correct %g\n", got, correct);	/*NOTREACHED*/
	}
}

```

jtutil/linear_map.cc:
```
// linear_map.cc -- linear mapping from integers <--> floating point values
// $Header$
//
// jtutil::linear_map::linear_map - basic ctor
// jtutil::linear_map::linear_map - ctor for subrange of existing linear_map
// jtutil::linear_map::fp_int_of_fp - convert fp --> int coord, return as fp
// jtutil::linear_map::int_of_fp - convert fp --> int, check for ==fuzzy int
// jtutil::linear_map::delta_int_of_delta_fp - ... same for spacings
//
// ***** template instantiation *****
//

#include <assert.h>
#include <stdio.h>

#include "stdc.h"
#include "util.hh"
#include "linear_map.hh"
using jtutil::error_exit;

//******************************************************************************
//******************************************************************************
// linear_map -- linear mapping from integers <--> floating point values
//******************************************************************************
//******************************************************************************

//
// This function constructs a  linear_map<fp_t>  object.
//
namespace jtutil
	  {
template <typename fp_t>
linear_map<fp_t>::linear_map(int min_int_in, int max_int_in,
			     fp_t min_fp_in, fp_t delta_fp_in, fp_t max_fp_in)
	: delta_(delta_fp_in), inverse_delta_(1.0 / delta_fp_in),
	  min_int_(min_int_in), max_int_(max_int_in)
{
constructor_common(min_fp_in, max_fp_in);
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function constructs a  linear_map<fp_t>  object with a subrange
// of an existing one.
//
namespace jtutil
	  {
template <typename fp_t>
linear_map<fp_t>::linear_map(const linear_map<fp_t> &lm_in,
			     int min_int_in, int max_int_in)	// subrange
	: delta_(lm_in.delta_fp()), inverse_delta_(lm_in.inverse_delta_fp()),
	  min_int_(min_int_in), max_int_(max_int_in)
{
if (! (is_in_range(min_int_in) && is_in_range(max_int_in)) )
   then error_exit(ERROR_EXIT,
"***** linear_map<fp_t>::linear_map:\n"
"        min_int_in=%d and/or max_int_in=%d\n"
"        aren't in integer range [%d,%d] of existing linear_map!\n"
,
		   min_int_, max_int_,
		   lm_in.min_int(), lm_in.max_int());		/*NOTREACHED*/

constructor_common(lm_in.fp_of_int_unchecked(min_int_in),
		   lm_in.fp_of_int_unchecked(max_int_in));
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function does the common argument validation and setup for
// all the constructors of class  linear_map<fp_t>:: .
//
namespace jtutil
	  {
template <typename fp_t>
void linear_map<fp_t>::constructor_common(fp_t min_fp_in, fp_t max_fp_in)
	// assumes
	//	min_int_, max_int_, delta_, inverse_delta_
	// are already initialized
	// ==> ok to use min_int(), max_int(), delta_fp(), inverse_delta_fp()
	// ... other class members *not* yet initialized
{
origin_ = 0.0;		// temp value
origin_ = min_fp_in - fp_of_int_unchecked(min_int());

// this should be guaranteed by the above calculation
assert( fuzzy<fp_t>::EQ(fp_of_int_unchecked(min_int()), min_fp_in) );

// this is a test of the consistency of the input arguments
if (fuzzy<fp_t>::NE(fp_of_int_unchecked(max_int()), max_fp_in))
   then error_exit(ERROR_EXIT,
"***** linear_map<fp_t>::linear_map:\n"
"        int range [%d,%d]\n"
"        and fp range [%g(%g)%g]\n"
"        are (fuzzily) inconsistent!\n"
,
		   min_int(), max_int(),
		   double(min_fp_in), double(delta_fp()), double(max_fp_in));
								/*NOTREACHED*/
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function converts  fp  --> int  coordinate, returning the result
// as an fp (which need not be fuzzily integral).
//
namespace jtutil
	  {
template <typename fp_t>
fp_t linear_map<fp_t>::fp_int_of_fp(fp_t x)
	const
{
if (! is_in_range(x))
   then error_exit(ERROR_EXIT,
"***** linear_map<fp_t>::fp_int_of_fp:\n"
"        fp value x=%g is (fuzzily) outside the grid!\n"
"        {min(delta)max}_fp = %g(%g)%g\n"
,
		   double(x),
		   double(min_fp()), double(delta_fp()), double(max_fp()));
								/*NOTREACHED*/

return inverse_delta_ * (x - origin_);
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function converts  fp  --> int  and checks that the result is
// fuzzily integral.  (The  nia  argument specifies what to do if the
// result *isn't* fuzzily integral.)
//
// FIXME:
// Having to explicitly specify the namespace for jtutil::round<fp_t>::
// is ++ugly. :(
//
namespace jtutil
	  {
template <typename fp_t>
int linear_map<fp_t>::int_of_fp(fp_t x, noninteger_action nia /* = nia_error */)
	const
{
const fp_t fp_int = fp_int_of_fp(x);

if (fuzzy<fp_t>::is_integer(fp_int))
   then {
	// x is (fuzzily) a grid point ==> return that
	return jtutil::round<fp_t>::to_integer(fp_int);	// *** EARLY RETURN ***
	}

// get to here ==> x isn't (fuzzily) a grid point
static const char *const noninteger_msg =
   "%s linear_map<fp_t>::int_of_fp:\n"
   "        x=%g isn't (fuzzily) a grid point!\n"
   "        {min(delta)max}_fp() = %g(%g)%g\n"
   ;
switch	(nia)
	{
case nia_error:
	error_exit(ERROR_EXIT,
		   noninteger_msg,
		   "*****",
		   double(x),
		   double(min_fp()), double(delta_fp()), double(max_fp()));
								/*NOTREACHED*/

case nia_warning:
	printf(noninteger_msg,
	       "---",
	       double(x),
	       double(min_fp()), double(delta_fp()), double(max_fp()));
	// fall through

case nia_round:
	return jtutil::round<fp_t>::to_integer(fp_int);	// *** EARLY RETURN ***

case nia_floor:
	return jtutil::round<fp_t>::floor(fp_int);	// *** EARLY RETURN ***

case nia_ceiling:
	return jtutil::round<fp_t>::ceiling(fp_int);	// *** EARLY RETURN ***

default:
	error_exit(PANIC_EXIT,
"***** linear_map<fp_t>::int_of_fp: illegal nia=(int)%d\n"
"                                   (this should never happen!)\n"
,
		   int(nia));					/*NOTREACHED*/
	}
return 0;	// dummy return to quiet gcc
		// (which doesn't grok that error_exit() never returns)
}
	  }	// namespace jtutil::

//******************************************************************************

//
// This function converts "delta" spacings in the fp coordinate to
// corresponding "delta" spacings in the int coordinate, and checks that
// the result is fuzzily integral.  (The  nia  argument specifies what to
// do if the result *isn't* fuzzily integral.)
//
// FIXME:
// Having to explicitly specify the namespace for jtutil::round<fp_t>::
// is ++ugly. :(
//
namespace jtutil
	  {
template <typename fp_t>
int linear_map<fp_t>::delta_int_of_delta_fp
	(fp_t delta_x, noninteger_action nia /* = nia_error */)
	const
{
const fp_t fp_delta_int = inverse_delta_ * delta_x;

if (fuzzy<fp_t>::is_integer(fp_delta_int))
   then {
	// delta_x is (fuzzily) an integer number of grid spacings
	// ==> return that
	return jtutil::round<fp_t>::to_integer(fp_delta_int);
							// *** EARLY RETURN ***
	}

// get to here ==> delta_x isn't (fuzzily) an integer number of grid spacings
static const char *const noninteger_msg =
   "%s linear_map<fp_t>::delta_int_of_delta_fp:\n"
   "        delta_x=%g isn't (fuzzily) an integer number of grid spacings!\n"
   "        {min(delta)max}_fp() = %g(%g)%g\n"
   ;
switch	(nia)
	{
case nia_error:
	error_exit(ERROR_EXIT,
		   noninteger_msg,
		   "*****",
		   double(delta_x),
		   double(min_fp()), double(delta_fp()), double(max_fp()));
								/*NOTREACHED*/

case nia_warning:
	printf(noninteger_msg,
	       "---",
	       double(delta_x),
	       double(min_fp()), double(delta_fp()), double(max_fp()));
	// fall through

case nia_round:
	return jtutil::round<fp_t>::to_integer(fp_delta_int);
							// *** EARLY RETURN ***

case nia_floor:
	return jtutil::round<fp_t>::floor(fp_delta_int);// *** EARLY RETURN ***

case nia_ceiling:
	return jtutil::round<fp_t>::ceiling(fp_delta_int);
							// *** EARLY RETURN ***

default:
	error_exit(PANIC_EXIT,
"***** linear_map<fp_t>::delta_int_of_delta_fp: illegal nia=(int)%d\n"
"                                               (this should never happen!)\n"
,
		   int(nia));					/*NOTREACHED*/
	}
return 0;	// dummy return to quiet gcc
		// (which doesn't grok that error_exit() never returns)
}
	  }	// namespace jtutil::

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** template instantiation *****
//

template class jtutil::linear_map<float>;
template class jtutil::linear_map<double>;

```

jtutil/util.hh:
```
// util.hh -- utility stuff for this thorn (all lives in namespace jtutil::)
// $Header$

#ifndef AHFINDERDIRECT__UTIL_HH
#define AHFINDERDIRECT__UTIL_HH

//
// prerequisites:
//	"stdc.h"
//

namespace jtutil
	  {

//******************************************************************************

// how many integers are in the closed interval [low,high]
inline int how_many_in_range(int low, int high) { return high - low + 1; }

// is an integer even/odd
inline int is_even(int i) { return !(i & 0x1); }
inline int is_odd (int i) { return  (i & 0x1); }

//
// min/max/absolute value template
// FIXME: <algorithm> is supposed to have min/max, but these are
//	  broken on too many platforms (eg older gcc versions)
//
template <typename T>
  inline T min(T x, T y) { return (x < y) ? x : y; }
template <typename T>
  inline T max(T x, T y) { return (x > y) ? x : y; }
template <typename T>
  inline T abs(T x) { return (x > 0) ? x : -x; }

//
// These functions raise their arguments to various small-integer powers.
//
template <typename T>
  inline T pow2(T x) { return x*x; }
template <typename T>
  inline T pow3(T x) { return x*x*x; }
template <typename T>
  inline T pow4(T x) { return pow2(pow2(x)); }
#ifdef NOT_USED
template <typename T>
  inline T pow5(T x) { return x * pow4(x); }
template <typename T>
  inline T pow6(T x) { return pow3(pow2(x)); }
template <typename T>
  inline T pow7(T x) { return x * pow6(x); }
template <typename T>
  inline T pow8(T x) { return pow2(pow2(pow2(x))); }
#endif

//
// misc math stuff
//
double signum(double x);
double hypot3(double x, double y, double z);
double arctan_xy(double x, double y);

// reduce x modulo xmod to be in the interval [xmin,xmax],
// or error_exit() if no such value exists
double modulo_reduce(double x, double xmod, double xmin, double xmax);

// initialize C-style array to all zeros
template <typename fp_t>
  void zero_C_array(int N, fp_t array[]);

//
// more misc math stuff, valid only if <math.h> has been #included;
//
#ifdef M_PI	/* test for <math.h> */
		/* n.b. C-style comment needed for some preprocessors! */
  // floor/ceiling of double, returned as an int
  inline int ifloor(double x) { return static_cast<int>(floor(x)); }
  inline int iceil (double x) { return static_cast<int>(ceil (x)); }
#endif

#ifdef PI	/* PI is defined in "../include/stdc.h" */
		/* n.b. C-style comment needed for some preprocessors! */
  // convert degrees <--> radians
  template <typename fp_t>
    inline fp_t degrees_of_radians(fp_t radians) { return (180.0/PI)*radians; }
  template <typename fp_t>
    inline fp_t radians_of_degrees(fp_t degrees) { return (PI/180.0)*degrees; }
#endif

//******************************************************************************

//
// This template class computes means, 2-norms, rms-norms, infinity-norms,
// and various related values.
//
template <typename fp_t>
class	norm
	{
public:
	// get norms etc
	fp_t mean() const;
	fp_t std_dev() const;         // sqrt(sum (x_i - average of x_i)^2 / N)
	fp_t two_norm() const;		// sqrt(sum x_i^2)
	fp_t rms_norm() const;		// sqrt(average of x_i^2)
	fp_t infinity_norm() const { return max_abs_value_; }

	fp_t max_abs_value() const { return max_abs_value_; }
	fp_t min_abs_value() const { return min_abs_value_; }

	fp_t max_value() const { return max_value_; }
	fp_t min_value() const { return min_value_; }

	// specify data point
	void data(fp_t x);

	// have any data points been specified?
	bool is_empty()    const { return N_ == 0; }
	bool is_nonempty() const { return N_ > 0; }

	// reset ==> just like newly-constructed object
	void reset();

	// constructor, destructor
	// ... compiler-generated no-op destructor is ok
	norm();

private:
        // we forbid copying and passing by value
        // by declaring the copy constructor and assignment operator
        // private, but never defining them
        norm(const norm &rhs);
	norm& operator=(const norm &rhs);

private:
	long N_;		// # of data points
	fp_t sum_;		// sum(data)
	fp_t sum2_;		// sum(data^2)
	fp_t max_abs_value_;	// max |data|
	fp_t min_abs_value_;	// min |data|
	fp_t max_value_;	// max data
	fp_t min_value_;	// min data
	};

//******************************************************************************

//
// This template does fuzzy comparisons and related operations on
// floating point values, parameterized by the floating point type.
//
// The fuzzy comparison semantics are based on those of APL, but are
// modified to use an absolute error tolerance for values close to 0.
//

// this template class has only static members
// ... it's a class, not a namespace, because we want to express the
//     semantics that the entire class is a single template, rather
//     than the individual members being conceptually-unrelated templates
// ... moreover, we need the *data* member (template)  tolerance , and
//     it seems C++ doesn't grok data templates which aren't in a class
template <typename fp_t>
class	fuzzy
	{
public:
	// comparison tolerance (may be modified by user code if needed)
	static fp_t get_tolerance() { return tolerance_; }
	static void set_tolerance(fp_t new_tolerance)
		{ tolerance_ = new_tolerance; }

	// fuzzy commparisons
	static bool EQ(fp_t x, fp_t y);
	static bool NE(fp_t x, fp_t y) { return ! EQ(x,y); }
	static bool LT(fp_t x, fp_t y) { return EQ(x,y) ? false : (x < y); }
	static bool LE(fp_t x, fp_t y) { return EQ(x,y) ? true  : (x < y); }
	static bool GT(fp_t x, fp_t y) { return EQ(x,y) ? false : (x > y); }
	static bool GE(fp_t x, fp_t y) { return EQ(x,y) ? true  : (x > y); }

	static bool is_integer(fp_t x);	// is x fuzzily an integer?
	static int floor(fp_t x);	// round x fuzzily down to integer
	static int ceiling(fp_t x);	// round x fuzzily up to integer

private:
	// comparison tolerance
	// ... must be explicitly initialized when instantiating
	//     for a new <fp_t> type, see "fuzzy.cc" for details/examples
	static fp_t tolerance_;
	};

//******************************************************************************

//
// This template does machine-independent rounding of floating point
// values, parameterized by the floating point type.
//

// this template class has only static members
// ... it's a class, not a namespace, because we want to express the
//     semantics that the entire class is a single template, rather
//     than the individual members being conceptually-unrelated templates
template <typename fp_t>
class	round
	{
public:
	static int to_integer(fp_t x);	// round to nearest integer

	static int floor(fp_t x);	// round down to integer
	static int ceiling(fp_t x);	// round up to integer
	};

//******************************************************************************

	  }	// namespace jtutil

#endif	/* AHFINDERDIRECT__UTIL_HH */

```

elliptic/row_sparse_Jacobian.hh:
```
// Jacobian.hh -- data structures for the Jacobian matrix
// $Header$
//
#ifdef HAVE_ROW_SPARSE_JACOBIAN
// row_sparse_Jacobian -- Jacobian stored as row-oriented sparse matrix
#endif
#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
// row_sparse_Jacobian__ILUCG -- ... with ILUCG linear solver
#endif
#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
// row_sparse_Jacobian__UMFPACK -- ... with UMFPACK linear solver
#endif
//

#ifndef AHFINDERDIRECT__ROW_SPARSE_JACOBIAN_HH
#define AHFINDERDIRECT__ROW_SPARSE_JACOBIAN_HH

//
// prerequisites:
//	"../patch/patch_system.hh"
//	"Jacobian.hh"
//

#undef  DEBUG_ROW_SPARSE_JACOBIAN	// define this for detailed
					// debugging of data structures
					// (quite slow, not for production use)
#ifdef DEBUG_ROW_SPARSE_JACOBIAN
  // define this to sanity-check the matrix data structures
  // at the start of each new row
  #define ROW_SPARSE_JACOBIAN__CHECK_AT_ROW_START

  // define this to sanity-check the matrix data structures
  // after each new element is inserted
  #undef  ROW_SPARSE_JACOBIAN__CHECK_AFTER_INSERT

  // define this to print a line or two of information
  // for each of the main data-structure operations,
  // e.g. zero the matrix, start a new row, insert a new matrix element, etc
  // ... note this produces a lot of output
  //     (tens of megabytes for a reasonable-sized angular grid)
  #define ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS

  // define this to print and sanity-check the matrix data structures
  // at the start of each new row; note this produces a *huge* amount of
  // output (many hundreds of megabytes for a reasonable-sized angular grid),
  // and is only suitable for tiny examples
  #undef  ROW_SPARSE_JACOBIAN__PRINT_AT_ROW_START

  // define this to print and sanity-check the matrix data structures
  // after each new element is inserted; note this produces even more
  // output than "just" printing at the start of each row!
  #undef  ROW_SPARSE_JACOBIAN__PRINT_AFTER_INSERT
#endif

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This class stores the Jacobian as a row-oriented sparse matrix.
// This sparse matrix format is widely used by sparse matrix libraries.
//
// There are two variants of the format, depending on whether the array
// indices are C-style 0-origin or Fortran-style 1-origin values.  Note
// that these variants actually store different values in memory -- the
// difference is *not* just an adjustment of the subscripting.  To handle
// both variants with common code, we store an integer "index origin" IO,
// which is 0 for C, 1 for Fortran.
//
// The matrix is represented by 3 arrays:
//	IA[N_rows+1] = IO-relative indices in JA and A of the start of
//		       each row's matrix elements;
//			IA(IO       ) = IO
//			IA(IO+N_rows) = IO + N_nonzeros
//	JA[N_nonzeros] = IO-relative column indices of the corresponding
//			 entries in A
//	A[N_nonzeros] = nonzero matrix elements, ordered by rows;
//			within a row the matrix elements may either be
//			in arbitrary order, or may be sorted in increasing
//			order of their column indices
// A[] may include explicitly stored zeros if necessary.
// IA[] and JA[] are arrays of  integer  (a C typedef which matches the
// Fortran "integer" datatype) so they can be passed by reference to/from
// Fortran code if necessary.
//
// For example, the matrix
//	[ 11.   12.   13.             ]
//	[ 21.   22.         24.   25. ]
//	[       32.         34.       ]
//	[                   44.   45. ]
//	[             53.         55. ]
// could be represented by the IO=0 arrays
//	IA[] = {  0,           3,               7,       9,      11,     13 }
//	JA[] = {  0,  1,  2,   0,  1,  3,  4,   1,  3,   3,  4,   2,  4 }
//	A [] = { 11.,12.,13., 21.,22.,24.,25., 32.,34., 44.,45., 53.,55.}
// or the IO=1 arrays
//	IA[] = {  1,           4,               8,      10,      12,     14 }
//	JA[] = {  1,  2,  3,   1,  2,  4,  5,   2,  4,   4,  5,   3,  5 }
//	A [] = { 11.,12.,13., 21.,22.,24.,25., 32.,34., 44.,45., 53.,55.}
// Notice that the A[] array is identical in both cases, but the IA[] and
// JA[] arrays vary.
//
class	row_sparse_Jacobian
	: public Jacobian
	{
public:
	//
	// index origin can be either C or Fortran
	//

	int IO() const { return IO_; }
	enum {C_index_origin = 0, Fortran_index_origin = 1};


	//
	// routines to access the matrix
	//

	// get a matrix element
	fp element(int II, int JJ) const;

	// is the matrix element (II,JJ) stored explicitly?
	bool is_explicitly_stored(int II, int JJ) const
		{ return find_element(II,JJ) > 0; }


	//
	// routines for setting values in the matrix
	// ... with the current implementation, clients *must* set up
	//     the matrix in row order.
	//

	// zero the entire matrix
	void zero_matrix();

	// set a matrix element to a specified value
	void set_element(int II, int JJ, fp value);

	// sum a value into a matrix element
	void sum_into_element(int II, int JJ, fp value);


	//
	// internal routines
	//
protected:
	// return 0-origin position of (II,JJ) in A_ and JA_,
	// or -1 if not found
	int find_element(int II, int JJ) const;

	// insert new array element (II,JJ) in matrix,
	// starting new row and/or growing arrays if necessary
	// return 0-origin position (1-origin) in A_ and JA_
	int insert_element(int II, int JJ, fp value);

	// grow arrays to make room for more elements
	// ... growth is geometric ==> amortized cost remains O(current size)
	void grow_arrays();		// this fn does the actual growing

	// parameter for growth policy
	// ... this should be > 0
	// ... for debugging it may be useful to set this to a fairly
	//     small value (even 1), to force some  grow_array()  calls
	//     when the arrays are still small enough for easy examination
	enum {base_growth_amount = 1000};	// grow by this much
						// plus half the current size

	// sort each row's JA_[] and A_[] array elements
	// so the columns (JA_[] values) are in increasing order
	// ... this doesn't change the abstract value of the matrix
	void sort_each_row_into_column_order();

#ifdef DEBUG_ROW_SPARSE_JACOBIAN
	// sanity-check and optionally print matrix data structure
	// (i.e. the IA_ and JA_ arrays)
	void check_and_print_data_structure(bool print_flag) const;
#endif


	//
	// constructor, destructor
	//
protected:
	// the constructor only uses ps to get the size of the matrix
	// ... print_msg_flag controls messages about data structure setup
	//     during construction and element-setting process
	row_sparse_Jacobian(patch_system& ps, int IO_in,
			    bool print_msg_flag = false);
	~row_sparse_Jacobian();


protected:
	int IO_;		// index origin (0=C, 1=Fortran)
#ifdef DEBUG_ROW_SPARSE_JACOBIAN
	const char*const IOstr_;// --> "c" or "f" as appropriate
#endif

	int N_nonzeros_;	// current number of nonzeros in matrix
				// = number of elements valid in JA_[], A_[]
	int current_N_rows_;	// current number of rows in matrix
				// i.e. current rows have 0-origin indices
				//      0 <= II < current_N_rows_

	int N_nonzeros_allocated_;	// allocated size of JA_[], A_[]

	// --> new[]-allocated arrays
	// ***** due to constructor initialization list ordering,
	// ***** these must be declared *AFTER* N_nonzeros_allocated_

	// this is allocated in the constructor
	integer* IA_;		// --> array of size N_rows_+1
				// valid for 0-origin indices
				//       0 <= II <= current_N_rows_

	// this is allocated in the constructor,
	// but may be reallocated by  grow_arrays()
	// ... using STL vector would be much cleaner here, but alas
	//     there are too many broken compilers/linkers in the world
	//     world which don't fully grok vector :( :(
	integer* JA_;		// --> array of size N_nonzeros_allocated_
				// valid for 0-origin indices
				//       0 <= posn < II[current_N_rows]
	fp* A_;			// ditto
	};
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
//
// This class defines the linear solver routine using ILUCG.
//
// This class stores the matrix with IO=1 (Fortran-style indices),
// and does not sort the elements in a row into increasing-column order.
//
class row_sparse_Jacobian__ILUCG
	: public row_sparse_Jacobian
	{
public:
	// solve linear system J.x = rhs via ILUCG
	// ... rhs and x are nominal-grid gridfns
	// ... overwrites Jacobian matrix with its LU decomposition
	// ... returns -1.0 to signal that condition number is unknown
	fp solve_linear_system(int rhs_gfn, int x_gfn,
			       const struct linear_solver_pars& pars,
			       bool print_msg_flag);

	// constructor, destructor
public:
	// the constructor only uses ps to get the size of the matrix
	row_sparse_Jacobian__ILUCG(patch_system& ps,
				   bool print_msg_flag = false);
	~row_sparse_Jacobian__ILUCG();

private:
	// work vectors for ILUCG subroutine
	// ... allocated by  solve_linear_system()  on first call
	integer* itemp_;
	fp*      rtemp_;
	};
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__ILUCG */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
//
// This class defines the linear solver routine using UMFPACK.
//
// This class stores the matrix with IO=0 (C-style indices),
// and sorts the elements in a row into increasing-column order.
//
// Notice that due to the pImpl-style design of the UMFPACK classes,
// and our using Fortran "integer" instead of UMFPACK "Int" for the
// integer arrays, "umfpack.h" is *not* a prerequisite for including
// this header file.
//
class row_sparse_Jacobian__UMFPACK
	: public row_sparse_Jacobian
	{
public:
	// solve linear system J.x = rhs via UMFPACK
	// ... rhs and x are nominal-grid gridfns
	// ... does symbolic factorization on first call,
	//     reuses this on all following calls
	// ... returns estimated reciprocal condition number
	//	       ... rcond = 0.0         ==> exactly singular
	//		   rcond < DBL_EPSILON ==> numerically singular
	//		   rcond = 1.0         ==> orthogonal matrix
	fp solve_linear_system(int rhs_gfn, int x_gfn,
			       const struct linear_solver_pars& pars,
			       bool print_msg_flag);

	// constructor, destructor
public:
	// the constructor only uses ps to get the size of the matrix
	row_sparse_Jacobian__UMFPACK(patch_system& ps,
				     bool print_msg_flag = false);
	~row_sparse_Jacobian__UMFPACK();

private:
	// pointers to UMFPACK control arrays
	double *Control_;
	double *Info_;

	// pointers to UMFPACK workspace arrays
	// ... allocated by  solve_linear_system()  on first call
	integer *solve_workspace_integer_;
	double  *solve_workspace_double_;

	// pointers to UMFPACK data objects
	// (UMFPACK takes these as  void*  and casts them internally)
	void* Symbolic_;
	void* Numeric_;

	// 
	};
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__UMFPACK */

//******************************************************************************

	  }	// namespace AHFinderDirect
#endif		/* AHFINDERDIRECT__ROW_SPARSE_JACOBIAN_HH */

```

elliptic/row_sparse_Jacobian.cc:
```
// row_sparse_Jacobian.cc -- data structures for row-sparse Jacobian matrices
// $Header$
//
// <<<literal contents of "ilucg.h">>>
// data structures local to this file
// prototypes for functions local to this file
//
#ifdef HAVE_ROW_SPARSE_JACOBIAN
// row_sparse_Jacobian::row_sparse_Jacobian
// row_sparse_Jacobian::~row_sparse_Jacobian
// row_sparse_Jacobian::element
// row_sparse_Jacobian::zero_matrix
// row_sparse_Jacobian::set_element
// row_sparse_Jacobian::sum_into_element
/// row_sparse_Jacobian::find_element
/// row_sparse_Jacobian::insert_element
/// row_sparse_Jacobian::grow_arrays
/// row_sparse_Jacobian::sort_each_row_into_column_order
/// compare_matrix_elements
#ifdef DEBUG_ROW_SPARSE_JACOBIAN
/// row_sparse_Jacobian::check_and_print_data_structure
#endif
#endif
//
#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
// row_sparse_Jacobian__ILUCG::row_sparse_Jacobian__ILUCG
// row_sparse_Jacobian__ILUCG::~row_sparse_Jacobian__ILUCG
// row_sparse_Jacobian__ILUCG::solve_linear_system
#endif
//
#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
// row_sparse_Jacobian__UMFPACK::row_sparse_Jacobian__UMFPACK
// row_sparse_Jacobian__UMFPACK::~row_sparse_Jacobian__UMFPACK
// row_sparse_Jacobian__UMFPACK::solve_linear_system
#endif
//

#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include <math.h>
#include <string.h>

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

#include "config.h"
#include "stdc.h"

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
//
// FIXME:
//   Cactus's CCTK_FCALL() isn't expanded in .h files (this is a bug),
//   so we include the contents of "../sparse-matrix/ilucg/ilucg.h"
//   inline below.  This is a doubleplusungood kludge! :( :(
//#include "../sparse-matrix/ilucg/ilucg.h"
//
#endif

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
extern "C"
       {
  #include "../sparse-matrix/umfpack/umfpack.h"

  #ifdef FORTRAN_INTEGER_IS_INT
    #define umfpack_defaults		umfpack_di_defaults
    #define umfpack_symbolic		umfpack_di_symbolic
    #define umfpack_numeric		umfpack_di_numeric
    #define umfpack_wsolve		umfpack_di_wsolve
    #define umfpack_free_numeric	umfpack_di_free_numeric
    #define umfpack_free_symbolic	umfpack_di_free_symbolic
  #endif

  #ifdef FORTRAN_INTEGER_IS_LONG
    #define umfpack_defaults		umfpack_dl_defaults
    #define umfpack_symbolic		umfpack_dl_symbolic
    #define umfpack_numeric		umfpack_dl_numeric
    #define umfpack_wsolve		umfpack_dl_wsolve
    #define umfpack_free_numeric	umfpack_dl_free_numeric
    #define umfpack_free_symbolic	umfpack_dl_free_symbolic
  #endif
       }
#endif

#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "Jacobian.hh"
#include "row_sparse_Jacobian.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// FIXME:
//   Cactus's CCTK_FCALL() isn't expanded in .h files (this is a bug),
//   so we include the contents of "../sparse-matrix/ilucg/ilucg.h"
//   inline here.  This is a doubleplusungood kludge! :( :(
//

//***** begin "ilucg.h" contents ******
/* ilucg.h -- C/C++ prototypes for [sd]ilucg() routines */
/* $Header$ */

/*
 * prerequisites:
 *	"cctk.h"
 *	"config.h"	// for "integer" = Fortran integer
 */

#ifdef __cplusplus
extern "C"
       {
#endif

/*
 * ***** ILUCG *****
 */
void CCTK_FCALL
  CCTK_FNAME(silucg)(const integer* N,
		     const integer IA[], const integer JA[], const float A[],
		     const float B[], float X[],
		     integer ITEMP[], float RTEMP[],
		     const float* EPS, const integer* ITER,
		     integer* ISTATUS);
void CCTK_FCALL
  CCTK_FNAME(dilucg)(const integer* N,
		     const integer IA[], const integer JA[], const double A[],
		     const double B[], double X[],
		     integer ITEMP[], double RTEMP[],
		     const double* EPS, const integer* ITER,
		     integer* ISTATUS);

#ifdef __cplusplus
       }	/* extern "C" */
#endif
//***** end "ilucg.h" contents ******

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** data structures local to this file *****
//

// this represents a single element stored in the matrix for
// sort_row_into_column_order()  and  sort_row_into_column_order__cmp()
struct	matrix_element
	{
	int JA;
	fp  A;
	};

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** prototypes for functions local to this file *****
//
namespace {
int compare_matrix_elements(const void* x, const void* y);
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function constructs a  row_sparse_Jacobian  object.
//
row_sparse_Jacobian::row_sparse_Jacobian(patch_system& ps, int IO_in,
					 bool print_msg_flag /* = false */)
	: Jacobian(ps), IO_(IO_in),
	#ifdef DEBUG_ROW_SPARSE_JACOBIAN
	  IOstr_((IO_in == 0) ? "c" : "f"),
	#endif
	  N_nonzeros_(0),
	  current_N_rows_(0),
	  N_nonzeros_allocated_(0),
	  IA_(new integer[N_rows_+1]),
	  JA_(NULL), A_(NULL)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   row sparse matrix Jacobian [IO=%d] (%d rows)",
		   IO_, N_rows_);

zero_matrix();
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function destroys a  row_sparse_Jacobian  object.
//
row_sparse_Jacobian::~row_sparse_Jacobian()
{
delete[]  A_;
delete[] JA_;
delete[] IA_;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function gets a matrix element.
//
fp row_sparse_Jacobian::element(int II, int JJ)
	const
{
const int posn = find_element(II,JJ);
return (posn >= 0) ? A_[posn] : 0.0;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function zeros a  row_sparse_Jacobian  object.
//
void row_sparse_Jacobian::zero_matrix()
{
#ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
printf("row_sparse_Jacobian::zero_matrix()\n");
#endif

N_nonzeros_ = 0;
current_N_rows_= 0;
IA_[0] = IO_;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function sets a matrix element to a specified value.
//
void row_sparse_Jacobian::set_element(int II, int JJ, fp value)
{
const int posn = find_element(II,JJ);
if (posn >= 0)
   then A_[posn] = value;
   else insert_element(II,JJ, value);
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function sums a value into a matrix element.
//
void row_sparse_Jacobian::sum_into_element(int II, int JJ, fp value)
{
const int posn = find_element(II,JJ);
if (posn >= 0)
   then A_[posn] += value;
   else insert_element(II,JJ, value);
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function searches our data structures for element (II,JJ).
// It returns the 0-origin position of the (II,JJ) element in A_ and JA_,
// or -1 if (II,JJ) is not found.
//
int row_sparse_Jacobian::find_element(int II, int JJ)
	const
{
if (II >= current_N_rows_)
   then return -1;			// this row not defined yet

const int start = IA_[II  ] - IO_;
const int stop  = IA_[II+1] - IO_;
	for (int posn = start ; posn < stop ; ++posn)
	{
	if (JA_[posn]-IO_ == JJ)
	   then return posn;				// found
	}

return -1;						// not found
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function inserts a new element in the matrix, either appending
// it to the current (last) row or starting a new row, and in either case
// growing the arrays if necessary.  It should only be called if II is
// the last row or one beyond, and JJ isn't already in row II.
//
int row_sparse_Jacobian::insert_element(int II, int JJ, fp value)
{
#ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
printf("row_sparse_Jacobian::insert_element(II=%d,JJ=%d, %s=%d,%d, value=%g)\n",
       II,JJ, IOstr_,II+IO_,JJ+IO_, value);
#endif


if (! ((II == current_N_rows_-1) || (II == current_N_rows_)) )
   then error_exit(PANIC_EXIT,
"***** row_sparse_Jacobian::insert_element(II=%d, JJ=%d, value=%g):\n"
"        attempt to insert element elsewhere than {last row, last row+1}!\n"
"        N_rows_=%d   current_N_rows_=%d   IO_=%d\n"
"        N_nonzeros_=%d   N_nonzeros_allocated_=%d\n"
		   ,
		   II, JJ, double(value),
		   N_rows_, current_N_rows_, IO_,
		   N_nonzeros_, N_nonzeros_allocated_);		/*NOTREACHED*/

// start a new row if necessary
if (II == current_N_rows_)
   then {
      #ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
	printf("   starting new row: current_N_rows_=%d", current_N_rows_);
      #endif
	assert(current_N_rows_ < N_rows_);
	IA_[current_N_rows_+1] = IA_[current_N_rows_];
	++current_N_rows_;
      #ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
	printf(" --> %d\n", current_N_rows_);
      #endif
      #ifdef ROW_SPARSE_JACOBIAN__CHECK_AT_ROW_START
	check_and_print_data_structure(false);
      #endif
      #ifdef ROW_SPARSE_JACOBIAN__PRINT_AT_ROW_START
	check_and_print_data_structure(true);
      #endif
	}

// insert into current row
assert(II == current_N_rows_-1);
if (IA_[II+1]-IO_ >= N_nonzeros_allocated_)
   then grow_arrays();
const int posn = IA_[II+1]-IO_;
assert(posn < N_nonzeros_allocated_);
JA_[posn] = JJ+IO_;
 A_[posn] = value;
++IA_[II+1];
++N_nonzeros_;
#ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
printf("   stored at posn=%d (new N_nonzeros_=%d)\n", posn, N_nonzeros_);
#endif

#ifdef ROW_SPARSE_JACOBIAN__CHECK_AFTER_INSERT
check_and_print_data_structure(false);
#endif
#ifdef ROW_SPARSE_JACOBIAN__PRINT_AFTER_INSERT
check_and_print_data_structure(true);
#endif

return posn;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
//
// This function grows the storage arrays to make room for more elements.
// The growth is geometric, so the amortized time to grow to size N is O(N).
//
void row_sparse_Jacobian::grow_arrays()
{
#ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
printf("   row_sparse_Jacobian::grow_arrays(): N_nonzeros_allocated=%d",
       N_nonzeros_allocated_);
#endif

N_nonzeros_allocated_ += base_growth_amount + (N_nonzeros_allocated_ >> 1);

#ifdef ROW_SPARSE_JACOBIAN__LOG_MAIN_OPS
printf(" --> %d\n", N_nonzeros_allocated_);
#endif

integer* const new_JA = new integer[N_nonzeros_allocated_];
fp     * const new_A  = new fp     [N_nonzeros_allocated_];
	for (int posn = 0 ; posn < N_nonzeros_ ; ++posn)
	{
	new_JA[posn] = JA_[posn];
	new_A [posn] = A_ [posn];
	}
delete[] A_ ;
delete[] JA_;
JA_ = new_JA;
A_  = new_A;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************

//
// This function sorts each row's JA_[] and A_[] array elements
// so the columns (JA_[] values) are in increasing order.
// This doesn't change the abstract value of the matrix.
//
void row_sparse_Jacobian::sort_each_row_into_column_order()
{
//
// Implementation notes:
//
// The present implementation is quite inefficient: It copies the row's
// JA_[] and A_[] values into a contiguous buffer, calls qsort(3) on that
// buffer,
//	[the STL sort template would be a lot faster here,
//	but too many systems still have broken STLs -- sigh...]
// then copies the result back into JA_[] and A_[].
//

// buffer must be big enough to hold the largest row
int max_N_in_row = 0;
	  {
	for (int II = 0 ; II < N_rows_ ; ++II)
	{
        max_N_in_row = jtutil::max(max_N_in_row, IA_[II+1]-IA_[II]);
	}
	  }

// contiguous buffer for sorting
struct matrix_element *const buffer = new struct matrix_element[max_N_in_row];

	  {
	for (int II = 0 ; II < N_rows_ ; ++II)
	{
	const int N_in_row = IA_[II+1] - IA_[II];

	// copy this row's JA_[] and A_[] values to the buffer
	const int start = IA_[II]-IO_;
		for (int p = 0 ; p < N_in_row ; ++p)
		{
		const int posn = start + p;
		buffer[p].JA = JA_[posn];
		buffer[p].A  = A_ [posn];
		}

	// sort the buffer
	qsort(static_cast<void *>(buffer), N_in_row, sizeof(buffer[0]),
	      &compare_matrix_elements);

	// copy the buffer values back to this row's JA_[] and A_[]
		for (int p = 0 ; p < N_in_row ; ++p)
		{
		const int posn = start + p;
		JA_[posn] = buffer[p].JA;
		A_ [posn] = buffer[p].A;
		}
	}
	  }

delete[] buffer;
}

//**************************************

//
// This function is a qsort(3) comparison function for
// row_sparse_matrix::sort_each_row_into_column_order().
//
// Arguments:
// x,y = (void *) casts of pointers to  struct matrix_element  objects
//	 to be compared
//
// Results:
// This function returns < 0 if x < y, 0 if x == y, > 0 if x > y in the
// desired sort ordering.
namespace {
int compare_matrix_elements(const void* x, const void* y)
{
const struct matrix_element* const px
	= static_cast<const struct matrix_element*>(x);
const struct matrix_element* const py
	= static_cast<const struct matrix_element*>(y);

return px->JA - py->JA;
}
	  }

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN
#ifdef DEBUG_ROW_SPARSE_JACOBIAN
//
// This function sanity-checks and optionally prints the sparse-matrix
// data structures.
//
void row_sparse_Jacobian::check_and_print_data_structure(bool print_flag)
	const
{
if (print_flag)
   then {
	printf("--- begin Jacobian printout: "
	       "N_rows_=%d   current_N_rows_=%d   IO_=%d\n",
	       N_rows_, current_N_rows_, IO_);
	printf("                             "
	       "N_nonzeros_=%d   N_nonzeros_allocated_=%d\n",
		N_nonzeros_, N_nonzeros_allocated_);
	}

assert(N_rows_ >= 0);
assert(current_N_rows_ >= 0);
assert(current_N_rows_ <= N_rows_);
assert(N_nonzeros_ >= 0);
assert(N_nonzeros_allocated_ >= 0);
assert(N_nonzeros_ <= N_nonzeros_allocated_);

	for (int II = 0 ; II < current_N_rows_ ; ++II)
	{
	if (print_flag)
	   then printf("%sII=%d", IOstr_, II+IO_);

	const int start = IA_[II  ]-IO_;
	const int stop  = IA_[II+1]-IO_;
	if (print_flag)
	   then printf("\t%sposn=[%d,%d):", IOstr_, start+IO_, stop+IO_);
	if (II > 0)
	   then assert(IA_[II] >= IA_[II-1]);
	assert(start >= 0);
	assert(start <= N_nonzeros_allocated_);
	assert(stop >= 0);
	assert(stop <= N_nonzeros_allocated_);
	assert(stop >= start);

	if (print_flag)
	   then printf("\t%sJJ =", IOstr_);
		for (int posn = start ; posn < stop ; ++posn)
		{
		assert(posn >= 0);
		assert(posn < N_nonzeros_allocated_);
		const int gJJ = JA_[posn];
		if (print_flag)
		   then printf(" %d", gJJ);
		assert(gJJ >= IO_);
		assert(gJJ < N_rows_+IO_);
		}
	if (print_flag)
	   then printf("\n");
	}

if (print_flag)
   then printf("--- end Jacobian printout\n");
}
#endif	/* DEBUG_ROW_SPARSE_JACOBIAN */
#endif	/* HAVE_ROW_SPARSE_JACOBIAN */

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
//
// This function constructs a  row_sparse_Jacobian__ILUCG  object.
//
row_sparse_Jacobian__ILUCG::row_sparse_Jacobian__ILUCG
	(patch_system& ps,
	 bool print_msg_flag /* = false */)
	: row_sparse_Jacobian(ps, Fortran_index_origin,
			      print_msg_flag),
	  itemp_(NULL),
	  rtemp_(NULL)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      ILUCG linear-equations solver");
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__ILUCG */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
//
// This function destroys a  row_sparse_Jacobian__ILUCG  object.
//
row_sparse_Jacobian__ILUCG::~row_sparse_Jacobian__ILUCG()
{
delete[] rtemp_;
delete[] itemp_;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__ILUCG */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
//
// This function solves the linear system J.x = rhs, with rhs and x
// being nominal-grid gridfns, using an ILUCG subroutine originally
// provided to me in 1985 (!) by Tom Nicol of the UBC Computing Center.
//
// It returns -1.0 (no condition number estimate).
//
// FIXME:
// It would be more efficient to adjust the ILUCG error tolerance
// based on the current Newton-iteration error level (in ../driver/Newton.cc).
// That is, at early stages of the Newton iteration there's no need to
// solve this linear system to high accuracy.
//
fp row_sparse_Jacobian__ILUCG::solve_linear_system
	(int rhs_gfn, int x_gfn,
	 const struct linear_solver_pars& pars,
	 bool print_msg_flag)
{
assert(IO_ == Fortran_index_origin);	// ILUCG uses Fortran indices
assert(current_N_rows_ == N_rows_);	// matrix must be fully defined

//
// if this is our first call, allocate the scratch arrays
//
if (itemp_ == NULL)
   then {
	if (print_msg_flag)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "row_sparse_Jacobian__ILUCG::solve_linear_system()");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "   N_rows_=%d N_nonzeros_=%d N_nonzeros_allocated_=%d",
			   N_rows_, N_nonzeros_, N_nonzeros_allocated_);
		}
	itemp_ = new integer[3*N_rows_ + 3*N_nonzeros_ + 2];
	rtemp_ = new fp     [4*N_rows_ +   N_nonzeros_    ];
	}

//
// set up the ILUCG subroutine
//

// initial guess = all zeros
fp *x = ps_.gridfn_data(x_gfn);
	for (int II = 0 ; II < N_rows_ ; ++II)
	{
	x[II] = 0.0;
	}

const integer N = N_rows_;
const fp *rhs = ps_.gridfn_data(rhs_gfn);
const fp      eps            = pars.ILUCG_pars.error_tolerance;
const integer max_iterations = pars.ILUCG_pars.limit_CG_iterations
			       ? N_rows_ : 0;
integer istatus;

// the actual linear solution
#if   defined(FP_IS_FLOAT)
  CCTK_FNAME(silucg)(&N,
		     IA_, JA_, A_,
		     rhs, x,
		     itemp_, rtemp_,
		     &eps, &max_iterations,
		     &istatus);
#elif defined(FP_IS_DOUBLE)
  CCTK_FNAME(dilucg)(&N,
		     IA_, JA_, A_,
		     rhs, x,
		     itemp_, rtemp_,
		     &eps, &max_iterations,
		     &istatus);
#else
  #error "don't know fp datatype!"
#endif
if (istatus < 0)
   then error_exit(ERROR_EXIT,
"***** row_sparse_Jacobian__ILUCG::solve_linear_system(rhs_gfn=%d, x_gfn=%d):\n"
"        error return from [sd]ilucg() routine!\n"
"        istatus=%d < 0 ==> bad matrix structure, eg. zero diagonal element!\n"
		   ,
		   rhs_gfn, x_gfn,
		   int(istatus));				/*NOTREACHED*/

//
// If istatus == 0,
//    we didn't reach the convergence level within the specified
//    maximum number of conjugate gradient (CG) iterations. :(
//
//    In practice, however, most of the time we don't need an
//    uber-accurate solution, so it's reasonable to just continue here
//    with whatever approximate solution the CG iteration reached.
//
//    If the Newton iteration converges, we're fine (if |Theta| is
//    small then we have a good horizon position regardless of how we
//    got there), so the only danger in continuing with an approximate
//    linear-system solution here is that we may slow or even prevent
//    the convergence of the Newton iteration.  In practice, this
//    doesn't seem to be a serious problem...
//
const int actual_N_iterations = (istatus == 0) ? max_iterations : istatus;
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   %d CG iteration%s%s",
		   actual_N_iterations,
		   ((actual_N_iterations == 1) ? "" : "s"),
		   ((istatus == 0) ? " (no convergence ==> continuing)"
				   : " (converged ok)"));

return -1.0;			// no condition number estimate available
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__ILUCG */

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
//
// This function constructs a  row_sparse_Jacobian__UMFPACK  object.
//
row_sparse_Jacobian__UMFPACK::row_sparse_Jacobian__UMFPACK
	(patch_system& ps,
	 bool print_msg_flag /* = false */)
	: row_sparse_Jacobian(ps, C_index_origin,
			      print_msg_flag),
	  Control_(new double[UMFPACK_CONTROL]),
	  Info_   (new double[UMFPACK_INFO   ]),
	  solve_workspace_integer_(NULL),
	  solve_workspace_double_ (NULL),
	  Symbolic_(NULL),
	  Numeric_(NULL)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      UMFPACK linear-equations solver");

umfpack_defaults(Control_);
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__UMFPACK */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
//
// This function destroys a  row_sparse_Jacobian__UMFPACK  object.
//
row_sparse_Jacobian__UMFPACK::~row_sparse_Jacobian__UMFPACK()
{
if (Numeric_ != NULL)
   then umfpack_free_numeric (&Numeric_ );
if (Symbolic_ != NULL)
   then umfpack_free_symbolic(&Symbolic_);
delete[] solve_workspace_double_;
delete[] solve_workspace_integer_;
delete[] Info_;
delete[] Control_;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__UMFPACK */

//******************************************************************************

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
//
// This function solves the linear system J.x = rhs, with rhs and x
// being nominal-grid gridfns, using the UMFPACK sparse-LU-decomposition
// package.
//
// Because the UMFPACK condition number estimator doesn't seem to be
// reliable, this function conditionally prints it, but returns -1.0
// to indicate that no (reliable) condition number estimate is available.
//
fp row_sparse_Jacobian__UMFPACK::solve_linear_system
	(int rhs_gfn, int x_gfn,
	 const struct linear_solver_pars& pars,
	 bool print_msg_flag)
{
int status;

assert(IO_ == C_index_origin);		// UMFPACK uses C indices
assert(current_N_rows_ == N_rows_);	// matrix must be fully defined

if (print_msg_flag)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "row_sparse_Jacobian__UMFPACK::solve_linear_system()");
	CCTK_VInfo(CCTK_THORNSTRING,
		   "   N_rows_=%d N_nonzeros_=%d N_nonzeros_allocated_=%d",
		   N_rows_, N_nonzeros_, N_nonzeros_allocated_);
	}

//
// we set up the matrix in row-sparse format, with the entries in each
// column unsorted, but UMFPACK wants column-sparse format, with the
// entries in each column sorted in increasing order of their rows
// ==> sort the entries in each row,
//     then use UMFPACK to solve the transposed system
//
sort_each_row_into_column_order();

//
// if we haven't done so already, symbolically factor the matrix
//
if (Symbolic_ == NULL)
   then {
	if (print_msg_flag)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   UMFPACK symbolic factorization");
	status = umfpack_symbolic(N_rows_, N_rows_,	// matrix size
				  IA_, JA_,		// sparsity structure
				  &Symbolic_,	// umfpack sets Symbolic to
						// point to the new object
				  Control_, Info_);
	if (status != UMFPACK_OK)
	   then error_exit(ERROR_EXIT,
"***** row_sparse_Jacobian__UMFPACK::solve_linear_system():\n"
"        error return status=%d from umfpack_symbolic() routine\n"
		   ,
			   status);				/*NOTREACHED*/
	}

//
// do the sparse LU decomposition
//
assert(Symbolic_ != NULL);
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   UMFPACK sparse LU decomposition");
status = umfpack_numeric(IA_, JA_, A_,		// input matrix
			 Symbolic_,
			 &Numeric_,
			 Control_, Info_);
if (status != UMFPACK_OK)
   then error_exit(ERROR_EXIT,
"***** row_sparse_Jacobian__UMFPACK::solve_linear_system():\n"
"        error return status=%d from umfpack_numeric() routine\n"
		   ,
		   status);					/*NOTREACHED*/
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      UMFPACK rcond=%.1e (unreliable ==> ignoring)",
		   double(Info_[UMFPACK_RCOND]));
const fp rcond = -1.0;


//
// set parameters for linear solve
//
if (pars.UMFPACK_pars.N_II_iterations >= 0)
   then Control_[UMFPACK_IRSTEP] = pars.UMFPACK_pars.N_II_iterations;
   else {
	// accept the UMFPACK default (which we've already set)
	// ==> no-op here
	}
const bool II_flag = (Control_[UMFPACK_IRSTEP] > 0);


//
// if we haven't done so already, allocate workspace
// (how much depends on whether or not UMFPACK does iterative improvement)
//
if (solve_workspace_integer_ == NULL)
   then solve_workspace_integer_ = new integer[N_rows_];
if (solve_workspace_double_ == NULL)
   then solve_workspace_double_  = new double [II_flag ? 5*N_rows_ : N_rows_];


//
// solve the transposed linear system
// 
const double* rhs = ps_.gridfn_data(rhs_gfn);
      double*   x = ps_.gridfn_data(  x_gfn);
if (print_msg_flag)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "   UMFPACK solution using LU decomposition");
	if (II_flag)
	   then CCTK_VInfo(CCTK_THORNSTRING,
		   "                          and iterative improvement");
	}
status = umfpack_wsolve(UMFPACK_At,		// solve transposed system
			IA_, JA_, A_,		// input matrix
			x,			// solution vector
			rhs,			// rhs vector
			Numeric_,		// LU decomposition object
			Control_, Info_,
			solve_workspace_integer_,
			solve_workspace_double_);
if (status != UMFPACK_OK)
   then error_exit(ERROR_EXIT,
"***** row_sparse_Jacobian__UMFPACK::solve_linear_system():\n"
"        error return status=%d from umfpack_wsolve() routine\n"
		   ,
		   status);					/*NOTREACHED*/

if (Numeric_ != NULL)
   then umfpack_free_numeric (&Numeric_ );

return rcond;
}
#endif	/* HAVE_ROW_SPARSE_JACOBIAN__UMFPACK */

//******************************************************************************
//******************************************************************************
//******************************************************************************

	  }	// namespace AHFinderDirect

```

elliptic/README:
```
This directory contains code for solving elliptic systems on our
($S^2$ topology) multipatch system in ../patch/.

The main files are as follows:

Jacobian.{hh,cc}
	These define a  Jacobian  class.  This is a generic interface
	(a C++ abstract base class) to set up a Jacobian matrix and
	solve linear systems with this matrix as the right hand side
	matrix.

dense_Jacobian.{hh,cc}
	These define a  dense_Jacobian  class (to store a Jacobian matrix
	in a Fortran dense-matrix format) and a  dense_Jacobian__LAPACK
	class (to solve linear systems using LAPACK routines).  These
	classes are derived from (and hence share the generic interface
	of) the  Jacobian  class.

row_sparse_Jacobian.{hh,cc}
	These define a  row_sparse_Jacobian  class (to store a Jacobian
	matrix in a row-oriented sparse-matrix format) and two different
	linear solver classed derived from it:
	row_sparse_Jacobian__ILUCG	// ILUCG linear solver
	row_sparse_Jacobian__UMFPACK	// UMFPACK linear solver

lapack.h
	Header file defining C/C++ prototypes for a few LAPACK routines.
lapack_wrapper.F77
	Wrapper routines around a few LAPACK routines, to avoid problems
	with C <--> Fortran passing of character-string arguments.

```

elliptic/dense_Jacobian.cc:
```
// dense_Jacobian.cc -- dense-matrix Jacobian
// $Header$

//
// <<<literal contents of "lapack.hh">>>
//
#ifdef HAVE_DENSE_JACOBIAN
// dense_Jacobian::dense_Jacobian
// dense_Jacobian::zero_matrix
#endif
//
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
// dense_Jacobian__LAPACK::dense_Jacobian__LAPACK
// dense_Jacobian__LAPACK::~dense_Jacobian__LAPACK
// dense_Jacobian__LAPACK::solve_linear_system
#endif
//

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "Jacobian.hh"
#include "dense_Jacobian.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// FIXME:
//   Cactus's CCTK_FCALL() isn't expanded in .h files (this is a bug),
//   so we include the contents of "lapack.h" inline here.  This is a
//   kludge! :( :(
//#include "lapack.h"
//

//***** begin "lapack.h" contents ******
/* lapack.h -- C/C++ prototypes for (some) BLAS+LAPACK+wrapper routines */
/* $Header$ */

/*
 * prerequisites:
 *	"cctk.h"
 *	"config.h"	// for "integer" = Fortran integer
 */

#ifdef __cplusplus
extern "C"
       {
#endif

/*
 * ***** BLAS *****
 */
integer CCTK_FCALL
  CCTK_FNAME(isamax)(const integer* N, const float SX[], const integer* incx);
integer CCTK_FCALL
  CCTK_FNAME(idamax)(const integer* N, const double DX[], const integer* incx);

/*
 * ***** LAPACK *****
 */
void CCTK_FCALL
  CCTK_FNAME(sgesv)(const integer* N, const integer* NRHS,
		    float A[], const int* LDA,
		    integer IPIV[],
		    float B[], const integer* LDB, integer* info);
void CCTK_FCALL
  CCTK_FNAME(dgesv)(const integer* N, const integer* NRHS,
		    double A[], const int* LDA,
		    integer IPIV[],
		    double B[], const integer* LDB, integer* info);

/*
 * ***** wrappers (for passing character-string args) *****
 */
/* norm_int = 0 for infinity-norm, 1 for 1-norm */
void CCTK_FCALL
  CCTK_FNAME(sgecon_wrapper)(const integer* norm_int,
			     const integer* N,
			     float A[], const integer* LDA,
			     const float* anorm, float* rcond,
			     float WORK[], integer IWORK[],
			     integer* info);
void CCTK_FCALL
  CCTK_FNAME(dgecon_wrapper)(const integer* norm_int,
			     const integer* N,
			     double A[], const integer* LDA,
			     const double* anorm, double* rcond,
			     double WORK[], integer IWORK[],
			     integer* info);

#ifdef __cplusplus
       }	/* extern "C" */
#endif
//***** end "lapack.h" contents ********

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN
//
// This function constructs a  dense_Jacobian  object.
//
dense_Jacobian::dense_Jacobian(patch_system& ps,
			       bool print_msg_flag /* = false */)
	: Jacobian(ps),
	  matrix_(0,N_rows_-1, 0,N_rows_-1)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   dense Jacobian matrix (%d rows)",
		   N_rows_);
}
#endif	/* HAVE_DENSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN
//
// This function zeros a  dense_Jacobian  object.
// Bugs: it could be made more efficient...
//
void dense_Jacobian::zero_matrix()
{
	for (int JJ = 0 ; JJ < N_rows_ ; ++JJ)
	{
		for (int II = 0 ; II < N_rows_ ; ++II)
		{
		set_element(II,JJ, 0.0);
		}
	}
}
#endif	/* HAVE_DENSE_JACOBIAN */

//******************************************************************************
//******************************************************************************
//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN__LAPACK
//
// This function constructs a  dense_Jacobian__LAPACK  object.
//
dense_Jacobian__LAPACK::dense_Jacobian__LAPACK
	(patch_system& ps,
	 bool print_msg_flag /* = false */)
	: dense_Jacobian(ps, print_msg_flag),
	  pivot_(new integer[  N_rows_]),
	  iwork_(new integer[  N_rows_]),
	  rwork_(new fp     [4*N_rows_])
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      LAPACK linear-equations solver");
}
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */

//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN__LAPACK
//
// This function destroys a  dense_Jacobian__LAPACK  object.
//
dense_Jacobian__LAPACK::~dense_Jacobian__LAPACK()
{
delete[] rwork_;
delete[] iwork_;
delete[] pivot_;
}
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */

//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN__LAPACK
//
// This function solves the linear system J.x = rhs, with rhs and x
// being nominal-grid gridfns, using LAPACK LU-decomposition routines.
//
// It returns the (infinity-norm) estimated reciprocal condition number
// of the linear system.
//
fp dense_Jacobian__LAPACK::solve_linear_system
	(int rhs_gfn, int x_gfn,
	 const struct linear_solver_pars& pars,
	 bool print_msg_flag)
{
const fp *rhs = ps_.gridfn_data(rhs_gfn);
fp       *x   = ps_.gridfn_data(x_gfn);
fp       *A   = matrix_.data_array();

const integer infinity_norm_flag = 0;
const integer stride = 1;
const integer NRHS = 1;
const integer N = N_rows_;
const integer N2 = N_rows_ * N_rows_;

// compute the infinity-norm of the matrix A
// ... max_posn = 1-origin index of A[] element with largest absolute value
#if   defined(FP_IS_FLOAT)
  const integer max_posn = CCTK_FNAME(isamax)(&N2, A, &stride);
#elif defined(FP_IS_DOUBLE)
  const integer max_posn = CCTK_FNAME(idamax)(&N2, A, &stride);
#else
  #error "don't know fp datatype!"
#endif
const fp A_infnorm = jtutil::abs(A[max_posn-1]);

// LU decompose and solve the linear system
//
// ... [sd]gesv() use an "in out" design, where the same argument
//     is used for both rhs and x ==> we must first copy rhs to x
//
	for (int II = 0 ; II < N_rows_ ; ++II)
	{
	x[II] = rhs[II];
	}
integer info;
#if   defined(FP_IS_FLOAT)
  CCTK_FNAME(sgesv)(&N, &NRHS, A, &N, pivot_, x, &N, &info);
#elif defined(FP_IS_DOUBLE)
  CCTK_FNAME(dgesv)(&N, &NRHS, A, &N, pivot_, x, &N, &info);
#else
  #error "don't know fp datatype!"
#endif

if (info < 0)
   then error_exit(ERROR_EXIT,
"\n"
"***** dense_Jacobian__LAPACK::solve_linear_system(rhs_gfn=%d, x_gfn=%d):\n"
"        error return (bad argument) info=%d from [sd]gesv() LAPACK routine!"
		   ,
		   rhs_gfn, x_gfn,
		   int(info));					/*NOTREACHED*/

if (info > 0)
   then return 0.0;					// *** ERROR RETURN ***
							// *** (singular matrix)

// estimate infinity-norm condition number
fp rcond;
#if   defined(FP_IS_FLOAT)
  CCTK_FNAME(sgecon_wrapper)(&infinity_norm_flag,
			     &N, A, &N, &A_infnorm, &rcond,
			     rwork_, iwork_, &info);
#elif defined(FP_IS_DOUBLE)
  CCTK_FNAME(dgecon_wrapper)(&infinity_norm_flag,
			     &N, A, &N, &A_infnorm, &rcond,
			     rwork_, iwork_, &info);
#else
  #error "don't know fp datatype!"
#endif

return rcond;
}
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */

//******************************************************************************
//******************************************************************************
//******************************************************************************

	  }	// namespace AHFinderDirect

```

elliptic/make.code.defn:
```
# Cactus specification of things to be compiled in this directory
# $Header$

# Source files in this directory
SRCS = Jacobian.cc \
       dense_Jacobian.cc lapack_wrapper.F77 \
       row_sparse_Jacobian.cc

# Subdirectories containing source files
SUBDIRS =

```

elliptic/Jacobian.hh:
```
// Jacobian.hh -- generic data structures for the Jacobian matrix
// $Header$
//
// Jacobian -- ABC to describe Jacobian matrix
// decode_Jacobian_store_solve_method - decode string into internal enum
// new_Jacobian - factory method
//

#ifndef AHFINDERDIRECT__JACOBIAN_HH
#define AHFINDERDIRECT__JACOBIAN_HH

//
// prerequisites:
//	"../patch/patch_system.hh"
//

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// These classes are used to store and manipulate Jacobian matrices
// for a patch system.
//
// Jacobian is an abstract base class (ABC) that defines the generic
// Jacobian API.  We derive classes from it for each type of sparsity
// pattern, then we derive classes from them for each linear solver.
//
// At present the inheritance graph looks like this:
//	Jacobian
//	    dense_Jacobian
//		dense_Jacobian__LAPACK
//	    row_sparse_Jacobian
//		row_sparse_Jacobian__ILUCG
//		row_sparse_Jacobian__UMFPACK
// each derived class is inside a corresponding #ifdef (set or unset
// as appropriate, in "../include/config.h").
//

//******************************************************************************

//
// We assume a "traversal" interface for computing Jacobians, defined
// by the  Jacobian  API.  The typical code to construct and use a
// Jacobian matrix looks like this:
//	// prototype
//	// ... calls Jac.zero_matrix()
//	//           Jac.set_element()
//	//           Jac.sum_into_element()
//	void traverse_Jacobian(const patch_system& ps, Jacobian& Jac);
//
//	Jacobian& Jac = new_Jacobian(Jac_type, ps);
//	traverse_Jacobian(ps, Jac);
//	Jac.solve_linear_system(...);
//
//	Jac.zero_matrix()
//	traverse_Jacobian(ps, Jac);	// must specify same sparsity pattern
//					// as before
//	Jac.solve_linear_system(...);
//	
//

//
// A row/column index of the Jacobian (denoted II/JJ) is a 0-origin grid
// point number within the patch system.
//
// Since many of the derived classes use Fortran routines, we also use
// 1-origin indices; these have a leading "f", eg fII/fJJ.  Finally, we
// use generic indices that might be either 0-origin or 1-origin; these
// have a leading "g", eg gII/gJJ.
//

//
// Note that the APIs here implicitly assume there is only a *single* gridfn
// in the Jacobian computation.  (If we had N gridfns for this, then the
// Jacobian would really be a block matrix with N*N blocks.)  This isn't
// very general, but matches our present use in this thorn.
//

//******************************************************************************

// forward declarations
class linear_solver_pars;

// ABC to define Jacobian matrix
class	Jacobian
	{
public:
	// basic meta-info
	patch_system& my_patch_system() const { return ps_; }
	int N_rows() const { return N_rows_; }

	// convert (patch,irho,isigma) <--> row/column index
	int II_of_patch_irho_isigma(const patch& p, int irho, int isigma)
		const
		{ return ps_.gpn_of_patch_irho_isigma(p, irho,isigma); }
	const patch& patch_irho_isigma_of_II(int II, int& irho, int& isigma)
		const
		{ return ps_.patch_irho_isigma_of_gpn(II, irho,isigma); }


#ifdef NOT_USED
	//
	// convert C <--> Fortran indices
	//
	int csub(int f) const { return f-1; }
	int fsub(int c) const { return c+1; }
#endif


	//
	// routines to access the matrix
	//

	// get a matrix element
	virtual fp element(int II, int JJ) const = 0;

	// is a given element explicitly stored, or implicitly 0 via sparsity
	virtual bool is_explicitly_stored(int II, int JJ) const = 0;


	//
	// routines for setting values in the matrix
	//

	// zero the entire matrix
	virtual void zero_matrix() = 0;

	// set a matrix element to a specified value
	virtual void set_element(int II, int JJ, fp value) = 0;

	// sum a value into a matrix element
	virtual void sum_into_element(int II, int JJ, fp value) = 0;


	//
	// solve linear system J.x = rhs
	// ... rhs and x are nominal-grid gridfns
	// ... may modify Jacobian matrix (eg for LU decomposition)
	// ... returns estimated reciprocal condition number if known,
	//	       -1.0 if condition number is unknown
	//	       ... rcond = 0.0         ==> exactly singular
	//		   rcond < DBL_EPSILON ==> numerically singular
	//		   rcond = 1.0         ==> orthogonal matrix
	// ... once this has been called, the sparsity pattern should
	//     not be changed, i.e. no new nonzeros should be introduced
	//     into the matrix
	//
	virtual fp solve_linear_system(int rhs_gfn, int x_gfn,
				       const struct linear_solver_pars& pars,
				       bool print_msg_flag) = 0;


	//
	// constructor, destructor
	//
protected:
	// the constructor only uses  ps  to get the size of the matrix
	Jacobian(patch_system& ps)
		: ps_(ps),
		  N_rows_(ps.N_grid_points() + ps.N_additional_points())
		{ }
public:
	virtual ~Jacobian() { }

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	Jacobian(const Jacobian &rhs);
	Jacobian& operator=(const Jacobian &rhs);

protected:
	patch_system& ps_;
	int N_rows_;
	};

//**************************************

//
// this class defines parameters for  solve_linear_system()
// for all of our derived classes
//
struct	linear_solver_pars
	{
	struct	LAPACK_pars
		{
		} LAPACK_pars;
	struct	ILUCG_pars
		{
		fp  error_tolerance;
		// should we limit to N_rows_ conjugate gradient iterations?
		bool limit_CG_iterations;
		} ILUCG_pars;
	struct	UMFPACK_pars
		{
		// number of iterative-improvement iterations to do
		// inside UMFPACK after the sparse LU decompose/solve,
		// each time we solve a linear system
		int N_II_iterations;
		} UMFPACK_pars;
	};

//******************************************************************************

enum	Jacobian_store_solve_method
	{
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
	Jacobian__dense_matrix__LAPACK,
#endif
#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
	Jacobian__row_sparse_matrix__ILUCG,
#endif
#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
	Jacobian__row_sparse_matrix__UMFPACK // no comma on last entry in enum
#endif
	};

//
// prototypes of various Jacobian-related functions
//

// decode string into internal enum
enum Jacobian_store_solve_method
  decode_Jacobian_store_solve_method
	(const char Jacobian_store_solve_method_string[]);

// "object factory" routines to construct and return
// pointers to new-allocated objects of specified derived types
Jacobian* new_Jacobian(enum Jacobian_store_solve_method Jac_method,
		       patch_system& ps,
		       bool print_msg_flag = false);

//******************************************************************************

	  }	// namespace AHFinderDirect
#endif		/* AHFINDERDIRECT__JACOBIAN_HH */

```

elliptic/lapack_wrapper.F77:
```
c lapack_wrapper.f -- wrapper routines for LAPACK [sd]gecon()
c $Header$

c
c These subroutines are wrappers around the LAPACK [sd]gecon() subroutines.
c These subroutines take only integer/real/double precision arguments,
c avoiding problems with C/C++ --> Fortran passing of the character string
c arguments used by [sd]gecon().
c
c Arguments:
c norm_int = (in) 0 ==> infinity-norm
c                 1 ==> 1-norm
c

c
c Note that the Compaq f90 compiler complains about empty (or all-comment)
c files, so we still have to define an empty subroutine even if it is never
c called.  :( Oh well, memory is cheap...
c

#include "config.h"

	subroutine sgecon_wrapper(norm_int,
     $	                          N, A, LDA, anorm, rcond,
     $	                          WORK, IWORK, info)
	integer norm_int
	integer N, LDA
	real A(LDA,N)
	real anorm, rcond
	real WORK(*)
	integer iwork(*)
	integer info
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
#ifdef FP_IS_FLOAT
	if	(norm_int .eq. 0) then
		call sgecon('I', N,A,LDA, anorm,rcond, WORK,IWORK, info)
	else if (norm_int .eq. 1) then
		call sgecon('1', N,A,LDA, anorm,rcond, WORK,IWORK, info)
	else
		info = -1;
	end if
#endif /* FP_IS_FLOAT */
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */
	return
	end

	subroutine dgecon_wrapper(norm_int,
     $	                          N, A, LDA, anorm, rcond,
     $	                          WORK, IWORK, info)
	integer norm_int
	integer N, LDA
	double precision A(LDA,N)
	double precision anorm, rcond
	double precision WORK(*)
	integer iwork(*)
	integer info
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
#ifdef FP_IS_DOUBLE
	if	(norm_int .eq. 0) then
		call dgecon('I', N,A,LDA, anorm,rcond, WORK,IWORK, info)
	else if (norm_int .eq. 1) then
		call dgecon('1', N,A,LDA, anorm,rcond, WORK,IWORK, info)
	else
		info = -1;
	end if
#endif /* FP_IS_DOUBLE */
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */
	return
	end

```

elliptic/Jacobian.cc:
```
// Jacobian.cc -- generic routines for the Jacobian matrix
// $Header$

//
// <<<literal contents of "lapack.hh">>>
//
// decode_Jacobian_store_solve_method -- decode string into internal enum
// new_Jacobian -- object factory for Jacobian objects
//

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "Jacobian.hh"
#include "dense_Jacobian.hh"
#include "row_sparse_Jacobian.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function decodes a character string specifying a specific type
// (derived class) of Jacobian, into an internal enum.
//
enum Jacobian_store_solve_method
  decode_Jacobian_store_solve_method
	(const char Jacobian_store_solve_method_string[])
{
if	(STRING_EQUAL(Jacobian_store_solve_method_string,
		      "dense matrix/LAPACK"))
   then {
  #ifdef HAVE_DENSE_JACOBIAN__LAPACK
	return Jacobian__dense_matrix__LAPACK;
  #endif
	}

else if (STRING_EQUAL(Jacobian_store_solve_method_string,
		      "row-oriented sparse matrix/ILUCG"))
   then {
  #ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
	return Jacobian__row_sparse_matrix__ILUCG;
  #endif
	}

else if (STRING_EQUAL(Jacobian_store_solve_method_string,
		      "row-oriented sparse matrix/UMFPACK"))
   then {
  #ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
	return Jacobian__row_sparse_matrix__UMFPACK;
  #endif
	}

else	error_exit(ERROR_EXIT,
"decode_Jacobian_store_solve_method():\n"
"        unknown Jacobian_store_solve_method_string=\"%s\"!\n",
		   Jacobian_store_solve_method_string);		/*NOTREACHED*/

// fall through to here ==> we recognize the matrix store_solve_method,
//                          but it's not configured
error_exit(ERROR_EXIT,
"\n"
"   decode_Jacobian_store_solve_method():\n"
"        Jacobian store_solve_method=\"%s\"\n"
"        is not configured in this binary; see \"src/include/config.hh\"\n"
"        for details on what methods are configured and how to change this\n"
	   ,
	   Jacobian_store_solve_method_string);			/*NOTREACHED*/
}

//******************************************************************************

//
// This function is an "object factory" for Jacobian objects: it constructs
// and returns a pointer to a new-allocated Jacobian object of the
// specified derived type.
//
// FIXME: the patch system shouldn't really have to be non-const, but
//	  the Jacobian constructors all require this to allow the
//	  linear solvers to directly update gridfns
//
Jacobian* new_Jacobian(enum Jacobian_store_solve_method Jac_method,
		       patch_system& ps,
		       bool print_msg_flag /* = false */)
{
switch	(Jac_method)
	{
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
  case Jacobian__dense_matrix__LAPACK:
	return new dense_Jacobian__LAPACK(ps, print_msg_flag);
#endif

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
  case Jacobian__row_sparse_matrix__ILUCG:
	return new row_sparse_Jacobian__ILUCG(ps, print_msg_flag);
#endif

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
  case Jacobian__row_sparse_matrix__UMFPACK:
	return new row_sparse_Jacobian__UMFPACK(ps, print_msg_flag);
#endif

  default:
	error_exit(ERROR_EXIT,
		   "new_Jacobian(): unknown method=(int)%d!\n",
		   int(Jac_method));				/*NOTREACHED*/
	}
}

//******************************************************************************
//******************************************************************************
//******************************************************************************

	  }	// namespace AHFinderDirect

```

elliptic/lapack.h:
```
/* lapack.h -- C/C++ prototypes for (some) BLAS+LAPACK+wrapper routines */
/* $Header$ */

/*
 * prerequisites:
 *	"cctk.h"
 *	"config.h"	// for "integer" = Fortran integer
 */

#ifdef __cplusplus
extern "C"
       {
#endif

/*
 * ***** BLAS *****
 */
integer CCTK_FCALL
  CCTK_FNAME(isamax)(const integer* N, const float SX[], const integer* incx);
integer CCTK_FCALL
  CCTK_FNAME(idamax)(const integer* N, const double DX[], const integer* incx);

/*
 * ***** LAPACK *****
 */
void CCTK_FCALL
  CCTK_FNAME(sgesv)(const integer* N, const integer* NRHS,
		    float A[], const int* LDA,
		    integer IPIV[],
		    float B[], const integer* LDB, integer* info);
void CCTK_FCALL
  CCTK_FNAME(dgesv)(const integer* N, const integer* NRHS,
		    double A[], const int* LDA,
		    integer IPIV[],
		    double B[], const integer* LDB, integer* info);

/*
 * ***** wrappers (for passing character-string args) *****
 */
/* norm_int = 0 for infinity-norm, 1 for 1-norm */
void CCTK_FCALL
  CCTK_FNAME(sgecon_wrapper)(const integer* norm_int,
			     const integer* N,
			     float A[], const integer* LDA,
			     const float* anorm, float* rcond,
			     float WORK[], integer IWORK[],
			     integer* info);
void CCTK_FCALL
  CCTK_FNAME(dgecon_wrapper)(const integer* norm_int,
			     const integer* N,
			     double A[], const integer* LDA,
			     const double* anorm, double* rcond,
			     double WORK[], integer IWORK[],
			     integer* info);

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

```

elliptic/dense_Jacobian.hh:
```
// dense_Jacobian.hh -- dense-matrix Jacobian 
// $Header$
//
#ifdef HAVE_DENSE_JACOBIAN
// dense_Jacobian -- Jacobian stored as a dense matrix
#endif
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
// dense_Jacobian__LAPACK -- dense_Jacobian with LAPACK linear solver
#endif
//

#ifndef AHFINDERDIRECT__DENSE_JACOBIAN_HH
#define AHFINDERDIRECT__DENSE_JACOBIAN_HH

//
// prerequisites:
//	"../patch/patch_system.hh"
//	"Jacobian.hh"
//

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN
//
// This class stores the Jacobian as a dense matrix in Fortran (column)
// order.
//
class	dense_Jacobian
	: public Jacobian
	{
public:
	//
	// routines to access the matrix
	//

	// get a matrix element
	fp element(int II, int JJ) const
		{ return matrix_(JJ,II); }

	// dense matrix ==> all elements are explicitly stored
	bool is_explicitly_stored(int II, int JJ) const
		{ return true; }


	//
	// routines for setting values in the matrix
	//

	// zero the entire matrix
	void zero_matrix();

	// set a matrix element to a specified value
	void set_element(int II, int JJ, fp value)
		{ matrix_(JJ,II) = value; }

	// sum a value into a matrix element
	void sum_into_element(int II, int JJ, fp value)
		{ matrix_(JJ,II) += value; }

	//
	// constructor, destructor
	//
protected:
	// the constructor only uses ps to get the size of the matrix
	// ... print_msg_flag controls messages about data structure setup
	//     during construction and element-setting process
	dense_Jacobian(patch_system& ps,
		       bool print_msg_flag = false);
	~dense_Jacobian() { }

protected:
	// Fortran storage order ==> subscripts are (JJ,II)
	jtutil::array2d<fp> matrix_;
	};
#endif	/* HAVE_DENSE_JACOBIAN */

//******************************************************************************

#ifdef HAVE_DENSE_JACOBIAN__LAPACK
//
// This class defines the linear solver routine using LAPACK.
//
class	dense_Jacobian__LAPACK
	: public dense_Jacobian
	{
public:
	// solve linear system J.x = rhs via LAPACK
	// ... rhs and x are nominal-grid gridfns
	// ... overwrites Jacobian matrix with its LU decomposition
	// ... returns estimated reciprocal condition number
	//	       ... rcond = 0.0         ==> exactly singular
	//		   rcond < DBL_EPSILON ==> numerically singular
	//		   rcond = 1.0         ==> orthogonal matrix
	fp solve_linear_system(int rhs_gfn, int x_gfn,
			       const struct linear_solver_pars& pars,
			       bool print_msg_flag);

	// constructor, destructor
public:
	// the constructor only uses ps to get the size of the matrix
	dense_Jacobian__LAPACK(patch_system& ps,
			       bool print_msg_flag = false);
	~dense_Jacobian__LAPACK();

private:
	// pivot vector for LAPACK routines
	integer *pivot_;	// size N_rows_

	// work vectors for LAPACK condition number computation
	integer *iwork_;	// size N_rows_
	fp *rwork_;		// size 4*N_rows_
	};
#endif	/* HAVE_DENSE_JACOBIAN__LAPACK */

//******************************************************************************

	  }	// namespace AHFinderDirect
#endif		/* AHFINDERDIRECT__DENSE_JACOBIAN_HH */

```

util/AH2xdmf.py:
```
#!/usr/bin/env python
# -*- coding: utf-8 -*-

# Author: Frank Löffler
# license: CC BY 4.0 (http://creativecommons.org/licenses/by/4.0/)

from __future__ import print_function
import atexit
import numpy as np
import h5py, math, re, sys, os, os.path, fnmatch

if len(sys.argv) == 2 and sys.argv[1] == "--help":
  print("Usage: "+sys.argv[0]+" [filename]"+"""
Collect information about apparent horizon shape files within the current
directory and store them in hdf5 files. This assumes that the filename
scheme in AHFinderDirect (for ASCII output) has not been changed from the
default one.

The optional argument [filename] specifies another hdf5 file from which
timestep information will be read and used to create (if necessary dummy)
horizons for all timesteps in that file also in the apparent horizon output
files. The intend here is to allow visualization tools (like VisIt) to
automatically combine time sliders opon opening the specified file and the
created apparent horizon files.

The output files will be named AH_%d.[h5,xml], with %d being the number of each
horizon. The .h5 files contain the raw shape information, while the .xml files
describe its layout (and should be the one to open in a visualization tool).""")
  sys.exit(1)

h5alignfilename = None
if len(sys.argv) == 2:
  h5alignfilename = sys.argv[1]
  if not os.path.isfile(h5alignfilename):
    print("'"+h5alignfilename+"' is not a readable file.", file=sys.stderr)
    sys.exit(1)

# Class to store AH information into while it is read.
class AH(object):
  # Write stored xml to file - to be called when AH is destructed
  def write(self):
    self.xml += """
    </Grid>
  </Domain>
</Xdmf>"""
    with open(self.filename + '.xmf', 'w') as f:
      f.write(self.xml)

  # Constructor
  def __init__(self, filename):
    atexit.register(AH.write, self)
    self.filename   = filename
    self.h5filename = filename + '.h5'
    self.h5 = h5py.File(self.h5filename, 'w')
    self.xml = """<?xml version="1.0" ?>
<!DOCTYPE Xdmf SYSTEM "Xdmf.dtd" []>
<Xdmf Version="2.0">
  <Domain>
    <Grid Name="AHs" GridType="Collection" CollectionType="Temporal">"""

  # Read AH data from file 'filename'.
  def get_ah(self, filename):
    # Get shape information from file
    N_rho   = None
    N_sigma = None
    with open(filename, 'r') as f:
      for line in f:
        if line[0:10] == '# N_rho = ':
          regex = re.match(r'# N_rho = (\d+)', line)
          if (regex):
            N_rho = int(regex.group(1))
        if line[0:12] == '# N_sigma = ':
          regex = re.match(r'# N_sigma = (\d+)', line)
          if (regex):
            N_sigma = int(regex.group(1))
        if (N_rho != None and N_sigma != None):
          break
    # Bail out if this doesn't look like a file we expect
    if not N_rho or not N_sigma:
      print("Could not find N_rho and N_sigma. Is this a uncorrupted AHFinderdirect file?",
            file=sys.stderr)
      sys.exit(1)
    if N_rho != N_sigma:
      print("N_rho (%d) != N_sigma (%d). This is completely untested and probably does not "
            "work" % (N_rho, N_sigma), file=sys.stderr)
      sys.exit(1)
    # read actual data
    (x,y,z) = np.genfromtxt(filename, usecols=(3,4,5), comments='#', unpack=True)
    x = x.reshape((6, N_rho, N_sigma))
    y = y.reshape((6, N_rho, N_sigma))
    z = z.reshape((6, N_rho, N_sigma))
    return (N_rho, N_sigma, x, y, z)

  # Append data from AH in filename (iteration it) to xdmf
  def append(self, filename, it):
    # If we don't have an AH for this timestep, add a dummy mesh.
    if (filename == None):
      (N_rho, N_sigma, x, y, z) = (1, 1, np.zeros((6,1,1)),
                                         np.zeros((6,1,1)),
                                         np.zeros((6,1,1)))
    else:
      (N_rho, N_sigma, x, y, z) = self.get_ah(filename)
    self.xml += """
      <Grid Name="AH" GridType="Collection">
        <Time Value="%(it)d" />""" % {'it': it}
    # copy data into hdf5 file and save corresponding xml
    for i in range(6):
      group = '/it_%d/h_%d/p_%d/' % (it, 1, i+1)
      self.h5[group + 'x'] = x[i,:,:]
      self.h5[group + 'y'] = y[i,:,:]
      self.h5[group + 'z'] = z[i,:,:]
      hlink = '/h_%d/it_%d/p_%d/' % (1, it, i+1)
      self.h5[hlink + 'x'] = h5py.SoftLink(group + 'x')
      self.h5[hlink + 'y'] = h5py.SoftLink(group + 'y')
      self.h5[hlink + 'z'] = h5py.SoftLink(group + 'z')

      self.xml += """
        <Grid Name="AH_mesh%(i)d" GridType="Uniform">
          <Topology TopologyType="3DSMesh" NumberOfElements="%(xy)s"/>
          <Geometry GeometryType="X_Y_Z">
            <DataItem Dimensions="%(xy)s" NumberType="Float" Precision="8" Format="HDF">
              %(h5fn)s:%(group)sx
            </DataItem>
            <DataItem Dimensions="%(xy)s" NumberType="Float" Precision="8" Format="HDF">
              %(h5fn)s:%(group)sy
            </DataItem>
            <DataItem Dimensions="%(xy)s" NumberType="Float" Precision="8" Format="HDF">
              %(h5fn)s:%(group)sz
            </DataItem>
          </Geometry>
        </Grid>""" % {'i': i, 'i1': i+1, 'xy': "%d %d" % (N_rho, N_sigma),
                      'h5fn': self.h5filename, 'group': group}
    self.xml += """
      </Grid>"""

# figure out which iterations are present in related hdf5 output
h5_align_its = {}
if (h5alignfilename != None):
  with h5py.File(h5alignfilename, 'r') as h5_align:
    for item in h5_align.keys():
      reg_it = re.search(r'\S+ it=(\d+) ', item)
      if reg_it:
        h5_align_its[int(reg_it.group(1))] = 1
h5_align_its = np.asarray(sorted(h5_align_its.keys()))

# find number of horizons
hs = {}
for root, subdirs, files in os.walk('.'):
  for filename in files:
    if fnmatch.fnmatch(filename, 'h.t*.ah*.gp'):
      h = int(re.search('h\.t\d+\.ah(\d+)\.gp', filename).group(1))
      hs[h] = 1
hs = np.asarray(sorted(hs.keys()))

# find timesteps for each horizon
ah_align_fns = {}
ah_align_its = {}
for h in hs:
  ah_align_fns[h] = {}
  for root, subdirs, files in os.walk('.'):
    for filename in files:
      if fnmatch.fnmatch(filename, 'h.t*.ah%d.gp' % (h)):
        it = int(re.search('h\.t(\d+)\.ah%d\.gp' % (h), filename).group(1))
        ah_align_fns[h][it] = os.path.join(root, filename)
  ah_align_its[h] = np.array(sorted(ah_align_fns[h].keys()))

# Generation of intersecting iterations, and some info output
if (h5alignfilename != None):
  print("Found shapes for %d horizon(s), and %d iterations in hdf5 output." %
        (hs.size, h5_align_its.size))
else:
  print("Found shapes for %d horizon(s)." %
        (hs.size))
h5_align_interect = {}
for h in hs:
  h5_align_interect[h] = np.intersect1d(h5_align_its, ah_align_its[h], assume_unique=True)
  if (h5alignfilename != None):
    print("horizon %d: %d timesteps, out of which %d intersect with hdf5." %
          (h, ah_align_its[h].size, h5_align_interect[h].size))
  else:
    print("horizon %d: %d timesteps." % (h, ah_align_its[h].size))

if (h5alignfilename != None):
  # Add horizon for each iteration in h5 file: write dummy if not present
  for h in hs:
    ah = AH("AH_%d" % (h))
    for it in h5_align_its:
      if it in h5_align_interect[h]:
        ah.append(ah_align_fns[h][it], it)
      else:
        ah.append(None, it)
else:
  # add all iterations to h5 file
  for h in hs:
    ah = AH("AH_%d" % (h))
    for it in ah_align_fns[h].keys():
      ah.append(ah_align_fns[h][it], it)


```

gr/curvature.maple:
```
# curvature.maple - evaluate various "derivatives of the metric" quantities
# $Header$
#
# curvature - overall driver
## inverse_metric_gradient - compute partial_d_g_uu
## metric_det_gradient - compute partial_d_ln_sqrt_g
#

################################################################################
################################################################################
################################################################################

#
# This function is a driver to compute, and optionally generate C code
# for, various xyz-coordinate 1st derivatives of the metric.
#
# Inputs:
#	N
#	partial_d_g_dd
#	g_uu
#
# Outputs (Maple + C code file "inverse_metric_gradient.c")
#	partial_d_g_uu = partial_d_g_uu__fnd(g_uu, partial_d_g_dd)
#
# Outputs (Maple + C code file "metric_det_gradient.c")
#	partial_d_ln_sqrt_g = partial_d_ln_sqrt_g__fnd(g_uu, partial_d_g_dd)
#
curvature :=
proc(cg_flag::boolean)

inverse_metric_gradient(cg_flag);
metric_det_gradient(cg_flag);

NULL;
end proc;

################################################################################

#
# This function computes the xyz-coordinate gradient of the inverse metric
# and optionally also generates C code for this.
#
# Inputs:
#	N
#	partial_d_g_dd
#	g_uu
#
# Outputs (Maple + C code file "inverse_metric_gradient.c")
#	partial_d_g_uu = partial_d_g_uu__fnd(g_uu, partial_d_g_dd)
#
inverse_metric_gradient :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local k, i, j, m, n;

printf("%a...\n", procname);

assert_fnd_exists(g_dd);
assert_fnd_exists(g_uu);
assert_fnd_exists(partial_d_g_uu, fnd);

	for k from 1 to N
	do
	for i from 1 to N
	do
	for j from i to N	# upper triangle
	do
	partial_d_g_uu__fnd[k,i,j]
	    := simplify(
		  - msum('g_uu[i,m] * g_uu[j,n] * partial_d_g_dd[k,m,n]',
			 'm'=1..N, 'n'=1..N)
		       );
	end do;
	end do;
	end do;

if (cg_flag)
   then codegen2(partial_d_g_uu__fnd,
		 'partial_d_g_uu',
		 "../gr.cg/inverse_metric_gradient.c");
fi;

NULL;
end proc;

################################################################################

#
# This function computes the xyz-coordinate gradient of the metric
# determinate, using the formula on page 79 of my mpe notes, and
# optionally also generates C code for this.
#
# Inputs:
#	N
#	partial_d_g_dd
#	g_uu
#
# Outputs (Maple + C code file "metric_det_gradient.c")
#	partial_d_ln_sqrt_g = partial_d_ln_sqrt_g__fnd(g_uu, partial_d_g_dd)
#
metric_det_gradient :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local k, i, j;

printf("%a...\n", procname);

assert_fnd_exists(g_dd);
assert_fnd_exists(g_uu);
assert_fnd_exists(partial_d_ln_sqrt_g, fnd);

	for k from 1 to N
	do
	partial_d_ln_sqrt_g__fnd[k]
		:= simplify(
		      (1/2) * msum('g_uu[i,j] * partial_d_g_dd[k,i,j]',
				   'i'=1..N, 'j'=1..N)
			   );
	end do;

if (cg_flag)
   then codegen2(partial_d_ln_sqrt_g__fnd,
		 'partial_d_ln_sqrt_g',
		 "../gr.cg/metric_det_gradient.c");
fi;

NULL;
end proc;

```

gr/gr.hh:
```

// gr.hh -- header file for general relativity code
// $Header$

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// number of spatial dimensions in the main Cactus grid
// and in our trial-horizon-surface grid
//
enum	{ N_GRID_DIMS = 3, N_HORIZON_DIMS = 2 };

//
// this enum specifies what kind of surface we want
//
enum    a_surface_definition
        {
        definition_error,      // this value is illegal
        definition_expansion,  // apparent horizon
        definition_inner_expansion, // expansion Theta_(l), ingoing null normal
        definition_mean_curvature, // mean curvature
        definition_expansion_product // product of Theta_(n) and Theta_(l)
        };

//
// this enum specifies how the surface definition is modified
//
enum    a_surface_modification
        {
        modification_error,     // this value is illegal
        modification_none,      // no modification
        modification_radius,    // times coordinate radius
        modification_radius2    // times coordinate radius^2
#if 0
        modification_mean_radius, // times mean coordinate radius
        modification_areal_radius // times areal radius
#endif
        };

//
// this enum specifies how we select the surface
//
enum    a_surface_selection
        {
        selection_error,        // this value is illegal
        selection_definition,   // use the surface's definition
        selection_mean_coordinate_radius, // mean coordinate radius (cheap)
        selection_areal_radius,  // areal radius
        selection_expansion_mean_coordinate_radius, // expansion times mean coordinate radius
        selection_expansion_areal_radius // expansion times areal radius
        };

//
// this struct specifies what to calculate
//
struct  what_to_compute
        {
        // how Theta is calculated
        a_surface_definition surface_definition;
        // how Theta is modified
        a_surface_modification surface_modification;
        // what is solved for
        a_surface_selection surface_selection;
        // the desired value (expansion, areal radius, etc.)
        fp desired_value;
        
        what_to_compute ()
          : surface_definition (definition_error),
            surface_modification (modification_error),
            surface_selection (selection_error),
            desired_value (0.0)
        { }
        };

//
// this enum holds the (a) decoded  Jacobian_compute_method  parameter,
// i.e. it specifies how we compute the (a) Jacobian matrix
//
enum	Jacobian_compute_method
	{
	Jacobian__numerical_perturbation,
	Jacobian__symbolic_diff_with_FD_dr,
	Jacobian__symbolic_diff // no comma
	};

//
// this enum describes the status of an  expansion()  or  expansion_Jacobian()
// computation which returns (i.e. which doesn't abort the Cactus run)
//
enum	expansion_status
	{
	// successful computation
	// ... this is also returned for dummy computations
	expansion_success,

	// non-finite() (i.e. +/-infinity or NaN) values found in h
	expansion_failure__surface_nonfinite,

	// surface is too large
	// ... this value is never returned by  expansion()  or
	//      expansion_Jacobian() , but is placed in this enum
	//     for the convenience of higher-level software which
	//     wishes to have such an error condition
	expansion_failure__surface_too_large,

	// geometry interpolator returns CCTK_ERROR_INTERP_POINT_OUTSIDE
	expansion_failure__surface_outside_grid,

	// geometry interpolator returns CCTK_ERROR_INTERP_POINT_EXCISED
	expansion_failure__surface_in_excised_region,	// (not implemented yet)

	// non-finite (i.e. +/-infinity or NaN) values found
	// in interpolated geometry (g_ij, K_ij, partial_k g_ij)
	expansion_failure__geometry_nonfinite,

	// interpolated g_ij isn't positive definite
	expansion_failure__gij_not_positive_definite // no comma
	};

//******************************************************************************

//
// This structure holds all the information we need about the Cactus grid
// and gridfns in order to interpolate the geometry information.
//
struct	cactus_grid_info
	{
	const cGH *GH;			// --> Cactus grid hierarchy
	int coord_system_handle;	// Cactus coordinate system handle

	// this describes the semantics of the Cactus gij gridfns:
	// true ==> the Cactus g_ij are conformal values as per
	//          CactusEinstein/StaticConformal and the  psi  gridfn
	// false ==> the Cactus g_ij are the physical metric
	bool use_Cactus_conformal_metric;

	// Cactus variable indices of geometry variables
        int mask_varindex;
	int g_dd_11_varindex, g_dd_12_varindex, g_dd_13_varindex,
			      g_dd_22_varindex, g_dd_23_varindex,
						g_dd_33_varindex;
	int K_dd_11_varindex, K_dd_12_varindex, K_dd_13_varindex,
			      K_dd_22_varindex, K_dd_23_varindex,
						K_dd_33_varindex;
	int psi_varindex;	// unused if !use_Cactus_conformal_metric
	};

//
// This structure holds information for computing the spacetime geometry.
// This is normally done by interpolating $g_{ij}$ and $K_{ij}$ from the
// usual Cactus grid, but can optionally instead by done by hard-wiring
// the Schwarzschild geometry in Eddington-Finkelstein coordinates.
//
struct	geometry_info
	{
	// normally false; true for testing/debugging
	bool hardwire_Schwarzschild_EF_geometry;

	// parameters for the normal case
	//   hardwire_Schwarzschild_EF_geometry == false
	int operator_handle;		// Cactus handle to interpolation op
	int param_table_handle;		// Cactus handle to parameter table
					// for the interpolator

	// parameters for  hardwire_Schwarzschild_EF_geometry == true
	fp geometry__Schwarzschild_EF__x_posn;	// x posn of Schwarzschild BH
	fp geometry__Schwarzschild_EF__y_posn;	// y posn of Schwarzschild BH
	fp geometry__Schwarzschild_EF__z_posn;	// z posn of Schwarzschild BH
	fp geometry__Schwarzschild_EF__mass;	// mass of Schwarzschild BH
	fp geometry__Schwarzschild_EF__epsilon;	// use z axis limits if
						// (x^2+y^2)/r^2 <= this
	fp geometry__Schwarzschild_EF__Delta_xyz;// "grid spacing" for FD
						// computation of partial_k g_ij

	// should we check various gridfns for NaNs?
	bool check_that_h_is_finite;
	bool check_that_geometry_is_finite;

	// horizon may shrink?
	bool mask_is_noshrink;
	};

//
// This struct holds parameters for computing the Jacobian matrix.
//
struct	Jacobian_info
	{
	enum Jacobian_compute_method     Jacobian_compute_method;
	enum Jacobian_store_solve_method Jacobian_store_solve_method;
	fp perturbation_amplitude;
	};

//
// This struct holds information on what to do if various error/warning
// conditions occur.
//
struct	error_info
	{
	// CCTK_VWarn() level for point outside (or too close to any
	// boundary of) the Cactus grid, i.e. geometry interpolator returns
	// CCTK_ERROR_INTERP_POINT_OUTSIDE
	// ... warning level if error occurs on first Newton iteration,
	//     i.e. when evaluating expansion/Jacobian for initial guess
	int warn_level__point_outside__initial;
	// ... warning level if error occurs on a subsequent Newton iteration
	int warn_level__point_outside__subsequent;

	// CCTK_VWarn() level for the user set
	//  check_that_geometry_is_finite = "true"
	// but the Cactus configure process failed to find the finite()
	// function ==> we have to skip the check
	int warn_level__skipping_finite_check;

	// CCTK_VWarn() level for infinity or NaN in interpolated geometry
	// (g_ij, partial_k g_ij, and/or K_ij)
	int warn_level__nonfinite_geometry;

	// CCTK_VWarn() level for interpolated g_ij isn't positive definite
	// (usually this means we're too close to a singularity)
	// ... warning level if error occurs on first Newton iteration,
	//     i.e. when evaluating expansion/Jacobian for initial guess
	int warn_level__gij_not_positive_definite__initial;
	// ... warning level if error occurs on a subsequent Newton iteration
	int warn_level__gij_not_positive_definite__subsequent;
	};

//******************************************************************************

//
// prototypes for functions visible outside their source files
//

// expansion.cc
enum expansion_status
  expansion(patch_system* ps_ptr,
            const struct what_to_compute& comput_info,
	    const struct cactus_grid_info& cgi,
	    const struct geometry_info& gi,
	    const struct error_info& error_info, bool initial_flag,
	    bool Jacobian_flag = false,
	    bool print_msg_flag = false,
	    jtutil::norm<fp>* H_norms_ptr = NULL,
	    jtutil::norm<fp>* expansion_H_norms_ptr = NULL,
	    jtutil::norm<fp>* inner_expansion_H_norms_ptr = NULL,
	    jtutil::norm<fp>* product_expansion_H_norms_ptr = NULL,
	    jtutil::norm<fp>* mean_curvature_H_norms_ptr = NULL);

// expansion_Jacobian.cc
enum expansion_status
  expansion_Jacobian(patch_system* ps_ptr, Jacobian* Jac_ptr,
                     const struct what_to_compute& comput_info,
		     const struct cactus_grid_info& cgi,
		     const struct geometry_info& gi,
		     const struct Jacobian_info& Jacobian_info,
		     const struct error_info& error_info, bool initial_flag,
		     bool print_msg_flag = false);

// Schwarzschild_EF.cc
void Schwarzschild_EF_geometry(patch_system& ps,
			       const struct geometry_info& gi,
			       bool msg_flag);

// misc-gr.cc
enum Jacobian_compute_method
  decode_Jacobian_compute_method(const char Jacobian_compute_method_string[]);
const char* expansion_status_string(enum expansion_status status);

//******************************************************************************

	  }	// namespace AHFinderDirect

```

gr/gr_gfas.minc:
```
# Maple include file listing all gfa functional-dependence forms
# $Header$

g_dd,
K_dd,

g_uu, g_uu__fnd,
K_uu, K_uu__fnd,

K, K__fnd,

partial_d_g_dd,

partial_d_ln_sqrt_g, partial_d_ln_sqrt_g__fnd,
partial_d_g_uu, partial_d_g_uu__fnd,

h, h__fnd,

s_d, s_d__fnd,
partial_d_s_d, partial_d_s_d__fnd,

n_u, n_u__fnd,

Theta_A, Theta_A__fnd,
Theta_B, Theta_B__fnd,
Theta_C, Theta_C__fnd,
Theta_D, Theta_D__fnd,
Theta, Theta__fnd,

partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd,
partial_d_Theta_C, partial_d_Theta_C__fnd,
partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd,

partial_Theta_A_wrt_partial_d_h, partial_Theta_A_wrt_partial_d_h__fnd,
partial_Theta_B_wrt_partial_d_h, partial_Theta_B_wrt_partial_d_h__fnd,
partial_Theta_C_wrt_partial_d_h, partial_Theta_C_wrt_partial_d_h__fnd,
partial_Theta_D_wrt_partial_d_h, partial_Theta_D_wrt_partial_d_h__fnd,
partial_Theta_A_wrt_partial_dd_h, partial_Theta_A_wrt_partial_dd_h__fnd,
partial_Theta_B_wrt_partial_dd_h, partial_Theta_B_wrt_partial_dd_h__fnd,

partial_Theta_X_wrt_partial_d_h, partial_Theta_X_wrt_partial_d_h__fnd,
partial_Theta_Y_wrt_partial_d_h, partial_Theta_Y_wrt_partial_d_h__fnd,
partial_Theta_X_wrt_partial_dd_h, partial_Theta_X_wrt_partial_dd_h__fnd,
partial_Theta_Y_wrt_partial_dd_h, partial_Theta_Y_wrt_partial_dd_h__fnd # no comma

```

gr/horizon.maple:
```
# horizon.maple - evaluate $H$ = LHS of horizon function
# $Header$
#
# horizon - overall driver
## non_unit_normal - compute s_d
## non_unit_normal_deriv - compute partial_d_s_d
## expansion - compute Theta_[ABCD],Theta = fn(s_d__fnd) = fn(h)
## expansion_Jacobian - compute Jacobian coeffs for Theta_[ABCD], Theta
#

################################################################################
################################################################################
################################################################################

#
# This function is a driver to compute, and optionally generate C code
# for, the LHS of the apparent horizon equation, H.
#
# Inputs:
#	h
#
# Outputs:
#   Theta = Theta__fnd(h, ...)
#   partial_Theta_wrt_partial_d_h__fnd  = partial_Theta_wrt_partial_d_h(h, ...)
#   partial_Theta_wrt_partial_dd_h__fnd = partial_Theta_wrt_partial_dd_h(h, ...)
#
horizon :=
proc(cg_flag::boolean)

non_unit_normal();
non_unit_normal_deriv();
expansion(cg_flag);
expansion_Jacobian(cg_flag);

NULL;
end proc;

################################################################################

#
# This function computes the xyz components of the non-unit
# outward-pointing normal (covector) to the horizon, s_d = s_d(h),
# using the equation on p.7.1 of my apparent horizon finding notes.
#
# This function does *NOT* generate any C code.
#
# Outputs:
#   s_d = s_d__fnd( x_xyz, X_ud, Diff(h,y_rs) )
#
non_unit_normal :=
proc()
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local i, u;

printf("%a...\n", procname);

assert_fnd_exists(h);
assert_fnd_exists(X_ud);
assert_fnd_exists(s_d, fnd);

	for i from 1 to N
	do
	s_d__fnd[i] := x_xyz[i]/r
		       - sum('X_ud[u,i]*Diff(h,y_rs[u])', 'u'=1..N_ang);
	end do;

NULL;
end proc;

################################################################################

#
# This function computes the xyz derivatives of the non-unit outward-pointing
# normal (covector) to the horizon, using the equation on p.7.2 of my
# apparent horizon finding notes.
#
# This function does *NOT* generate any C code.
#
# Inputs:
#   s_d = s_d__fnd( x_xyz, X_ud, Diff(h,y_rs) )
#
# Outputs:
#   partial_d_s_d = partial_d_s_d__fnd( x_xyz, X_ud, X_udd,
#					Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#
non_unit_normal_deriv :=
proc()
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local temp, i, j, k, u, v;

printf("%a...\n", procname);

assert_fnd_exists(h);
assert_fnd_exists(X_ud);
assert_fnd_exists(X_udd);
assert_fnd_exists(partial_d_s_d, fnd);

	for i from 1 to N
	do
	for j from 1 to N
	do
	temp := `if`(i = j,
		     sum('x_xyz[k]^2', 'k'=1..N) - x_xyz[i]^2,
		     - x_xyz[i] * x_xyz[j]);

	# simplify likes to put things over a common denominator,
	# so we only apply it to the individual terms, not to
	# the whole expression
	partial_d_s_d__fnd[i,j]
	   := + simplify(  temp/r^3  )
	      - simplify(  sum('X_udd[u,i,j]*Diff(h,y_rs[u])', 'u'=1..N_ang)  )
	      - simplify(  msum('X_ud[u,i]*X_ud[v,j]*Diff(h,y_rs[u],y_rs[v])',
				'u'=1..N_ang, 'v'=1..N_ang)  );
	end do;
	end do;

NULL;
end proc;

################################################################################

#
# This function computes the expansion $\Theta$ of a trial horizon surface
# as a function of 1st and 2nd angular partial derivatives of the surface
# radius $h$, using equations (14) and (15[abcd]) in my 1996 AH-finding
# paper, but using partial_d_g_uu[k,i,j] instead of Diff(g_uu[i,j], x_xyz[k]).
#
# These equations give Theta_[ABCD] and Theta as functions of s_d, but
# here we use s_d__fnd, which we assume is already given in terms of angular
# derivatives of h.  The result is that we compute Theta_[ABCD] and Theta
# directly in terms of 1st and 2nd angular derivatives of h, without s_d
# ever appearing in our final results.
#
# This function also optionally generates C code for the computation
# of Theta_[ABCD].  It does *not* compute C code for the computation of
# Theta itself, since we may want to check that Theta_D > 0 in the C
# code before we compute Theta itself.
#
# Inputs:
#   s_d = s_d__fnd( x_xyz, X_ud, Diff(h,y_rs) )
#   partial_d_s_d = partial_d_s_d__fnd( x_xyz, X_ud, X_udd,
#					Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#
# Outputs:
#   Theta_A = Theta_A__fnd( x_xyz, X_ud, X_udd, g_uu, partial_d_g_uu,
#			    Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#   Theta_B = Theta_B__fnd( x_xyz, X_ud, X_udd,
#			    g_uu, partial_d_g_uu, partial_d_ln_sqrt_g,
#			    Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#   Theta_C = Theta_C__fnd( x_xyz, X_ud, K_uu, Diff(h,y_rs) )
#   Theta_D = Theta_D__fnd( x_xyz, X_ud, g_uu, Diff(h,y_rs) )
#   ---------------------------------------------------------------
#   Theta = Theta__fnd(Theta_A__fnd, Theta_B__fnd, Theta_C__fnd, Theta_D__fnd)
#
expansion :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local i,j,k,l;

printf("%a...\n", procname);

assert_fnd_exists(g_uu);
assert_fnd_exists(K_uu);
assert_fnd_exists(partial_d_ln_sqrt_g);
assert_fnd_exists(partial_d_g_uu);
assert_fnd_exists(s_d, fnd);
assert_fnd_exists(partial_d_s_d, fnd);

#
# n.b. no simplify() in these subexpressions; empirically it makes
#      them much *more* complicated (measured by codegen(...,optimized))
#

# (15a) in my paper
Theta_A__fnd
    := - msum('g_uu[i,k]*s_d__fnd[k] * g_uu[j,l]*s_d__fnd[l]
				     * partial_d_s_d__fnd[i,j]',
	      'i'=1..N, 'j'=1..N, 'k'=1..N, 'l'=1..N)
       - (1/2)*msum('g_uu[i,j]*s_d__fnd[j]
		     * partial_d_g_uu[i,k,l] * s_d__fnd[k]*s_d__fnd[l]',
		    'i'=1..N, 'j'=1..N, 'k'=1..N, 'l'=1..N);

# (15b) in my paper
Theta_B__fnd
    := + msum('partial_d_g_uu[i,i,j]*s_d__fnd[j]', 'i'=1..N, 'j'=1..N)
       + msum('g_uu[i,j]*partial_d_s_d__fnd[i,j]', 'i'=1..N, 'j'=1..N)
       + msum('g_uu[i,j]*partial_d_ln_sqrt_g[i]*s_d__fnd[j]',
	      'i'=1..N, 'j'=1..N);

# (15c) in my paper
Theta_C__fnd := msum('K_uu[i,j]*s_d__fnd[i]*s_d__fnd[j]', 'i'=1..N, 'j'=1..N);

# (15d) in my paper
Theta_D__fnd := msum('g_uu[i,j]*s_d__fnd[i]*s_d__fnd[j]', 'i'=1..N, 'j'=1..N);

# n.b. no simplify() here, it would try to put things over a common
#      denominator, which would make the equation *much* more complicated
Theta__fnd := + Theta_A__fnd/Theta_D__fnd^(3/2)
	      + Theta_B__fnd/Theta_D__fnd^(1/2)
	      + Theta_C__fnd/Theta_D__fnd
	      - K;

if (cg_flag)
   then codegen2([ Theta_A__fnd, Theta_B__fnd, Theta_C__fnd, Theta_D__fnd],
		 ['Theta_A',    'Theta_B',    'Theta_C',    'Theta_D'    ],
		 "../gr.cg/expansion.c");
fi;

NULL;
end proc;

################################################################################

#
# This function computes the Jacobian coefficients for the expansion
# $\Theta$ of a trial horizon surface with respect to 1st and 2nd angular
# partial derivatives of the surface radius $h$.  These coefficients
# are (or at least should be :) the same as those in equation (A1) in
# my 1996 apparent horizon finding paper, bue here we compute them in
# a different manner: we have Maple directly differentiate Theta__fnd with
# respect to Diff(h,y_rs[u]) and Diff(h,y_rs[u],y_rs[v]).  We use the
# Maple frontend() function to do this.
#
# This function also optionally generates C code for the Jacobian
# coefficients.
#
# Inputs:
#   Theta_A = Theta_A__fnd( x_xyz, X_ud, X_udd, g_uu, partial_d_g_uu,
#			    Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#   Theta_B = Theta_B__fnd( x_xyz, X_ud, X_udd,
#			    g_uu, partial_d_g_uu, partial_d_ln_sqrt_g,
#			    Diff(h,y_rs), Diff(h,y_rs,y_rs) )
#   Theta_C = Theta_C__fnd( x_xyz, X_ud, K_uu, Diff(h,y_rs) )
#   Theta_D = Theta_D__fnd( x_xyz, X_ud, g_uu, Diff(h,y_rs) )
#   Theta = Theta__fnd(Theta_A__fnd, Theta_B__fnd, Theta_C__fnd, Theta_D__fnd)
#
# Outputs:
#   partial_Theta_A_wrt_partial_d_h	partial_Theta_A_wrt_partial_dd_h
#   partial_Theta_B_wrt_partial_d_h	partial_Theta_B_wrt_partial_dd_h
#   partial_Theta_C_wrt_partial_d_h
#   partial_Theta_D_wrt_partial_d_h
#   ---------------------------------------------------------------
#   partial_Theta_wrt_partial_d_h	partial_Theta_wrt_partial_dd_h
#
expansion_Jacobian :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local u,v,
      temp1,temp2;

printf("%a...\n", procname);

assert_fnd_exists(g_uu);
assert_fnd_exists(K_uu);
assert_fnd_exists(partial_d_ln_sqrt_g);
assert_fnd_exists(partial_d_g_uu);
assert_fnd_exists(Theta_A);
assert_fnd_exists(Theta_B);
assert_fnd_exists(Theta_C);
assert_fnd_exists(Theta_D);

# Jacobian coefficients of Theta_[ABCD] and Theta wrt Diff(h,y_rs[u])
	for u from 1 to N_ang
	do
	partial_Theta_A_wrt_partial_d_h__fnd[u]
		:= frontend('diff', [Theta_A__fnd, Diff(h,y_rs[u])]);
	partial_Theta_B_wrt_partial_d_h__fnd[u]
		:= frontend('diff', [Theta_B__fnd, Diff(h,y_rs[u])]);
	partial_Theta_C_wrt_partial_d_h__fnd[u]
		:= frontend('diff', [Theta_C__fnd, Diff(h,y_rs[u])]);
	partial_Theta_D_wrt_partial_d_h__fnd[u]
		:= frontend('diff', [Theta_D__fnd, Diff(h,y_rs[u])]);

	# equation (A1a) in my 1996 apparent horizon finding paper
	temp1 := + (3/2)*Theta_A/Theta_D^(5/2)
		 + (1/2)*Theta_B/Theta_D^(3/2);
	partial_Theta_X_wrt_partial_d_h__fnd[u]
		:= + partial_Theta_A_wrt_partial_d_h__fnd[u] / Theta_D^(3/2)
		   + partial_Theta_B_wrt_partial_d_h__fnd[u] / Theta_D^(1/2)
		   - partial_Theta_D_wrt_partial_d_h__fnd[u] * temp1;
	temp2 := + Theta_C/Theta_D^2;
	partial_Theta_Y_wrt_partial_d_h__fnd[u]
		:= + partial_Theta_C_wrt_partial_d_h__fnd[u] / Theta_D
		   - partial_Theta_D_wrt_partial_d_h__fnd[u] * temp2;
	end do;

# Jacobian coefficients of Theta_[AB] and Theta wrt Diff(h,y_rs[u],y_rs[v])
	for u from 1 to N_ang
	do
	for v from u to N_ang
	do
	partial_Theta_A_wrt_partial_dd_h__fnd[u,v]
		:= frontend('diff', [Theta_A__fnd, Diff(h,y_rs[u],y_rs[v])]);
	partial_Theta_B_wrt_partial_dd_h__fnd[u,v]
		:= frontend('diff', [Theta_B__fnd, Diff(h,y_rs[u],y_rs[v])]);

	# equation (A1b) in my 1996 apparent horizon finding paper
	partial_Theta_X_wrt_partial_dd_h__fnd[u,v]
		:= + partial_Theta_A_wrt_partial_dd_h__fnd[u,v] / Theta_D^(3/2)
		   + partial_Theta_B_wrt_partial_dd_h__fnd[u,v] / Theta_D^(1/2);
	partial_Theta_Y_wrt_partial_dd_h__fnd[u,v]
		:= 0;
	end do;
	end do;

if (cg_flag)
   then codegen2([partial_Theta_X_wrt_partial_d_h__fnd,
		  partial_Theta_Y_wrt_partial_d_h__fnd,
		  partial_Theta_X_wrt_partial_dd_h__fnd,
		  partial_Theta_Y_wrt_partial_dd_h__fnd],
		 ['partial_Theta_X_wrt_partial_d_h',
		  'partial_Theta_Y_wrt_partial_d_h',
		  'partial_Theta_X_wrt_partial_dd_h',
		  'partial_Theta_Y_wrt_partial_dd_h'],
		 "../gr.cg/expansion_Jacobian.c");
fi;

NULL;
end proc;

```

gr/doit.maple:
```
# top-level Maple file to read/run all code in this directory
# $Header$

read "../maple/setup.mm";

read "setup_gr_gfas.mm";
setup_gr_gfas();

read "auxiliary.mm";
read "curvature.mm";
read "horizon.mm";

`saveit/level` := 10;
auxiliary(true);
curvature(true);
horizon(true);

```

gr/maple.log:
```
RedHat v <9 or other Linux present, starting standard mode...
    |\^/|     Maple 7 (IBM INTEL LINUX)
._|\|   |/|_. Copyright (c) 2001 by Waterloo Maple Inc.
 \  MAPLE  /  All rights reserved. Maple is a registered trademark of
 <____ ____>  Waterloo Maple Inc.
      |       Type ? for help.
# top-level Maple file to read/run all code in this directory
# $Header: /numrelcvs/AEIThorns/AHFinderDirect/src/gr/doit.maple,v 1.5 2002/09/13 14:12:18 jthorn Exp $
> 
> read "../maple/setup.mm";
msum := proc(fn::algebraic)
local expr, sum_index;
    if nargs < 2 then ERROR("must have two or more arguments") end if;
    expr := fn;
    for sum_index in [args[2 .. nargs]] do
        expr; sum_index; expr := 'sum'(''%%'', ''%'')
    end do;
    return eval(expr)
end proc

      arctan_xy := proc(x::algebraic, y::algebraic) arctan(y, x) end proc

            ssqrt := proc(x::algebraic) sqrt(x, 'symbolic') end proc

indices_in_order :=

    proc(T::table) return sort([indices(T)], lexorder_integer_list) end proc

lexorder_integer_list := proc(list1::list(numeric), list2::list(numeric))
local len1, len2, k;
    len1 := nops(list1);
    len2 := nops(list2);
    for k to min(len1, len2) do
        if list1[k] < list2[k] then return true
        elif list2[k] < list1[k] then return false
        end if
    end do;
    return evalb(len1 < len2)
end proc

sort_var_list := proc(var_list::list(name))
global lexorder_vars;
option remember;
    return sort(var_list, lexorder_vars)
end proc

lexorder_vars := proc(x::name, y::name)
local xposn, yposn;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set;
option remember;
    if member(x, xy_all_list, 'xposn') and member(y, xy_all_list, 'yposn')
    then return evalb(xposn < yposn)
    else return lexorder(x, y)
    end if
end proc

gensym := proc(opt_base_name::string)
local base_name, tn;
global `gensym/counter`;
    if 1 <= nargs then base_name := opt_base_name
    else base_name := 'temp_'
    end if;
    if not assigned(`gensym/counter`) then `gensym/init`() end if;
    tn := cat(base_name, `gensym/counter`);
    `gensym/counter` := `gensym/counter` + 1;
    tn;
    return '%'
end proc

gensym/init := proc(opt_initial_counter::integer)
local initial_counter;
global `gensym/counter`;
    if 1 <= nargs then initial_counter := opt_initial_counter
    else initial_counter := 1
    end if;
    `gensym/counter` := initial_counter;
    NULL
end proc

saveit := proc(
n::integer, fn::{procedure, string}, label::string, expr::anything)
local save_name;
global `saveit/level`;
    if assigned(`saveit/level`) and type(`saveit/level`, integer) and
    n <= `saveit/level` then
        save_name := cat(convert(fn, string), "/", label);
        printf("      --> `%s`\n", save_name);
        assign(convert(eval(save_name, 1), name) = expr)
    end if;
    NULL
end proc

setup_coords := proc()
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set;
    N := 3;
    N_ang := 2;
    delta := array(1 .. N, 1 .. N, identity);
    x_xyz := array(1 .. N);
    x_xyz[1] := xx;
    x_xyz[2] := yy;
    x_xyz[3] := zz;
    x_xyz_list := [xx, yy, zz];
    x_xyz_set := {yy, xx, zz};
    r__fnd := ssqrt(xx^2 + yy^2 + zz^2);
    y_rs := array(1 .. N_ang);
    y_rs[1] := rho;
    y_rs[2] := sigma;
    y_rs_list := [rho, sigma];
    y_rs_set := {sigma, rho};
    xy_all_list := [op(x_xyz_list), op(y_rs_list)];
    xy_all_set := {op(xy_all_list)};
    NULL
end proc

simplify/Diff := proc(expr)
local temp;
option remember;
    if type(expr, {`*`, `^`, `=`, `+`, set, table, list}) then
        return map(simplify, expr)
    end if;
    if type(expr, {procedure, name, numeric}) then return expr end if;
    if type(expr, function) then
        if op(0, expr) = 'Diff' then return Diff(op(expr))
        else
            temp := map(simplify, [op(expr)]);
            op(0, expr);
            return '%'(op(temp))
        end if
    end if;
    ERROR(`expr has unknown type`, `whattype(expr)=`, whattype(expr))
end proc

Diff := proc(operand)
local var_list, nn, nderiv, op_cdr, f, g, x, x_car, x_cdr, temp, n,
inner_operand, inner_var_list, k, sorted_var_list, operand2, var_seq2;
option remember;
    var_list := [args[2 .. nargs]];
    nn := nops(operand);
    nderiv := nops(var_list);
    if type(operand, `+`) then return
        simplify(sum('Diff(op(k, operand), op(var_list))', 'k' = 1 .. nn))
    end if;
    if type(operand, `*`) and 1 <= nn and type(op(1, operand), numeric)
    then
        op_cdr := product('op(k, operand)', 'k' = 2 .. nn);
        return simplify(op(1, operand)*Diff(op_cdr, op(var_list)))
    end if;
    if type(operand, numeric) then return 0 end if;
    if type(operand, name) and var_list = [operand] then return 1 end if;
    if type(operand, `*`) then
        if nn = 0 then return 0
        elif nn = 1 then
            return simplify(Diff(op(1, operand), op(var_list)))
        elif 2 <= nn then
            f := op(1, operand);
            g := product('op(k, operand)', 'k' = 2 .. nn);
            if nderiv = 1 then
                x := var_list[1];
                return simplify(Diff(f, x)*g + f*Diff(g, x))
            else
                x_car := var_list[1];
                x_cdr := var_list[2 .. nderiv];
                temp := simplify(Diff(f*g, x_car));
                return simplify(Diff(temp, op(x_cdr)))
            end if
        else ERROR(`impossible value of nn in product rule!`,
            `(this should never happen!)`, `   operand=`, operand, `   nn=`,
            nn)
        end if
    end if;
    if type(operand, `^`) then
        f := op(1, operand);
        n := op(2, operand);
        if nderiv = 1 then
            x := var_list[1]; return simplify(n*f^(n - 1)*Diff(f, x))
        else
            x_car := var_list[1];
            x_cdr := var_list[2 .. nderiv];
            temp := simplify(Diff(f^n, x_car));
            return simplify(Diff(temp, op(x_cdr)))
        end if
    end if;
    if type(operand, function) and op(0, operand) = 'Diff' then
        inner_operand := op(1, operand);
        inner_var_list := [op(2 .. nn, operand)];
        return
            simplify(Diff(inner_operand, op(inner_var_list), op(var_list)))
    end if;
    sorted_var_list := sort_var_list(var_list);
    temp := `Diff/gridfn`(operand, op(sorted_var_list));
    if type(`Diff/gridfn2`, procedure) and type(temp, function) and
    op(0, temp) = 'Diff' then
        operand2 := op(1, temp);
        var_seq2 := op(2 .. nops(temp), temp);
        temp := `Diff/gridfn2`(operand2, var_seq2)
    end if;
    return temp
end proc

Diff/gridfn := proc(operand)
local var_list, posn;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
option remember;
    var_list := [args[2 .. nargs]];
    if type(operand, indexed) and op(0, operand) = 'X_ud' and
    nops(var_list) = 1 and member(var_list[1], x_xyz_list, 'posn') then
        return X_udd[op(operand), posn]
    end if;
    return 'Diff'(operand, op(var_list))
end proc

make_gfa := proc(gfa_name::name, fnd_name_set::set(name),
index_bounds::list(integer .. integer), index_fn::{name, identical(none)})
local fnd_name, var_name, index_fn_seq;
global N, `gfa/fnd_table`;
    if not type(N, integer) then ERROR("must set up coordinates first!")
    end if;
    if index_bounds = [] and index_fn <> 'none' then ERROR(
        "not meaningful to specify a symmetry function for a scalar!",
        "   gfa_name=", gfa_name)
    end if;
    for fnd_name in fnd_name_set do
        var_name := Maple_name(gfa_name, fnd_name);
        if assigned(`gfa/fnd_table`[eval(var_name, 1)]) then ERROR(
            "duplicate gfa/fnd definition!", "   gfa_name=", gfa_name,
            "   fnd_name_set=", fnd_name_set)
        end if;
        `gfa/fnd_table`[eval(var_name, 1)] := true;
        if index_bounds = [] then unassign(eval(var_name, 1))
        else
            if index_fn = 'none' then index_fn_seq := NULL
            else index_fn_seq := index_fn
            end if;
            assign(
                eval(var_name, 1) = array(index_fn_seq, op(index_bounds)))
        end if
    end do;
    NULL
end proc

assert_fnd_exists := proc(gfa_name::name, fnd_name::name)
local var_name;
global `gfa/fnd_table`;
    var_name := Maple_name(gfa_name, args[2 .. nargs]);
    if not assigned(`gfa/fnd_table`[eval(var_name, 1)]) then ERROR(
        "functional-dependence form doesn't exist!", "var_name=", var_name)
    end if
end proc

Maple_name := proc(gfa_name::name, fnd_name::name)
    if nargs = 1 or fnd_name = 'inert' then return gfa_name
    else return cat(gfa_name, "__", fnd_name)
    end if
end proc

index/symmetric3_23 := proc(ilist::list, tab::table, vlist::list)
local k, i, j, index_seq;
    if not (nops(ilist) = 3) then ERROR(`must have exactly 3 indices!`)
    end if;
    k := eval(ilist[1]);
    i := eval(ilist[2]);
    j := eval(ilist[3]);
    index_seq := k, op(sort([i, j]));
    if nargs = 2 then return tab[index_seq]
    else tab[index_seq] := op(vlist)
    end if
end proc

print_symmetric3_23 := proc(A::array)
local bounds, k, i, j, M23;
    if op(1, eval(A)) <> 'symmetric3_23' then
        ERROR(`can only print symmetric3_23 arrays`)
    end if;
    bounds := op(2, eval(A));
    M23 := array(bounds[2 .. 3], symmetric);
    for k in `$`(bounds[1]) do
        for i in `$`(bounds[2]) do for j in `$`(bounds[3]) do
                if i <= j then M23[i, j] := A[k, i, j] end if
            end do
        end do;
        printf("[%d] = \n", k);
        print(M23)
    end do;
    NULL
end proc

setup_coeff_gfas := proc()
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd;
    make_gfa('X_ud', {inert}, [1 .. N_ang, 1 .. N], none);
    make_gfa('X_udd', {inert}, [1 .. N_ang, 1 .. N, 1 .. N], symmetric3_23)
        ;
    NULL
end proc

codegen2 := proc(expr_in::{algebraic, list(algebraic)},
lhs_name::{name, list(name)}, output_file_name::string)
local expr, expr_temps, input_set, output_set, expr_cost;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd;
    printf("codegen2(%a) --> \"%s\"\n", lhs_name, output_file_name);
    expr := expr_in;
    saveit(10, procname, "input", expr);
    printf("   convert --> equation list\n");
    expr := cvt_to_eqnlist(expr, lhs_name);
    saveit(10, procname, "eqnlist", expr);
    printf("   optimizing computation sequence\n");
    expr := [codegen[optimize](expr)];
    saveit(10, procname, "optimize", expr);
    printf("   find temporary variables\n");
    expr_temps := temps_in_eqnlist(expr, lhs_name);
    saveit(10, procname, "temps", expr_temps);
    printf(
        "   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc\n")
        ;
    expr := fix_Diff(expr);
    saveit(10, procname, "fix_Diff", expr);
    input_set := deindex_names(
        (indets(map(rhs, expr), name) minus {op(expr_temps)}) minus
        xy_all_set);
    output_set :=
        deindex_names({op(map(lhs, expr))} minus {op(expr_temps)});
    printf("   convert R_dd[2,3] --> R_dd_23 etc\n");
    expr := unindex_names(expr);
    saveit(10, procname, "unindex", expr);
    expr_cost := codegen[cost](expr);
    printf("   convert p/q --> RATIONAL(p/q)\n");
    expr := fix_rationals(expr);
    saveit(10, procname, "fix_rationals", expr);
    printf("   writing C code\n");
    ftruncate(output_file_name);
    fprintf(output_file_name, "/*\n");
    fprintf(output_file_name, " * inputs = %a\n", input_set);
    fprintf(output_file_name, " * outputs = %a\n", output_set);
    fprintf(output_file_name, " * cost = %a\n", expr_cost);
    fprintf(output_file_name, " */\n");
    print_name_list_dcl(expr_temps, "fp", output_file_name);
    codegen[C](expr, filename = output_file_name);
    NULL
end proc

cvt_to_eqnlist := proc(expr::{algebraic, array, list({algebraic, array})},
lhs_name::{name, list(name)})
    if type(expr, array) and type(lhs_name, name) then return map(
        proc(ii) return lhs_name[op(ii)] = expr[op(ii)] end proc,
        indices_in_order(expr))
    end if;
    if type(expr, algebraic) and type(lhs_name, name) then
        return [lhs_name = expr]
    end if;
    if type(expr, list({algebraic, array})) and type(lhs_name, list(name))
    then return zip(op@cvt_to_eqnlist, expr, lhs_name)
    end if;
    error
        "unknown type for expression!\n   expr=%1\n   whattype(expr)=%2\n",
        expr, whattype(expr)
end proc

fix_Diff := proc(
expr::{algebraic, name = algebraic, list({algebraic, name = algebraic})})
local nn, k, base, power, fn, fn_args_list, Darg, Dvars;
global `fix_Diff/remap_table`;
    if type(expr, list) then return map(fix_Diff, expr) end if;
    if type(expr, name = algebraic) then
        return lhs(expr) = fix_Diff(rhs(expr))
    end if;
    nn := nops(expr);
    if type(expr, `+`) then
        return sum('fix_Diff(op(k, expr))', 'k' = 1 .. nn)
    end if;
    if type(expr, `*`) then
        return product('fix_Diff(op(k, expr))', 'k' = 1 .. nn)
    end if;
    if type(expr, `^`) then
        base := op(1, expr);
        power := op(2, expr);
        return fix_Diff(base)^power
    end if;
    if type(expr, function) and op(0, expr) <> 'Diff' then
        fn := op(0, expr);
        fn_args_list := [op(expr)];
        fn;
        return '%'(op(map(fix_Diff, fn_args_list)))
    end if;
    if type(expr, function) and op(0, expr) = 'Diff' then
        Darg := op(1, expr);
        Dvars := [op(2 .. nn, expr)];
        if assigned(`fix_Diff/remap_table`[op(Dvars)]) then
            `fix_Diff/remap_table`[op(Dvars)]; return '%'(Darg)
        else error "don't know how to remap Diff() call!\n   Darg = %1\n\
               Dvars = %2\n", Darg, Dvars
        end if
    end if;
    return expr
end proc

                    fix_Diff/remap_table[rho] := PARTIAL_RHO

                  fix_Diff/remap_table[sigma] := PARTIAL_SIGMA

               fix_Diff/remap_table[rho, rho] := PARTIAL_RHO_RHO

             fix_Diff/remap_table[rho, sigma] := PARTIAL_RHO_SIGMA

           fix_Diff/remap_table[sigma, sigma] := PARTIAL_SIGMA_SIGMA

                     fix_Diff/remap_table[xx] := PARTIAL_X

                     fix_Diff/remap_table[yy] := PARTIAL_Y

                     fix_Diff/remap_table[zz] := PARTIAL_Z

                   fix_Diff/remap_table[xx, xx] := PARTIAL_XX

                   fix_Diff/remap_table[xx, yy] := PARTIAL_XY

                   fix_Diff/remap_table[xx, zz] := PARTIAL_XZ

                   fix_Diff/remap_table[yy, yy] := PARTIAL_YY

                   fix_Diff/remap_table[yy, zz] := PARTIAL_YZ

                   fix_Diff/remap_table[zz, zz] := PARTIAL_ZZ

temps_in_eqnlist := proc(
expr::list(name = algebraic), result_name::{name, list(name), set(name)})
    return remove(is_result, map(lhs, expr), result_name)
end proc

is_result := proc(try_name::name, result_name_in::{name, list(name), set(name)}
)
local result_name, rn;
    if type(result_name_in, name) then result_name := {result_name_in}
    else result_name := result_name_in
    end if;
    for rn in result_name do
        if try_name = rn then return true
        elif type(try_name, indexed) and op(0, try_name) = rn then
            return true
        end if
    end do;
    return false
end proc

deindex_names := proc(
expr::{function, name, list({function, name}), set({function, name})})
local fn, fn_args_list;
    if type(expr, {set, list}) then return map(deindex_names, expr) end if;
    if type(expr, function) then
        fn := op(0, expr);
        fn_args_list := [op(expr)];
        fn;
        return '%'(op(map(deindex_names, fn_args_list)))
    end if;
    if type(expr, indexed) then return op(0, expr) end if;
    if type(expr, {name, numeric}) then return expr end if;
    error "expr has unknown type!\nwhattype(expr)=%1\n", whattype(expr)
end proc

unindex_names := proc(expr::{algebraic, name = algebraic,
list({algebraic, name = algebraic}), set({algebraic, name = algebraic})})
local nn, k, base, power, fn, fn_args_list, base_name, index_seq;
    if type(expr, {set, list}) then return map(unindex_names, expr) end if;
    if type(expr, `=`) then
        return unindex_names(lhs(expr)) = unindex_names(rhs(expr))
    end if;
    nn := nops(expr);
    if type(expr, `+`) then
        return sum('unindex_names(op(k, expr))', 'k' = 1 .. nn)
    end if;
    if type(expr, `*`) then
        return product('unindex_names(op(k, expr))', 'k' = 1 .. nn)
    end if;
    if type(expr, `^`) then
        base := op(1, expr);
        power := op(2, expr);
        return unindex_names(base)^power
    end if;
    if type(expr, function) then
        fn := op(0, expr);
        fn_args_list := [op(expr)];
        fn;
        return '%'(op(map(unindex_names, fn_args_list)))
    end if;
    if type(expr, indexed) then
        base_name := op(0, expr);
        index_seq := op(expr);
        return cat(base_name, "_", index_seq)
    end if;
    if type(expr, {name, numeric}) then return expr end if;
    error "expr has unknown type!\nwhattype(expr)=%1\n", whattype(expr)
end proc

fix_rationals := proc(
expr::{algebraic, name = algebraic, list({algebraic, name = algebraic})})
local nn, k, expr_sign, expr_abs, base, power, fbase, fpower, fn,
fn_args_list, int_factors, nonint_factors, num, den, mult;
    if type(expr, list) then return map(fix_rationals, expr) end if;
    if type(expr, name = algebraic) then
        return lhs(expr) = fix_rationals(rhs(expr))
    end if;
    if type(expr, function) then
        fn := op(0, expr);
        if fn <> 'RATIONAL' then
            fn_args_list := [op(expr)];
            fn;
            return '%'(op(map(fix_rationals, fn_args_list)))
        end if
    end if;
    nn := nops(expr);
    if type(expr, `+`) then
        return sum('fix_rationals(op(k, expr))', 'k' = 1 .. nn)
    end if;
    if type(expr, `*`) then
        int_factors, nonint_factors := selectremove(type, expr, integer);
        if 0 < nops(int_factors) then return op(1, int_factors)*product(
            'fix_rationals(op(k, nonint_factors))',
            'k' = 1 .. nops(nonint_factors))
        else return product('fix_rationals(op(k, expr))', 'k' = 1 .. nn)
        end if
    end if;
    if type(expr, `^`) then
        base := op(1, expr);
        power := op(2, expr);
        fbase := fix_rationals(base);
        if type(power, integer) then fpower := power
        else fpower := fix_rationals(power)
        end if;
        return fbase^fpower
    end if;
    if type(expr, integer) then return 'RATIONAL'(expr, 1) end if;
    if type(expr, fraction) then
        num := op(1, expr); den := op(2, expr); return 'RATIONAL'(num, den)
    end if;
    if type(expr, float) then
        mult := op(1, expr);
        power := op(2, expr);
        return fix_rationals(mult*10^power)
    end if;
    if type(expr, name) then return expr end if;
    error "expr has unknown type!\nwhattype(expr)=%1\nexpr=%2\n",
        whattype(expr), expr
end proc

print_name_list_dcl := proc(
name_list::list({name, string}), name_type::string, file_name::string)
local nn;
    nn := nops(name_list);
    if nn <= 10 then
        map(convert, name_list, string);
        ListTools[Join](%, ", ");
        cat(op(%));
        fprintf(file_name, "%s %s;\n", name_type, %);
        NULL;
        return
    end if;
    print_name_list_dcl([op(1 .. 10, name_list)], name_type, file_name);
    print_name_list_dcl([op(11 .. nn, name_list)], name_type, file_name)
end proc

> 
> read "setup_gr_gfas.mm";
setup_gr_gfas := proc()
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    make_gfa('g_dd', {inert}, [1 .. N, 1 .. N], symmetric);
    make_gfa('K_dd', {inert}, [1 .. N, 1 .. N], symmetric);
    make_gfa('g_uu', {inert, fnd}, [1 .. N, 1 .. N], symmetric);
    make_gfa('K_uu', {inert, fnd}, [1 .. N, 1 .. N], symmetric);
    make_gfa('K', {inert, fnd}, [], none);
    make_gfa('partial_d_g_dd', {inert}, [1 .. N, 1 .. N, 1 .. N],
        symmetric3_23);
    make_gfa('partial_d_ln_sqrt_g', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_g_uu', {inert, fnd}, [1 .. N, 1 .. N, 1 .. N],
        symmetric3_23);
    make_gfa('h', {inert, fnd}, [], none);
    make_gfa('s_d', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_s_d', {inert, fnd}, [1 .. N, 1 .. N], none);
    make_gfa('Theta_A', {inert, fnd}, [], none);
    make_gfa('Theta_B', {inert, fnd}, [], none);
    make_gfa('Theta_C', {inert, fnd}, [], none);
    make_gfa('Theta_D', {inert, fnd}, [], none);
    make_gfa('Theta', {inert, fnd}, [], none);
    make_gfa('partial_d_Theta_A', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_Theta_B', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_Theta_C', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_Theta_D', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_d_Theta', {inert, fnd}, [1 .. N], none);
    make_gfa('partial_Theta_A_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_B_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_C_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_D_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_A_wrt_partial_dd_h', {inert, fnd},
        [1 .. N_ang, 1 .. N_ang], symmetric);
    make_gfa('partial_Theta_B_wrt_partial_dd_h', {inert, fnd},
        [1 .. N_ang, 1 .. N_ang], symmetric);
    make_gfa('partial_Theta_X_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_Y_wrt_partial_d_h', {inert, fnd}, [1 .. N_ang],
        none);
    make_gfa('partial_Theta_X_wrt_partial_dd_h', {inert, fnd},
        [1 .. N_ang, 1 .. N_ang], symmetric);
    make_gfa('partial_Theta_Y_wrt_partial_dd_h', {inert, fnd},
        [1 .. N_ang, 1 .. N_ang], symmetric);
    NULL
end proc

Diff/gridfn2 := proc(operand)
local var_list, posn;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
option remember;
    var_list := [args[2 .. nargs]];
    if type(operand, indexed) and op(0, operand) = 'g_dd' and
    nops(var_list) = 1 and member(var_list[1], x_xyz_list, 'posn') then
        return partial_d_g_dd[posn, op(operand)]
    end if;
    return 'Diff'(operand, op(var_list))
end proc

> setup_gr_gfas();
> 
> read "auxiliary.mm";
auxiliary := proc(cg_flag::boolean)
    inverse_metric(cg_flag); extrinsic_curvature_trace_raise(cg_flag); NULL
end proc

inverse_metric := proc(cg_flag::boolean)
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_dd);
    assert_fnd_exists(g_uu, fnd);
    g_uu__fnd := linalg[inverse](g_dd);
    if cg_flag then
        codegen2(g_uu__fnd, 'g_uu', "../gr.cg/inverse_metric.c")
    end if;
    NULL
end proc

extrinsic_curvature_trace_raise := proc(cg_flag::boolean)
local i, j, m, n;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_uu);
    assert_fnd_exists(K_dd);
    assert_fnd_exists(K, fnd);
    assert_fnd_exists(K_uu, fnd);
    K__fnd :=
        simplify(msum('g_uu[i, j]*K_dd[i, j]', 'i' = 1 .. N, 'j' = 1 .. N))
        ;
    for i to N do for j from i to N do K_uu__fnd[i, j] := simplify(msum(
            'g_uu[i, m]*g_uu[j, n]*K_dd[m, n]', 'm' = 1 .. N, 'n' = 1 .. N))
        end do
    end do;
    if cg_flag then codegen2([K__fnd, K_uu__fnd], ['K', 'K_uu'],
        "../gr.cg/extrinsic_curvature_trace_raise.c")
    end if;
    NULL
end proc

> read "curvature.mm";
curvature := proc(cg_flag::boolean)
    inverse_metric_gradient(cg_flag); metric_det_gradient(cg_flag); NULL
end proc

inverse_metric_gradient := proc(cg_flag::boolean)
local k, i, j, m, n;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_dd);
    assert_fnd_exists(g_uu);
    assert_fnd_exists(partial_d_g_uu, fnd);
    for k to N do for i to N do for j from i to N do
                partial_d_g_uu__fnd[k, i, j] := simplify(-msum(
                'g_uu[i, m]*g_uu[j, n]*partial_d_g_dd[k, m, n]',
                'm' = 1 .. N, 'n' = 1 .. N))
            end do
        end do
    end do;
    if cg_flag then codegen2(partial_d_g_uu__fnd, 'partial_d_g_uu',
        "../gr.cg/inverse_metric_gradient.c")
    end if;
    NULL
end proc

metric_det_gradient := proc(cg_flag::boolean)
local k, i, j;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_dd);
    assert_fnd_exists(g_uu);
    assert_fnd_exists(partial_d_ln_sqrt_g, fnd);
    for k to N do partial_d_ln_sqrt_g__fnd[k] := simplify(1/2*msum(
        'g_uu[i, j]*partial_d_g_dd[k, i, j]', 'i' = 1 .. N, 'j' = 1 .. N))
    end do;
    if cg_flag then codegen2(partial_d_ln_sqrt_g__fnd,
        'partial_d_ln_sqrt_g', "../gr.cg/metric_det_gradient.c")
    end if;
    NULL
end proc

> read "horizon.mm";
horizon := proc(cg_flag::boolean)
    non_unit_normal();
    non_unit_normal_deriv();
    expansion(cg_flag);
    expansion_Jacobian(cg_flag);
    NULL
end proc

non_unit_normal := proc()
local i, u;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(h);
    assert_fnd_exists(X_ud);
    assert_fnd_exists(s_d, fnd);
    for i to N do s_d__fnd[i] :=
        x_xyz[i]/r - sum('X_ud[u, i]*Diff(h, y_rs[u])', 'u' = 1 .. N_ang)
    end do;
    NULL
end proc

non_unit_normal_deriv := proc()
local temp, i, j, k, u, v;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(h);
    assert_fnd_exists(X_ud);
    assert_fnd_exists(X_udd);
    assert_fnd_exists(partial_d_s_d, fnd);
    for i to N do for j to N do
            temp := `if`(i = j,
                sum('x_xyz[k]^2', 'k' = 1 .. N) - x_xyz[i]^2,
                -x_xyz[i]*x_xyz[j]);
            partial_d_s_d__fnd[i, j] := simplify(temp/r^3) - simplify(
                sum('X_udd[u, i, j]*Diff(h, y_rs[u])', 'u' = 1 .. N_ang))
                 - simplify(msum(
                'X_ud[u, i]*X_ud[v, j]*Diff(h, y_rs[u], y_rs[v])',
                'u' = 1 .. N_ang, 'v' = 1 .. N_ang))
        end do
    end do;
    NULL
end proc

expansion := proc(cg_flag::boolean)
local i, j, k, l;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_uu);
    assert_fnd_exists(K_uu);
    assert_fnd_exists(partial_d_ln_sqrt_g);
    assert_fnd_exists(partial_d_g_uu);
    assert_fnd_exists(s_d, fnd);
    assert_fnd_exists(partial_d_s_d, fnd);
    Theta_A__fnd := -msum('g_uu[i, k]*s_d__fnd[k]*g_uu[j, l]*s_d__fnd[l]*
        partial_d_s_d__fnd[i, j]', 'i' = 1 .. N, 'j' = 1 .. N, 'k' = 1 .. N,
        'l' = 1 .. N) - 1/2*msum('g_uu[i, j]*s_d__fnd[j]*
        partial_d_g_uu[i, k, l]*s_d__fnd[k]*s_d__fnd[l]', 'i' = 1 .. N,
        'j' = 1 .. N, 'k' = 1 .. N, 'l' = 1 .. N);
    Theta_B__fnd := msum('partial_d_g_uu[i, i, j]*s_d__fnd[j]',
        'i' = 1 .. N, 'j' = 1 .. N) + msum(
        'g_uu[i, j]*partial_d_s_d__fnd[i, j]', 'i' = 1 .. N, 'j' = 1 .. N)
         + msum('g_uu[i, j]*partial_d_ln_sqrt_g[i]*s_d__fnd[j]',
        'i' = 1 .. N, 'j' = 1 .. N);
    Theta_C__fnd := msum('K_uu[i, j]*s_d__fnd[i]*s_d__fnd[j]', 'i' = 1 .. N,
        'j' = 1 .. N);
    Theta_D__fnd := msum('g_uu[i, j]*s_d__fnd[i]*s_d__fnd[j]', 'i' = 1 .. N,
        'j' = 1 .. N);
    Theta__fnd := Theta_A__fnd/Theta_D__fnd^(3/2)
         + Theta_B__fnd/Theta_D__fnd^(1/2) + Theta_C__fnd/Theta_D__fnd - K;
    if cg_flag then codegen2(
        [Theta_A__fnd, Theta_B__fnd, Theta_C__fnd, Theta_D__fnd],
        ['Theta_A', 'Theta_B', 'Theta_C', 'Theta_D'],
        "../gr.cg/expansion.c")
    end if;
    NULL
end proc

expansion_Jacobian := proc(cg_flag::boolean)
local u, v, temp1, temp2;
global delta, N, N_ang, xx, yy, zz, x_xyz, x_xyz_list, x_xyz_set, r, r__fnd,
rho, sigma, y_rs, y_rs_list, y_rs_set, xy_all_list, xy_all_set, inert, none,
fnd, symmetric3_23, X_ud, X_ud__fnd, X_udd, X_udd__fnd, g_dd, K_dd, g_uu,
g_uu__fnd, K_uu, K_uu__fnd, K, K__fnd, partial_d_g_dd, partial_d_ln_sqrt_g,
partial_d_ln_sqrt_g__fnd, partial_d_g_uu, partial_d_g_uu__fnd, h, h__fnd,
s_d, s_d__fnd, partial_d_s_d, partial_d_s_d__fnd, n_u, n_u__fnd, Theta_A,
Theta_A__fnd, Theta_B, Theta_B__fnd, Theta_C, Theta_C__fnd, Theta_D,
Theta_D__fnd, Theta, Theta__fnd, partial_d_Theta_A, partial_d_Theta_A__fnd,
partial_d_Theta_B, partial_d_Theta_B__fnd, partial_d_Theta_C,
partial_d_Theta_C__fnd, partial_d_Theta_D, partial_d_Theta_D__fnd,
partial_d_Theta_, partial_d_Theta__fnd, partial_Theta_A_wrt_partial_d_h,
partial_Theta_A_wrt_partial_d_h__fnd, partial_Theta_B_wrt_partial_d_h,
partial_Theta_B_wrt_partial_d_h__fnd, partial_Theta_C_wrt_partial_d_h,
partial_Theta_C_wrt_partial_d_h__fnd, partial_Theta_D_wrt_partial_d_h,
partial_Theta_D_wrt_partial_d_h__fnd, partial_Theta_A_wrt_partial_dd_h,
partial_Theta_A_wrt_partial_dd_h__fnd, partial_Theta_B_wrt_partial_dd_h,
partial_Theta_B_wrt_partial_dd_h__fnd, partial_Theta_X_wrt_partial_d_h,
partial_Theta_X_wrt_partial_d_h__fnd, partial_Theta_Y_wrt_partial_d_h,
partial_Theta_Y_wrt_partial_d_h__fnd, partial_Theta_X_wrt_partial_dd_h,
partial_Theta_X_wrt_partial_dd_h__fnd, partial_Theta_Y_wrt_partial_dd_h,
partial_Theta_Y_wrt_partial_dd_h__fnd;
    printf("%a...\n", procname);
    assert_fnd_exists(g_uu);
    assert_fnd_exists(K_uu);
    assert_fnd_exists(partial_d_ln_sqrt_g);
    assert_fnd_exists(partial_d_g_uu);
    assert_fnd_exists(Theta_A);
    assert_fnd_exists(Theta_B);
    assert_fnd_exists(Theta_C);
    assert_fnd_exists(Theta_D);
    for u to N_ang do
        partial_Theta_A_wrt_partial_d_h__fnd[u] :=
            frontend('diff', [Theta_A__fnd, Diff(h, y_rs[u])]);
        partial_Theta_B_wrt_partial_d_h__fnd[u] :=
            frontend('diff', [Theta_B__fnd, Diff(h, y_rs[u])]);
        partial_Theta_C_wrt_partial_d_h__fnd[u] :=
            frontend('diff', [Theta_C__fnd, Diff(h, y_rs[u])]);
        partial_Theta_D_wrt_partial_d_h__fnd[u] :=
            frontend('diff', [Theta_D__fnd, Diff(h, y_rs[u])]);
        temp1 := 3/2*Theta_A/Theta_D^(5/2) + 1/2*Theta_B/Theta_D^(3/2);
        partial_Theta_X_wrt_partial_d_h__fnd[u] :=
            partial_Theta_A_wrt_partial_d_h__fnd[u]/Theta_D^(3/2)
             + partial_Theta_B_wrt_partial_d_h__fnd[u]/Theta_D^(1/2)
             - partial_Theta_D_wrt_partial_d_h__fnd[u]*temp1;
        temp2 := Theta_C/Theta_D^2;
        partial_Theta_Y_wrt_partial_d_h__fnd[u] :=
            partial_Theta_C_wrt_partial_d_h__fnd[u]/Theta_D
             - partial_Theta_D_wrt_partial_d_h__fnd[u]*temp2
    end do;
    for u to N_ang do for v from u to N_ang do
            partial_Theta_A_wrt_partial_dd_h__fnd[u, v] :=
                frontend('diff', [Theta_A__fnd, Diff(h, y_rs[u], y_rs[v])])
                ;
            partial_Theta_B_wrt_partial_dd_h__fnd[u, v] :=
                frontend('diff', [Theta_B__fnd, Diff(h, y_rs[u], y_rs[v])])
                ;
            partial_Theta_X_wrt_partial_dd_h__fnd[u, v] :=
                partial_Theta_A_wrt_partial_dd_h__fnd[u, v]/Theta_D^(3/2)
                 +
                partial_Theta_B_wrt_partial_dd_h__fnd[u, v]/Theta_D^(1/2);
            partial_Theta_Y_wrt_partial_dd_h__fnd[u, v] := 0
        end do
    end do;
    if cg_flag then codegen2([partial_Theta_X_wrt_partial_d_h__fnd,
        partial_Theta_Y_wrt_partial_d_h__fnd,
        partial_Theta_X_wrt_partial_dd_h__fnd,
        partial_Theta_Y_wrt_partial_dd_h__fnd], [
        'partial_Theta_X_wrt_partial_d_h',
        'partial_Theta_Y_wrt_partial_d_h',
        'partial_Theta_X_wrt_partial_dd_h',
        'partial_Theta_Y_wrt_partial_dd_h'],
        "../gr.cg/expansion_Jacobian.c")
    end if;
    NULL
end proc

> 
> `saveit/level` := 10;
                               saveit/level := 10

> auxiliary(true);
inverse_metric...
codegen2(g_uu) --> "../gr.cg/inverse_metric.c"
      --> `codegen2/input`
   convert --> equation list
      --> `codegen2/eqnlist`
   optimizing computation sequence
      --> `codegen2/optimize`
   find temporary variables
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
bytes used=1000776, alloc=917336, time=0.13
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
      --> `codegen2/unindex`
   convert p/q --> RATIONAL(p/q)
      --> `codegen2/fix_rationals`
   writing C code
extrinsic_curvature_trace_raise...
codegen2([K, K_uu]) --> "../gr.cg/extrinsic_curvature_trace_raise.c"
      --> `codegen2/input`
   convert --> equation list
      --> `codegen2/eqnlist`
   optimizing computation sequence
bytes used=2001072, alloc=1441528, time=0.20
      --> `codegen2/optimize`
   find temporary variables
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
      --> `codegen2/unindex`
bytes used=3001364, alloc=1638100, time=0.26
   convert p/q --> RATIONAL(p/q)
      --> `codegen2/fix_rationals`
   writing C code
> curvature(true);
inverse_metric_gradient...
bytes used=4001680, alloc=1703624, time=0.34
codegen2(partial_d_g_uu) --> "../gr.cg/inverse_metric_gradient.c"
      --> `codegen2/input`
   convert --> equation list
      --> `codegen2/eqnlist`
   optimizing computation sequence
bytes used=5001836, alloc=1703624, time=0.42
      --> `codegen2/optimize`
   find temporary variables
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
bytes used=6002212, alloc=1769148, time=0.49
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
      --> `codegen2/unindex`
bytes used=7002736, alloc=1769148, time=0.55
   convert p/q --> RATIONAL(p/q)
      --> `codegen2/fix_rationals`
   writing C code
bytes used=8003012, alloc=1769148, time=0.62
metric_det_gradient...
codegen2(partial_d_ln_sqrt_g) --> "../gr.cg/metric_det_gradient.c"
      --> `codegen2/input`
   convert --> equation list
      --> `codegen2/eqnlist`
   optimizing computation sequence
bytes used=9003256, alloc=1769148, time=0.75
      --> `codegen2/optimize`
   find temporary variables
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
      --> `codegen2/unindex`
   convert p/q --> RATIONAL(p/q)
      --> `codegen2/fix_rationals`
   writing C code
codegen/C/expression:   Unknown function:   RATIONAL   will be left as is.
> horizon(true);
non_unit_normal...
non_unit_normal_deriv...
bytes used=10005164, alloc=1769148, time=0.82
expansion...
bytes used=11005388, alloc=1834672, time=0.89
codegen2([Theta_A, Theta_B, Theta_C, Theta_D]) --> "../gr.cg/expansion.c"
      --> `codegen2/input`
   convert --> equation list
      --> `codegen2/eqnlist`
   optimizing computation sequence
bytes used=12005892, alloc=1834672, time=0.96
bytes used=13006112, alloc=2031244, time=1.09
bytes used=14006296, alloc=2031244, time=1.20
      --> `codegen2/optimize`
   find temporary variables
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
bytes used=15006844, alloc=2096768, time=1.27
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
bytes used=16007112, alloc=2096768, time=1.34
      --> `codegen2/unindex`
bytes used=17007616, alloc=2096768, time=1.40
   convert p/q --> RATIONAL(p/q)
bytes used=18007784, alloc=2096768, time=1.46
      --> `codegen2/fix_rationals`
   writing C code
codegen/C/expression:   Unknown function:   PARTIAL_RHO   will be left as is.
codegen/C/expression:   Unknown function:   PARTIAL_SIGMA   will be left as is.
codegen/C/expression:   Unknown function:   PARTIAL_RHO_RHO   
will be left as is.
codegen/C/expression:   Unknown function:   PARTIAL_RHO_SIGMA   
will be left as is.
codegen/C/expression:   Unknown function:   PARTIAL_SIGMA_SIGMA   
will be left as is.
bytes used=19008004, alloc=2096768, time=1.51
bytes used=20008500, alloc=2096768, time=1.62
expansion_Jacobian...
bytes used=21009180, alloc=2096768, time=1.70
codegen2([partial_Theta_X_wrt_partial_d_h, partial_Theta_Y_wrt_partial_d_h, partial_Theta_X_wrt_partial_dd_h, partial_Theta_Y_wrt_partial_dd_h]) --> "../gr.cg/expansion_Jacobian.c"
      --> `codegen2/input`
   convert --> equation list
bytes used=22009512, alloc=2096768, time=1.77
      --> `codegen2/eqnlist`
   optimizing computation sequence
bytes used=23009696, alloc=2162292, time=1.84
bytes used=24009880, alloc=2293340, time=1.91
bytes used=25010716, alloc=2293340, time=1.97
bytes used=26010940, alloc=2293340, time=2.07
bytes used=27011284, alloc=2293340, time=2.21
bytes used=28011604, alloc=2293340, time=2.37
bytes used=29011784, alloc=2293340, time=2.47
bytes used=30012024, alloc=2424388, time=2.60
bytes used=31012336, alloc=2424388, time=2.69
bytes used=32012604, alloc=2489912, time=2.80
      --> `codegen2/optimize`
   find temporary variables
bytes used=33012892, alloc=2620960, time=2.87
      --> `codegen2/temps`
   convert Diff(expr,rho,sigma) --> PARTIAL_RHO_SIGMA(expr) etc
bytes used=34013116, alloc=2620960, time=2.94
bytes used=35013316, alloc=2620960, time=3.01
bytes used=36013600, alloc=2620960, time=3.08
      --> `codegen2/fix_Diff`
   convert R_dd[2,3] --> R_dd_23 etc
bytes used=37014080, alloc=2620960, time=3.15
bytes used=38014560, alloc=2620960, time=3.22
bytes used=39014928, alloc=2620960, time=3.29
      --> `codegen2/unindex`
bytes used=40015272, alloc=2620960, time=3.36
bytes used=41015476, alloc=2620960, time=3.43
bytes used=42015660, alloc=2620960, time=3.49
bytes used=43016244, alloc=2620960, time=3.56
bytes used=44016600, alloc=2620960, time=3.63
   convert p/q --> RATIONAL(p/q)
bytes used=45016764, alloc=2620960, time=3.68
bytes used=46016940, alloc=2620960, time=3.74
bytes used=47017228, alloc=2620960, time=3.81
bytes used=48017676, alloc=2620960, time=3.87
      --> `codegen2/fix_rationals`
   writing C code
bytes used=49017944, alloc=2620960, time=3.94
bytes used=50018104, alloc=2620960, time=3.99
bytes used=51018308, alloc=2620960, time=4.08
bytes used=52018568, alloc=2620960, time=4.20
bytes used=53018900, alloc=2620960, time=4.35
bytes used=54019192, alloc=2620960, time=4.53
bytes used=55019432, alloc=2620960, time=4.68
> quit
bytes used=55315640, alloc=2620960, time=4.73

```

gr/expansion.cc:
```
// expansion.cc -- evaluate expansion Theta of trial horizon surface
// $Header$
//
// <<<prototypes for functions local to this file>>>
// expansion - top-level driver
//
/// setup_xyz_posns - setup global xyz posns of grid points
/// interpolate_geometry - interpolate g_ij and K_ij from Cactus 3-D grid
/// convert_conformal_to_physical - convert conformal gij to physical
///
/// h_is_finite - does function h contain any NaNs/infinities?
/// geometry_is_finite - do geometry vars contain NaN/infty?
///
/// compute_Theta - compute Theta(h) given earlier setup
///

//
// debugging flags
//
#undef GEOMETRY_INTERP_DEBUG	// define this for verbose debugging
				// of geometry interpolator calls/results
#undef GEOMETRY_INTERP_DEBUG2	// define this for even more verbose debugging
				// of geometry interpolator calls/results
#undef GEOMETRY_INTERP_SYNC_SLEEP	// use sleep() to try to ensure we're
					// synchronized across all processors
					// before calling geometry interpolator
#undef GEOMETRY_INTERP_SYNC_BARRIER	// use CCTK_Barrier() to ensure we're
					// synchronized across all processors
					// before calling geometry interpolator
#undef COMPUTE_THETA_DEBUG	// define this for verbose debugging
				// in compute_Theta()

#ifdef GEOMETRY_INTERP_SYNC_SLEEP
#include <unistd.h>		// sleep()
#endif

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;
using jtutil::pow2;
using jtutil::pow3;
using jtutil::pow4;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "../elliptic/Jacobian.hh"

#include "gfns.hh"
#include "gr.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// ***** prototypes for functions local to this file *****
//

namespace {
void setup_xyz_posns(patch_system& ps, bool print_msg_flag);
enum expansion_status
  interpolate_geometry(patch_system* ps_ptr,
		       const struct cactus_grid_info& cgi,
		       const struct geometry_info& gi,
		       const struct error_info& error_info, bool initial_flag,
		       bool print_msg_flag);
void convert_conformal_to_physical(patch_system& ps,
				   bool print_msg_flag);
void Schwarzschild_EF_geometry(patch_system& ps,
			       const struct cactus_grid_info& cgi,
			       const struct geometry_info& gi,
			       bool print_msg_flag);

bool h_is_finite(patch_system& ps,
		 const struct error_info& error_info, bool initial_flag,
		 bool print_msg_flag);
bool geometry_is_finite(patch_system& ps,
			const struct error_info& error_info, bool initial_flag,
			bool print_msg_flag);

bool compute_Theta(patch_system& ps, const struct what_to_compute& comput_info,
		   bool Jacobian_flag,
                   jtutil::norm<fp>* Theta_norms_ptr,
                   jtutil::norm<fp>* expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* inner_expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* product_expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* mean_curvature_Theta_norms_ptr,
		   const struct error_info& error_info, bool initial_flag,
		   bool print_msg_flag);
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// If ps_ptr != NULL, this function computes the LHS function Theta(h),
// and optionally also its Jacobian coefficients (from which the Jacobian
// matrix may be computed later).
//
// If ps_ptr == NULL, this function does a dummy computation, described
// below.
//
// Inputs (angular gridfns, on ghosted grid):
// ... defined on ghosted grid
// ... only values on nominal grid are actually used as input
//	h				# shape of trial surface
//
// Inputs (Cactus 3-D gridfns):
//	gxx,gxy,gxz,gyy,gyz,gzz		# 3-metric $g_{ij}$
//	kxx,kxy,kxz,kyy,kyz,kzz		# extrinsic curvature $K_{ij}$
//
// Outputs (temporaries computed at each grid point)
//	## computed by hand-written code
//	global_[xyz]			# xyz positions of grid points
//	X_ud_*, X_udd_*			# xyz derivative coefficients
//	## computed by Maple-generated code
//	g_uu_{11,12,13,22,23,33}	# $g^{ij}$
//	K				# $K$
//	K_dd_{11,12,13,22,23,33}	# $K^{ij}$
//	partial_d_ln_sqrt_g_d		# $\partial_i \ln \sqrt{g}$
//	partial_d_g_uu_{1,2,3}{11,12,13,22,23,33}	# $\partial_k g^{ij}$
//
// Outputs (angular gridfns, all on the nominal grid):
//	## interpolated from 3-D Cactus grid
//	g_dd_{11,12,13,22,23,33}			# $g_{ij}$
//	K_dd_{11,12,13,22,23,33}			# $K_{ij}$
//	partial_d_g_dd_{1,2,3}{11,12,13,22,23,33}	# $\partial_k g_{ij}$
//	## computed at the nominal grid points
//	Theta						# $\Theta = \Theta(h)$
//
// Arguments:
// ps_ptr --> The patch system, or == NULL to do (only) a dummy computation
//	      in which only the parameter-table setup and a dummy geometry
//	      interpolator call are done, the latter with the number of
//	      interpolation points is set to 0 and all the output array
//	      pointers set to NULL.
// add_to_expansion = A real number which is added to the computed expansion
//		      at each grid point.
// initial_flag = true if this is the first evaluation of  expansion()
//		       for this horizon,
//		  false otherwise;
//		  this is used (only) to select which elements of  error_info
//		  are relevant
// Jacobian_flag = true to compute the Jacobian coefficients,
//		   false to skip this.
// print_msg_flag = true to print status messages,
//		    false to skip this.
// Theta_norms_ptr = (out) If this pointer is non-NULL, the norm object it
//			   points to is updated with all the Theta values
//			   in the grid.  This norm object can then be used
//			   to compute various (gridwise) norms of Theta.
//
// Results:
// This function returns a status code indicating whether the computation
// succeeded or failed, and if the latter, what caused the failure.
//
enum expansion_status
  expansion(patch_system* ps_ptr,
            const struct what_to_compute& compute_info,
	    const struct cactus_grid_info& cgi,
	    const struct geometry_info& gi,
	    const struct error_info& error_info, bool initial_flag,
	    bool Jacobian_flag /* = false */,
	    bool print_msg_flag /* = false */,
	    jtutil::norm<fp>* Theta_norms_ptr /* = NULL */,
	    jtutil::norm<fp>* expansion_Theta_norms_ptr /* = NULL */,
	    jtutil::norm<fp>* inner_expansion_Theta_norms_ptr /* = NULL */,
	    jtutil::norm<fp>* product_expansion_Theta_norms_ptr /* = NULL */,
	    jtutil::norm<fp>* mean_curvature_Theta_norms_ptr /* = NULL */)
{
const bool active_flag = (ps_ptr != NULL);
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   %sexpansion",
		   active_flag ? "" : "dummy ");

if (active_flag)
   then {
	//
	// normal computation
	//

	// fill in values of all ghosted gridfns in ghost zones
	ps_ptr->synchronize();

	if (gi.check_that_h_is_finite && !h_is_finite(*ps_ptr,
						      error_info, initial_flag,
						      print_msg_flag))
	   then return expansion_failure__surface_nonfinite;
							// *** ERROR RETURN ***

	// set up xyz positions of grid points
	setup_xyz_posns(*ps_ptr, print_msg_flag);
	}

// compute the "geometry" g_ij, K_ij, and partial_k g_ij
if (gi.hardwire_Schwarzschild_EF_geometry)
   then {
	if (active_flag)
	   then Schwarzschild_EF_geometry(*ps_ptr,
					  gi,
					  print_msg_flag);
	}
   else {
	// this is the only function we call unconditionally; it looks at
	// ps_ptr (non-NULL vs NULL) to choose a normal vs dummy computation
	const enum expansion_status status
		= interpolate_geometry(ps_ptr,
				       cgi, gi,
				       error_info, initial_flag,
				       print_msg_flag);
	if (status != expansion_success)
	   then return status;				// *** ERROR RETURN ***
	if (active_flag && cgi.use_Cactus_conformal_metric)
	   then convert_conformal_to_physical(*ps_ptr,
					      print_msg_flag);
	}

if (active_flag)
   then {


	if (gi.check_that_geometry_is_finite
	    && !geometry_is_finite(*ps_ptr,
				   error_info, initial_flag,
				   print_msg_flag))
	   then return expansion_failure__geometry_nonfinite;
							// *** ERROR RETURN ***

        // Ensure that there is a norm object
        const bool want_norms = Theta_norms_ptr;
        jtutil::norm<fp> norms;
        if (compute_info.surface_selection != selection_definition)
           then if (! Theta_norms_ptr) Theta_norms_ptr = &norms;


	// compute remaining gridfns --> $\Theta$
	// and optionally also the Jacobian coefficients
	// by algebraic ops and angular finite differencing
        what_to_compute this_compute_info (compute_info);
        this_compute_info.surface_selection = selection_definition;
	if (!compute_Theta(*ps_ptr, this_compute_info,
			   Jacobian_flag, Theta_norms_ptr,
                           expansion_Theta_norms_ptr,
                           inner_expansion_Theta_norms_ptr,
                           product_expansion_Theta_norms_ptr,
                           mean_curvature_Theta_norms_ptr,
			   error_info, initial_flag,
			   print_msg_flag))
	   then return expansion_failure__gij_not_positive_definite;
							// *** ERROR RETURN ***

        if (compute_info.surface_selection != selection_definition) {
          //
          // Apply correction to find a surface by its areal radius
          //
          // get mean expansion
          fp mean_expansion;
          fp areal_radius;
          switch (compute_info.surface_selection) {
          case selection_mean_coordinate_radius: {
            const int np = ps_ptr->N_grid_points();
            fp sum_expansion = 0;
            fp sum_radius = 0;
            for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
              patch& p = ps_ptr->ith_patch(pn);
              for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
                for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
                  sum_expansion += p.gridfn(gfns::gfn__Theta, irho,isigma);
                  sum_radius += p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
                }
              }
            }
            mean_expansion = sum_expansion / np;
            areal_radius = sum_radius / np;
            break;
          }
          case selection_areal_radius: {
            // get surface area
            const fp area = ps_ptr->integrate_gridfn
              (gfns::gfn__one, true, true, true,
               gfns::gfn__h,
               gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                                   gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                       gfns::gfn__g_dd_33,
               patch::integration_method__automatic_choice);
            mean_expansion = Theta_norms_ptr->mean();
            areal_radius = sqrt(area / (4.0*PI));
            break;
          }
          case selection_expansion_mean_coordinate_radius: {
            const int np = ps_ptr->N_grid_points();
            fp sum_expansion = 0;
            fp sum_radius = 0;
            for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
              patch& p = ps_ptr->ith_patch(pn);
              for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
                for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
                  sum_expansion += p.gridfn(gfns::gfn__Theta, irho,isigma);
                  sum_radius += p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
                }
              }
            }
            mean_expansion = sum_expansion / np;
            areal_radius = mean_expansion * sum_radius / np;
            break;
          }
          case selection_expansion_areal_radius: {
            // get surface area
            const fp area = ps_ptr->integrate_gridfn
              (gfns::gfn__one, true, true, true,
               gfns::gfn__h,
               gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                                   gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                       gfns::gfn__g_dd_33,
               patch::integration_method__automatic_choice);
            mean_expansion = Theta_norms_ptr->mean();
            areal_radius = mean_expansion * sqrt(area / (4.0*PI));
            break;
          }
          default:
            assert (0);
          } // switch areal_radius_definition
          
          if (! ps_ptr->N_additional_points()) {
            // calculate correction
            const fp correction
              = (- mean_expansion
                 + areal_radius - compute_info.desired_value);
            // apply correction
            ps_ptr->add_to_gridfn(-correction, gfns::gfn__Theta);
          } else {
            const int np = ps_ptr->N_grid_points();
            const int gnp = ps_ptr->ghosted_N_grid_points();
            // apply correction
            const fp correction
              = ps_ptr->ghosted_gridfn_data(gfns::gfn__h)[gnp];
            ps_ptr->add_to_gridfn(-correction, gfns::gfn__Theta);
            ps_ptr->gridfn_data(gfns::gfn__Theta)[np]
              = (mean_expansion - correction
                 - areal_radius + compute_info.desired_value);
          }
          if (want_norms) {
            // recalculate norms
            ps_ptr->gridfn_norms (gfns::gfn__Theta, *Theta_norms_ptr);
          } // if want_norms
        } else {
          //
          // do not apply correction
          //
          if (ps_ptr->N_additional_points()) {
            const int np = ps_ptr->N_grid_points();
            const int gnp = ps_ptr->ghosted_N_grid_points();
            ps_ptr->gridfn_data(gfns::gfn__Theta)[np]
              = ps_ptr->ghosted_gridfn_data(gfns::gfn__h)[gnp];
          }
        } // if use-areal-radius
	}

return expansion_success;				// *** NORMAL RETURN ***
}

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function sets up the global xyz positions of the grid points
// in the gridfns global_[xyz].  These will be used by interplate_geometry().
//
namespace {
void setup_xyz_posns(patch_system& ps, const bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      xyz positions and derivative coefficients");

#ifdef GEOMETRY_INTERP_DEBUG2
        printf ("AH exp\n");
#endif
	for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
	{
	patch& p = ps.ith_patch(pn);

		for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
		{
		for (int isigma = p.min_isigma() ;
		     isigma <= p.max_isigma() ;
		     ++isigma)
		{
                const fp r = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
		const fp rho = p.rho_of_irho(irho);
		const fp sigma = p.sigma_of_isigma(isigma);
		fp local_x, local_y, local_z;
		p.xyz_of_r_rho_sigma(r,rho,sigma, local_x,local_y,local_z);
#ifdef GEOMETRY_INTERP_DEBUG2
                 printf ("   pn=%d irho=%d isigma=%d   x=%g y=%g z=%g\n",
                         pn, irho, isigma, local_x, local_y, local_z);
#endif

		const fp global_x = ps.origin_x() + local_x;
		const fp global_y = ps.origin_y() + local_y;
		const fp global_z = ps.origin_z() + local_z;

		p.gridfn(gfns::gfn__global_x, irho,isigma) = global_x;
		p.gridfn(gfns::gfn__global_y, irho,isigma) = global_y;
		p.gridfn(gfns::gfn__global_z, irho,isigma) = global_z;

		const fp global_xx = global_x * global_x;
		const fp global_xy = global_x * global_y;
		const fp global_xz = global_x * global_z;
		const fp global_yy = global_y * global_y;
		const fp global_yz = global_y * global_z;
		const fp global_zz = global_z * global_z;

		p.gridfn(gfns::gfn__global_xx, irho,isigma) = global_xx;
		p.gridfn(gfns::gfn__global_xy, irho,isigma) = global_xy;
		p.gridfn(gfns::gfn__global_xz, irho,isigma) = global_xz;
		p.gridfn(gfns::gfn__global_yy, irho,isigma) = global_yy;
		p.gridfn(gfns::gfn__global_yz, irho,isigma) = global_yz;
		p.gridfn(gfns::gfn__global_zz, irho,isigma) = global_zz;
		}
		}
	}
}
	  }

//******************************************************************************

//
// If ps_ptr != NULL, this function interpolates the Cactus gridfns
//	gxx...gzz
//	kxx...kzz
//	psi			# optional
// to determine the nominal-grid angular gridfns
//	g_dd_ij
//	partial_d_g_dd_kij
//	K_dd_ij
//	psi			# optional
//	partial_d_psi_k		# optional
// at the nominal-grid trial horizon surface positions given by the
// global_(x,y,z) angular gridfns in the patch system *ps_ptr.  The psi
// interpolation is only done if the cgi.use_Cactus_conformal_metric flag
// is set.  Note that this function ignores the physical-vs-conformal
// semantics of the gridfns; it just interpolates and takes derivatives
// of the stored gridfn values.
//
// If ps_ptr == NULL, this function does (only) the parameter-table
// setup and a a dummy interpolator call, as described in the comments
// to  expansion()  above.
//
// The interpolation is done via  CCTK_InterpGridArrays() .  This has the
// option to return both an overall interpolation status, and a "local"
// status which gives the results of interpolating only the points requested
// on *this* processor; if the local status is available we use it, otherwise
// we fall back to the overall status.
//
// Inputs (angular gridfns, all on the nominal grid):
//	global_[xyz]			# xyz positions of grid points
//
// Inputs (Cactus 3-D gridfns):
//      ahmask                          # excision mask
//	gxx,gxy,gxz,gyy,gyz,gzz		# 3-metric $g_{ij}$
//					# (may be either physical or conformal)
//	kxx,kxy,kxz,kyy,kyz,kzz		# extrinsic curvature $K_{ij}$
//	psi				# optional conformal factor $\psi$
//
// Outputs (angular gridfns, all on the nominal grid):
//      mask                                    # excision mask
//      partial_d_mask_[123]                    # derivatives of the mask
//	g_dd_{11,12,13,22,23,33}		# $\stored{g}_{ij}$
//	K_dd_{11,12,13,22,23,33}		# $K_{ij}$
//	partial_d_g_dd_[123]{11,12,13,22,23,33}	# $\partial_k \stored{g}_{ij}$
//	psi					# (optional) $\psi$
//	partial_d_psi_[123]			# (optional) $\partial_k \psi$
//
// This function may also modify the interpolator parameter table.
//
// Results:
// This function returns a status code indicating whether the computation
// succeeded or failed, and if the latter, what caused the failure.  Possible
// failure codes are
// * expansion_failure__surface_outside_grid
// * expansion_failure__surface_in_excised_region	// not implemented yet
//
namespace {
enum expansion_status
  interpolate_geometry(patch_system* ps_ptr,
			  const struct cactus_grid_info& cgi,
			  const struct geometry_info& gi,
			  const struct error_info& error_info, bool initial_flag,
			  bool print_msg_flag)
{
const bool active_flag = (ps_ptr != NULL);
const bool psi_flag = cgi.use_Cactus_conformal_metric;

//
// Implementation Notes:
//
// To handle the optional interpolation of psi, we set up all the data
// type and pointer arrays to include psi, but with the psi entries at
// the end.  We then choose the array sizes passed to the interpolator
// to either include or exclude the psi entries as appropriate.
//
// We remember whether or not psi was interpolated on the previous call,
// and only modify the interpolator parameter table if this changes (or
// if this is our first call).
//

if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      interpolating %s from Cactus grid",
		   (psi_flag ? "{g_ij, K_ij, psi}" : "{g_ij, K_ij}"));

int status;

#define CAST_PTR_OR_NULL(type_,ptr_)	\
	(ps_ptr == NULL) ? NULL : static_cast<type_>(ptr_)


//
// ***** interpolation points *****
//
const int N_interp_points = (ps_ptr == NULL) ? 0 : ps_ptr->N_grid_points();
const int interp_coords_type_code = CCTK_VARIABLE_REAL;
const void* const interp_coords[N_GRID_DIMS]
  = {
    CAST_PTR_OR_NULL(const void*, ps_ptr->gridfn_data(gfns::gfn__global_x)),
    CAST_PTR_OR_NULL(const void*, ps_ptr->gridfn_data(gfns::gfn__global_y)),
    CAST_PTR_OR_NULL(const void*, ps_ptr->gridfn_data(gfns::gfn__global_z)),
    };


//
// ***** input arrays *****
//

const CCTK_INT input_array_variable_indices[]
	= {
          cgi.mask_varindex,
	  cgi.g_dd_11_varindex, cgi.g_dd_12_varindex, cgi.g_dd_13_varindex,
				cgi.g_dd_22_varindex, cgi.g_dd_23_varindex,
						      cgi.g_dd_33_varindex,
	  cgi.K_dd_11_varindex, cgi.K_dd_12_varindex, cgi.K_dd_13_varindex,
				cgi.K_dd_22_varindex, cgi.K_dd_23_varindex,
						      cgi.K_dd_33_varindex,
	  cgi.psi_varindex,
	  };
const int N_input_arrays_for_psi = 1;
const int N_input_arrays_dim =   sizeof(input_array_variable_indices)
			       / sizeof(input_array_variable_indices[0]);
const int N_input_arrays_use
	= psi_flag ? N_input_arrays_dim
		   : N_input_arrays_dim - N_input_arrays_for_psi;


//
// ***** output arrays *****
//

const CCTK_INT output_array_type_codes[]
	= {
 // mask             $\partial_x$ mask   $\partial_y$ mask   $\partial_z$ mask
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 // $g_{ij}$         $\partial_x g_{ij}$ $\partial_y g_{ij}$ $\partial_z g_{ij}$
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
 // $K_{ij}$
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
		     CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
					 CCTK_VARIABLE_REAL,
 // $\psi$           $\partial_x \psi$   $\partial_y \psi$   $\partial_z \psi$
 CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL,
	  };

const CCTK_INT operand_indices[]
	= {
	  0, 0, 0, 0,		// mask, partial_[xyz] mask
	  1, 1, 1, 1,		// g_dd_11, partial_[xyz] g_dd_11
	  2, 2, 2, 2,		// g_dd_12, partial_[xyz] g_dd_12
	  3, 3, 3, 3,		// g_dd_13, partial_[xyz] g_dd_13
	  4, 4, 4, 4,		// g_dd_22, partial_[xyz] g_dd_22
	  5, 5, 5, 5,		// g_dd_23, partial_[xyz] g_dd_23
	  6, 6, 6, 6,		// g_dd_33, partial_[xyz] g_dd_33
	  7, 8, 9, 10, 11, 12,	// K_dd_{11,12,13,22,23,33}
	  13, 13, 13, 13,	// psi, partial_[xyz] psi
	  };
#define DERIV(x)	x
const CCTK_INT operation_codes[]
  = {
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // mask, partial_[xyz] mask
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_11, partial_[xyz] g_dd_11
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_12, partial_[xyz] g_dd_12
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_13, partial_[xyz] g_dd_13
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_22, partial_[xyz] g_dd_22
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_23, partial_[xyz] g_dd_23
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // g_dd_33, partial_[xyz] g_dd_33
    DERIV(0), DERIV(0), DERIV(0), DERIV(0), DERIV(0), DERIV(0),
					    // K_dd_{11,12,13,22,23,33}
    DERIV(0), DERIV(1), DERIV(2), DERIV(3), // psi, partial_[xyz] psi
    };

void* const output_arrays[]
  = {
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__mask)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_mask_1)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_mask_2)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_mask_3)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_11)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_111)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_211)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_311)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_12)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_112)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_212)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_312)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_13)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_113)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_213)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_313)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_22)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_122)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_222)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_322)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_23)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_123)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_223)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_323)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__g_dd_33)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_133)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_233)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_333)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_11)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_12)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_13)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_22)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_23)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__K_dd_33)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__psi)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_1)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_2)),
    CAST_PTR_OR_NULL(void*, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_3)),
    };

const int N_output_arrays_for_psi = 4;
const int N_output_arrays_dim
	= sizeof(output_arrays) / sizeof(output_arrays[0]);
const int N_output_arrays_use
	= psi_flag ? N_output_arrays_dim
		   : N_output_arrays_dim - N_output_arrays_for_psi;


//
// ***** parameter table *****
//

// this flag is true if and only if the parameter table already has the
//	suppress_warnings
//	operand_indices
//	operand_codes
// entries for  psi_flag == par_table_psi_flag .
static bool par_table_setup = false;

// if  par_table_setup,
//    this flag is the value of  psi_flag  for the parameter table entries
// otherwise this flag is ignored
static bool par_table_psi_flag = false;

if (par_table_setup && (psi_flag == par_table_psi_flag))
   then {
	// parameter table is already set to just what we need
	// ==> no-op here
	}
   else {
	// store derivative info in interpolator parameter table
	if (print_msg_flag)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "         setting up interpolator derivative info");

	// set a dummy value for the key "suppress_warnings"
	// to tell CCTK_InterpGridArrays() not to print warning messages
	// for points outside the grid
	status = Util_TableSetInt(gi.param_table_handle,
				  0,
				  "suppress_warnings");
	if (status < 0)
	   then error_exit(ERROR_EXIT,
"***** interpolate_geometry():\n"
"        unable to set \"suppress_warnings\" key in interpolator parameter table!\n"
"        Util_TableSetInt() status=%d\n"
			   ,
			   status);				/*NOTREACHED*/

	status = Util_TableSetIntArray(gi.param_table_handle,
				       N_output_arrays_use, operand_indices,
				       "operand_indices");
	if (status < 0)
	   then error_exit(ERROR_EXIT,
"***** interpolate_geometry():\n"
"        unable to set operand_indices in interpolator parameter table!\n"
"        Util_TableSetIntArray() status=%d\n"
			   ,
			   status);				/*NOTREACHED*/

	status = Util_TableSetIntArray(gi.param_table_handle,
				       N_output_arrays_use, operation_codes,
				       "operation_codes");
	if (status < 0)
	   then error_exit(ERROR_EXIT,
"***** interpolate_geometry():\n"
"        unable to set operation_codes in interpolator parameter table!\n"
"        Util_TableSetIntArray() status=%d\n"
			   ,
			   status);				/*NOTREACHED*/

	par_table_setup = true;
	par_table_psi_flag = psi_flag;
	}


//
// ***** the actual interpolation *****
//
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "         calling geometry interpolator (%s%d points)",
		   (active_flag ? "" : "dummy: "), N_interp_points);

#ifdef GEOMETRY_INTERP_DEBUG2
	  {
	printf("AHFinderDirect:: proc %d: CCTK_InterpGridArrays() coordinates are:\n",
	       int(CCTK_MyProc(cgi.GH)));
	for (int pt = 0 ; pt < N_interp_points ; ++ pt)
	{
	printf("   pt=%d   [x,y,z]=[%g,%g,%g]\n",
               pt,
               double(((const CCTK_REAL*)interp_coords[0])[pt]),
               double(((const CCTK_REAL*)interp_coords[1])[pt]),
               double(((const CCTK_REAL*)interp_coords[2])[pt]));
	}
	  }
#endif	/* GEOMETRY_INTERP_DEBUG2 */

#ifdef GEOMETRY_INTERP_DEBUG
printf("AHFinderDirect:: proc %d: initializing interpolator outputs to 999.999\n",
       int(CCTK_MyProc(cgi.GH)));
	  {
	for (int pt = 0 ; pt < N_interp_points ; ++pt)
	{
		for (int out = 0 ; out < N_output_arrays_use ; ++out)
		{
		CCTK_REAL* const out_ptr
			= static_cast<CCTK_REAL*>(output_arrays[out]);
		out_ptr[pt] = 999.999;
		}
	}
	  }
#endif

#ifdef GEOMETRY_INTERP_DEBUG
printf("AHFinderDirect:: proc %d: calling CCTK_InterpGridArrays(N_interp_points=%d)\n",
       int(CCTK_MyProc(cgi.GH)), N_interp_points);
fflush(stdout);
#endif

#ifdef GEOMETRY_INTERP_SYNC_SLEEP
sleep(1);
#endif
#ifdef GEOMETRY_INTERP_SYNC_BARRIER
CCTK_Barrier(cgi.GH);
#endif

status = CCTK_InterpGridArrays(cgi.GH, N_GRID_DIMS,
			       gi.operator_handle, gi.param_table_handle,
			       cgi.coord_system_handle,
			       N_interp_points,
				  interp_coords_type_code,
				  interp_coords,
			       N_input_arrays_use,
				  input_array_variable_indices,
			       N_output_arrays_use,
				  output_array_type_codes,
				  output_arrays);

#ifdef GEOMETRY_INTERP_DEBUG
printf("AHFinderDirect:: proc %d: CCTK_InterpGridArrays() returned status=%d\n",
       int(CCTK_MyProc(cgi.GH)), status);
fflush(stdout);
#endif

#ifdef GEOMETRY_INTERP_DEBUG2
	  {
	for (int pt = 0 ; pt < N_interp_points ; pt = 2*pt + (pt == 0))
	{
	printf("AHFinderDirect:: proc %d: CCTK_InterpGridArrays() results for pt=%d at [x,y,z]=[%g,%g,%g]:\n",
	       int(CCTK_MyProc(cgi.GH)), pt,
               double(((const CCTK_REAL*)interp_coords[0])[pt]),
               double(((const CCTK_REAL*)interp_coords[1])[pt]),
               double(((const CCTK_REAL*)interp_coords[2])[pt]));
		for (int out = 0 ; out < N_output_arrays_use ; ++out)
		{
		const CCTK_REAL* const out_ptr
			= static_cast<const CCTK_REAL*>(output_arrays[out]);
		printf("   out=%d   result=%g\n", out, double(out_ptr[pt]));
		}
	}
	  }
#endif	/* GEOMETRY_INTERP_DEBUG2 */


//
// ***** get the local interpolator status (if available)
//
// CCTK_InterpGridArrays() returns a status that reflects the interpolation
// on *all* processors, but what we really want here is just the status
// for the interpolation of the points that *we* (this processor) asked for
// ==> get the local status if it's available
//
CCTK_INT local_interpolator_status;
const int table_status = Util_TableGetInt(gi.param_table_handle,
					  &local_interpolator_status,
					  "local_interpolator_status");
if	(table_status == 1)
   then {
	// we got the local interpolator status successfully
	// ==> use it for all further checks
	#ifdef GEOMETRY_INTERP_DEBUG
	printf("AHFinderDirect:: proc %d: replacing status=%d with local_interpolator_status=%d\n",
	       int(CCTK_MyProc(cgi.GH)), status, int(local_interpolator_status));
	fflush(stdout);
	#endif
	status = local_interpolator_status;
	}
else if (table_status == UTIL_ERROR_TABLE_NO_SUCH_KEY)
   then {
	// evidently the interpolators don't provide the
	// local interpolator status
	// ==> stick with the status have
	// ==> no-op here
	}
else	error_exit(ERROR_EXIT,
"***** interpolate_geometry():\n"
"        error return %d trying to get local interpolator status\n"
"        from parameter table!  (CCTK_InterpGridArrays() status=%d)\n"
		   ,
		   table_status, status);		/*NOTREACHED*/


//
// ***** handle any interpolation errors *****
//
if (status == CCTK_ERROR_INTERP_POINT_OUTSIDE)
   then {
	if (print_msg_flag)
	   then {
		// see if we can get further info
		const int warn_level
		   = initial_flag
		     ? error_info.warn_level__point_outside__initial
		     : error_info.warn_level__point_outside__subsequent;


		CCTK_VWarn(warn_level, __LINE__, __FILE__, CCTK_THORNSTRING,
"interpolate_geometry():\n"
"        one or more points on the trial horizon surface point\n"
"        is/are outside the grid (or too close to the grid boundary)\n"
"        (in a single-processor run, this may also mean that\n"
"         driver::ghost_size is too small for this geometry interpolator)\n");
		}

	return expansion_failure__surface_outside_grid;	// *** ERROR RETURN ***
	}

else if (status == CCTK_ERROR_INTERP_GHOST_SIZE_TOO_SMALL)
   then error_exit(ERROR_EXIT,
"***** interpolate_geometry(): driver::ghost_size is too small\n"
"                              for this geometry interpolator!\n");
								/*NOTREACHED*/

else if (status < 0)
   then error_exit(ERROR_EXIT,
"***** interpolate_geometry(): error return %d from interpolator!\n",
		   status);					/*NOTREACHED*/

//
// ***** check the interpolated excision mask *****
//
{
bool did_use_excised_gridpoint = false;
if (active_flag)
   then {
        for (int pn = 0 ; pn < ps_ptr->N_patches() ; ++pn)
            {
            patch& p = ps_ptr->ith_patch(pn);
        
            for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
            for (int isigma = p.min_isigma() ; isigma <= p.max_isigma() ; ++isigma)
        	{
                const fp m = p.gridfn(gfns::gfn__mask, irho,isigma);
                const fp m1 = p.gridfn(gfns::gfn__partial_d_mask_1, irho,isigma);
                const fp m2 = p.gridfn(gfns::gfn__partial_d_mask_2, irho,isigma);
                const fp m3 = p.gridfn(gfns::gfn__partial_d_mask_3, irho,isigma);
                if (fabs(m) > 1.0e-12
                    || fabs(m1) > 1.0e-12 || fabs(m2) > 1.0e-12 || fabs(m3) > 1.0e-12)
                   then did_use_excised_gridpoint = true;
                }
            }
        }
if (gi.mask_is_noshrink && did_use_excised_gridpoint)
   then {
	if (print_msg_flag)
	   then {
		// see if we can get further info
		const int warn_level
		   = initial_flag
		     ? error_info.warn_level__point_outside__initial
		     : error_info.warn_level__point_outside__subsequent;


		CCTK_VWarn(warn_level, __LINE__, __FILE__, CCTK_THORNSTRING,
"interpolate_geometry():\n"
"        one or more points on the trial horizon surface point\n"
"        is/are in an excised region (or too close to the excision boundary)\n");
		}

	return expansion_failure__surface_in_excised_region;	// *** ERROR RETURN ***
	}
}

return expansion_success;				// *** NORMAL RETURN ***
}
	  }

//******************************************************************************

//
// This function converts the g_dd_ij and partial_d_g_dd_kij gridfns
// from the Cactus conformal semantics to the physical semantics.  As
// documented in the CactusEinstein/ConformalState thorn guide, the
// Cactus conformal semantics are
//	physical_gij = psi^4 * stored_gij
// From this it's trivial to derive the transformation for the derivatives,
//	partial_k physical_gij = 4 psi^3 (partial_k psi) stored_gij
//				 + psi^4 partial_k stored_gij
//
// Inputs (angular gridfns, all on the nominal grid):
//   psi					# $\psi$
//   partial_d_psi_{1,2,3}			# $\partial_k \psi$
//   g_dd_{11,12,13,22,23,33}			# $\stored{g}_{ij}$
//   partial_d_g_dd_{1,2,3}{11,12,13,22,23,33}	# $\partial_k \stored{g}_{ij}$
//
//
// Outputs (angular gridfns, all on the nominal grid):
//   g_dd_{11,12,13,22,23,33}			# $g_{ij}$
//   partial_d_g_dd_{1,2,3}{11,12,13,22,23,33}	# $\partial_k g_{ij}$
//
namespace {
void convert_conformal_to_physical(patch_system& ps, bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      converting Cactus conformal gij --> physical gij");

    for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
    {
    patch& p = ps.ith_patch(pn);

	for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
	{
	for (int isigma = p.min_isigma() ; isigma <= p.max_isigma() ; ++isigma)
	{
	const fp psi = p.gridfn(gfns::gfn__psi, irho,isigma);
	const fp psi3 = jtutil::pow3(psi);
	const fp psi4 = jtutil::pow4(psi);

	const fp partial_d_psi_1
		= p.gridfn(gfns::gfn__partial_d_psi_1, irho,isigma);
	const fp partial_d_psi_2
		= p.gridfn(gfns::gfn__partial_d_psi_2, irho,isigma);
	const fp partial_d_psi_3
		= p.gridfn(gfns::gfn__partial_d_psi_3, irho,isigma);

	const fp stored_g_dd_11 = p.gridfn(gfns::gfn__g_dd_11, irho, isigma);
	const fp stored_g_dd_12 = p.gridfn(gfns::gfn__g_dd_12, irho, isigma);
	const fp stored_g_dd_13 = p.gridfn(gfns::gfn__g_dd_13, irho, isigma);
	const fp stored_g_dd_22 = p.gridfn(gfns::gfn__g_dd_22, irho, isigma);
	const fp stored_g_dd_23 = p.gridfn(gfns::gfn__g_dd_23, irho, isigma);
	const fp stored_g_dd_33 = p.gridfn(gfns::gfn__g_dd_33, irho, isigma);

	p.gridfn(gfns::gfn__g_dd_11, irho, isigma) *= psi4;
	p.gridfn(gfns::gfn__g_dd_12, irho, isigma) *= psi4;
	p.gridfn(gfns::gfn__g_dd_13, irho, isigma) *= psi4;
	p.gridfn(gfns::gfn__g_dd_22, irho, isigma) *= psi4;
	p.gridfn(gfns::gfn__g_dd_23, irho, isigma) *= psi4;
	p.gridfn(gfns::gfn__g_dd_33, irho, isigma) *= psi4;

	p.gridfn(gfns::gfn__partial_d_g_dd_111, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_11
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_111, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_112, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_12
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_112, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_113, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_13
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_113, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_122, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_22
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_122, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_123, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_23
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_123, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_133, irho,isigma)
		= 4.0*psi3*partial_d_psi_1*stored_g_dd_33
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_133, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_211, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_11
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_211, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_212, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_12
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_212, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_213, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_13
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_213, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_222, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_22
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_222, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_223, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_23
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_223, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_233, irho,isigma)
		= 4.0*psi3*partial_d_psi_2*stored_g_dd_33
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_233, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_311, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_11
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_311, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_312, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_12
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_312, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_313, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_13
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_313, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_322, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_22
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_322, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_323, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_23
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_323, irho,isigma);
	p.gridfn(gfns::gfn__partial_d_g_dd_333, irho,isigma)
		= 4.0*psi3*partial_d_psi_3*stored_g_dd_33
		  + psi4*p.gridfn(gfns::gfn__partial_d_g_dd_333, irho,isigma);
	}
	}
    }
}
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function whether the horizon shape function  h  (nominal grid only)
// contains all finite floating-point numbers, or whether it contain one
// or more NaNs or infinities.
//
// Results:
#ifdef HAVE_FINITE
// This function returns true if all the h values are finite, false
// otherwise (i.e. if it contains any NaNs or infinities).
#else
// This function is a no-op, and just prints a warning message and
// returns true.
#endif
//
namespace {
bool h_is_finite(patch_system& ps,
		 const struct error_info& error_info, bool initial_flag,
		 bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING, "      checking that h is finite");

#ifdef HAVE_FINITE
	for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
	{
	patch& p = ps.ith_patch(pn);

		for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
		{
		for (int isigma = p.min_isigma() ;
		     isigma <= p.max_isigma() ;
		     ++isigma)
		{
		const fp h = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
		if (!finite(h))
		   then {
			const fp rho = p.rho_of_irho(irho);
			const fp sigma = p.sigma_of_isigma(isigma);
			const fp drho   = jtutil::degrees_of_radians(rho);
			const fp dsigma = jtutil::degrees_of_radians(sigma);
			CCTK_VWarn(error_info.warn_level__nonfinite_geometry,
				   __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   h=%g isn't finite!\n"
"   %s patch (rho,sigma)=(%g,%g) (drho,dsigma)=(%g,%g)\n"
				   ,
				   double(h),
				   p.name(), double(rho), double(sigma),
					     double(drho), double(dsigma));
			return false;			// *** found a NaN ***
			}
		}
		}
	}
return true;					// *** all values finite ***
#else
CCTK_VWarn(error_info.warn_level__skipping_finite_check,
	   __LINE__, __FILE__, CCTK_THORNSTRING,
           "      no finite() fn ==>  skipping is-h-finite check");
return true;					// *** no check possible ***
#endif
}
	  }

//******************************************************************************

//
// This function whether the geometry variables
//	g_dd_ij
//	partial_d_g_dd_kij
//	K_dd_ij
// are all finite floating-point numbers, or whether they contain one
// or more NaNs or infinities.
//
// Results:
#ifdef HAVE_FINITE
// This function returns true if all the geometry variables are finite,
// false otherwise (i.e. if they contain any NaNs or infinities).
#else
// This function is a no-op, and just prints a warning message and
// returns true.
#endif
//
namespace {
bool geometry_is_finite(patch_system& ps,
			const struct error_info& error_info, bool initial_flag,
			bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING, "      checking that geometry is finite");

#ifdef HAVE_FINITE
    for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
    {
    patch& p = ps.ith_patch(pn);

	for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
	{
	for (int isigma = p.min_isigma() ;
	     isigma <= p.max_isigma() ;
	     ++isigma)
	{
	const fp g_dd_11 = p.gridfn(gfns::gfn__g_dd_11, irho,isigma);
	const fp g_dd_12 = p.gridfn(gfns::gfn__g_dd_12, irho,isigma);
	const fp g_dd_13 = p.gridfn(gfns::gfn__g_dd_13, irho,isigma);
	const fp g_dd_22 = p.gridfn(gfns::gfn__g_dd_22, irho,isigma);
	const fp g_dd_23 = p.gridfn(gfns::gfn__g_dd_23, irho,isigma);
	const fp g_dd_33 = p.gridfn(gfns::gfn__g_dd_33, irho,isigma);

	const fp K_dd_11 = p.gridfn(gfns::gfn__K_dd_11, irho,isigma);
	const fp K_dd_12 = p.gridfn(gfns::gfn__K_dd_12, irho,isigma);
	const fp K_dd_13 = p.gridfn(gfns::gfn__K_dd_13, irho,isigma);
	const fp K_dd_22 = p.gridfn(gfns::gfn__K_dd_22, irho,isigma);
	const fp K_dd_23 = p.gridfn(gfns::gfn__K_dd_23, irho,isigma);
	const fp K_dd_33 = p.gridfn(gfns::gfn__K_dd_33, irho,isigma);

	const fp partial_d_g_dd_111
		= p.gridfn(gfns::gfn__partial_d_g_dd_111, irho,isigma);
	const fp partial_d_g_dd_112
		= p.gridfn(gfns::gfn__partial_d_g_dd_112, irho,isigma);
	const fp partial_d_g_dd_113
		= p.gridfn(gfns::gfn__partial_d_g_dd_113, irho,isigma);
	const fp partial_d_g_dd_122
		= p.gridfn(gfns::gfn__partial_d_g_dd_122, irho,isigma);
	const fp partial_d_g_dd_123
		= p.gridfn(gfns::gfn__partial_d_g_dd_123, irho,isigma);
	const fp partial_d_g_dd_133
		= p.gridfn(gfns::gfn__partial_d_g_dd_133, irho,isigma);
	const fp partial_d_g_dd_211
		= p.gridfn(gfns::gfn__partial_d_g_dd_211, irho,isigma);
	const fp partial_d_g_dd_212
		= p.gridfn(gfns::gfn__partial_d_g_dd_212, irho,isigma);
	const fp partial_d_g_dd_213
		= p.gridfn(gfns::gfn__partial_d_g_dd_213, irho,isigma);
	const fp partial_d_g_dd_222
		= p.gridfn(gfns::gfn__partial_d_g_dd_222, irho,isigma);
	const fp partial_d_g_dd_223
		= p.gridfn(gfns::gfn__partial_d_g_dd_223, irho,isigma);
	const fp partial_d_g_dd_233
		= p.gridfn(gfns::gfn__partial_d_g_dd_233, irho,isigma);
	const fp partial_d_g_dd_311
		= p.gridfn(gfns::gfn__partial_d_g_dd_311, irho,isigma);
	const fp partial_d_g_dd_312
		= p.gridfn(gfns::gfn__partial_d_g_dd_312, irho,isigma);
	const fp partial_d_g_dd_313
		= p.gridfn(gfns::gfn__partial_d_g_dd_313, irho,isigma);
	const fp partial_d_g_dd_322
		= p.gridfn(gfns::gfn__partial_d_g_dd_322, irho,isigma);
	const fp partial_d_g_dd_323
		= p.gridfn(gfns::gfn__partial_d_g_dd_323, irho,isigma);
	const fp partial_d_g_dd_333
		= p.gridfn(gfns::gfn__partial_d_g_dd_333, irho,isigma);

	if (    !finite(g_dd_11) || !finite(g_dd_12) || !finite(g_dd_13)
				 || !finite(g_dd_22) || !finite(g_dd_23)
						     || !finite(g_dd_33)
	     || !finite(K_dd_11) || !finite(K_dd_12) || !finite(K_dd_13)
				 || !finite(K_dd_22) || !finite(K_dd_23)
						     || !finite(K_dd_33)
	     || !finite(partial_d_g_dd_111)
	     || !finite(partial_d_g_dd_112)
	     || !finite(partial_d_g_dd_113)
	     || !finite(partial_d_g_dd_122)
	     || !finite(partial_d_g_dd_123)
	     || !finite(partial_d_g_dd_133)
	     || !finite(partial_d_g_dd_211)
	     || !finite(partial_d_g_dd_212)
	     || !finite(partial_d_g_dd_213)
	     || !finite(partial_d_g_dd_222)
	     || !finite(partial_d_g_dd_223)
	     || !finite(partial_d_g_dd_233)
	     || !finite(partial_d_g_dd_311)
	     || !finite(partial_d_g_dd_312)
	     || !finite(partial_d_g_dd_313)
	     || !finite(partial_d_g_dd_322)
	     || !finite(partial_d_g_dd_323)
	     || !finite(partial_d_g_dd_333)    )
	   then {
		const fp h = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
		const fp rho = p.rho_of_irho(irho);
		const fp sigma = p.sigma_of_isigma(isigma);
		const fp drho   = jtutil::degrees_of_radians(rho);
		const fp dsigma = jtutil::degrees_of_radians(sigma);
		fp local_x, local_y, local_z;
		p.xyz_of_r_rho_sigma(h,rho,sigma, local_x,local_y,local_z);
		const fp global_x = ps.origin_x() + local_x;
		const fp global_y = ps.origin_y() + local_y;
		const fp global_z = ps.origin_z() + local_z;
		CCTK_VWarn(error_info.warn_level__nonfinite_geometry,
			   __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   geometry isn't finite at %s patch\n"
"   h=%g (rho,sigma)=(%g,%g) (drho,dsigma)=(%g,%g)\n"
"   local_(x,y,z)=(%g,%g,%g)\n"
"   global_(x,y,z)=(%g,%g,%g)\n"
"   g_dd_11=%g   _12=%g   _13=%g\n"
"       _22=%g   _23=%g   _33=%g\n"
"   K_dd_11=%g   _12=%g   _13=%g\n"
"       _22=%g   _23=%g   _33=%g\n"
"   partial_d_g_dd_111=%g   _112=%g   _113=%g\n"
"                 _122=%g   _123=%g   _133=%g\n"
"   partial_d_g_dd_211=%g   _212=%g   _213=%g\n"
"                 _222=%g   _223=%g   _233=%g\n"
"   partial_d_g_dd_311=%g   _312=%g   _313=%g\n"
"                 _322=%g   _323=%g   _333=%g\n"
			   ,
			   p.name(),
			   double(h), double(rho), double(sigma),
				      double(drho), double(dsigma),
			   double(local_x), double(local_y), double(local_z),
			   double(global_x), double(global_y), double(global_z),
			   double(g_dd_11), double(g_dd_12), double(g_dd_13),
			   double(g_dd_22), double(g_dd_23), double(g_dd_33),
			   double(K_dd_11), double(K_dd_12), double(K_dd_13),
			   double(K_dd_22), double(K_dd_23), double(K_dd_33),
			   double(partial_d_g_dd_111),
			   double(partial_d_g_dd_112),
			   double(partial_d_g_dd_113),
			   double(partial_d_g_dd_122),
			   double(partial_d_g_dd_123),
			   double(partial_d_g_dd_133),
			   double(partial_d_g_dd_211),
			   double(partial_d_g_dd_212),
			   double(partial_d_g_dd_213),
			   double(partial_d_g_dd_222),
			   double(partial_d_g_dd_223),
			   double(partial_d_g_dd_233),
			   double(partial_d_g_dd_311),
			   double(partial_d_g_dd_312),
			   double(partial_d_g_dd_313),
			   double(partial_d_g_dd_322),
			   double(partial_d_g_dd_323),
			   double(partial_d_g_dd_333));
		return false;			// *** found a NaN ***
		}
	}
	}
    }
return true;						// *** no NaNs found ***
#else
CCTK_VWarn(error_info.warn_level__skipping_finite_check,
	   __LINE__, __FILE__, CCTK_THORNSTRING,
           "      no finite() ==>  skipping is-geometry-finite check");
return true;					// *** no check possible ***
#endif
}
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function computes the expansion Theta(h), and optionally also
// its Jacobian coefficients, (from which the Jacobian matrix may be
// computed later).  This function uses a mixture of algebraic operations
// and (rho,sigma) finite differencing.  The computation is done entirely
// on the nominal angular grid.
//
// N.b. This function #includes "cg.hh", which defines "dangerous" macros
//      which will stay in effect for the rest of this compilation unit!
//
// Arguments:
// Jacobian_flag = true to compute the Jacobian coefficients,
//		   false to skip this.
//
// Results:
// This function returns true for a successful computation, or false
// if the computation failed because Theta_D <= 0 (this means the interpolated
// g_ij isn't positive definite).
//
namespace {
bool compute_Theta(patch_system& ps, const struct what_to_compute& compute_info,
		   bool Jacobian_flag,
                   jtutil::norm<fp>* Theta_norms_ptr,
                   jtutil::norm<fp>* expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* inner_expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* product_expansion_Theta_norms_ptr,
                   jtutil::norm<fp>* mean_curvature_Theta_norms_ptr,
		   const struct error_info& error_info, bool initial_flag,
		   bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING, "      computing Theta(h)");

#if 0
 fp mean_radius, areal_radius;
 switch (compute_info.surface_modification) {
 case modification_none:
 case modification_radius:
 case modification_radius2:
   // do nothing
   break;
 case modification_mean_radius: {
   // get average coordinate radius
   const int np = ps.N_grid_points();
   fp sum_radius = 0;
   for (int pn = 0; pn < ps.N_patches(); ++pn) {
     patch& p = ps.ith_patch(pn);
     for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
       for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
         sum_radius += p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
       }
     }
   }
   mean_radius = sum_radius / np;
   break;
 }
 case modification_areal_radius: {
   // get surface area
   const fp area = ps.integrate_gridfn
     (gfns::gfn__one, true, true, true,
      gfns::gfn__h,
      gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                          gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                              gfns::gfn__g_dd_33,
      patch::integration_method__automatic_choice);
   areal_radius = sqrt(area / (4.0*PI));
   break;
 }
 default:
   assert (0);
 }
#endif

	for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
	{
	patch& p = ps.ith_patch(pn);

		for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
		{
		for (int isigma = p.min_isigma() ;
		     isigma <= p.max_isigma() ;
		     ++isigma)
		{
		//
		// compute the X_ud and X_udd derivative coefficients
		// ... n.b. this uses the *local* (x,y,z) coordinates
		//
		const fp r = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
		const fp rho = p.rho_of_irho(irho);
		const fp sigma = p.sigma_of_isigma(isigma);
		fp xx, yy, zz;
		p.xyz_of_r_rho_sigma(r,rho,sigma, xx, yy, zz);
		#ifdef COMPUTE_THETA_DEBUG
		if (    ((irho == 0) && (isigma == 0))
		     || ((irho == 5) && (isigma == 5))    )
		   then {
			printf("AHFinderDirect:: computing at %s patch (%d,%d) r=%g ==> local xyz=(%g,%g,%g)\n",
			       p.name(), irho,isigma, double(r),
			       double(xx), double(yy), double(zz));
			printf("AHFinderDirect:: got g_dd_11=%g g_dd_12=%g g_dd_13=%g\n",
			       p.gridfn(gfns::gfn__g_dd_11, irho,isigma),
			       p.gridfn(gfns::gfn__g_dd_12, irho,isigma),
			       p.gridfn(gfns::gfn__g_dd_13, irho,isigma));
			printf("                                g_dd_22=%g g_dd_23=%g\n",
			       p.gridfn(gfns::gfn__g_dd_22, irho,isigma),
			       p.gridfn(gfns::gfn__g_dd_23, irho,isigma));
			printf("                                           g_dd_33=%g\n",
			       p.gridfn(gfns::gfn__g_dd_33, irho,isigma));
			fflush(stdout);
			}
		#endif

		// 1st derivative coefficients X_ud
		const fp X_ud_11 = p.partial_rho_wrt_x(xx, yy, zz);
		const fp X_ud_12 = p.partial_rho_wrt_y(xx, yy, zz);
		const fp X_ud_13 = p.partial_rho_wrt_z(xx, yy, zz);
		const fp X_ud_21 = p.partial_sigma_wrt_x(xx, yy, zz);
		const fp X_ud_22 = p.partial_sigma_wrt_y(xx, yy, zz);
		const fp X_ud_23 = p.partial_sigma_wrt_z(xx, yy, zz);

		// 2nd derivative coefficient gridfns X_udd
		const fp X_udd_111 = p.partial2_rho_wrt_xx(xx, yy, zz);
		const fp X_udd_112 = p.partial2_rho_wrt_xy(xx, yy, zz);
		const fp X_udd_113 = p.partial2_rho_wrt_xz(xx, yy, zz);
		const fp X_udd_122 = p.partial2_rho_wrt_yy(xx, yy, zz);
		const fp X_udd_123 = p.partial2_rho_wrt_yz(xx, yy, zz);
		const fp X_udd_133 = p.partial2_rho_wrt_zz(xx, yy, zz);
		const fp X_udd_211 = p.partial2_sigma_wrt_xx(xx, yy, zz);
		const fp X_udd_212 = p.partial2_sigma_wrt_xy(xx, yy, zz);
		const fp X_udd_213 = p.partial2_sigma_wrt_xz(xx, yy, zz);
		const fp X_udd_222 = p.partial2_sigma_wrt_yy(xx, yy, zz);
		const fp X_udd_223 = p.partial2_sigma_wrt_yz(xx, yy, zz);
		const fp X_udd_233 = p.partial2_sigma_wrt_zz(xx, yy, zz);

		//
		// "call" the Maple-generated code
		// ... each cg/*.c file has a separate set of temp variables,
		//     and so must be inside its own set of { } braces
		//

		// gridfn #defines
		#include "cg.hh"

		  {
		// g_uu
		#include "../gr.cg/inverse_metric.c"
		  }

		  {
		// K, K_uu
		#include "../gr.cg/extrinsic_curvature_trace_raise.c"
		  }

		  {
		// partial_d_g_uu
		#include "../gr.cg/inverse_metric_gradient.c"
		  }

		  {
		// partial_d_ln_sqrt_g
		#include "../gr.cg/metric_det_gradient.c"
		  }

		  {
		// Theta_A, Theta_B, Theta_C, Theta_D
		#include "../gr.cg/expansion.c"
		  }

		if (Theta_D <= 0)
		   then {
const int warn_level
  = initial_flag ? error_info.warn_level__gij_not_positive_definite__initial
		 : error_info.warn_level__gij_not_positive_definite__subsequent;
CCTK_VWarn(warn_level, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   compute_Theta(): Theta_D = $g^{ij} s_i s_j$ = %g <= 0\n"
"                    at %s patch rho=%g sigma=%g!\n"
"                    (i.e. the interpolated g_ij isn't positive definite)",
	   double(Theta_D),
	   p.name(), double(rho), double(sigma));
			return false;			// *** ERROR RETURN ***
			}

                assert (compute_info.surface_selection == selection_definition);

		// compute H via equation (14) of my 1996 horizon finding paper
		const fp sqrt_Theta_D = sqrt(Theta_D);

		const fp Theta_X = + Theta_A/(Theta_D*sqrt_Theta_D)
                                   + Theta_B/sqrt_Theta_D;
                const fp Theta_Y = + Theta_C/Theta_D
                                   - K;

#define mean_curvature	p.gridfn(gfns::gfn__mean_curvature, irho,isigma)
		mean_curvature = Theta_X;
#undef mean_curvature

                switch (compute_info.surface_definition) {
                case definition_expansion:
                  Theta = + Theta_X + Theta_Y;
                  break;
                case definition_inner_expansion:
                  Theta = - Theta_X + Theta_Y;
                  break;
                case definition_mean_curvature:
                  Theta = + Theta_X;
                  break;
                case definition_expansion_product:
                  Theta = (+ Theta_X + Theta_Y) * (- Theta_X + Theta_Y);
                  break;
                default:
                  assert (0);
                }

                switch (compute_info.surface_modification) {
                case modification_none:
                  // do nothing
                  break;
                case modification_radius:
                  // multiply by radius
                  Theta *= r;
                  break;
                case modification_radius2:
                  // multiply by radius^2
                  Theta *= pow2(r);
                  break;
#if 0
                case modification_mean_radius:
                  // multiply by average coordinate radius
                  Theta *= mean_radius;
                  break;
                case modification_areal_radius:
                  // multiply by areal radius
                  Theta *= areal_radius;
                  break;
#endif
                default:
                  assert (0);
                }

                Theta -= compute_info.desired_value;
                
		// update running norms of Theta(h) function
		if (Theta_norms_ptr != NULL)
		   then Theta_norms_ptr->data(Theta);

		if (expansion_Theta_norms_ptr != NULL)
                   then expansion_Theta_norms_ptr->data(+ Theta_X + Theta_Y);

		if (inner_expansion_Theta_norms_ptr != NULL)
                   then inner_expansion_Theta_norms_ptr->data(- Theta_X + Theta_Y);

		if (product_expansion_Theta_norms_ptr != NULL)
                   then product_expansion_Theta_norms_ptr->data((+ Theta_X + Theta_Y) * (- Theta_X + Theta_Y));

		if (mean_curvature_Theta_norms_ptr != NULL)
                   then mean_curvature_Theta_norms_ptr->data(+ Theta_X);

                fp partial_Theta_X_wrt_partial_d_h_1;
                fp partial_Theta_X_wrt_partial_d_h_2;
                fp partial_Theta_X_wrt_partial_dd_h_11;
                fp partial_Theta_X_wrt_partial_dd_h_12;
                fp partial_Theta_X_wrt_partial_dd_h_22;
                fp partial_Theta_Y_wrt_partial_d_h_1;
                fp partial_Theta_Y_wrt_partial_d_h_2;
                fp partial_Theta_Y_wrt_partial_dd_h_11;
                fp partial_Theta_Y_wrt_partial_dd_h_12;
                fp partial_Theta_Y_wrt_partial_dd_h_22;

		if (Jacobian_flag)
		   then {
			// partial_Theta_wrt_partial_d_h,
			// partial_Theta_wrt_partial_dd_h
			#include "../gr.cg/expansion_Jacobian.c"
			}

		if (Jacobian_flag) {
                  switch (compute_info.surface_definition) {
                    
                  case definition_expansion:
                    partial_Theta_wrt_partial_d_h_1
                      = (+ partial_Theta_X_wrt_partial_d_h_1
                         + partial_Theta_Y_wrt_partial_d_h_1);
                    partial_Theta_wrt_partial_d_h_2
                      = (+ partial_Theta_X_wrt_partial_d_h_2
                         + partial_Theta_Y_wrt_partial_d_h_2);
                    partial_Theta_wrt_partial_dd_h_11
                      = (+ partial_Theta_X_wrt_partial_dd_h_11
                         + partial_Theta_Y_wrt_partial_dd_h_11);
                    partial_Theta_wrt_partial_dd_h_12
                      = (+ partial_Theta_X_wrt_partial_dd_h_12
                         + partial_Theta_Y_wrt_partial_dd_h_12);
                    partial_Theta_wrt_partial_dd_h_22
                      = (+ partial_Theta_X_wrt_partial_dd_h_22
                         + partial_Theta_Y_wrt_partial_dd_h_22);
                    break;
                    
                  case definition_inner_expansion:
                    partial_Theta_wrt_partial_d_h_1
                      = (- partial_Theta_X_wrt_partial_d_h_1
                         + partial_Theta_Y_wrt_partial_d_h_1);
                    partial_Theta_wrt_partial_d_h_2
                      = (- partial_Theta_X_wrt_partial_d_h_2
                         + partial_Theta_Y_wrt_partial_d_h_2);
                    partial_Theta_wrt_partial_dd_h_11
                      = (- partial_Theta_X_wrt_partial_dd_h_11
                         + partial_Theta_Y_wrt_partial_dd_h_11);
                    partial_Theta_wrt_partial_dd_h_12
                      = (- partial_Theta_X_wrt_partial_dd_h_12
                         + partial_Theta_Y_wrt_partial_dd_h_12);
                    partial_Theta_wrt_partial_dd_h_22
                      = (- partial_Theta_X_wrt_partial_dd_h_22
                         + partial_Theta_Y_wrt_partial_dd_h_22);
                    break;
                    
                  case definition_mean_curvature:
                    partial_Theta_wrt_partial_d_h_1
                      = + partial_Theta_X_wrt_partial_d_h_1;
                    partial_Theta_wrt_partial_d_h_2
                      = + partial_Theta_X_wrt_partial_d_h_2;
                    partial_Theta_wrt_partial_dd_h_11
                      = + partial_Theta_X_wrt_partial_dd_h_11;
                    partial_Theta_wrt_partial_dd_h_12
                      = + partial_Theta_X_wrt_partial_dd_h_12;
                    partial_Theta_wrt_partial_dd_h_22
                      = + partial_Theta_X_wrt_partial_dd_h_22;
                    break;
                    
                  case definition_expansion_product: {
#define f(x,y,dx,dy)  (- x*x + y*y)
#define df(x,y,dx,dy) (- 2*x*dx + 2*y*dy)
                    partial_Theta_wrt_partial_d_h_1   = df(Theta_X, Theta_Y, partial_Theta_X_wrt_partial_d_h_1  , partial_Theta_Y_wrt_partial_d_h_1  );
                    partial_Theta_wrt_partial_d_h_2   = df(Theta_X, Theta_Y, partial_Theta_X_wrt_partial_d_h_2  , partial_Theta_Y_wrt_partial_d_h_2  );
                    partial_Theta_wrt_partial_dd_h_11 = df(Theta_X, Theta_Y, partial_Theta_X_wrt_partial_dd_h_11, partial_Theta_Y_wrt_partial_dd_h_11);
                    partial_Theta_wrt_partial_dd_h_12 = df(Theta_X, Theta_Y, partial_Theta_X_wrt_partial_dd_h_12, partial_Theta_Y_wrt_partial_dd_h_12);
                    partial_Theta_wrt_partial_dd_h_22 = df(Theta_X, Theta_Y, partial_Theta_X_wrt_partial_dd_h_22, partial_Theta_Y_wrt_partial_dd_h_22);
#undef f
#undef df
                    break;
                  }
                    
                  default:
                    assert (0);
                  }
                }

		}
		}
	}

return true;						// *** NORMAL RETURN ***
}
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

	  }	// namespace AHFinderDirect

```

gr/misc-gr.cc:
```
// misc-gr.cc -- misc support routines
// $Header$
//
// expansion_status_string - string describing expansion_status
//

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "../elliptic/Jacobian.hh"

#include "gfns.hh"
#include "gr.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// This function decodes the  Jacobian_compute_method  parameter (string) into
// an internal enum for future use.
//
enum Jacobian_compute_method
  decode_Jacobian_compute_method(const char Jacobian_compute_method_string[])
{
if	(STRING_EQUAL(Jacobian_compute_method_string,
		      "numerical perturbation"))
   then return Jacobian__numerical_perturbation;
else if (STRING_EQUAL(Jacobian_compute_method_string,
		      "symbolic differentiation with finite diff d/dr"))
   then return Jacobian__symbolic_diff_with_FD_dr;
else if (STRING_EQUAL(Jacobian_compute_method_string,
		      "symbolic differentiation"))
   then return Jacobian__symbolic_diff;
else	CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   decode_Jacobian_compute_method():\n"
"        unknown Jacobian_compute_method_string=\"%s\"!",
		   Jacobian_compute_method_string);		/*NOTREACHED*/
}

//******************************************************************************

//
// This function returns (a pointer to) a C-style string describing
// an  expansion_status  value.
//
const char* expansion_status_string(enum expansion_status status)
{
switch	(status)
	{
case expansion_success:
	return "success";
	break;
case expansion_failure__surface_nonfinite:
	return "infinity/NaN in surface shape!";
	break;
case expansion_failure__surface_too_large:
	return "surface too large";
	break;
case expansion_failure__surface_outside_grid:
	return "surface outside grid";
	break;
case expansion_failure__surface_in_excised_region:
	return "surface in excised region";
	break;
case expansion_failure__geometry_nonfinite:
	return "infinity/NaN in 3-geometry!";
	break;
case expansion_failure__gij_not_positive_definite:
	return "g_ij not positive definite!";
	break;
default:
	CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
		    "expansion_status_string(): unknown status=(int)%d!",
		    status);					/*NOTREACHED*/
	}
}

//******************************************************************************

	  }	// namespace AHFinderDirect

```

gr/README:
```
This directory contains all the code for this thorn which "knows" about
general relativity.

The main source files in this directory are as follows:

expansion.cc
	Computes the expansion $\Theta = \Theta(h)$ of a trial horizon
	surface $r = h(angle)$

expansion_Jacobian.cc
	Computes the Jacobian $J[\Theta(h)]$ of the expansion $\Theta(h)$.

Schwarzschild_EF.cc
	Computes the Schwarzschild/Eddington-Finkelstein g_ij and K_ij

misc.cc
	Misc support routines.

gr.hh
	Overall header file for all the external routines in this directory.

gfns.hh
	Defines the gfns of all the gridfns as enums in namespace gfns::.

cg.hh
	This header file defines the "virtual machine" used by the
	machine-generated code in ../gr.cg/.  This file is "dangerous"
	in that it #defines macros for all the gridfns, which will
	break lots of other code.  See the header comments in this
	file for details.

doit.maple
	Top-level driver for all the Maple code.

maple.log
	This is a log file (transcript) of the Maple computation.

setup_gr_gfas.maple
gr_gfas.minc
	These files define the relativity gridfns for the Maple code,
	eg the 3-metric, 3-extrinsic curvature, etc.

auxiliary.maple
curvature.maple
horizon.maple
	These files compute the $\Theta(h)$ function and the $J[\Theta(h)]$
	coefficients in Maple.

makefile
	This drives the Maple code-generation process; the resulting
	(Maple-generated) C code lives in ../gr.cg/

```

gr/expansion_Jacobian.cc:
```
// expansion_Jacobian.cc -- evaluate Jacobian matrix of LHS function Theta(h)
// $Header$
//
// <<<prototypes for functions local to this file>>>
//
// expansion_Jacobian - top-level driver to compute the Jacobian
///
/// expansion_Jacobian_NP - compute the Jacobian by numerical perturbation
/// expansion_Jacobian_partial_SD - compute partial-deriv terms: symbolic diff
/// add_ghost_zone_Jacobian - add ghost zone dependencies to Jacobian
/// expansion_Jacobian_dr_FD - sum d/dr terms (compute via FD) into Jacobian
///

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "../elliptic/Jacobian.hh"

#include "../gr/gfns.hh"
#include "../gr/gr.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// ***** prototypes for functions local to this file *****
//

namespace {
enum expansion_status
  expansion_Jacobian_NP
	(patch_system& ps, Jacobian& Jac,
         const struct what_to_compute& comput_info,
	 const struct cactus_grid_info& cgi,
	 const struct geometry_info& gi,
	 const struct Jacobian_info& Jacobian_info,
	 const struct error_info& error_info, bool initial_flag,
	 bool print_msg_flag);

void expansion_Jacobian_partial_SD(patch_system& ps, Jacobian& Jac,
				   const struct cactus_grid_info& cgi,
				   const struct geometry_info& gi,
				   const struct Jacobian_info& Jacobian_info,
				   bool print_msg_flag);
void add_ghost_zone_Jacobian(const patch_system& ps,
			     Jacobian& Jac,
			     fp mol,
			     const patch& xp, const ghost_zone& xmgz,
			     int x_II,
			     int xm_irho, int xm_isigma);
enum expansion_status
  expansion_Jacobian_dr_FD
	(patch_system* ps_ptr, Jacobian* Jac_ptr,
         const struct what_to_compute& compute_info,
	 const struct cactus_grid_info& cgi,
	 const struct geometry_info& gi,
	 const struct Jacobian_info& Jacobian_info,
	 const struct error_info& error_info, bool initial_flag,
	 bool print_msg_flag);
	  }

//******************************************************************************

//
// If ps_ptr != NULL and Jac_ptr != NULL, this function computes the
// Jacobian matrix J[Theta(h)] of the expansion Theta(h).  We assume
// that Theta(h) has already been computed.
//
// If ps_ptr == NULL and Jac_ptr == NULL, this function does a dummy
// computation, in which only any expansion() (and hence geometry
// interpolator) calls are done, these with the number of interpolation
// points set to 0 and all the output array pointers set to NULL.
//
// It's illegal for one but not both of ps_ptr and Jac_ptr to be NULL.
//
// Only some values of  Jacobian_info.Jacobian_compute_method  support
// the dummy computation.
//
// Arguments:
// ps_ptr --> The patch system, or == NULL to do (only) a dummy computation.
// Jac_ptr --> The Jacobian, or == NULL to do (only) a dummy computation.
// add_to_expansion = A real number to add to the expansion.
//
// Results:
// This function returns a status code indicating whether the computation
// succeeded or failed, and if the latter, what caused the failure.
//
enum expansion_status
  expansion_Jacobian(patch_system* ps_ptr, Jacobian* Jac_ptr,
                     const struct what_to_compute& compute_info,
		     const struct cactus_grid_info& cgi,
		     const struct geometry_info& gi,
		     const struct Jacobian_info& Jacobian_info,
		     const struct error_info& error_info, bool initial_flag,
		     bool print_msg_flag /* = false */)
{
const bool active_flag = (ps_ptr != NULL) && (Jac_ptr != NULL);
enum expansion_status status;

switch	(Jacobian_info.Jacobian_compute_method)
	{
case Jacobian__numerical_perturbation:
	if (active_flag)
	   then {
		status = expansion_Jacobian_NP(*ps_ptr, *Jac_ptr,
					       compute_info,
					       cgi, gi, Jacobian_info,
					       error_info, initial_flag,
					       print_msg_flag);
		if (status != expansion_success)
		   then return status;			// *** ERROR RETURN ***
		break;
		}
	   else error_exit(ERROR_EXIT,
"***** expansion_Jacobian():\n"
"        dummy computation isn't supported for\n"
"        Jacobian_compute_method = \"numerical perturbation\"!\n");
								/*NOTREACHED*/

case Jacobian__symbolic_diff:
	error_exit(ERROR_EXIT,
"***** expansion_Jacobian():\n"
"        Jacobian_compute_method == \"symbolic differentiation\"\n"
"        isn't implemented (yet)!\n");				/*NOTREACHED*/

case Jacobian__symbolic_diff_with_FD_dr:
	if (active_flag)
	   then expansion_Jacobian_partial_SD(*ps_ptr, *Jac_ptr,
					      cgi, gi, Jacobian_info,
					      print_msg_flag);
	// this function looks at ps_ptr and Jac_ptr (non-NULL vs NULL)
	// to choose a normal vs dummy computation
	  {
	status = expansion_Jacobian_dr_FD(ps_ptr, Jac_ptr,
                                          compute_info,
					  cgi, gi, Jacobian_info,
					  error_info, initial_flag,
					  print_msg_flag);
	if (status != expansion_success)
	   then return status;				// *** ERROR RETURN ***
	  }
	break;

default:
	error_exit(PANIC_EXIT,
"***** expansion_Jacobian():\n"
"        unknown Jacobian_info.Jacobian_compute_method=(int)%d!\n"
"        (this should never happen!)\n"
,
		   int(Jacobian_info.Jacobian_compute_method));	/*NOTREACHED*/
	}

 if (active_flag) {

   switch (compute_info.surface_modification) {

   case modification_none:
     // do nothing
     break;

   case modification_radius: {
     // multiply with the coordinate radius
     // H_{(r)i} = H_i h_i
     // J_{(r)ij} = J_{ij} h_i + H_i \delta_{ij}
     const int np = ps_ptr->N_grid_points();
     for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
       patch& p = ps_ptr->ith_patch(pn);
       for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
         for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
           const int i = ps_ptr->gpn_of_patch_irho_isigma(p, irho,isigma);
           const fp radius = p.ghosted_gridfn(gfns::gfn__h, irho, isigma);
           for (int j=0; j<np; ++j) {
             if (Jac_ptr->is_explicitly_stored (i, j)) {
               const fp val = Jac_ptr->element (i, j);
               Jac_ptr->set_element (i, j, val * radius);
             }
           }
           const fp Theta = (p.gridfn(gfns::gfn__Theta, irho, isigma)
                             + compute_info.desired_value) / radius;
           Jac_ptr->sum_into_element (i, i, Theta);
         }
       }
     }
     break;
   }

   case modification_radius2: {
     // multiply with the square of the coordinate radius
     // H_{(r2)i} = H_i h_i^2
     // J_{(r2)ij} = J_{ij} h_i^2 + 2 H_i h_i \delta_{ij}
     const int np = ps_ptr->N_grid_points();
     for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
       patch& p = ps_ptr->ith_patch(pn);
       for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
         for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
           const int i = ps_ptr->gpn_of_patch_irho_isigma(p, irho,isigma);
           const fp radius = p.ghosted_gridfn(gfns::gfn__h, irho, isigma);
           const fp radius2 = radius * radius;
           for (int j=0; j<np; ++j) {
             if (Jac_ptr->is_explicitly_stored (i, j)) {
               const fp val = Jac_ptr->element (i, j);
               Jac_ptr->set_element (i, j, val * radius2);
             }
           }
           const fp Theta = (p.gridfn(gfns::gfn__Theta, irho, isigma)
                             + compute_info.desired_value) / radius2;
           Jac_ptr->sum_into_element (i, i, 2 * Theta * radius);
         }
       }
     }
     break;
   }

#if 0
   case modification_mean_radius: {
     // multiply with the average coordinate radius
     // H_{(\bar r)i} = H_i \bar r
     // J_{(\bar r)ij} = J_{ij} \bar r + H_i / N
     // calculate average coordinate radius
     const int np = ps_ptr->N_grid_points();
     fp sum_radius = 0;
     for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
       patch& p = ps_ptr->ith_patch(pn);
       for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
         for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
           sum_radius += p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
         }
       }
     }
     mean_radius = sum_radius / np;
     // correct Jacobian
     const int np = ps_ptr->N_grid_points();
     for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
       patch& p = ps_ptr->ith_patch(pn);
       for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
         for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
           const int i = ps_ptr->gpn_of_patch_irho_isigma(p, irho,isigma);
           for (int j=0; j<np; ++j) {
             if (Jac_ptr->is_explicitly_stored (i, j)) {
               const fp val = Jac_ptr->element (i, j);
               Jac_ptr->set_element (i, j, val * mean_radius);
             }
           }
#error "unfinished"
           const fp Theta = (p.gridfn(gfns::gfn__Theta, irho, isigma)
                             + compute_info.desired_value) / areal_radius;
           const fp dRdh = 0.5 * areal_radius;
           Jac_ptr->sum_into_element (i, i, Theta * dRdh);
         }
       }
     }
     break;
   }

   case modification_areal_radius: {
     // multiply with the areal radius
     // H_{(R)i} = H_i R
     // J_{(R)ij} = J_{ij} R + H_i dR/dh_j
     // get surface area
     const fp area = ps_ptr->integrate_gridfn
       (gfns::gfn__one, true, true, true,
        gfns::gfn__h,
        gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                            gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                gfns::gfn__g_dd_33,
        patch::integration_method__automatic_choice);
     const fp areal_radius = sqrt(area / (4.0*PI));
     // correct Jacobian
     const int np = ps_ptr->N_grid_points();
     for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
       patch& p = ps_ptr->ith_patch(pn);
       for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
         for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
           const int i = ps_ptr->gpn_of_patch_irho_isigma(p, irho,isigma);
           for (int j=0; j<np; ++j) {
             if (Jac_ptr->is_explicitly_stored (i, j)) {
               const fp val = Jac_ptr->element (i, j);
               Jac_ptr->set_element (i, j, val * areal_radius);
             }
           }
           const fp Theta = (p.gridfn(gfns::gfn__Theta, irho, isigma)
                             + compute_info.desired_value) / areal_radius;
           const fp dRdh = 0.5 * areal_radius;
           Jac_ptr->sum_into_element (i, i, Theta * dRdh);
         }
       }
     }
     break;
   }
#endif

   default:
     assert (0);
   } // switch surface_modification
   
   if (ps_ptr->N_additional_points()) {
     switch (compute_info.surface_selection) {

     case selection_definition: {
       // we want nothing special
       const int np = ps_ptr->N_grid_points();
       for (int i=0; i<np; ++i) {
         Jac_ptr->set_element (i, np, 0.0);
       }
       for (int j=0; j<np; ++j) {
         Jac_ptr->set_element (np, j, 0.0);
       }
       Jac_ptr->set_element (np, np, 1.0);
       break;
     }

     case selection_mean_coordinate_radius: {
       // Jac_ptr->set_element (II, JJ, x) == dTheta(II)/dh(JJ)
       // \frac{\partial R}{\partial h_j} = 1 / N
       const int np = ps_ptr->N_grid_points();
       for (int i=0; i<np; ++i) {
         Jac_ptr->set_element (i, np, -1.0);
       }
       for (int j=0; j<np; ++j) {
         fp val = 0;
         for (int k=0; k<np; ++k) {
           val += Jac_ptr->element (k, j) / np;
         }
         val -= 1.0 / np;
         Jac_ptr->set_element (np, j, val);
       }
       Jac_ptr->set_element (np, np, -1.0);
       break;
     }

     case selection_areal_radius: {
       // \frac{\partial R_a}{\partial h_j}
       //    = \sqrt{1 / 16 \pi A} \sum_k \sqrt{q_k} dS_k
       // The "trapezoid" method is faster
//        const enum patch::integration_method method
//          = patch::integration_method__automatic_choice;
       const enum patch::integration_method method
         = patch::integration_method__trapezoid;
       const fp area = ps_ptr->integrate_gridfn
         (gfns::gfn__one, true, true, true,
          gfns::gfn__h,
          gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
			      gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
						  gfns::gfn__g_dd_33,
          method);
       const int np = ps_ptr->N_grid_points();
       for (int i=0; i<np; ++i) {
         Jac_ptr->set_element (i, np, -1.0);
       }
       for (int j=0; j<np; ++j) {
         fp val = 0;
         for (int k=0; k<np; ++k) {
           val += Jac_ptr->element (k, j) / np;
         }
         Jac_ptr->set_element (np, j, val);
       }
       for (int jpn = 0; jpn < ps_ptr->N_patches(); ++jpn) {
         patch& jp = ps_ptr->ith_patch(jpn);
         for (int jrho = jp.min_irho(); jrho <= jp.max_irho(); ++jrho) {
           for (int jsigma = jp.min_isigma(); jsigma <= jp.max_isigma(); ++jsigma) {
             const int j = ps_ptr->gpn_of_patch_irho_isigma(jp, jrho,jsigma);
             // const fp radius = jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma);
             const fp epsilon = Jacobian_info.perturbation_amplitude;
             fp val1, val2;
#if 0
             // Re-calculate all points
             // (this is slow, but it works)
             val1 = area;
             jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma) += epsilon;
             val2 = ps_ptr->integrate_gridfn
               (gfns::gfn__one, true, true, true,
                gfns::gfn__h,
                gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                                    gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                        gfns::gfn__g_dd_33,
                method);
             jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma) -= epsilon;
#else
             // Re-calculate all points with non-zero Jacobian entries
             jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma) -= epsilon/2;
             val1 = 0;
             for (int ipn = 0; ipn < ps_ptr->N_patches(); ++ipn) {
               patch& ip = ps_ptr->ith_patch(ipn);
               for (int irho = ip.min_irho(); irho <= ip.max_irho(); ++irho) {
                 for (int isigma = ip.min_isigma(); isigma <= ip.max_isigma(); ++isigma) {
                   const int i = ps_ptr->gpn_of_patch_irho_isigma(ip, irho,isigma);
                   if (Jac_ptr->is_explicitly_stored (i, j)) {
                     val1 += ps_ptr->integrate_gridpoint
                       (gfns::gfn__one,
                        gfns::gfn__h,
                        gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                                            gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                                gfns::gfn__g_dd_33,
                        method,
                        ipn, irho, isigma);
                   }
                 }
               }
             }
             jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma) += epsilon;
             val2 = 0;
             for (int ipn = 0; ipn < ps_ptr->N_patches(); ++ipn) {
               patch& ip = ps_ptr->ith_patch(ipn);
               for (int irho = ip.min_irho(); irho <= ip.max_irho(); ++irho) {
                 for (int isigma = ip.min_isigma(); isigma <= ip.max_isigma(); ++isigma) {
                   const int i = ps_ptr->gpn_of_patch_irho_isigma(ip, irho,isigma);
                   if (Jac_ptr->is_explicitly_stored (i, j)) {
                     val2 += ps_ptr->integrate_gridpoint
                       (gfns::gfn__one,
                        gfns::gfn__h,
                        gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13,
                                            gfns::gfn__g_dd_22, gfns::gfn__g_dd_23,
                                                                gfns::gfn__g_dd_33,
                        method,
                        ipn, irho, isigma);
                   }
                 }
               }
             }
             jp.ghosted_gridfn(gfns::gfn__h, jrho, jsigma) -= epsilon/2;
#endif
             const fp val = 1 / sqrt(16*PI*area) * ps_ptr->integrate_correction(true, true, true) * (val2 - val1) / epsilon;
             Jac_ptr->sum_into_element (np, j, -val);
           }
         }
       }
       Jac_ptr->set_element (np, np, -1.0);
       break;
     }

     case selection_expansion_mean_coordinate_radius: {
       // Jac_ptr->set_element (II, JJ, x) == dTheta(II)/dh(JJ)
       const int np = ps_ptr->N_grid_points();
       fp sum_expansion = 0;
       fp sum_radius = 0;
       for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) {
         patch& p = ps_ptr->ith_patch(pn);
         for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) {
           for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) {
             sum_expansion += p.gridfn(gfns::gfn__Theta, irho,isigma);
             sum_radius += p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
           }
         }
       }
       for (int i=0; i<np; ++i) {
         Jac_ptr->set_element (i, np, -1.0);
       }
       for (int j=0; j<np; ++j) {
         fp val = 0;
         for (int k=0; k<np; ++k) {
           val += (Jac_ptr->element (k, j) / np) * (1.0 - sum_radius / np);
         }
         val -= (sum_expansion / np) / np;
         Jac_ptr->set_element (np, j, val);
       }
       Jac_ptr->set_element (np, np, -1.0);
       break;
     }

     case selection_expansion_areal_radius: {
       CCTK_WARN (0, "selection_expansion_areal_radius not implemented");
       break;
     }

     default:
       assert (0);
     } // switch surface_selection
   } else {
     assert (compute_info.surface_selection == selection_definition);
   }
   
 } // if active

return expansion_success;				// *** NORMAL RETURN ***
}

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function computes the Jacobian matrix of the expansion Theta(h)
// by numerical perturbation of the Theta(h) function.  The algorithm is
// as follows:
//
// we assume that Theta = Theta(h) has already been evaluated
// save_Theta = Theta
//	for each point (y,JJ)
//	{
//	const fp save_h_y = h at y;
//	h at y += perturbation_amplitude;
//	evaluate Theta(h) (silently)
//		for each point (x,II)
//		{
//		Jac(II,JJ) = (Theta(II) - save_Theta(II))
//			     / perturbation_amplitude;
//		}
//	h at y = save_h_y;
//	}
// Theta = save_Theta
//
// Inputs (angular gridfns, on ghosted grid):
//	h			# shape of trial surface
//	Theta			# Theta(h) assumed to already be computed
//
// Outputs:
//	The Jacobian matrix is stored in the Jacobian object Jac.
//	As implied by the above algorithm, it's traversed by columns.
//
// Results:
// This function returns a status code indicating whether the computation
// succeeded or failed, and if the latter, what caused the failure.
//
namespace {
enum expansion_status
  expansion_Jacobian_NP
        (patch_system& ps, Jacobian& Jac,
         const struct what_to_compute& compute_info,
	 const struct cactus_grid_info& cgi,
	 const struct geometry_info& gi,
	 const struct Jacobian_info& Jacobian_info,
	 const struct error_info& error_info, bool initial_flag,
	 bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   horizon Jacobian (numerical perturbation)");
const fp epsilon = Jacobian_info.perturbation_amplitude;

ps.gridfn_copy(gfns::gfn__Theta, gfns::gfn__save_Theta);
ps.gridfn_copy(gfns::gfn__mean_curvature, gfns::gfn__save_mean_curvature);

	for (int ypn = 0 ; ypn < ps.N_patches() ; ++ypn)
	{
	patch& yp = ps.ith_patch(ypn);
	if (print_msg_flag)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "      perturbing in %s patch",
			   yp.name());

	for (int y_irho = yp.min_irho() ; y_irho <= yp.max_irho() ; ++y_irho)
	{
	for (int y_isigma = yp.min_isigma() ;
	     y_isigma <= yp.max_isigma() ;
	     ++y_isigma)
	{
	const int JJ = ps.gpn_of_patch_irho_isigma(yp, y_irho,y_isigma);

	const fp save_h_y = yp.ghosted_gridfn(gfns::gfn__h, y_irho,y_isigma);
	yp.ghosted_gridfn(gfns::gfn__h, y_irho,y_isigma) += epsilon;
	const
	  enum expansion_status status = expansion(&ps,
                                                   compute_info,
						   cgi, gi,
						   error_info, initial_flag);
	if (status != expansion_success)
	   then return status;				// *** ERROR RETURN ***

		for (int xpn = 0 ; xpn < ps.N_patches() ; ++xpn)
		{
		patch& xp = ps.ith_patch(xpn);

		for (int x_irho = xp.min_irho() ;
		     x_irho <= xp.max_irho() ;
		     ++x_irho)
		{
		for (int x_isigma = xp.min_isigma() ;
		     x_isigma <= xp.max_isigma() ;
		     ++x_isigma)
		{
		const int II = ps.gpn_of_patch_irho_isigma(xp, x_irho,x_isigma);
		const fp old_Theta = xp.gridfn(gfns::gfn__save_Theta,
					       x_irho,x_isigma);
		const fp new_Theta = xp.gridfn(gfns::gfn__Theta,
					       x_irho,x_isigma);
		Jac.set_element(II,JJ, (new_Theta - old_Theta) / epsilon);
		}
		}
		}

	if (ps.N_additional_points())
		{
		const int np = ps.N_grid_points();
		Jac.set_element(np,JJ, 0.0);	// insert dummy value
		}

	yp.ghosted_gridfn(gfns::gfn__h, y_irho,y_isigma) = save_h_y;
	}
	}
   	} 

ps.gridfn_copy(gfns::gfn__save_Theta, gfns::gfn__Theta);
ps.gridfn_copy(gfns::gfn__save_mean_curvature, gfns::gfn__mean_curvature);
return expansion_success;				// *** NORMAL RETURN ***
}
	  }

//******************************************************************************

//
// This function computes the partial derivative terms in the Jacobian
// matrix of the expansion Theta(h), by symbolic differentiation from
// the Jacobian coefficient (angular) gridfns.  The Jacobian is traversed
// by rows, using equation (25) of my 1996 apparent horizon finding paper.
//
// Inputs (angular gridfns, on ghosted grid):
//	h			# shape of trial surface
//	Theta			# Theta(h) assumed to already be computed
//	partial_Theta_wrt_partial_d_h	# Jacobian coefficients
//	partial_Theta_wrt_partial_dd_h	# (also assumed to already be computed)
//
// Outputs:
//	The Jacobian matrix is stored in the Jacobian object Jac.
//
namespace {
void expansion_Jacobian_partial_SD(patch_system& ps, Jacobian& Jac,
				   const struct cactus_grid_info& cgi,
				   const struct geometry_info& gi,
				   const struct Jacobian_info& Jacobian_info,
				   bool print_msg_flag)
{
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   horizon Jacobian: partial-deriv terms (symbolic diff)");

Jac.zero_matrix();
ps.compute_synchronize_Jacobian();

    for (int xpn = 0 ; xpn < ps.N_patches() ; ++xpn)
    {
    patch& xp = ps.ith_patch(xpn);

	for (int x_irho = xp.min_irho() ; x_irho <= xp.max_irho() ; ++x_irho)
	{
	for (int x_isigma = xp.min_isigma() ;
	x_isigma <= xp.max_isigma() ;
	++x_isigma)
	{
	//
	// compute the main Jacobian terms for this grid point, i.e.
	//	partial Theta(this point x, Jacobian row II)
	//	---------------------------------------------
	//	partial h(other points y, Jacobian column JJ)
	//

	// Jacobian row index
	const int II = ps.gpn_of_patch_irho_isigma(xp, x_irho, x_isigma);

	// Jacobian coefficients for this point
	const fp Jacobian_coeff_rho
	   = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_1,
		       x_irho, x_isigma);
	const fp Jacobian_coeff_sigma
	   = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_2,
		       x_irho, x_isigma);
	const fp Jacobian_coeff_rho_rho
	   = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_11,
		       x_irho, x_isigma);
	const fp Jacobian_coeff_rho_sigma
	   = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_12,
		       x_irho, x_isigma);
	const fp Jacobian_coeff_sigma_sigma
	   = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_22,
		       x_irho, x_isigma);

	// partial_rho, partial_rho_rho
	      {
	    for (int m_irho = xp.molecule_min_m() ;
		 m_irho <= xp.molecule_max_m() ;
		 ++m_irho)
	    {
	    const int xm_irho = x_irho + m_irho;
	    const fp Jac_rho     = Jacobian_coeff_rho
				   * xp.partial_rho_coeff(m_irho);
	    const fp Jac_rho_rho = Jacobian_coeff_rho_rho
				   * xp.partial_rho_rho_coeff(m_irho);
	    const fp Jac_sum = Jac_rho + Jac_rho_rho;
	    if (xp.is_in_nominal_grid(xm_irho, x_isigma))
	       then {
		    const int xm_JJ
		       = Jac.II_of_patch_irho_isigma(xp,xm_irho,x_isigma);
		    Jac.sum_into_element(II, xm_JJ, Jac_sum);
		    }
	       else add_ghost_zone_Jacobian
			(ps, Jac,
			 Jac_sum,
			 xp, xp.minmax_rho_ghost_zone(m_irho < 0),
			 II, xm_irho, x_isigma);
	    }
	      }

	// partial_sigma, partial_sigma_sigma
	      {
	    for (int m_isigma = xp.molecule_min_m() ;
		 m_isigma <= xp.molecule_max_m() ;
		 ++m_isigma)
	    {
	    const int xm_isigma = x_isigma + m_isigma;
	    const fp Jac_sigma       = Jacobian_coeff_sigma
				       * xp.partial_sigma_coeff(m_isigma);
	    const fp Jac_sigma_sigma = Jacobian_coeff_sigma_sigma
				       * xp.partial_sigma_sigma_coeff(m_isigma);
	    const fp Jac_sum = Jac_sigma + Jac_sigma_sigma;
	    if (xp.is_in_nominal_grid(x_irho, xm_isigma))
	       then {
		    const int xm_JJ
		       = Jac.II_of_patch_irho_isigma(xp, x_irho, xm_isigma);
		    Jac.sum_into_element(II, xm_JJ, Jac_sum);
		    }
	       else add_ghost_zone_Jacobian
			(ps, Jac,
			 Jac_sum,
			 xp, xp.minmax_sigma_ghost_zone(m_isigma < 0),
			 II, x_irho, xm_isigma);
	    }
	      }

	// partial_rho_sigma
	      {
	    for (int m_irho = xp.molecule_min_m() ;
		 m_irho <= xp.molecule_max_m() ;
		 ++m_irho)
	    {
	    for (int m_isigma = xp.molecule_min_m() ;
		 m_isigma <= xp.molecule_max_m() ;
		 ++m_isigma)
	    {
	    const int xm_irho   = x_irho   + m_irho;
	    const int xm_isigma = x_isigma + m_isigma;
	    const fp Jac_rho_sigma
	       = Jacobian_coeff_rho_sigma
		 * xp.partial_rho_sigma_coeff(m_irho, m_isigma);
	    if (xp.is_in_nominal_grid(xm_irho, xm_isigma))
	       then {
		    const int xm_JJ
		       = Jac.II_of_patch_irho_isigma(xp, xm_irho, xm_isigma);
		    Jac.sum_into_element(II, xm_JJ, Jac_rho_sigma);
		    }
	       else {
		    const ghost_zone& xmgz
		       = xp.corner_ghost_zone_containing_point
				(m_irho < 0, m_isigma < 0,
				 xm_irho, xm_isigma);
		    add_ghost_zone_Jacobian(ps, Jac,
					    Jac_rho_sigma,
					    xp, xmgz,
					    II, xm_irho, xm_isigma);
		    }
	    }
	    }
	      }

	if (ps.N_additional_points())
		{
		const int np = ps.N_grid_points();
		Jac.set_element(II,np, 0.0);	// insert dummy value
		}

	}
	}
    }
}
	  }

//******************************************************************************

//
// This function adds the ghost-zone Jacobian dependency contributions
// for a single ghost-zone point, to a Jacobian matrix.
//
// Arguments:
// ps = The patch system.
// Jac = (out) The Jacobian matrix.
// mol = The molecule coefficient.
// xp = The patch containing the center point of the molecule.
// xmgz = If the x+m point is in a ghost zone, this must be that ghost zone.
//	  If the x+m point is not in a ghost zone, this argument is ignored.
// x_II = The Jacobian row of the x point.
// xm_(irho,isigma) = The coordinates (in xp) of the x+m point of the molecule.
//
namespace {
void add_ghost_zone_Jacobian(const patch_system& ps,
			     Jacobian& Jac,
			     fp mol,
			     const patch& xp, const ghost_zone& xmgz,
			     int x_II,
			     int xm_irho, int xm_isigma)
{
const patch_edge& xme = xmgz.my_edge();
const int xm_iperp = xme.iperp_of_irho_isigma(xm_irho, xm_isigma);
const int xm_ipar  = xme. ipar_of_irho_isigma(xm_irho, xm_isigma);

// FIXME: this won't change from one call to another
//        ==> it would be more efficient to reuse the same buffer
//            across multiple calls on this function
int global_min_ym, global_max_ym;
ps.synchronize_Jacobian_global_minmax_ym(global_min_ym, global_max_ym);
jtutil::array1d<fp> Jacobian_buffer(global_min_ym, global_max_ym);

// on what other points y does this molecule point xm depend
// via the patch_system::synchronize() operation?
int y_iperp;
int y_posn, min_ym, max_ym;
const patch_edge& ye = ps.synchronize_Jacobian(xmgz,
					       xm_iperp, xm_ipar,
					       y_iperp,
					       y_posn, min_ym, max_ym,
					       Jacobian_buffer);
patch& yp = ye.my_patch();

// add the Jacobian contributions from the ym points
	for (int ym = min_ym ; ym <= max_ym ; ++ym)
	{
	const int y_ipar = y_posn + ym;
	const int y_irho   = ye.  irho_of_iperp_ipar(y_iperp,y_ipar);
	const int y_isigma = ye.isigma_of_iperp_ipar(y_iperp,y_ipar);
	const int y_JJ = Jac.II_of_patch_irho_isigma(yp, y_irho, y_isigma);
	Jac.sum_into_element(x_II, y_JJ, mol*Jacobian_buffer(ym));
	}
}
	  }

//******************************************************************************

//
// If ps_ptr != NULL and Jac_ptr != NULL, this function sums the d/dr
// terms into the Jacobian matrix of the expansion Theta(h), computing
// those terms by finite differencing.
//
// If ps_ptr == NULL and Jac_ptr == NULL, this function does a dummy
// computation, in which only any expansion() (and hence geometry
// interpolator) calls are done, these with the number of interpolation
// points set to 0 and all the output array pointers set to NULL.
//
// It's illegal for one but not both of ps_ptr and Jac_ptr to be NULL.
//
// The basic algorithm is that
//	Jac += diag[ (Theta(h+epsilon/2) - Theta(h-epsilon/2)) / epsilon ]
//
// Inputs (angular gridfns, on ghosted grid):
//	h			# shape of trial surface
//	Theta			# Theta(h) assumed to already be computed
//				# (saved and restored, but not used)
//
// Outputs:
//	Jac += d/dr terms
//
// Results:
// This function returns a status code indicating whether the computation
// succeeded or failed, and if the latter, what caused the failure.
//
namespace {
enum expansion_status
  expansion_Jacobian_dr_FD
	(patch_system* ps_ptr, Jacobian* Jac_ptr,
         const struct what_to_compute& compute_info,
	 const struct cactus_grid_info& cgi,
	 const struct geometry_info& gi,
	 const struct Jacobian_info& Jacobian_info,
	 const struct error_info& error_info, bool initial_flag,
	 bool print_msg_flag)
{
const bool active_flag = (ps_ptr != NULL) && (Jac_ptr != NULL);
if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   horizon Jacobian: %sd/dr terms (finite diff)",
		   active_flag ? "" : "dummy ");

const fp epsilon = Jacobian_info.perturbation_amplitude;

what_to_compute this_compute_info (compute_info);
this_compute_info.surface_modification = modification_none;
this_compute_info.surface_selection = selection_definition;
this_compute_info.desired_value = 0.0;

fp additional_save_Theta;

// compute Theta(h-epsilon/2)
if (active_flag)
   then {
	ps_ptr->gridfn_copy(gfns::gfn__Theta, gfns::gfn__save_Theta);
	ps_ptr->gridfn_copy(gfns::gfn__mean_curvature, gfns::gfn__save_mean_curvature);
	if (ps_ptr->N_additional_points())
	   then {
		const int np = ps_ptr->N_grid_points();
		additional_save_Theta = ps_ptr->gridfn_data(gfns::gfn__Theta)[np];
		}
	ps_ptr->add_to_ghosted_gridfn(-epsilon/2, gfns::gfn__h);
	}
const
  enum expansion_status status = expansion(ps_ptr,
                                           this_compute_info,
					   cgi, gi,
					   error_info, initial_flag);
if (status != expansion_success)
   then {
        expansion(NULL,
                  this_compute_info,
                  cgi, gi,
                  error_info, false);
        return status;					// *** ERROR RETURN ***
  }

// compute Theta(h+epsilon/2)
if (active_flag)
   then {
	ps_ptr->gridfn_copy(gfns::gfn__Theta, gfns::gfn__old_Theta);
	ps_ptr->add_to_ghosted_gridfn(epsilon, gfns::gfn__h);
	}
const
  enum expansion_status status2 = expansion(ps_ptr,
                                            this_compute_info,
					    cgi, gi,
					    error_info, initial_flag);
if (status2 != expansion_success)
   then return status2;					// *** ERROR RETURN ***

if (active_flag)
   then {
	    for (int pn = 0 ; pn < ps_ptr->N_patches() ; ++pn)
	    {
	    patch& p = ps_ptr->ith_patch(pn);
		for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
		{
		for (int isigma = p.min_isigma() ;
		     isigma <= p.max_isigma() ;
		     ++isigma)
		{
		const int II = ps_ptr->gpn_of_patch_irho_isigma(p, irho,isigma);
		const fp old_Theta = p.gridfn(gfns::gfn__old_Theta,
					      irho,isigma);
		const fp new_Theta = p.gridfn(gfns::gfn__Theta,
					      irho,isigma);
		const fp d_dr_term = (new_Theta - old_Theta) / epsilon;
		Jac_ptr->sum_into_element(II,II, d_dr_term);
		}
		}
	    }

	// restore h and Theta
	ps_ptr->add_to_ghosted_gridfn(-epsilon/2, gfns::gfn__h);
	ps_ptr->gridfn_copy(gfns::gfn__save_Theta, gfns::gfn__Theta);
	ps_ptr->gridfn_copy(gfns::gfn__save_mean_curvature, gfns::gfn__mean_curvature);
	if (ps_ptr->N_additional_points())
	   then {
		const int np = ps_ptr->N_grid_points();
		ps_ptr->gridfn_data(gfns::gfn__Theta)[np] = additional_save_Theta;
		}
	}

return expansion_success;				// *** NORMAL RETURN ***
}
	  }

//******************************************************************************

	  }	// namespace AHFinderDirect

```

gr/Makefile.standalone:
```
# Makefile for GR code
# $Header$

#
# Environment Variables:
#	MAPLE_VERSION	used via @ifdef for version control in Maple code;
#			typically set to something like  MAPLE_V_RELEASE_4
#			(not presently used, but may be needed in the future)
#
# Targets:
#	cg		==> run all the *.mm files to generate C code 
#	mm		==> preprocess all *.maple files to produce *.mm files
#	clean		==> delete *.mm (mpp Maple preprocessor output)
#

ifneq ($(MAPLE_VERSION),)
MPP_FLAGS := -D$(MAPLE_VERSION)
endif

###############################################################################

# we don't want a (non--no-op) default target in this makefile
.PHONY	: dummy
dummy	:
	@echo 'there is no default target for this makefile'

.PHONY	: cg
cg	: mm
	maple <doit.mm 2>&1 | tee maple.log

.PHONY	: mm
mm	: $(patsubst %.maple, %.mm, $(wildcard *.maple))

%.mm	: %.maple $(wildcard *.minc $(gfa_dir)/*.minc $(gfa_dir)/*.maple)
	../misc/mpp $(MPP_FLAGS) <$< >$@

.PHONY	: clean
clean	:
	-rm *.mm

```

gr/make.code.defn:
```
# Cactus specification of things to be compiled in this directory
# $Header$

# Source files in this directory
SRCS = expansion.cc \
       expansion_Jacobian.cc \
       Schwarzschild_EF.cc \
       misc-gr.cc

# Subdirectories containing source files
SUBDIRS =

# disable automatic template instantiation on DEC Alphas
ifeq ($(shell uname), OSF1)
  ifeq ($(CXX), cxx)
    CXXFLAGS += -nopt
  endif
endif

```

gr/setup_gr_gfas.maple:
```
# Maple code to set up all gridfn arrays
# $Header$

#
# setup_gr_gfas - setup all the GR gfas
# `Diff/gridfn2` - Diff() simplification based on gridfn properties known here
#

################################################################################

setup_gr_gfas :=
proc()
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";

# metric and extrinsic curvature
make_gfa('g_dd', {inert}, [1..N, 1..N], symmetric);
make_gfa('K_dd', {inert}, [1..N, 1..N], symmetric);

# index-raised and contracted metric and extrinsic curvature
make_gfa('g_uu', {inert,fnd}, [1..N, 1..N], symmetric);
make_gfa('K_uu', {inert,fnd}, [1..N, 1..N], symmetric);
make_gfa('K', {inert,fnd}, [], none);

# xyz partial derivatives of metric
# ... as far as Maple is concerned, these are indeed separate gridfns;
#     the derivatives are actually taken by the interpolator
make_gfa('partial_d_g_dd', {inert}, [1..N, 1..N, 1..N], symmetric3_23);

# xyz partial derivatives of metric determinant
make_gfa('partial_d_ln_sqrt_g', {inert,fnd}, [1..N], none);

# xyz partial derivatives of inverse metric
# (computed in terms of xyz derivatives of g_dd)
make_gfa('partial_d_g_uu', {inert,fnd}, [1..N, 1..N, 1..N], symmetric3_23);

# radius of horizon
make_gfa('h', {inert,fnd}, [], none);

# outward-pointing *non*-unit normal (covector) to horizon
# and it's xyz-coordinate partial derivatives
make_gfa('s_d', {inert,fnd}, [1..N], none);
make_gfa('partial_d_s_d', {inert,fnd}, [1..N, 1..N], none);

# expansion of horizon and subexpressions for computing it
# ... these are defined by (14) and (15) in my 1996 AH-finding paper
#     except I now use Theta instead of H for the LHS
make_gfa('Theta_A', {inert,fnd}, [], none);
make_gfa('Theta_B', {inert,fnd}, [], none);
make_gfa('Theta_C', {inert,fnd}, [], none);
make_gfa('Theta_D', {inert,fnd}, [], none);
make_gfa('Theta', {inert,fnd}, [], none);

# 1st derivatives of Theta[ABCD] and of Theta
make_gfa('partial_d_Theta_A', {inert,fnd}, [1..N], none);
make_gfa('partial_d_Theta_B', {inert,fnd}, [1..N], none);
make_gfa('partial_d_Theta_C', {inert,fnd}, [1..N], none);
make_gfa('partial_d_Theta_D', {inert,fnd}, [1..N], none);
make_gfa('partial_d_Theta', {inert,fnd}, [1..N], none);

# Jacobian coefficients for Theta[ABCD]
# these are the partial derivatives of Theta[ABCD]
# ... wrt Diff(h,x_rs[x])
make_gfa('partial_Theta_A_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
make_gfa('partial_Theta_B_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
make_gfa('partial_Theta_C_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
make_gfa('partial_Theta_D_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
# ... wrt Diff(h,x_rs[x],x_rs[y])
make_gfa('partial_Theta_A_wrt_partial_dd_h', {inert,fnd},
	 [1..N_ang, 1..N_ang], symmetric);
make_gfa('partial_Theta_B_wrt_partial_dd_h', {inert,fnd},
	 [1..N_ang, 1..N_ang], symmetric);

# Jacobian coefficients for Theta itself
make_gfa('partial_Theta_X_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
make_gfa('partial_Theta_Y_wrt_partial_d_h', {inert,fnd}, [1..N_ang], none);
make_gfa('partial_Theta_X_wrt_partial_dd_h', {inert,fnd},
	 [1..N_ang, 1..N_ang], symmetric);
make_gfa('partial_Theta_Y_wrt_partial_dd_h', {inert,fnd},
	 [1..N_ang, 1..N_ang], symmetric);

NULL;
end proc;


################################################################################

#
# This function implements further simplification rules for  Diff()
# based on gridfn properties which are known here but not in ../maple/.
#
# It currently knows about the following simplifications:
# - Diff(g_dd[i,j], x_xyz[k]) --> partial_d_g_dd[k,i,j]
#
# Anything else is returned unchanged.  (To avoid infinite recursion,
# such a return is *unevaluated*.)
#
# Arguments:
# operand = (in) The thing to be differentiated.
# var_seq = (in) (varargs) An expression sequence of the variables to
#			   differentiate with respect to.
#
`Diff/gridfn2` :=
proc(operand)			# varargs
option remember;		# performance optimization
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local var_list, posn;

var_list := [args[2..nargs]];

if ( type(operand, indexed) and (op(0,operand) = 'g_dd')
     and (nops(var_list) = 1) and member(var_list[1],x_xyz_list,'posn') )
   then return partial_d_g_dd[posn, op(operand)];
end if;

# unevaluated return to avoid infinite recursion
return 'Diff'(operand, op(var_list));
end proc;

```

gr/cg.hh:
```
// cg.hh -- interface between machine-generated and other code
// $Header$

//
// This header file defines the "virtual machine" used by machine-generated
// code.  It is "dangerous" in that it #defines macros and local variables
// for all the gridfns, which will break lots of other code.  Thus this file
// can only be #included within a function, and should only be #included
// just before #including machine-generated code, and this should be as
// close as possible to the end of the source file (to minimize the amount
// of other code affected by this file).
//
// FIXME: we should have an "uncg.hh" header file to #undef all these macros
//
// prerequisites
//	gfns.hh
//

//******************************************************************************

//
// The machine-generated code uses the following variables:
//	patch& p		// current patch
//	int irho,isigma		// current generic integer coords within patch
//	fp xx, yy, zz;		// local (x,y,z) coords of this grid point
//	fp X_ud_[12][123]			// 1st derivative coefficients
//	fp X_udd_[12]{11,12,13,22,23,33}	// 2nd derivative coefficients
//

//
// rational numbers
//
#define RATIONAL(num,den)	(num/den)

//
// partial derivatives
//
#define PARTIAL_RHO(ghosted_gridfn_name)	\
	p.partial_rho(gfns::gfn__ ## ghosted_gridfn_name, irho,isigma)
#define PARTIAL_SIGMA(ghosted_gridfn_name)	\
	p.partial_sigma(gfns::gfn__ ## ghosted_gridfn_name, irho,isigma)
#define PARTIAL_RHO_RHO(ghosted_gridfn_name)	\
	p.partial_rho_rho(gfns::gfn__ ## ghosted_gridfn_name, irho,isigma)
#define PARTIAL_RHO_SIGMA(ghosted_gridfn_name)	\
	p.partial_rho_sigma(gfns::gfn__ ## ghosted_gridfn_name, irho,isigma)
#define PARTIAL_SIGMA_SIGMA(ghosted_gridfn_name)\
	p.partial_sigma_sigma(gfns::gfn__ ## ghosted_gridfn_name, irho,isigma)

//******************************************************************************

//
// ghosted-grid gridfns
// n.b. since we're always evaluating on the surface, r == h
//
#define h	p.ghosted_gridfn(gfns::gfn__h, irho,isigma)
#define r	h

//******************************************************************************

//
// nominal-grid gridfns
//
#define g_dd_11	p.gridfn(gfns::gfn__g_dd_11, irho,isigma)
#define g_dd_12	p.gridfn(gfns::gfn__g_dd_12, irho,isigma)
#define g_dd_13	p.gridfn(gfns::gfn__g_dd_13, irho,isigma)
#define g_dd_22	p.gridfn(gfns::gfn__g_dd_22, irho,isigma)
#define g_dd_23	p.gridfn(gfns::gfn__g_dd_23, irho,isigma)
#define g_dd_33	p.gridfn(gfns::gfn__g_dd_33, irho,isigma)
#define K_dd_11	p.gridfn(gfns::gfn__K_dd_11, irho,isigma)
#define K_dd_12	p.gridfn(gfns::gfn__K_dd_12, irho,isigma)
#define K_dd_13	p.gridfn(gfns::gfn__K_dd_13, irho,isigma)
#define K_dd_22	p.gridfn(gfns::gfn__K_dd_22, irho,isigma)
#define K_dd_23	p.gridfn(gfns::gfn__K_dd_23, irho,isigma)
#define K_dd_33	p.gridfn(gfns::gfn__K_dd_33, irho,isigma)

#define partial_d_g_dd_111	p.gridfn(gfns::gfn__partial_d_g_dd_111, irho,isigma)
#define partial_d_g_dd_112	p.gridfn(gfns::gfn__partial_d_g_dd_112, irho,isigma)
#define partial_d_g_dd_113	p.gridfn(gfns::gfn__partial_d_g_dd_113, irho,isigma)
#define partial_d_g_dd_122	p.gridfn(gfns::gfn__partial_d_g_dd_122, irho,isigma)
#define partial_d_g_dd_123	p.gridfn(gfns::gfn__partial_d_g_dd_123, irho,isigma)
#define partial_d_g_dd_133	p.gridfn(gfns::gfn__partial_d_g_dd_133, irho,isigma)
#define partial_d_g_dd_211	p.gridfn(gfns::gfn__partial_d_g_dd_211, irho,isigma)
#define partial_d_g_dd_212	p.gridfn(gfns::gfn__partial_d_g_dd_212, irho,isigma)
#define partial_d_g_dd_213	p.gridfn(gfns::gfn__partial_d_g_dd_213, irho,isigma)
#define partial_d_g_dd_222	p.gridfn(gfns::gfn__partial_d_g_dd_222, irho,isigma)
#define partial_d_g_dd_223	p.gridfn(gfns::gfn__partial_d_g_dd_223, irho,isigma)
#define partial_d_g_dd_233	p.gridfn(gfns::gfn__partial_d_g_dd_233, irho,isigma)
#define partial_d_g_dd_311	p.gridfn(gfns::gfn__partial_d_g_dd_311, irho,isigma)
#define partial_d_g_dd_312	p.gridfn(gfns::gfn__partial_d_g_dd_312, irho,isigma)
#define partial_d_g_dd_313	p.gridfn(gfns::gfn__partial_d_g_dd_313, irho,isigma)
#define partial_d_g_dd_322	p.gridfn(gfns::gfn__partial_d_g_dd_322, irho,isigma)
#define partial_d_g_dd_323	p.gridfn(gfns::gfn__partial_d_g_dd_323, irho,isigma)
#define partial_d_g_dd_333	p.gridfn(gfns::gfn__partial_d_g_dd_333, irho,isigma)

#define Theta	p.gridfn(gfns::gfn__Theta, irho,isigma)

#define partial_Theta_wrt_partial_d_h_1	\
	p.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_1, irho,isigma)
#define partial_Theta_wrt_partial_d_h_2	\
	p.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_2, irho,isigma)
#define partial_Theta_wrt_partial_dd_h_11	\
	p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_11, irho,isigma)
#define partial_Theta_wrt_partial_dd_h_12	\
	p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_12, irho,isigma)
#define partial_Theta_wrt_partial_dd_h_22	\
	p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_22, irho,isigma)

#define save_Theta	p.gridfn(gfns::gfn__save_Theta, irho,isigma)
#define old_Theta	p.gridfn(gfns::gfn__old_Theta, irho,isigma)
#define Delta_h		p.gridfn(gfns::gfn__Delta_h, irho,isigma)

//******************************************************************************

//
// pseudo-gridfns, i.e. temporaries used only at a single grid point
// (these are not actually stored as gridfns)
//
fp g_uu_11;
fp g_uu_12;
fp g_uu_13;
fp g_uu_22;
fp g_uu_23;
fp g_uu_33;
fp K;
fp K_uu_11;
fp K_uu_12;
fp K_uu_13;
fp K_uu_22;
fp K_uu_23;
fp K_uu_33;

fp partial_d_ln_sqrt_g_1;
fp partial_d_ln_sqrt_g_2;
fp partial_d_ln_sqrt_g_3;

fp partial_d_g_uu_111;
fp partial_d_g_uu_112;
fp partial_d_g_uu_113;
fp partial_d_g_uu_122;
fp partial_d_g_uu_123;
fp partial_d_g_uu_133;
fp partial_d_g_uu_211;
fp partial_d_g_uu_212;
fp partial_d_g_uu_213;
fp partial_d_g_uu_222;
fp partial_d_g_uu_223;
fp partial_d_g_uu_233;
fp partial_d_g_uu_311;
fp partial_d_g_uu_312;
fp partial_d_g_uu_313;
fp partial_d_g_uu_322;
fp partial_d_g_uu_323;
fp partial_d_g_uu_333;

fp Theta_A;
fp Theta_B;
fp Theta_C;
fp Theta_D;

```

gr/gfns.hh:
```
// gfns.hh -- define gfns of all gridfns
// $Header$

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// For a skeletal patch system we only use the ghosted gridfns.
//

namespace gfns
	  {

// ghosted gridfns
enum	{
	ghosted_min_gfn = -3,		// must set this by hand so
					// ghosted_max_gfn is still < 0
	gfn__h = ghosted_min_gfn,
	gfn__save_h,
	ghosted_max_gfn = gfn__save_h
	};

// nominal gridfns
enum	{
	nominal_min_gfn = 1,

	//
	// for a skeletal patch system we don't need any nominal gridfns
	//
	skeletal_nominal_max_gfn = nominal_min_gfn - 1,

	//
	// most of these gridfns have access macros in "cg.hh";
	// the ones that don't are marked explicitly
	//
	gfn__global_x = nominal_min_gfn,	// no access macro
	gfn__global_y,				// no access macro
	gfn__global_z,				// no access macro
        
	gfn__global_xx,				// no access macro
	gfn__global_xy,				// no access macro
	gfn__global_xz,				// no access macro
	gfn__global_yy,				// no access macro
	gfn__global_yz,				// no access macro
	gfn__global_zz,				// no access macro

        gfn__mask,				// no access macro
        gfn__partial_d_mask_1,			// no access macro
        gfn__partial_d_mask_2,			// no access macro
        gfn__partial_d_mask_3,			// no access macro

	gfn__g_dd_11,
	gfn__g_dd_12,
	gfn__g_dd_13,
	gfn__g_dd_22,
	gfn__g_dd_23,
	gfn__g_dd_33,
	gfn__partial_d_g_dd_111,
	gfn__partial_d_g_dd_112,
	gfn__partial_d_g_dd_113,
	gfn__partial_d_g_dd_122,
	gfn__partial_d_g_dd_123,
	gfn__partial_d_g_dd_133,
	gfn__partial_d_g_dd_211,
	gfn__partial_d_g_dd_212,
	gfn__partial_d_g_dd_213,
	gfn__partial_d_g_dd_222,
	gfn__partial_d_g_dd_223,
	gfn__partial_d_g_dd_233,
	gfn__partial_d_g_dd_311,
	gfn__partial_d_g_dd_312,
	gfn__partial_d_g_dd_313,
	gfn__partial_d_g_dd_322,
	gfn__partial_d_g_dd_323,
	gfn__partial_d_g_dd_333,
	gfn__K_dd_11,
	gfn__K_dd_12,
	gfn__K_dd_13,
	gfn__K_dd_22,
	gfn__K_dd_23,
	gfn__K_dd_33,

	gfn__psi,				// no access macro
	gfn__partial_d_psi_1,			// no access macro
	gfn__partial_d_psi_2,			// no access macro
	gfn__partial_d_psi_3,			// no access macro

	gfn__mean_curvature,			// no access macro
	gfn__save_mean_curvature,		// no access macro

	gfn__Theta,
	gfn__partial_Theta_wrt_partial_d_h_1,
	gfn__partial_Theta_wrt_partial_d_h_2,
	gfn__partial_Theta_wrt_partial_dd_h_11,
	gfn__partial_Theta_wrt_partial_dd_h_12,
	gfn__partial_Theta_wrt_partial_dd_h_22,
	gfn__Delta_h,
	gfn__save_Theta,
	gfn__old_Theta,
	gfn__zero,
	gfn__one,
	nominal_max_gfn = gfn__one		// no comma
	};

	  }	// namespace gfns::

//******************************************************************************

	  }	// namespace AHFinderDirect

```

gr/auxiliary.maple:
```
# auxiliary.maple -- Maple code to compute ADM auxiliary quantities
# $Header$

#
# auxiliary - compute and optionally generate C code for auxiliary quantities
## inverse_metric - metric determinant and inverse metric
## extrinsic_curvature_trace_raise - compute trace+contravariant K_ij
#

###############################################################################

#
# This function computes various auxiliary variables which are
# algebraic functions of the basic ADM fields {g_dd,K_dd}, and optionally
# also generates C code for them (the auxiliar variables).
#
# Code files are written to the directory ../gr.cg/ .
#
# Inputs (Maple):
#	N
#	g_dd
#	K_dd
#
# Outputs (Maple + code file "inverse_metric.c"):
#	g_uu = g_uu__fnd(g_dd)
#
# Outputs (Maple + code file "extrinsic_curvature_trace_raise.c"):
#	K = K__fnd(g_uu, K_dd)
#	K_uu = K_uu__fnd(g_uu, K_dd)
#
# Arguments:
# cg_flag = (in) false ==> Compute Maple expressions only.
#		 true ==> Compute Maple expressions and generate C code.
# 
auxiliary :=
proc(cg_flag::boolean)

inverse_metric(cg_flag);
extrinsic_curvature_trace_raise(cg_flag);

NULL;
end;

###############################################################################

#
# This function computes the inverse metric, and optionally also
# generates C code for this.
#
# Inputs (Maple):
#	N
#	g_dd
#
# Outputs (Maple + code file "inverse_metric.c"):
#	g_uu = g_uu__fnd(g_dd)
#
# Arguments:
# cg_flag = (in) false ==> Compute Maple expressions only.
#		 true ==> Compute Maple expressions and generate C code.
#
inverse_metric :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";

printf("%a...\n", procname);

assert_fnd_exists(g_dd);
assert_fnd_exists(g_uu, fnd);

g_uu__fnd := linalg[inverse](g_dd);

if (cg_flag)
   then codegen2(g_uu__fnd, 'g_uu', "../gr.cg/inverse_metric.c");
fi;

NULL;
end;

###############################################################################

#
# This function computes the trace of the extrinsic curvature, K,
# and the contravariant extrinsic curvature, K_uu, and optionally also
# generates C code for this.
#
# Inputs (as global variables):
#	N
#	K_dd
#	g_uu
#
# Outputs (Maple + code file "extrinsic_curvature_trace_raise.c"):
#	K = K__fnd(g_uu, K_dd)
#	K_uu = K_uu__fnd(g_uu, K_dd)
#
# Arguments:
# cg_flag = (in) false ==> Set up Maple variables only.
#		 true ==> Set up Maple variables and generate C code.
#
extrinsic_curvature_trace_raise :=
proc(cg_flag::boolean)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc",
  @include "../gr/gr_gfas.minc";
local i, j, m, n;

printf("%a...\n", procname);

assert_fnd_exists(g_uu);
assert_fnd_exists(K_dd);
assert_fnd_exists(K, fnd);
assert_fnd_exists(K_uu, fnd);

K__fnd := simplify(
	    msum('g_uu[i,j] * K_dd[i,j]', 'i'=1..N, 'j'=1..N)
		  );

	for i from 1 to N
	do
	for j from i to N		# upper triangle only
	do
	K_uu__fnd[i,j] := simplify(
			    msum('g_uu[i,m] * g_uu[j,n] * K_dd[m,n]',
				 'm'=1..N, 'n'=1..N)
				  );
	end do;
	end do;

if (cg_flag)
   then codegen2([K__fnd, K_uu__fnd],
		 ['K', 'K_uu'],
		 "../gr.cg/extrinsic_curvature_trace_raise.c");
fi;

NULL;
end;

```

gr/Schwarzschild_EF.cc:
```
// Schwarzschild_EF.cc -- set up Schwarzschild/EF geometry variables
// $Header$
//
// <<<prototypes for functions local to this file>>>
// Schwarzschild_EF_geometry - top-level driver
/// Schwarzschild_EF_gij_xyz - (x,y,z) g_ij
/// Schwarzschild_EF_Kij_xyz - (x,y,z) g_ij
/// Schwarzschild_EF_gij_rthetaphi - (r,theta,phi) g_ij
/// Schwarzschild_EF_Kij_rthetaphi - (r,theta,phi) g_ij
/// tensor_xform_rthetaphi_to_xyz - tensor xform diag T_dd
///

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

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

#include "config.h"
#include "stdc.h"
#include "../jtutil/util.hh"
#include "../jtutil/array.hh"
#include "../jtutil/cpm_map.hh"
#include "../jtutil/linear_map.hh"
using jtutil::error_exit;

#include "../patch/coords.hh"
#include "../patch/grid.hh"
#include "../patch/fd_grid.hh"
#include "../patch/patch.hh"
#include "../patch/patch_edge.hh"
#include "../patch/patch_interp.hh"
#include "../patch/ghost_zone.hh"
#include "../patch/patch_system.hh"

#include "../elliptic/Jacobian.hh"

#include "gfns.hh"
#include "gr.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// ***** prototypes for functions local to this file *****
//

namespace {
void Schwarzschild_EF_gij_xyz(fp m, fp epsilon,
			      fp x, fp y, fp z,
			      fp& g_xx, fp& g_xy, fp& g_xz,
					fp& g_yy, fp& g_yz,
						  fp& g_zz);
void Schwarzschild_EF_Kij_xyz(fp m, fp epsilon,
			      fp x, fp y, fp z,
			      fp& K_xx, fp& K_xy, fp& K_xz,
					fp& K_yy, fp& K_yz,
						  fp& K_zz);

void Schwarzschild_EF_gij_rthetaphi(fp m,
				    fp r, fp theta, fp phi,
				    fp& g_rr, fp& g_theta_theta);
void Schwarzschild_EF_Kij_rthetaphi(fp m,
				    fp r, fp theta, fp phi,
				    fp& K_rr, fp& K_theta_theta);

void xform_from_rthetaphi_to_xyz(fp epsilon,
				 fp x, fp y, fp z,
				 fp T_rr, fp T_theta_theta,
				 fp& T_xx, fp& T_xy, fp& T_xz,
					   fp& T_yy, fp& T_yz,
						     fp& T_zz);
	  }

//******************************************************************************
//******************************************************************************
//******************************************************************************

//
// This function sets the geometry gridfns to their analytic values
// for a unit-mass Schwarzschild spacetime in Eddington-Finkelstein
// coordinates.
//
// The (r,theta,phi) $g_{ij}$ and $K_{ij}$ are as given in appendix A2
// of my (Jonathan Thornburg's) Ph.D thesis, available on my web page at
//	http://www.aei.mpg.de/~jthorn/phd/html/phd.html
// The (r,theta,phi) --> (x,y,z) tensor transformation is as worked out
// on pages 16-17 of my AHFinderDirect working notes.
// The $\partial_k g_{kl}$ is done by numerical finite differencing.
//
// Inputs (angular gridfns, on ghosted grid):
// ... defined on ghosted grid
// ... only values on nominal grid are actually used as input
//	h				# shape of trial surface
//
// Inputs (angular gridfns, all on the nominal grid):
//	global_[xyz]			# xyz positions of grid points
//
// Outputs (angular gridfns, all on the nominal grid):
//	g_dd_{11,12,13,22,23,33}			# $g_{ij}$
//	K_dd_{11,12,13,22,23,33}			# $K_{ij}$
//	partial_d_g_dd_{1,2,3}{11,12,13,22,23,33}	# $\partial_k g_{ij}$
//
void Schwarzschild_EF_geometry(patch_system& ps,
			       const struct geometry_info& gi,
			       bool msg_flag)
{
const fp mass      = gi.geometry__Schwarzschild_EF__mass;
const fp x_posn    = gi.geometry__Schwarzschild_EF__x_posn;
const fp y_posn    = gi.geometry__Schwarzschild_EF__y_posn;
const fp z_posn    = gi.geometry__Schwarzschild_EF__z_posn;
const fp epsilon   = gi.geometry__Schwarzschild_EF__epsilon;
const fp Delta_xyz = gi.geometry__Schwarzschild_EF__Delta_xyz;

if (msg_flag)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "      setting up exact Schwarzschild/EF geometry");
	CCTK_VInfo(CCTK_THORNSTRING,
		   "                 posn=(%g,%g,%g) mass=%g",
		   double(x_posn),double(y_posn),double(z_posn), double(mass));
	}

    for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
    {
    patch& p = ps.ith_patch(pn);

	for (int irho = p.min_irho() ; irho <= p.max_irho() ; ++irho)
	{
	for (int isigma = p.min_isigma() ;
	     isigma <= p.max_isigma() ;
	     ++isigma)
	{
	const fp r = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
	const fp rho = p.rho_of_irho(irho);
	const fp sigma = p.sigma_of_isigma(isigma);
	fp local_x, local_y, local_z;
	p.xyz_of_r_rho_sigma(r,rho,sigma, local_x, local_y, local_z);
	const fp global_x = ps.origin_x() + local_x;
	const fp global_y = ps.origin_y() + local_y;
	const fp global_z = ps.origin_z() + local_z;

	const fp x_rel = global_x - x_posn;
	const fp y_rel = global_y - y_posn;
	const fp z_rel = global_z - z_posn;

	// compute g_ij and K_ij
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel, y_rel, z_rel,
				 p.gridfn(gfns::gfn__g_dd_11, irho,isigma),
				 p.gridfn(gfns::gfn__g_dd_12, irho,isigma),
				 p.gridfn(gfns::gfn__g_dd_13, irho,isigma),
				 p.gridfn(gfns::gfn__g_dd_22, irho,isigma),
				 p.gridfn(gfns::gfn__g_dd_23, irho,isigma),
				 p.gridfn(gfns::gfn__g_dd_33, irho,isigma));
	Schwarzschild_EF_Kij_xyz(mass, epsilon,
				 x_rel, y_rel, z_rel,
				 p.gridfn(gfns::gfn__K_dd_11, irho,isigma),
				 p.gridfn(gfns::gfn__K_dd_12, irho,isigma),
				 p.gridfn(gfns::gfn__K_dd_13, irho,isigma),
				 p.gridfn(gfns::gfn__K_dd_22, irho,isigma),
				 p.gridfn(gfns::gfn__K_dd_23, irho,isigma),
				 p.gridfn(gfns::gfn__K_dd_33, irho,isigma));

	fp g11p, g12p, g13p, g22p, g23p, g33p;
	fp g11m, g12m, g13m, g22m, g23m, g33m;

	// compute partial_x g_ij by finite differencing in xyz
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel+Delta_xyz, y_rel, z_rel,
				 g11p, g12p, g13p,
				       g22p, g23p,
					     g33p);
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel-Delta_xyz, y_rel, z_rel,
				 g11m, g12m, g13m,
				       g22m, g23m,
					     g33m);
	const fp fx = 1.0 / (2.0*Delta_xyz);
	p.gridfn(gfns::gfn__partial_d_g_dd_111,irho,isigma) = fx * (g11p-g11m);
	p.gridfn(gfns::gfn__partial_d_g_dd_112,irho,isigma) = fx * (g12p-g12m);
	p.gridfn(gfns::gfn__partial_d_g_dd_113,irho,isigma) = fx * (g13p-g13m);
	p.gridfn(gfns::gfn__partial_d_g_dd_122,irho,isigma) = fx * (g22p-g22m);
	p.gridfn(gfns::gfn__partial_d_g_dd_123,irho,isigma) = fx * (g23p-g23m);
	p.gridfn(gfns::gfn__partial_d_g_dd_133,irho,isigma) = fx * (g33p-g33m);

	// compute partial_y g_ij by finite differencing in xyz
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel, y_rel+Delta_xyz, z_rel,
				 g11p, g12p, g13p,
				       g22p, g23p,
					     g33p);
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel, y_rel-Delta_xyz, z_rel,
				 g11m, g12m, g13m,
				       g22m, g23m,
					     g33m);
	const fp fy = 1.0 / (2.0*Delta_xyz);
	p.gridfn(gfns::gfn__partial_d_g_dd_211,irho,isigma) = fy * (g11p-g11m);
	p.gridfn(gfns::gfn__partial_d_g_dd_212,irho,isigma) = fy * (g12p-g12m);
	p.gridfn(gfns::gfn__partial_d_g_dd_213,irho,isigma) = fy * (g13p-g13m);
	p.gridfn(gfns::gfn__partial_d_g_dd_222,irho,isigma) = fy * (g22p-g22m);
	p.gridfn(gfns::gfn__partial_d_g_dd_223,irho,isigma) = fy * (g23p-g23m);
	p.gridfn(gfns::gfn__partial_d_g_dd_233,irho,isigma) = fy * (g33p-g33m);

	// compute partial_x g_ij by finite differencing in xyz
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel, y_rel, z_rel+Delta_xyz,
				 g11p, g12p, g13p,
				       g22p, g23p,
					     g33p);
	Schwarzschild_EF_gij_xyz(mass, epsilon,
				 x_rel, y_rel, z_rel-Delta_xyz,
				 g11m, g12m, g13m,
				       g22m, g23m,
					     g33m);
	const fp fz = 1.0 / (2.0*Delta_xyz);
	p.gridfn(gfns::gfn__partial_d_g_dd_311,irho,isigma) = fz * (g11p-g11m);
	p.gridfn(gfns::gfn__partial_d_g_dd_312,irho,isigma) = fz * (g12p-g12m);
	p.gridfn(gfns::gfn__partial_d_g_dd_313,irho,isigma) = fz * (g13p-g13m);
	p.gridfn(gfns::gfn__partial_d_g_dd_322,irho,isigma) = fz * (g22p-g22m);
	p.gridfn(gfns::gfn__partial_d_g_dd_323,irho,isigma) = fz * (g23p-g23m);
	p.gridfn(gfns::gfn__partial_d_g_dd_333,irho,isigma) = fz * (g33p-g33m);
	}
	}
    }
}

//******************************************************************************

//
// This function computes the Schwarzschild/Eddington-Finkelstein
// 3-metric $g_{ij}$ in $(x,y,z)$ spatial coordinates.
//
namespace {
void Schwarzschild_EF_gij_xyz(fp m, fp epsilon,
			      fp x, fp y, fp z,
			      fp& g_xx, fp& g_xy, fp& g_xz,
					fp& g_yy, fp& g_yz,
						  fp& g_zz)
{
fp r, theta, phi;
local_coords::r_theta_phi_of_xyz(x,y,z, r,theta,phi);

fp g_rr, g_theta_theta;
Schwarzschild_EF_gij_rthetaphi(m,
			       r, theta, phi,
			       g_rr, g_theta_theta);
xform_from_rthetaphi_to_xyz(epsilon,
			    x, y, z,
			    g_rr, g_theta_theta,
			    g_xx, g_xy, g_xz,
				  g_yy, g_yz,
					g_zz);
}
	  }

//******************************************************************************

//
// This function computes the Schwarzschild/Eddington-Finkelstein
// 3-extrinsic curvature $K_{ij}$ in $(x,y,z)$ spatial coordinates.
//
namespace {
void Schwarzschild_EF_Kij_xyz(fp m, fp epsilon,
			      fp x, fp y, fp z,
			      fp& K_xx, fp& K_xy, fp& K_xz,
					fp& K_yy, fp& K_yz,
						  fp& K_zz)
{
fp r, theta, phi;
local_coords::r_theta_phi_of_xyz(x,y,z, r,theta,phi);

fp K_rr, K_theta_theta;
Schwarzschild_EF_Kij_rthetaphi(m,
			       r, theta, phi,
			       K_rr, K_theta_theta);
xform_from_rthetaphi_to_xyz(epsilon,
			    x, y, z,
			    K_rr, K_theta_theta,
			    K_xx, K_xy, K_xz,
				  K_yy, K_yz,
					K_zz);
}
	  }

//******************************************************************************

//
// This function computes the two independent components of the 3-metric
// $g_{ij}$ for Schwarzschild spacetime in Eddington-Finkelstein coordinates
// $(r,theta,phi)$, as per equation (A2.2) of my Ph.D thesis, rescaled in
// the obvious way for non-unit mass.
//
// By the spherical symmetry, $g_{\phi\phi} = g_{\theta\theta} \sin^2\theta$.
//
namespace {
void Schwarzschild_EF_gij_rthetaphi(fp m,
				    fp r, fp theta, fp phi,
				    fp& g_rr, fp& g_theta_theta)
{
g_rr          = 1.0 + 2.0*m/r;
g_theta_theta = r*r;
}
	  }

//******************************************************************************

//
// This function computes the two independent components of the 3-extrinsic
// curvature $K_{ij}$ for Schwarzschild spacetime in Eddington-Finkelstein
// coordinates $(r,theta,phi)$, as per equation (A2.2) of my Ph.D thesis,
// rescaled in the obvious way for non-unit mass.
//
// By the spherical symmetry, $K_{\phi\phi} = K_{\theta\theta} \sin^2\theta$.
//
//
namespace {
void Schwarzschild_EF_Kij_rthetaphi(fp m,
				    fp r, fp theta, fp phi,
				    fp& K_rr, fp& K_theta_theta)
{
fp temp = 1.0 / sqrt(1.0 + 2.0*m/r);
K_rr          = -(2.0/(r*r)) * (1.0 + m/r) * temp;
K_theta_theta = 2.0 * temp;
}
	  }

//******************************************************************************

//
// This function transforms a diagonal T_dd (rank 2 covariant) tensor
// in spherical symmetry,
//	T_dd = diag[ T_rr   T_theta_theta   T_theta_theta*sin(theta)**2 ]
// from (r,theta,phi) to (x,y,z) coordinates, as per pages 16-17 of my
// AHFInderDirect working notes.
//
// Arguments:
// epsilon = Tolerance parameter for deciding when to switch from
//	     generic expressions to z-axis limits: we switch iff
//	     sin^2 theta = (x^2+y^2)/r^2 is <= epsilon
//
namespace {
void xform_from_rthetaphi_to_xyz(fp epsilon,
				 fp x, fp y, fp z,
				 fp T_rr, fp T_theta_theta,
				 fp& T_xx, fp& T_xy, fp& T_xz,
					   fp& T_yy, fp& T_yz,
						     fp& T_zz)
{
const fp x2 = x*x;
const fp y2 = y*y;
const fp x2py2 = x2 + y2;
const fp z2 = z*z;
const fp r2 = x2 + y2 + z2;		const fp r4 = r2*r2;
const bool z_flag = x2py2/r2 <= epsilon;

T_xx = (x2/r2)*T_rr + (z_flag ? 1.0/r2 : (x2*z2/r2 + y2) / (r2*x2py2))
		      *T_theta_theta;
T_yy = (y2/r2)*T_rr + (z_flag ? 1.0/r2 : (y2*z2/r2 + x2) / (r2*x2py2))
		      *T_theta_theta;
T_zz = (z2/r2)*T_rr + (x2py2/r4)*T_theta_theta;
T_xy = (x*y/r2)*T_rr + (z_flag ? 0.0 : (z2/r2 - 1.0) * x*y / (r2*x2py2))
		       *T_theta_theta;
T_xz = (x*z/r2)*T_rr - (x*z/r4)*T_theta_theta;
T_yz = (y*z/r2)*T_rr - (y*z/r4)*T_theta_theta;
}
	  }

//******************************************************************************

	  }	// namespace AHFinderDirect

```

driver/BH_diagnostics.hh:
```
// BH_diagnostics.hh -- header file for BH diagnostics
// $Header$

//
// prerequisites:
//	<stdio.h>
//	"cctk_Arguments.h"
//

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

//******************************************************************************

//
// This struct holds info for computing black hole diagnostics.
//
struct	BH_diagnostics_info
	{
	enum patch::integration_method integral_method;
	};

//******************************************************************************

//
// A  struct BH_diagnostics  holds all of our black hole diagnostics
// for a single apparent horizon.  These diagnostics are only meaningful
// if the apparent horizon has indeed been found.
//
// Note that all the diagnostics are for the full apparent horizon, even
// if we don't actually store all of it due to patch-system symmetries.
//
struct	BH_diagnostics
	{
public:
	fp origin_x, origin_y, origin_z;
	fp centroid_x, centroid_y, centroid_z;
        fp quadrupole_xx, quadrupole_xy, quadrupole_xz;
        fp quadrupole_yy, quadrupole_yz, quadrupole_zz;
	fp min_radius, max_radius, mean_radius;

	// xyz bounding box
	fp min_x, max_x, min_y, max_y, min_z, max_z;

        fp circumference_xy, circumference_xz, circumference_yz;
        fp area;
        fp expansion;
        fp inner_expansion;
        fp product_expansion;
        fp mean_curvature;

        fp area_gradient;
        fp expansion_gradient;
        fp inner_expansion_gradient;
        fp product_expansion_gradient;
        fp mean_curvature_gradient;
        fp mean_curvature_minimum;
        fp mean_curvature_maximum;
        fp mean_curvature_integral;

public:
	// position of diagnostics in buffer and number of diagnostics
	enum	{
		posn__origin_x = 0, posn__origin_y, posn__origin_z,
		posn__centroid_x, posn__centroid_y, posn__centroid_z,
                posn__quadrupole_xx, posn__quadrupole_xy, posn__quadrupole_xz,
                posn__quadrupole_yy, posn__quadrupole_yz, posn__quadrupole_zz,
		posn__min_radius, posn__max_radius, posn__mean_radius,

		posn__min_x, posn__max_x,
		posn__min_y, posn__max_y,
		posn__min_z, posn__max_z,

		posn__circumference_xy, posn__circumference_xz,
					posn__circumference_yz,
		posn__area,
                posn__expansion,
                posn__inner_expansion,
                posn__product_expansion,
                posn__mean_curvature,

		posn__area_gradient,
                posn__expansion_gradient,
                posn__inner_expansion_gradient,
                posn__product_expansion_gradient,
                posn__mean_curvature_gradient,
                posn__mean_curvature_minimum,
                posn__mean_curvature_maximum,
                posn__mean_curvature_integral,

		N_buffer // no comma	// size of buffer
		};

	// copy diagnostics to/from buffer
	void copy_to_buffer  (      CCTK_REAL buffer[N_buffer]) const;
	void copy_from_buffer(const CCTK_REAL buffer[N_buffer]);

public:
	// compute diagnostics (assuming that apparent horizon has been found)
	void compute(const patch_system& ps,
                     const fp area,
                     const fp mean_expansion,
                     const fp mean_inner_expansion,
                     const fp mean_product_expansion,
                     const fp mean_mean_curvature,
                     const fp area_gradient,
                     const fp mean_expansion_gradient,
                     const fp mean_inner_expansion_gradient,
                     const fp mean_product_expansion_gradient,
                     const fp mean_mean_curvature_gradient,
		     const struct BH_diagnostics_info& BH_diagnostics_info);

	// print (CCTK_VInfo()) a line or two summarizing diagnostics
	void print(int N_horizons, int hn)
		const;

	// create/open output file and write header describing output() fields
	// ... stream is flushed after output to help with
	//     looking at diagnostics while Cactus is still running
	FILE* setup_output_file(const struct IO_info& IO_info,
				int N_horizons, int hn)
		const;

	// output a (long) line of all the diagnostics, to a stdio stream
	// ... stream is flushed after output to help with
	//     looking at diagnostics while Cactus is still running
	void output(FILE* fileptr, const struct IO_info& IO_info)
		const;

	// store the diagnostics in the Cactus variables
        void store(CCTK_ARGUMENTS, int horizon_number, int surface_number)
                const;

	// save the horizon shape in grid arrays
        void save(CCTK_ARGUMENTS, int horizon_number)
                const;

	// load the horizon shape from grid arrays
        void load(CCTK_ARGUMENTS, int horizon_number);

	// constructor initializes all diagnostics to 0.0
	BH_diagnostics();

	// no destructor needed, compiler-generated no-op is fine

private:
	// helper function: compute surface integral of specified gridfn
	static
	  fp surface_integral(const patch_system& ps,
			      int src_gfn, bool src_gfn_is_even_across_xy_plane,
					   bool src_gfn_is_even_across_xz_plane,
					   bool src_gfn_is_even_across_yz_plane,
			      enum patch::integration_method method);

private:
	// we forbid copying and passing by value
	// by declaring the copy constructor and assignment operator
	// private, but never defining them
	BH_diagnostics(const BH_diagnostics& rhs);
	BH_diagnostics& operator=(const BH_diagnostics& rhs);
	};

//******************************************************************************

	  }	// namespace AHFinderDirect

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn AHFinderDirect
Authors    : Jonathan Thornburg <jthorn@aei.mpg.de>
Maintainer : Jonathan Thornburg <jthorn@aei.mpg.de>
CVS info   : $Header$
--------------------------------------------------------------------------

Purpose of This Thorn
=====================

This thorn finds an apparent horizon (or more generally, a closed
2-surface with S^2 topology having any desired constant expansion)
given the 3D xyz-grid metric and extrinsic curvature (and optionally
the StaticConformal conformal factor).  It uses a direct method,
writing the apparent horizon equation as an elliptic PDE on
angular-coordinate space.  This is very fast and accurate, but
it does require an intitial guess for the apparent horizon position.


Documentation
=============

The doc/ directory contains detailed documentation for this thorn,
including a discussion of those parameters which you'll likely want
to set (or at least know about) in practice.  For full information
on all the parameters, see the comments in the  param.ccl  file.

The par/ directory contains some sample par files.

src/CODESTYLE documents the general programming conventions used in
this thorn.

src/PORTING.OUTSIDE.CACTUS has some general remarks on what it would
take to port this thorn to a non-Cactus numerical relativity code.

See below in this file for notes on compiling this thorn.


Publications
============
The algorithms used in this thorn are described in the papers
@article{
	Thornburg2003:AH-finding,
	author = "Jonathan Thornburg",
	title  = "A Fast Apparent-Horizon Finder
		  for 3-Dimensional {C}artesian Grids in Numerical Relativity",
	journal = "Classical and Quantum Gravity",
	volume = 21, number = 2,
	year   = "2004", month = "January 21",
	pages  = "743--766",
	doi    = "10.1088/0264-9381/21/2/026",
	url    = "http://stacks.iop.org/0264-9381/21/743",
	eprint = "gr-qc/0306056",
	note   = "gr-qc/0306056",
	}
and
@article{
	Thornburg-1996-horizon-finding,
	author = "Jonathan Thornburg",
	title = "Finding Apparent Horizons in Numerical Relativity",
	journal = "Physical Review D",
	pages = "4899--4918",
	volume = 54, number = 8,
	year = 1996, month = "October 15",
	eprint = "gr-qc/9508014",
	}
As a courtesy, I ask that these papers be cited in any published research
which uses this thorn, or which uses code from this thorn.


Copyright
=========

This thorn is copyright (C) 2001-2004
by Jonathan Thornburg <jthorn@aei.mpg.de>.

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


Other Software Used (Already Contained within AHFinderDirect)
=============================================================

AHFinderDirect's  src/sparse-matrix/  directory contains various
sparse-matrix libraries, which have their own copyrights and licensing terms:

The src/sparse-matrix/umfpack/ directory contains a subset of the files
in UMFPACK version 4.0 (11.Apr.2002).  This code is copyright (C) 2002 by
Timothy A. Davis, and is subect to the UMFPACK License:

    Your use or distribution of UMFPACK or any modified version of
    UMFPACK implies that you agree to this License.

    THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
    EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.

    Permission is hereby granted to use or copy this program, provided
    that the Copyright, this License, and the Availability of the original
    version is retained on all copies.  User documentation of any code that
    uses UMFPACK or any modified version of UMFPACK code must cite the
    Copyright, this License, the Availability note, and "Used by permission."
    Permission to modify the code and to distribute modified code is granted,
    provided the Copyright, this License, and the Availability note are
    retained, and a notice that the code was modified is included.  This
    software was developed with support from the National Science Foundation,
    and is provided to you free of charge.


Other Software Required
=======================

This thorn inherits from Grid, ADMBase, StaticConformal, SpaceMask, IO
(all in the CactusBase or CactusEinstein arrangements), and
SphericalSurface (in the AEIThorns arrangement; you can get AEIThorns
by anonymous CVS checkout from cvs_anon@cvs.aei.mpg.de:/numrelcvs, CVS
path AEIThorns/SphericalSurface).

By default this thorn uses various Cactus APIs which are supplied by
other thorns:
* This thorn uses CCTK_InterpGridArrays() for interpolating grid arrays.
  This is supplied by a driver-specific thorn, such as PUGHInterp or
  CarpetInterp.
* This thorn uses CCTK_ReduceLocArrayToArray1D() for interprocessor
  communication in the multiprocessor Newton solver.
	[see src/driver/README.parallel for details]
  This is supplied by a driver-specific thorn; at present PUGHReduce
  it this for the PUGH driver.
* This thorn uses CCTK_InterpLocalUniform() for interpatch and surface
  interpolation, and it needs various interpolation options which at
  present are (only) supported by the AEIThorns/AEILocalInterp local
  interpolator.

This thorn is written in C++, so you'll need a C++ compiler -- in fact
a fairly modern one -- to compile this thorn.  See the "Compilation Notes"
section below for details.

Most of this thorn's relativity code is machine-generated using Maple
(version 7), but you don't need Maple unless you want to modify the
relativity code.

By default, this thorn doesn't use any external libraries.  However,
if HAVE_DENSE_JACOBIAN__LAPACK is defined in src/include/config.h,
then this thorn uses the LAPACK library (which in turn uses the BLAS
library), so you will need to configure your Cactus to use LAPACK.
Instructions on doing this are in the file README.library in this
directory.


Code Notes
==========

This thorn is written in C++, and requires a fairly modern C++ compiler.
In particular:
* Templates are used, but only rather simple ones for containers or other
  low-level stuff templated on the floating-point or integer datatype.
  These templates are always instantiated explicitly.
* bool, mutable, typename are used.
* The new-style casts static_cast<...> and const_cast<...> are used.
  reinterpret_cast<...> and dynamic_cast<...> are *not* used.
* The code will compile ok under either the archaic or the modern
  for-loop declaration scope rules.
* C header files are used in the pre-namespaces form (eg <stdio.h>).
  (In ISO-standard C++ this is deprecated (but still supported), but
  alas none of the more modern forms (<cstdio> and namespace std::)
  seem to be supported on as wide a range of systems as the pre-namespaces
  form.)
* <assert.h> is used fairly heavily for sanity checks.
* To avoid various portability problems, none of the C++ standard
  template library (STL) is used.


Compiler Notes
==============

This thorn should be fully portable across architectures and operating
systems, but C++ compilers may be a problem:

This thorn has been compiled and run successfully using

x86
===
* gcc version 2.95.3 20010125 (prerelease)
* g++ (GCC) 3.2 for x86
* g++ (GCC) 3.2.2 for x86
* g++ (GCC) 3.3 for x86
* Intel(R) C++ Compiler for 32-bit applications, Version 5.0.1   Build 010730D0
* Intel C++ Compiler for Linux, version 6.0
* Intel(R) C++ Compiler for 32-bit applications, Version 7.0   Build 20021021Z
  On platinum.ncsa.uiuc.edu, Denis Pollney reports success configuring Cactus
  with
    LIBS="crypt F90 CEPCF90 intrins mkl mkl_lapack guide"
    LIBDIRS=/usr/local/intel/mkl/lib/32
* Portland Group pgCC 3.3-2
  On platinum.ncsa.uiuc.edu, Denis Pollney reports success configuring Cactus
  with
    LAPACK=yes
    LAPACK_DIR=/usr/local/pgi/linux86

ia64, a.k.a. Itanium
====================
* Intel(R) C++ Itanium(R) Compiler for Itanium(R)-based applications
  Version 7.0 Beta, Build 20020911
  On titan.ncsa.uiuc.edu, Denis Pollney reports success configuring Cactus
  with
    LIBS="crypt F90 CEPCF90 intrins mkl_lapack mkl_itp guide"
    LIBDIRS=/usr/local/intel/mkl/lib/64

Alpha
=====
* g++ (GCC) 3.0
  On lemieux.psc.edu, Denis Pollney reports success configuring Cactus
  with
    LIBS="m c_r dxml for"
* Using the DEC/Compaq/HP/whatever-their-corporate-name-is-this-week
  compiler, you need to specify the  -nopt  compiler option to disable
  automatic template instantiation.

SGI
===
* On modi4.ncsa.uiuc.edu (an old SGI Origin), using
  MIPSpro Compilers: Version 7.3.1.3m
  you need to specify the  -no_auto_include  compiler option to disable
  automatic template instantiation.  In fact, you should probably specify
  this option on any SGI system...

IBM Power4 (AIX)
================
* C for AIX Compiler, Version 6
  On psi19.rzg.mpg.de, Denis Pollney reports success configuring Cactus
  with
    LIBS="f m lapack-essl essl"
    LIBDIRS="/afs/rzg/@sys/lib"

Please let me (Jonathan) know of any other compilers which are ok.

This thorn compiles, but does *NOT* work, using the folloing
systems/compilers; the cure is to switch to a newer compiler version:
x86
===
* gcc version 2.96 20000731 (Red Hat Linux 7.1 2.96-98)
  (This is the system gcc on Red Hat GNU/Linux 7.2 systems)

The code will almost certainly *not* compile using
* any "egcs" version of gcc, or more generally, any version of gcc
  earlier than 2.95
* any version of Microsoft Visual C++ up to and including mid-2002

```

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

```tex
=== documentation.tex ===
% *======================================================================*
%  Cactus Thorn template for ThornGuide documentation
%  Author: Ian Kelley
%  Date: Sun Jun 02, 2002
%  $Header$
%
%  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
%       % BEGIN CACTUS THORNGUIDE",
%     except for filling in the title, author, date etc. fields.
%   - You can define your own macros are OK, but they must appear after
%     the BEGIN CACTUS THORNGUIDE line, and do 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.
%   - 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/}}
%
% *======================================================================*

% If you are using CVS use this line to give version information
% $Header$

\documentclass{article}
\bibliographystyle{alpha}

% 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{Jonathan Thornburg \quad {\tt <jthorn@aei.mpg.de>}}

% The title of the document (not necessarily the name of the Thorn)
\title{{\bf AHFinderDirect} -- A Fast Apparent Horizon Finder}

% the date your document was last changed, if your document is in CVS,
% please us:
%    \date{$ $Date$ $}
\date{$ $Date$ $}

\maketitle

% Do not delete next line
% START CACTUS THORNGUIDE

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% misc text stuff
\def\code#1{{\tt #1}}			% variable names, parameter values, etc
\def\defn#1{``#1''}			% definition of a term
\def\arrangement#1{{\bf #1}}		% name of an arrangement
\def\thorn#1{{\bf #1}}			% name of a thorn
\def\program#1{{\bf #1}}		% name of computer program
\def\cvsplace#1{{\bf #1}}		% name of a CVS repository/directory/tag
\def\cf{\hbox{cf.\hbox{}}}
\def\eg{\hbox{eg.\hbox{}}}
\def\ie{\hbox{i.e.\hbox{}}}
\def\eqref#1{$(\ref{#1})$}

% get size/spacing of "++" right, cf online C++ FAQ question 35.1
\def\Cplusplus{\hbox{C\raise.25ex\hbox{\footnotesize ++}}}

% misc math mode stuff
\def\assign{\leftarrow}			% for pseudocode algorithms
\def\ltsim{\lesssim}
\def\gtsim{\gtrsim}
\def\tfrac#1#2{{\textstyle    \frac{#1}{#2}}}
\def\dfrac#1#2{{\displaystyle \frac{#1}{#2}}}
\def\thalf{\tfrac{1}{2}}
\def\const{{\rm const}}
\def\ij{{ij}}
\def\uv{{uv}}
\def\del{\nabla}

\def\I{{\text{\scriptsize I}}}                  % grid-point index
\def\J{{\text{\scriptsize J}}}                  % grid-point index
\def\K{{\text{\scriptsize K}}}                  % grid-point index
\def\M{{\text{\scriptsize M}}}                  % molecule index

\def\Jac[#1]{{\bf J} \bigl[ #1 \bigr]}          % discrete Jacobian for fn #1

% Add an abstract for this thorn's documentation
\begin{abstract}
Thorn \thorn{AHFinderDirect} locates apparent horizons (or more
generally, closed 2-surfaces with $S^2$ topology having any desired
constant expansion) in a numerically computed slice using a direct
method, posing the apparent horizon equation as an elliptic PDE on
angular-coordinate space.  This is very fast and accurate, but
requires a ``reasonable'' initial guess.  This thorn guide describes
how to use the thorn.
\end{abstract}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Introduction}

A \defn{marginally trapped surface} is a closed 2-surface in a slice whose
congruence of future-pointing outgoing null geodesics has zero expansion.
There may be several such surfaces, some nested inside others; an
\defn{apparent horizon} is an outermost marginally trapped surface.
In terms of the usual $3+1$ variables, an apparent horizon satisfies
the equation
\begin{equation}
\Theta \equiv \del_i n^i + K_\ij n^i n^j - K = 0
					\label{AHFinderDirect/eqn-horizon}
\end{equation}
where $n^i$ is the outward-pointing unit normal to the apparent horizon,
and $\del_i$ is the covariant derivative operator associated with the
3-metric $g_\ij$ in the slice.  (See \cite{AHFinderDirect/York89}
for a derivation of equation~\eqref{AHFinderDirect/eqn-horizon}.)
(Optionally, you can replace the right hand side
of~\eqref{AHFinderDirect/eqn-horizon} by any specified nonzero
constant, \ie{} you can find a surface of constant
(in general nonzero) expansion.; this is dicsussed in
section~\ref{AHFinderDirect/sect-parameters/other-parameters}.)

Thorn~\thorn{AHFinderDirect} finds an apparent horizon by numerically
solving equation~\eqref{AHFinderDirect/eqn-horizon}.  It requires
as input the usual Cactus 3-metric $g_\ij$ and extrinsic curvature
$K_\ij$, (and optionally the conformal factor $\psi$ if the
\thorn{StaticConformal} metric semantics are used),
and produces as output the Cactus $(x,y,z)$ coordinates of a large
number of points on the apparent horizon, together with some auxiliary
information like the apparent horizon area and centroid position, and
the irreducable mass associated with the area.

Besides this thorn guide, the other main sources of information on
\thorn{AHFinderDirect} are the comments in the \verb|param.ccl| file,
the paper \cite{AHFinderDirect/Thornburg2003:AH-finding},
and to a lesser extent the paper \cite{AHFinderDirect/Thornburg95}.
As a courtesy, I ask that both these papers be cited in any published
research which uses this thorn, or which uses code from this thorn.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{What \thorn{AHFinderDirect} Needs}
\label{AHFinderDirect/sect-what-AHFinderDirect-needs}

There are some restrictions on the spacetime, or more precisely
on each slice where you want to find apparent horizons, which are
necessary in order for \thorn{AHFinderDirect} to work:
\begin{itemize}
\item	\thorn{AHFinderDirect} requires that the Cactus geometry
	($g_{ij}$, $K_{ij}$, and optionally $\psi$) be nonsingular
	in a neighborhood of the apparent horizon.  In particular,
	this means that it quite certainly will {\em not\/} work for
	spacetimes/slicings which have a singular geometry on the
	horizon, such as Schwarzschild/Schwarzschild and
	Kerr/Boyer-Lindquist.%%%
\footnote{%%%
	 Nonsingular slicings of those same spacetimes,
	 such as Schwarzschild/Eddington-Finkelstein,
	 Kerr/Kerr, and Kerr/Kerr-Schild, are fine, and
	 are in fact nice test cases.
	 }%%%
\item	Less obviously, this also means that if there is a
	singularity in the geometry somewhere near the apparent
	horizon, then you need to have a high enough Cactus 3-D grid
	resolution that the geometry interpolation doesn't ``see''
	the singularity.  (If \thorn{AHFinderDirect} ``sees'' the
	singularity, it may ``just'' fail to find the horizon,
	and/or it may report that the interpolated $g_{ij}$ fails
	to be positive definite or even contains NaNs.)
\item	At the moment \thorn{AHFinderDirect} and the Cactus interpolators
	don't know how to avoid an excised region, so if the apparent horizon
	(or any trial horizon surface as the algorithm is iterating
	towards the apparent horizon) gets too close to an excised
	region, you'll get garbage results as the interpolator tries
	to interpolate data from the excised region.  I plan to fix
	this sometime soon.
\item	\thorn{AHFinderDirect} requires that any apparent horizon
	it's going to (try to) find must be a \defn{Strahlk\"{o}rper}
	(literally ``ray body'', or more commonly ``star-shaped region'')
	relative to some local coordinate origin (which you must specify).
	A Strahlk\"{o}rper is defined by Minkowski
	(\cite[p.~108]{AHFinderDirect/Schroeder86})
	as
	   \begin{quote}
	   a region in $n$-dimensional Euclidean space containing the
	   origin and whose surface, as seen from the origin, exhibits
	   only one point in any direction.
	   \end{quote}
	In other words, using polar spherical coordinates relative
	to the local coordinate origin, the apparent horizon's shape
	must be parameterizable as $r = h(\text{angle})$ for some
	single-valued function $h: S^2 \to \Re^+$.  (\thorn{AHFinderDirect}
	uses precisely this parameterization.)
\end{itemize}

There are also some restrictions on your Cactus configuration and run;
here's what works and what doesn't:
\begin{itemize}
\item	I {\em strongly\/} recommend using a current-CVS checkout of
	the Cactus flesh and of all relevant thorns.  I haven't tested
	\thorn{AHFinderDirect} at all with older versions of the flesh
	or other thorns.
\item	\thorn{AHFinderDirect} works fine with the \thorn{PUGH} unigrid
	driver and with the \thorn{Carpet} mesh-refinement driver.  So
	far as I know it's never been tested with any other driver.
\item	\thorn{AHFinderDirect} works fine in single- or multi-processor
	Cactus runs.
\item	Obviously, your Cactus configuration must include
	\thorn{AHFinderDirect}, and your \code{ActiveThorns} parameter(s)
	must activate it.
\item	\thorn{AHFinderDirect} inherits from the other thorns
	(strictly speaking, implementations) listed in
	table~\ref{AEIThorns/AHFinderDirect/tab-inherits-from},
	so you'll need them (or more precisely some thorns providing them)
	in your configuration and activated, too.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{table}[tbp]
\begin{center}
\begin{tabular}{l@{\qquad}l}
\thorn{Implementation}		& Typically provided by \thorn{Thorn}	\\
\hline %---------------------------------------------------------------
\thorn{Grid}			& \thorn{CactusBase/CartGrid3d}		\\
\thorn{IO}			& \thorn{CactusBase/IOUtil}		\\
\thorn{ADMBase}			& \thorn{CactusEinstein/ADMBase}	\\
\thorn{StaticConformal}		& \thorn{CactusEinstein/StaticConformal}\\
\thorn{SpaceMask}		& \thorn{CactusEinstein/SpaceMask}	\\
\thorn{SphericalSurface}	& \thorn{AEIThorns/SphericalSurface}	%%%\\
\end{tabular}
\end{center}
\caption[Other Thorns from which \thorn{AHFinderDirect} Inherits]
	{
	This table lists all the other implementations from which
	\thorn{AHFinderDirect} inherits, and the thorns which typically
	provide these implementations.
	}
\label{AEIThorns/AHFinderDirect/tab-inherits-from}
\end{table}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\item	\verb|Grid::domain = "full"|, \verb|"bitant"|,
	\verb|"quadrant"|, and \verb|"octant"| are supported.
	Alas, at present rotating (or more precisely nonlocal)
	symmetry boundary conditions aren't supported.
\item	The \verb|ADMBase::metric_type| values \verb|"physical"| and
	\verb|"static conformal"| are supported; for the latter you must
	have storage turned on for at least the conformal factor
	\verb|StaticConformal::psi|.  (The Cactus 3-D grid functions
	for 1st and 2nd derivatives of \verb|psi| aren't used.)
\item	\thorn{AHFinderDirect} uses the \verb|CCTK_InterpGridArrays()|
	Cactus global (multi-processor grid array) interpolator API;
	this is provided by \thorn{PUGHInterp} or \thorn{CarpetInterp}
	(so you must have the appropriate one of these thorns compiled
	in and activated).  \verb|CCTK_InterpGridArrays()| in turn uses
	the new \verb|CCTK_InterpLocalUniform()| processor-local
	interpolator API; \thorn{AHFinderDirect} uses various options
	in this API which at present are only supported by thorn
	\thorn{AEILocalInterp} (so you must have this thorn compiled in
	and activated)
\item	\thorn{AHFinderDirect} uses various Cactus reduction APIs to
	coordinate multi-processor horizon finding, so (even if you're
	only going to run on a single processor) you must have a reduction
	thorn like \thorn{PUGHReduce} or \thorn{CarpetReduce} compiled in
	and activated.
\item	At present only a few of \thorn{AHFinderDirect}'s parameters
	are steerable.  (This is actually quite easy to fix; I just
	haven't gotten around to it yet.)
\item	I think \thorn{AHFinderDirect} will ``work'' with checkpoint/restart,
	but I haven't tested this yet.  Here ``work'' means the restart
	will be like starting a new run, in that \thorn{AHFinderDirect}
	will set the initial guess for each horizon in a start-of-a-new-run
	manner.  Alas, it will also write a new \verb|BH_diagnostics| file
	for each horizon found, overwriting any existing \verb|BH_diagnostics|
	files.  This is a bug, which I plan to fix soon (the right behavior
	is/will be to {\em append\/} to the existing \verb|BH_diagnostics|
	file).
\end{itemize}

\thorn{AHFinderDirect} can pass information to the rest of Cactus in
several ways; these are described in detail in
section~\ref{AHFinderDirect/sect-parameters/communicating-with-other-thorns}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Obtaining and Compiling \thorn{AHFinderDirect}}

You should be able to obtain the source code for this thorn via the
usual procedures for anonymous git checkout; at present it lives in
the \arrangement{EinsteinAnalysis} arrangement.

This thorn is written primarily in \Cplusplus{}, calling C and
Fortran~77 numerical libraries.%%%
\footnote{%%%
	 The (C) code for the relativity computations
	 (\ie{}~the apparent horizon equation itself)
	 is mainly machine-generated from Maple code,
	 which in turn uses a Perl preprocessor.
	 But the machine-generated C code is already
	 in CVS along with the rest of this thorn's
	 source code, so you don't need to have Maple
	 installed unless you want to modify the
	 relativity computations.%%%
	 }%%%
{}  In theory the code should be quite portable to modern \Cplusplus{}
compilers, but in practice I've had a number of portability problems
with various compilers.  See the ``Code Notes'' and ``Compiler Notes''
sections in the top-level \code{README} file for details and lists of
compilers currently known to be ok or not.

By default \thorn{AHFinderDirect} doesn't use any external libraries.
However, if \code{HAVE\_DENSE\_JACOBIAN\_\_LAPACK} is defined in
\code{src/include/config.h}, then \thorn{AHFinderDirect} uses the
LAPACK library for solving linear equations.  In this case you need
to configure Cactus with \code{LAPACK=yes}.  See the top-level
\code{README} and \code{README.library} files for details on this.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{\thorn{AHFinderDirect} Parameters}

This thorn has lots of parameters, but most of them have reasonable
default values which you probably won't need to change.  Here I describe
the parameters which you are likely to want to at least look at, and
possibly set explicitly.

Note that all of the ``\code{[}$n$\code{]}'' parameters are Cactus
array parameters, which you need to specify separately in your parameter
file for each apparent horizon.  {\bf IMPORTANT: Apparent horizons are
numbered starting at 1, not 0!}  The example in
section~\ref{AHFinderDirect/sect-examples} should make this clear.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Overall Parameters}
\label{AHFinderDirect/sect-parameters/overall-parameters}

\begin{description}
\item[\code{find\_every}]
\mbox{}\\
	This is an integer parameter specifying how often
	\thorn{AHFinderDirect} should try to find apparent horizons:
	If $\verb|find_every| = 0$, \thorn{AHFinderDirect} is a no-op.
	If $\verb|find_every| \ne 0$, \thorn{AHFinderDirect} tries to
	find apparent horizons each \verb|find_every| time steps.%%%
\footnote{%%%
	 More precisely, if ${\tt find\_every} \ne 0$,
	 \thorn{AHFinderDirect} tries to find apparent
	 horizons at each time step where {\tt cctk\_iteration}
	 is evenly divisible by {\tt find\_every}.
	 }%%%
{}	The default value is~1, \ie{} \thorn{AHFinderDirect} tries
	to find apparent horizons at every time step.
\item[\code{N\_horizons}]
\mbox{}\\
	How many apparent horizons do you want to find in each slice?
	Typical values are 1 (the default), 2, or 3.%%%
\footnote{%%%
	 Larger values are also possible.  The present upper
	 limit is 100, but it would be trivial to raise this
	 further if desired -- see the comments in \code{param.ccl}
	 for details.
	 }%%%
{}	{\bf This thorn numbers the apparent horizons from 1 to
	\code{N\_horizons} inclusive.}
	There are a number of other parameters (described below)
	which you need to set for of these each apparent horizons.

	Note that \code{N\_horizons} sets the number of apparent horizons
	you want to find {\em in the Cactus 3-D numerical grid\/}, not in
	the whole spacetime.  For example, if you are simulating (say)
	Misner data with \verb|Grid::domain = "bitant"|, with the two
	throats at (say) roughly $z = \pm 1$, then you should set
	\verb|N_horizons = 1| to find those two apparent horizons,
	since you're only finding one apparent horizon within the
	numerical grid.  If you also want to search for a common
	apparent horizon surrounding both black holes, then you should
	set \verb|N_horizons = 2|, since you're finding at most 2
	apparent horizons within the numerical grid.

\item[\code{verbose\_level}]
\mbox{}\\
	This controls how verbose this thorn is in printing
	informational (non-error) messages describing what it's
	doing.  In order from tersest to most verbose, the allowable
	values are
	\begin{description}
	\item[\code{"no output"}]
	\mbox{}\\
		Don't print anything.
	\item[\code{"physics highlights"}]
	\mbox{}\\
		Print only a single line each time
		\thorn{AHFinderDirect} runs, giving which
		horizons were found.
	\item[\code{"physics details"}]
	\mbox{}\\
		Print two lines for each horizon found, giving
		the horizon area, centroid position, and irreducible mass.
		This is the default.
	\item[\code{"algorithm highlights"}]
	\mbox{}\\
		Also print a single line for each Newton iteration giving
		the 2-norm and $\infty$-norm of the $\Theta(h)$ function
		defined by equation~\eqref{AHFinderDirect/eqn-horizon}.
	\item[\code{"algorithm details"}]
	\mbox{}\\
		Print lots of detailed messages tracing what the code
		is doing.
	\item[\code{"algorithm debug"}]
	\mbox{}\\
		Print even more detailed messages tracing what the code
		is doing, mainly useful for debugging purposes.
	\end{description}
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Choosing the Local Coordinate Origin for each Apparent Horizon}
\label{AHFinderDirect/sect-parameters/local-coordinate-origin}

For each apparent horizon you want to find, you need to specify
the Cactus $(x,y,z)$ coordinates of a local coordinate system origin.
As described in
section~\ref{AHFinderDirect/sect-what-AHFinderDirect-needs},
each apparent horizon must be a Strahlk\"{o}rper with respect to its
local coordinate system origin.

You specify the local coordinate system origin for each horizon with
the (Cactus array) parameters
\begin{description}
\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{origin\_x[}$n$\code{]}	\\
     \code{origin\_y[}$n$\code{]}	\\
     \code{origin\_z[}$n$\code{]}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These all default to 0.0.
	In practice, you should set these parameters to be somewhere
	reasonably close to your best guess for the center of each apparent
	horizon.  These aren't {\em too\/} critical: being off by 1/4
	of the horizon radius is no problem, and -- assuming the algorithm
	still converges -- even 1/2 of the horizon radius only slows
	the convergence by an extra iteration or two.  But poor values
	of these parameters do make the algorithm more likely to fail
	to converge.
\end{description}

At present the local coordinate origin is fixed once you set it;
there's no provision for it to move to track a moving black hole.
I hope to add such a provision soon.%%%
\footnote{%%%
	 This would be along the lines of the
	 \thorn{AHFinder} apparent horizon finder's
	 \code{AHFinder::ahf\_wander = true}
	 option.
	 }%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Specifying the Initial Guess}

\thorn{AHFinderDirect} requires an initial guess
for the apparent horizon's coordinate position and shape
(that is, for the $h(\text{angle})$ function defined in
section~\ref{AHFinderDirect/sect-what-AHFinderDirect-needs}),
for each apparent horizon you want to find.  Unlike some other apparent
horizon finders (\eg{}~the curvature flow method in \thorn{AHFinder}),
for \thorn{AHFinderDirect} there's no restriction on whether the initial
guess is inside, outside, or crossing the actual apparent horizon: the
only important thing is that it should be ``close''.  Just how close
the initial guess needs to be for \thorn{AHFinderDirect} to find the
(a) apparent horizon depends on the slice and the coordinates, but as
a general rule of thumb any initial guess that's within 1/3 to 1/2 of
the mean horizon radius will probably work.

The ``initial guess'' specification is used the first time we try to
find any given apparent horizon, and also any succeeding time when the
most recent attempt to find this apparent horizon failed.  If we succeed
in finding a given apparent horizon, than that apparent horizon position
is automatically reused as the initial guess the next time we try to
find the same apparent horizon; in this case the explicit ``initial guess''
specification is ignored.%%%
\footnote{%%%
	 This is similar to the \thorn{AHFinder} apparent
	 horizon finder's behavior with the
	 \code{AHFinder::ahf\_guessold = true}
	 option.
	 }%%%

There are a number of parameters for specifying the initial guess:
\begin{description}
\item[\code{initial\_guess\_method[}$n$\code{]}]
\mbox{}\\
	This sets what type of the initial guess is used for each
	apparent horizon position.
	There are several possibilities, most with their own sets
	of subparameters:%%%
\footnote{%%%
	 The naming scheme for these is similar to
	 that used in the \thorn{Exact} thorn.
	 }%%%
$^,$%%%
\footnote{%%%
	 For the Kerr parameters, note that this thorn
	 always uses the convention that the spin parameter
	 $a \equiv J/m^2$ is dimensionless.
	 }%%%
	\begin{description}
	\item[\code{"read from file"}]
	\mbox{}\\
		This reads the initial-guess $h(\text{angle})$ function
		from a data file.  The file format is currently hard-wired
		to be that written with \verb|file_format = "ASCII (gnuplot)"|
		(see below).  The subparameter
		\verb|initial_guess__read_from_named_file__file_name|
		specifies the file name.
	\item[\code{"Kerr/Kerr"}]
	\mbox{}\\
		This sets the initial guess to the analytically-known
		apparent horizon position in a Kerr spacetime
		in Kerr coordinates.  This is a coordinate sphere
		of radius $(1 + \sqrt{1 - a^2}) m$.
		There are subparameters
		\begin{description}
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_Kerr\_Kerr\_\_x\_posn[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_Kerr\_\_y\_posn[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_Kerr\_\_z\_posn[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			to set the position of the Kerr black hole
			(note this position is in {\em global\/} Cactus
			coordinates, not relative to the local coordinate
			origin), and
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_Kerr\_Kerr\_\_mass[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_Kerr\_\_spin[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			to set its mass and spin.
		\end{description}
	\item[\code{"Kerr/Kerr-Schild"}]
	\mbox{}\\
		This sets the initial guess to the analytically-known
		apparent horizon position in a Kerr spacetime in
		Kerr-Schild coordinates.  This is a coordinate ellipsoid
		with radia (semi-major axes)
		\begin{equation}
		\renewcommand{\arraystretch}{2.0}
		\begin{array}{lclcl}
		r_z	& = &	(1 + \sqrt{1 - a^2}) m			\\
		r_x = r_y
			& = &	r_z \sqrt{1 + \left(\dfrac{am}{r_z}\right)^2}
			& = &	\sqrt{\dfrac{2 r_z}{m}} \, m
									%%%\\
		\end{array}
		\end{equation}
		\begin{description}
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_Kerr\_KerrSchild\_\_x\_posn[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_KerrSchild\_\_y\_posn[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_KerrSchild\_\_z\_posn[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			(note this position is in {\em global\/} Cactus
			coordinates, not relative to the local coordinate
			origin), and
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_Kerr\_KerrSchild\_\_mass[}$n$\code{]} \\
		     \code{initial\_guess\_\_Kerr\_KerrSchild\_\_spin[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			to set its mass and spin.
		\end{description}
	\item[\code{"coordinate sphere"}]
	\mbox{}\\
		This sets the initial guess to a coordinate sphere;
		there are subparameters
		\begin{description}
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_coord\_sphere\_\_x\_center[}$n$\code{]} \\
		     \code{initial\_guess\_\_coord\_sphere\_\_y\_center[}$n$\code{]} \\
		     \code{initial\_guess\_\_coord\_sphere\_\_z\_center[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			(note this position is in {\em global\/} Cactus
			coordinates, not relative to the local coordinate
			origin), and
		\item[\code{initial\_guess\_\_coord\_sphere\_\_radius[}$n$\code{]}]
		\mbox{}\\
			to set the radius.
		\end{description}
	\item[\code{"coordinate ellipsoid"}]
	\mbox{}\\
		This sets the initial guess to a coordinate ellipsoid;
		there are subparameters
		\begin{description}
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_x\_center[}$n$\code{]} \\
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_y\_center[}$n$\code{]} \\
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_z\_center[}$n$\code{]} %%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			(note this position is in {\em global\/} Cactus
			coordinates, not relative to the local coordinate
			origin), and
		\item[%%%
		     \begin{tabular}{@{}l@{}}
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_x\_radius[}$n$\code{]}	\\
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_y\_radius[}$n$\code{]}	\\
		     \code{initial\_guess\_\_coord\_ellipsoid\_\_z\_radius[}$n$\code{]}	%%%\\
		     \end{tabular}%%%
		     ]
		\mbox{}\\
			to set the radia (semimajor axes).
		\end{description}
	\end{description}
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{I/O Parameters for the Apparent Horizon Shape(s)}

The main output of this thorn is the computed horizon shape function
$h({\rm angle})$, and correspondingly the $(x,y,z)$ coordinate positions
of the apparent-horizon-surface (angular) grid points.  There are several
parameters controlling if, how often, and how these should be written
to data files:

\begin{description}
\item[\code{output\_h\_every}]
\mbox{}\\
	As described in
	section~\ref{AHFinderDirect/sect-parameters/overall-parameters},
	\thorn{AHFinderDirect} will try to find the apparent horizon(s)
	every \verb|find_every| time steps.  However, you can control
	how often (if at all) the apparent horizon shape(s) are written
	to data files: this is only done if \verb|output_h_every|
	is nonzero, and the Cactus time step number \verb|cctk_iteration|
	is an integral multiple of this parameter (\verb|output_h_every|).

\item[\code{file\_format}]
\mbox{}\\
	This specifies the file format for horizon-shape (and other
	angular-grid-function) data files.  Unfortunately, at the
	moment only a single format is implemented,
	\begin{description}
	\item[\code{"ASCII (gnuplot)"}]
	\mbox{}\\
		This is a simple ASCII format designed for easy
		plotting with gnuplot:
		\begin{itemize}
		\item	\thorn{AHFinderDirect} writes a separate data file
			for each Cactus time step and for each apparent
			horizon found.  By default these are all written
			in to the \verb|IOUtil::out_dir| directory;
			see \verb|h_directory| (below) to change this.
		\item	The time step number and the apparent horizon number
			are both encoded in the file name; the actual
			file name is given by a \verb|printf()| format
			\verb|"%s/%s.t%d.ah%d.%s"|, where
			\begin{itemize}
			\item	the first \verb|%s| is the directory
				set by the \verb|IO::out_dir| and/or
				\verb|h_directory| parameters (see below)
			\item	the second \verb|%s| is the base file name
				set by the \verb|h_base_file_name|
				parameter (see below)
			\item	the first \verb|%d| is the
				Cactus time step number
			\item	the second \verb|%d| is the
				apparent horizon number
			\item	the third \verb|%s| is the
				file name extension, set by the
				\verb|ASCII_gnuplot_file_name_extension|
				parameter; this defaults to \verb|"gp"|
			\end{itemize}
		\item	Comment lines begin with \verb|#|.
		\item	Patches are separated by 2 blank lines;
			rows of apparent-horizon points within a patch
			are separated by single blank lines.
		\item	Each apparent-horizon-surface point
			is described by a single line, containing
			the whitespace-separated fields
			\begin{itemize}
			\item	Two ``unwrapped'' angular coordinates
				in degrees, representing a point on $S^2$.
			\item	The $h$ value, giving the radius
				of the apparent horizon surface
				at that angle.
			\item	The corresponding Cactus $(x,y,z)$
				coordinates.
			\end{itemize}
		\end{itemize}
		See section~\ref{AHFinderDirect/sect-visualization}
		for a discussion of visualization for these and other
		\thorn{AHFinderDirect} output files.
	\end{description}

\item[\code{h\_directory}]
\mbox{}\\
	This specifies the directory in which the $h$ data files
	are to be written.  If it doesn't already exist, this directory
	is created before writing the data files.  This parameter
	defaults to the value of the \verb|IO::out_dir| parameter.

\item[\code{h\_base\_file\_name}]
\mbox{}\\
	This specifies the base file name for $h$ data files, as
	described above.  This defaults to "h".

\item[\code{ASCII\_gnuplot\_file\_name\_extension}]
\mbox{}\\
	This specifies the file name extension for $h$ data files, as
	described above.  This defaults to "gp".
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Parameters for the ``BH\_diagnostics'' Files}
\label{AHFinderDirect/sect-parameters/BH-diagnostics-parameters}

As well as the apparent horizon shape files, this thorn can also
write files giving time series of various diagnostics.  These are
controlled by the following parameters:

\begin{description}
\item[\code{output\_BH\_diagnostics}]
\mbox{}\\
	If this Boolean parameter is set to true,
	\thorn{AHFinderDirect} will write a ``black hole diagnostics''
	file for each distinct apparent horizon found
	(up to \verb|N_horizons| files in all).  Each such file
	contains a time series of various diagnostics for all time
	steps when the corresponding apparent horizon was found.
	The file format is again a simple ASCII format designed
	for easy plotting with gnuplot:
	\begin{itemize}
	\item	The apparent horizon number is encoded in the file name;
		the actual file name is given by a \verb|printf()| format
		\verb|"%s/%s.ah%d.%s"|, where
		\begin{itemize}
		\item	the first \verb|%s| is the directory
			set by the \verb|IO::out_dir| and/or
			\verb|BH_diagnostics_directory| parameters (see below)
		\item	the second \verb|%s| is the base file name
			set by the \verb|BH_diagnostics_base_file_name|
			parameter (see below); this defaults to
			\verb|"BH_diagnostics"|
		\item	the \verb|%d| is the apparent horizon number
		\item	the third \verb|%s| is the file name extension,
			set by the \verb|BH_diagnostics_file_name_extension|
			parameter; this defaults to \verb|"gp"|
		\end{itemize}
	\item	The file begins with a block of header comments
		(lines begining with \verb|#|) describing the data
		fields.
	\item	Each time this apparent horizon is found, a single
		line is appended to the data file, containing various
		whitespace-separated fields.  The the precise list of
		fields, see the header comments, or see the function
		\verb|output()| in \verb|src/driver/BH_diagnostics.cc|.
		As of this writing the fields are:
		\begin{itemize}
		\item	the Cactus iteration number \verb|cctk_iteration|
		\item	the Cactus time coordinate \verb|cctk_time|
		\item	the Cactus $(x,y,z)$ coordinates of the apparent
			horizon centroid
		\item	the minimum, maximum, and mean coordinate radia
			of the apparent horizon about the local
			coordinate origin
		\item	the minimum and maximum Cactus $x$, $y$, and $z$
			coordinates of the apparent horizon surface
		\item	the proper circumferences of the apparent horizon
			in the $xy$, $xz$, and $yz$ local-coordinate planes%%%
\footnote{%%%
	 Note that if the apparent horizon is not
	 symmetric across one of these coordinate planes,
	 then the circumference in this plane is not
	 very meaningful.  In particular, in this case
	 this circumference is probably different from
	 the apparent horizon's maximum ``hoop'' circumference.
	 }%%%
		\item	the $xz/xy$ and $yz/xy$ ratios of the proper
			circumferences
		\item	the proper area of the apparent horizon, $A$
		\item	the irreducible mass of the apparent horizon,
			$\sqrt{A/16\pi}$
		\item	the areal radius of the apparent horizon,
			$\sqrt{A/4\pi}$
		\end{itemize}
	\end{itemize}

\item[\code{BH\_diagnostics\_directory}]
\mbox{}\\
	This specifies the directory in which the black hole diagnostics
	data files are to be written.  If it doesn't already exist, this
	directory is created before writing the data files.  This parameter
	defaults to the value of the \verb|IO::out_dir| parameter.

\item[\code{BH\_diagnostics\_base\_file\_name}]
\mbox{}\\
	This specifies the base file name for black hole diagnostics
	data files, as described above.  This defaults to
	\verb|"BH_diagnostics"|.

\item[\code{BH\_diagnostics\_file\_name\_extension}]
\mbox{}\\
	This specifies the file name extension for black hole diagnostics
	data files, as described above.  This defaults to \verb|"gp"|.
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{(Excision) Mask Parameters}
\label{AHFinderDirect/sect-parameters/mask-parameters}

This thorn can optionally set a mask grid function (or functions)
at each point of the Cactus grid, to indicate where that point is
with respect to the apparent horizon(s).  This is usually used for
excision.

\begin{description}
\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{set\_mask\_for\_all\_horizons}			\\
     \code{set\_mask\_for\_individual\_horizon[}$n$\code{]}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These Boolean parameters control whether \thorn{AHFinderDirect}
	should set a mask grid function(s): If the (C) expression
	\verb:set_mask_for_all_horizons || set_mask_for_individual_horizon[i]:
	is true, then \thorn{AHFinderDirect} will set a mask grid
	function(s) for apparent horizon $i$.
	All these parameters default to false (don't set a mask).

	If any of these parameters is set to true, you almost certainly
	also need to set the Boolean parameter \verb|SpaceMask::use_mask|
	to true to to turn on storage for the mask grid function(s)!
\end{description}

If it's setting a mask(s), \thorn{AHFinderDirect} partitions the
Cactus grid into 3~regions: an \defn{inside}, a \defn{buffer},
and an \defn{outside}.  Typically the inner region is excised, but
\thorn{AHFinderDirect} doesn't itself do this:  It just sets the mask(s);
you need to use some other thorn(s) to do the actual excision.

The 3~regions are defined as follows:  For a grid point a distance $r[i]$
from horizon~$i$'s local coordinate origin, with horizon~$i$'s radius
in this same direction (again, measured from its local coordinate origin)
being $r_{\text horizon}[i]$,%%%
\footnote{%%%
	 Note that these are flat-space distances
	 $[(x-x_0)^2 + (y - y_0)^2 + (z-z_0)^2]^{1/2}$
	 -- the spacetime metric is {\em not\/} used here.
	 }%%%
{} the regions are defined by
\begin{equation}
\renewcommand{\arraystretch}{1.333}
\begin{tabular}{l@{~}lll@{~}lll}
$r[i] \le r{	ext{r}}[i]$	& \text{for some $i$}
	&
	&				&
	& $\Rightarrow$	& \text{inner}					\\
$r[i] >   r_{\text{r}}[i]$	& \text{for all $i$}
	& \text{and}	&
	$r[i] \le r_{\text{r}}[i]$	& \text{for some $i$}
	& $\Rightarrow$	& \text{buffer}					\\
$r[i] >   r_{\text{r}}[i]$	& \text{for all $i$}
	&
	&				&
	& $\Rightarrow$	& \text{outer}				%%%\\
\end{tabular}
\end{equation}
where
\begin{equation}
\renewcommand{\arraystretch}{1.333}
\begin{array}{lcl}
r_{\text{r}}
	& = &	\verb|mask_radius_multiplier| \times r_{\text{n}}
		\,\,+\,\,
		\verb|mask_radius_offset| \times {\Delta x}_{\text{e}}
									\\
r_{\text{r}}
	& = &	r_{\text{r}}
		\,\,+\,\,
		\verb|mask_buffer_thickness| \times {\Delta x}_{\text{e}}
									%%%\\
\end{array}
				\label{AHFinderDirect/eqn-r-inside-outside}
\end{equation}
and where ${\Delta x}_{\text{e}}$ is the base-grid Cactus grid spacing
(more precisely, the geometric mean of the base grid's $x$, $y$,
and $z$ Cactus grid spacings)%%%
\footnote{%%%
	 The ``base grid'' part here only matters if
	 you're doing mesh refinement, in which case
	 it's necessary to keep excision consistent
	 between the different refinement levels.
	 }%%%
.

\begin{description}
\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{mask\_radius\_multiplier}	\\
     \code{mask\_radius\_offset}	\\
     \code{mask\_buffer\_thickness}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These parameters are used to define the radia $r_{\text{r}}$
	and $r_{\text{r}}$ in
	equation~\eqref{AHFinderDirect/eqn-r-inside-outside} above.

	Note that the sign convention here is that
	\verb|mask_radius_multiplier| is {\em multiplied\/}
	by the horizon radius, then \verb|mask_radius_offset|
	(scaled by the Cactus grid spacing) is {\em added\/}.
	Thus for use with excision (where the inner region --
	which will be excised -- must be somewhat {\em inside\/}
	the horizon), \verb|mask_radius_multiplier| should be a
	positive real number slightly less than~1.0, and/or
	\verb|mask_radius_offset| a negative real number.

	The default values for these parameters are
	\begin{verbatim}
	mask_radius_multiplier =  0.8
	mask_radius_offset     = -5.0
	mask_buffer_thickness  =  5.0
	\end{verbatim}

\item[\code{mask\_is\_noshrink}]
\mbox{}\\
	This Boolean parameter specifies whether the inside and
	buffer regions should be prevented from ever shrinking
	during a time evolution (this is the default), or whether
	they should be set independently from one time step to the
	next (and thus allowed to either grow or shrink).  More
	precisely, once a given grid point has been classified as
	inside, buffer, or outside, \thorn{AHFinderDirect} executes
	the following algorithm:
	\begin{description}
	\item[inside]\mbox{}\\[-\baselineskip]
		\begin{tabbing}
		$\verb|mask| \assign \verb|inside_value|$		  %%%\\
		\end{tabbing}
	\item[buffer]\mbox{}\\[-\baselineskip]
		\begin{tabbing}
		if \=(\verb|mask_is_noshrink|
		      \verb|&&|
		      ($\verb|mask| = \verb|inside_value|$))		\+\\
		   then \=\{						\+\\
			\verb|#|
			this point was previously {\bf inside}
			$\Rightarrow$ no-op here			  \\
			\}						\-\\
		   else \>$\verb|mask| \assign \verb|buffer_value|$	\-%%%\\
		\end{tabbing}
	\item[outside]\mbox{}\\[-\baselineskip]
		\begin{tabbing}
		if \=(\verb|mask_is_noshrink|
		      \verb|&&|
		      (($\verb|mask| = \verb|inside_value|$)
		       \verb.||. ($\verb|mask| = \verb|buffer_value|$))	\+\\
		   then \=\{						\+\\
			\verb|#|
			this point was previously {\bf inside}
			or {\bf buffer} $\Rightarrow$ no-op here	  \\
			\}						\-\\
		   else \>$\verb|mask| \assign \verb|outside_value|$	\-%%%\\
		\end{tabbing}
	\end{description}

\item[\code{min\_horizon\_radius\_points\_for\_mask}]
\mbox{}\\
	By default, \thorn{AHFinderDirect} sets the mask for each
	apparent horizon found.  If we're using mesh refinement, it's
	possible for an apparent horizon to be found on a coarse grid,
	and the masked region to be only a few grid points across on
	a fine grid.  This causes some other Cactus thorns
	(\eg{} \thorn{LegoExcision}) to crash. :(

	This parameter can be used to avoid this problem:
	For each apparent horizon that it finds, \thorn{AHFinderDirect}
	only sets the mask on a given grid if
	\begin{equation}
	r_{\text{inner},\min} \ge \verb|min_horizon_radius_points_for_mask|
		     * {\Delta x}_{\text{current},\max}
	\end{equation}
	where $r_{\text{inner},\min}$ is the minimum over all angles
	of $r_{\text{r}}$ as defined by
	equation~\eqref{AHFinderDirect/eqn-r-inside-outside},
	and ${\Delta x}_{\text{current},\max}$ is the maximum of the
	Cactus $x$, $y$, and~$z$ grid spacings on the current Cactus
	grid.%%%
\footnote{%%%
	 Note that this is the {\bf current\/} Cactus
	 grid spacing, not the {\bf base\/} Cactus grid
	 spacing that's used when calculating
	 $r_{\text{r}}$ and $r_{\text{r}}$ by
	 equation~\eqref{AHFinderDirect/eqn-r-inside-outside}.
	 }%%%
{}	If this condition isn't satisfied, then \thorn{AHFinderDirect}
	skips setting the mask for this apparent horizon, just as if
	this apparent horizon wasn't found.  (Note that all other
	processing for an apparent horizon being found is still done,
	including writing output files, using the apparent horizon shape
	as the initial guess for the next time step's apparent-horizon
	finding, etc.; it's only the mask processing for this horizon
	(at this time step) that's skipped.)
\end{description}

\thorn{AHFinderDirect} supports two types of mask grid functions;
the following two Boolean parameters choose which of them you want
to set; you can set either or even both of these:
\begin{description}
\item[\code{set\_old\_style\_mask}]
\mbox{}\\
	This parameter (default \verb|true|) specifies an
	old-style excision mask, one stored in a \verb|CCTK_REAL|
	Cactus grid function.  (The \thorn{AHFinder} apparent horizon
	finder uses this type of mask.)

\item[\code{set\_new\_style\_mask}]
\mbox{}\\
	This parameter (default \verb|false|) specifies a
	new-style excision mask, one stored in a specified bit field
	of a \verb|CCTK_INT| Cactus grid function.
	The bit field is specified by its name,
	as registered with the \thorn{SpaceMask} thorn.
	We plan to eventually convert all Cactus excision
	(and other uses of mask grid functions) to this scheme,
	but at the moment not much code supports it.
	Note that \thorn{AHFinderDirect} doesn't itself create/register
	any bit fields or state names with \thorn{SpaceMask} --
	you must arrange for some other thorn(s) to do this.
\end{description}

For an old-style mask, the following parameters specify the mask grid
function and how it should be set:
\begin{description}
\item[\code{old\_style\_mask\_gridfn\_name}]
\mbox{}\\
	This parameter specifies the mask grid function's name.

\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{old\_style\_mask\_inside\_value}	\\
     \code{old\_style\_mask\_buffer\_value}	\\
     \code{old\_style\_mask\_outside\_value}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	If an old-style mask is to be set in the corresponding
	regions, these parameters specify the values to which
	it should be set.  These are all \verb|CCTK_REAL| values.
\end{description}

For an new-style mask, the following parameters specify the mask grid
function and how it should be set:
\begin{description}
\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{new\_style\_mask\_gridfn\_name}	\\
     \code{new\_style\_mask\_bitfield\_name}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These parameters specify the mask grid function's name
	and the bitfield name within it.

\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{new\_style\_mask\_inside\_value}	\\
     \code{new\_style\_mask\_buffer\_value}	\\
     \code{new\_style\_mask\_outside\_value}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	If an new-style mask is to be set in the corresponding
	regions, these parameters specify the values to which
	it should be set.  These are all character-string state
	names, as registered with the \thorn{SpaceMask} thorn.
\end{description}
Note that \thorn{AHFinderDirect} doesn't itself register any bitfields
or states with \thorn{SpaceMask} -- you must arrange for some other thorn(s)
to do this before \thorn{AHFinderDirect} tries to find the horizon(s).

If \thorn{AHFinderDirect} sets a mask or masks, this happens in the
same schedule bin(s) as the horizon finding.  More precisely,
\thorn{AHFinderDirect} creates two schedule groups for this purpose:
\begin{itemize}
\item	The schedule group \verb|group_for_mask_stuff| is
	scheduled to run just after the horizon is found.
\item	The schedule group \verb|group_where_mask_is_set|
	is scheduled inside the schedule group \verb|group_for_mask_stuff|.
\item	The actual setting of the mask is scheduled inside
	the schedule group \verb|group_where_mask_is_set|.
\end{itemize}
Thorn \thorn{PreviousMask} uses these schedule groups to keep a
``previous'' as well as a ``current'' mask.  See that thorn's thorn
guide for further details.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Communicating with Other Thorns}
\label{AHFinderDirect/sect-parameters/communicating-with-other-thorns}

Besides the data files it writes, \thorn{AHFinderDirect} currently
has three ways to communicate with other Cactus thorns:
\begin{itemize}
\item	\thorn{AHFinderDirect} can set a mask grid function(s) based
	on the (a) horizon's shape; other thorns may then use this for
	excision or other purposes.  \thorn{AHFinderDirect} supports
	both the old-style (\verb|CCTK_REAL|) mask
	(compatible with \thorn{AHFinder}) or
	the new-style (\verb|CCTK_INT|) mask bit-fields defined by
	\thorn{SpaceMask}; you can even use both styles simultaneously.
\item	\thorn{AHFinderDirect} can announce a selected horizon's centroid
	position to another thorn (typically \thorn{DriftCorrect}, which
	uses this to adjust its corotating shift vector).
	This uses the new function-aliasing version of \thorn{DriftCorrect},
	not the old version which worked with an auxiliary thorn
	\thorn{AHFSetDCCentroid}.
\item	\thorn{AHFinderDirect} provides a set of aliased functions
	which any other thorn(s) can call to find out the shape of
	a specified horizon.
\item	\thorn{AHFinderDirect} can store information about the
	horizon(s) it finds in the \thorn{SphericalSurface} variables
	for other thorns to use.
\end{itemize}

\thorn{AHFinderDirect}'s mask features are described in
section~\ref{AHFinderDirect/sect-parameters/mask-parameters};
the other communication mechanisms are described in the following
subsections.

%%%%%%%%%%%%%%%%%%%%

\subsubsection{Parameters for Announcing a Horizon Centroid to Other Thorns}

This thorn can optionally announce the centroid of a specified
apparent horizon to another thorn (typically \thorn{DriftCorrect})
each time that apparent horizon is found.  This is controlled by the
following parameter:

\begin{description}
\item[\code{which\_horizon\_to\_announce\_centroid}]
\mbox{}\\
	This is an integer parameter which defaults to
	0 (which means not to announce any centroid).
	If it's set to a nonzero integer, that specifies the
	horizon number to have its centroid announced.
\end{description}

%%%%%%%%%%%%%%%%%%%%

\subsubsection{Aliased Functions to Provide Horizon-Shape Information}

\thorn{AHFinderDirect} provides the following aliased functions
to allow other thorns to find out about the horizons.  Each function
returns a status code which is $\ge 0$~for ok, or negative for an error.
\begin{verbatim}
#
# This function returns the local coordinate origin for a given horizon.
#
CCTK_INT FUNCTION HorizonLocalCoordinateOrigin                          \
   (CCTK_INT IN horizon_number,                                         \
    CCTK_REAL OUT origin_x, CCTK_REAL OUT origin_y, CCTK_REAL OUT origin_z)

#
# The following function queries whether or not the specified horizon
# was found the most recent time AHFinderDirect searched for it.
# The return value is:
#  1 if the horizon was found
#  0 if the horizon was not found
#  negative for an error
#
CCTK_INT FUNCTION HorizonWasFound(CCTK_INT IN horizon_number)

#
# The following function computes the horizon radius in the direction
# of each (x,y,z) point, or -1.0 if this horizon wasn't found the most
# recent time AHFinderDirect searched for it.  More precisely, for each
# (x,y,z), consider the ray from the local coordinate origin through
# (x,y,z).  This function computes the Euclidean distance between the
# local coordinate origin and this ray's intersection with the horizon,
# or -1.0 if this horizon wasn't found the most recent time AHFinderDirect
# searched for it.  
#
# If this function is to be used in a multiprocessor run on a horizon
# which was found on some other processor, the parameter
#   AHFinderDirect::always_broadcast_horizon_shape
# must be set to true to get the correct answer.
#
CCTK_INT FUNCTION HorizonRadiusInDirection                              \
   (CCTK_INT IN horizon_number,                                         \
    CCTK_INT IN N_points,                                               \
    CCTK_REAL IN ARRAY x, CCTK_REAL IN ARRAY y, CCTK_REAL IN ARRAY z,   \
    CCTK_REAL OUT ARRAY radius)
\end{verbatim}

%%%%%%%%%%%%%%%%%%%%

\subsubsection{Storing Horizon-Shape Information in the \thorn{SphericalSurface} Variables}

\thorn{SphericalSurface} (in the \thorn{AEIThorns} arrangement)
defines a set of generic grid arrays which describe ``spherical surfaces''.
\thorn{AHFinderDirect} can optionally store information about the
horizons it finds in the \thorn{SphericalSurface} variables.
This is controlled by the following parameters:
\begin{description}
\item[\code{which\_surface\_to\_store\_info[}$n$\code{]}]
\mbox{}\\
	This parameter should be set to the \thorn{SphericalSurface}
	surface number into which information on a given \thorn{AHFinderDirect}
	horizon should be stored, or to -1 to skip storing the information.
	It defaults to -1 for each horizon.

	{\bf Note that \thorn{SphericalSurface} numbers surfaces
	starting from 0, whereas \thorn{AHFinderDirect} numbers
	horizons starting from 1!}

	At present, if multiple \thorn{AHFinderDirect} horizons
	specify the same \thorn{SphericalSurface} surface, the
	highest-numbered horizon will ``win'', \ie{} it will overwrite
	the data from any lower-numbered horizons.
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Other Parameters}
\label{AHFinderDirect/sect-parameters/other-parameters}

\begin{description}
\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{run\_at\_CCTK\_ANALYSIS}			\\
     \code{run\_at\_CCTK\_POSTSTEP}			\\
     \code{run\_at\_CCTK\_POSTINITIAL}			\\
     \code{run\_at\_CCTK\_POST\_RECOVER\_VARIABLES}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These parameters (which default to \verb|true|, \verb|false|,
	\verb|false|, and \verb|true| respectively) control which
	schedule bins \thorn{AHFinderDirect} runs in.  Historically,
	\thorn{AHFinderDirect} ran in CCTK\_ANALYSIS, and that's
	still the default, but these parameters allow you to change this
	so it runs in CCTK\_POSTSTEP and/or CCTK\_POSTINITIAL
	instead.  (You can even run in all three bins if you want!)

	In general we need to run at CCTK\_POST\_RECOVER\_VARIABLES, since
	\begin{itemize}
	\item	parameters may have been steered at recovery, so we may need
		to find a new horizon or horizons, and
	\item	we need to set the mask again to make sure it's correct
		right away (since our next regular horizon-finding may not
		be until some time steps later)
	\end{itemize}
	Therefore the \verb|run_at_CCTK_POST_RECOVER_VARIABLES| parameter
	should probably be left at its default setting of \verb|true|.

\item[%%%
     \begin{tabular}{@{}l@{}}
     \code{geometry\_interpolator\_name}	\\
     \code{geometry\_interpolator\_pars}	%%%\\
     \end{tabular}
     ]
\mbox{}\\
	These parameters control the (3-D) \defn{geometry interpolation}
	of the spacetime geometry ($g_{ij}$ and $K_{ij}$, or their
	\thorn{StaticConformal} equivalents) to the apparent horizon
	position.  The defaults are set to use a quadratic Hermite
	interpolator.  This works fairly well, but because of the interpolator
	molecule size you must use $\verb|driver::ghost_size| \ge 2$.

	If you want to get very high accuracy from \thorn{AHFinderDirect},
	then you should use a cubic Hermite geometry interpolator, by
	setting
\begin{verbatim}
AHFinderDirect::geometry_interpolator_pars = "
  order=3
  boundary_off_centering_tolerance={1.0e-10 1.0e-10 1.0e-10 1.0e-10 1.0e-10 1.0e-10}
  boundary_extrapolation_tolerance={0.0 0.0 0.0 0.0 0.0 0.0}
                                             "
\end{verbatim}
	Assuming perfectly accurate geometry variables in the 3-D Cactus grid,
	this will make \thorn{AHFinderDirect} (very) roughly an order
	of magnitude more accurate.  However, the larger molecule size
	will make it about a factor of 2--3~slower, and will also require
	that you set $\verb|driver::ghost_size| \ge 3$.
	The sample parameter file \verb|par/Kerr-order3.par|
	shows an example of this.

\item[\code{N\_zones\_per\_right\_angle[}$n$\code{]}]
\mbox{}\\
	This parameter sets the angular resolution used to compute
	each patch.  The units are the number of angular grid zones
	per right angle.  The default is 18, \ie{} a 5~degree angular
	resolution.  There's no problem with this parameter varying
	from one horizon to another, but for simplicity it should be
	even.%%%
\footnote{%%%
	 More precisely, it {\em must\/} be even for
	 any horizon whose patch system type is anything
	 other than {\tt "full sphere"}.  See the comments
	 in {\tt param.ccl} for further information.%%%
	 }%%%

{}	For any horizon which is close to spherical about its
	local coordinate origin, you can lower this parameter to make
	\thorn{AHFinderDirect} run faster (typical run-times scale
	roughly as the cube of this parameter); 6~is about the
	minimum reasonable value.

	For any horizon which is highly non-spherical about its
	local coordinate origin, you can raise this parameter to
	get better resolution; 30~should be enough for even a
	highly non-spherical horizon.

\item[\code{max\_allowable\_horizon\_radius[}$n$\code{]}]
\mbox{}\\
	This parameter gives the maximum mean-coordinate-radius
	which any given trial surface may have in the course of
	trying to solve the apparent horizon equation.%%%
\footnote{%%%
	 Note that this is an unweighted arithmetic
	 mean over the horizon-surface grid points,
	 the same value which is printed as \code{r\_grid}
	 during the horizon-finding iterations.
	 }%%%
{}	In particular, if any trial surface has a mean coordinate radius
	which exceeds this parameter, \thorn{AHFinderDirect} gives up
	and deems this apparent horizon to be ``not found''.

	This parameter defaults to $10^{10}$ (effectively $+\infty$)
	for each apparent horizon.  You can set it to a smaller value
	to make \thorn{AHFinderDirect} a bit more efficient, or
	(probably more important in practice) to stop
	\thorn{AHFinderDirect} from iterating off the edge of the grid
	if this causes problems with interpolation or boundary conditions.

\item[\code{max\_allowable\_Theta}]
\mbox{}\\
	This parameter gives the maximum $\|\Theta\|_\infty$
	which any given trial surface may have in the course of
	trying to solve the apparent horizon equation.
	In particular, if any trial surface has $\|\Theta\|_\infty$
	exceeding this parameter, \thorn{AHFinderDirect} gives up
	and deems this apparent horizon to be ``not found''.
	This parameter defaults to $10^{10}$ (effectively $+\infty$)
	for each apparent horizon.

\item[\code{surface\_expansion[}$n$\code{]}]
\mbox{}\\
	This parameter (which defaults to 0.0) sets the expansion
	of each surface.  With the default setting this thorn
	solves~\eqref{AHFinderDirect/eqn-horizon} to find apparent
	horizons.  With other settings of this parameter this thorn
	can be used to find \defn{surfaces of constant expansion};
	these may be useful for excision, wave extraction, or
	other purposes (\cite{AHFinderDirect/Schnetter03a}).

	To help in choosing the value(s) of the
	\verb|surface_expansion[|$n$\verb|]| parameter,
	figure~\ref{AHFinderDirect/fig-Schwarzschild-EF-Theta(r)}
	(from \cite{AHFinderDirect/Thornburg95}),
	shows the expansion of $r = \text{constant}$ surfaces
	in an Eddington-Finkelsteon slice of the unit-mass
	Schwarzschild spacetime.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{figure}[htbp]
\begin{center}
\includegraphics{AEIThorns_AHFinderDirect_Schw_EF_Theta_of_r}
\end{center}
\caption[Expansion $\Theta$ for $r = \text{constant}$ Surfaces
	 in an Eddington-Finkelstein slice
	 of the Unit-Mass Schwarzschild Spacetime]
	{
	This figure shows the expansion $\Theta$ for $r = \text{constant}$
	surfaces in an Eddington-Finkelstein slice of the unit-Mass
	Schwarzschild Spacetime.
	}
\label{AHFinderDirect/fig-Schwarzschild-EF-Theta(r)}
\end{figure}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Monitoring \thorn{AHFinderDirect}'s Status}

There are two primary ways of monitoring what \thorn{AHFinderDirect}
is doing during a Cactus run: the \verb|BH_diagnostics| files and the
\verb|CCTK_INFO| messages written to the Cactus standard output:

The \verb|BH_diagnostics| files are described in detail in
section~\ref{AHFinderDirect/sect-parameters/BH-diagnostics-parameters}.
These files are written and ``flushed'' at each time step, so they're
always up-to-date.

During the apparent-horizon--finding process, \thorn{AHFinderDirect}
writes various \verb|CCTK_INFO| messages describing the convergence
of the iterative solution of the apparent horizon
equation~\ref{AHFinderDirect/eqn-horizon} on each processor.
In particular, if \verb|verbose_level| is set to
\verb|"algorithm highlights"| or a more verbose setting
(\cf{}~section~\ref{AHFinderDirect/sect-parameters/overall-parameters}),
then \thorn{AHFinderDirect} writes \verb|CCTK_INFO| messages like
these:
\begin{verbatim}
INFO (AHFinderDirect):    proc 0/horizon 1:it 1 r_grid=0.595 ||Theta||=1.1e-01
INFO (AHFinderDirect):    proc 0/horizon 1:it 2 r_grid=0.614 ||Theta||=7.2e-02
INFO (AHFinderDirect):    proc 0/horizon 1:it 3 r_grid=0.632 ||Theta||=2.9e-02
INFO (AHFinderDirect):    proc 0/horizon 1:it 4 r_grid=0.642 ||Theta||=9.9e-04
INFO (AHFinderDirect):    proc 0/horizon 1:it 5 r_grid=0.642 ||Theta||=7.9e-07
INFO (AHFinderDirect):    proc 0/horizon 1:it 6 r_grid=0.642 ||Theta||=7.2e-13
INFO (AHFinderDirect): AH 1/2: r=0.660716 at (0.000000,0.000000,1.127434)
INFO (AHFinderDirect): AH 1/2: area=338.0473838 m_irreducible=2.59330658
INFO (AHFinderDirect): writing h to "misner.h.t0.ah1.gp"
\end{verbatim}
Here \verb|r_grid| is a rough estimate of the mean radius of
the trial surface at each iteration, and \verb:||Theta||: is the
infinity-norm of $\Theta$, the left hand side of the apparent
horizon equation~\ref{AHFinderDirect/eqn-horizon} over the surface.
Once the apparent horizon has been found
(\verb:||Theta||: is sufficiently small), then \thorn{AHFinderDirect}
prints its mean radius,%%%
\footnote{%%%
	 Note that this may differ significantly from
	 the last iterations' estimated radius.  This
	 is because the mean radius printed during the
	 iterations is only a rough estimate (it's the
	 unweighted arithmetic mean of the radius at
	 all the horizon-surface grid points), while
	 the radius printed after the horizon is found
	 is a more accurate value (it's computed via
	 numerical integrals over the surface, taking
	 into account the induced metric).
	 }%%%
{} centroid position, area, and irreducible mass.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Visualization}
\label{AHFinderDirect/sect-visualization}

There are several ways to visualize \thorn{AHFinderDirect}'s output:

The simplest is to plot various quantities from the
\verb|BH_diagnostics| files (described in detail in
section~\ref{AHFinderDirect/sect-parameters/BH-diagnostics-parameters}).
For example, using gnuplot (\verb|http://www.gnuplot.info|), you can
plot a graph of the surface area of horizon \#4 as a function of
coordinate time, with the command
\begin{verbatim}
plot 'BH_diagnostics.ah4.gp' using 2:26 with points
\end{verbatim}
ygraph (\verb|http://www.aei.mpg.de/~pollney/ygraph/|) may also be
able to directly plot the \verb|BH_diagnostics| files.

Given a horizon-shape data file \verb|h.t105.h4.gp|, the gnuplot
command
\begin{verbatim}
splot 'h.t105.h4.gp' with lines
\end{verbatim}
will plot the $h(\text{angle})$ function, with the $x$ and $y$~axes
of the plot being the two ``unwrapped'' angular coordinates on $S^2$,
in degrees, and the $z$~axis being $h(\text{angle})$.  However,
in practice this usually isn't very informative.  Instead, you
probably want the gnuplot command
\begin{verbatim}
splot 'h.t105.h4.gp' using 4:5:6 with lines
\end{verbatim}
which will plot the 3-D shape of the apparent horizon surface.

The \verb|src/misc| directory of the \thorn{AHFinderDirect} source
code contains several perl scripts which are useful in visualizing
\thorn{AHFinderDirect} output.  In particular, the script \verb|select.plane|
selects a particular 2-D plane.  If you put this in your Unix path,
it can be used with a gnuplot command like
\begin{verbatim}
splot '<select.plane xy <h.t105.h4.gp' using 4:5 with lines
\end{verbatim}
to show the shape of an apparent horizon in the xy plane.%%%
\footnote{%%%
	 Note that this script isn't very smart: it doesn't
	 know about the \thorn{AHFinderDirect} local coordinate
	 origin.  That is, for example, if you select the $xy$
	 plane, you're selecting the \emph{global} $xy$ plane
	 ($z=0$).
	 }%%%

Another Visualization option is OpenDX (\verb|http://www.opendx.org/|).
Thomas Radke's has written some OpenDX macros
\program{ImportAHFinderDirectGnuplot.net}
and \program{ImportAHFinderDirectGnuplotPatch.net}
to import \thorn{AHFinderDirect} horizon-shape data files.  
These macros use a set of ``control files'' named \verb|*.dx|,
one per horizon, which \thorn{AHFinderDirect} (by default) writes
into the same directory as the main horizon--shape output files.
You can get these macros by anonymous CVS with the command
\begin{verbatim}
cvs -d :pserver:cvs_anon@cvs.aei.mpg.de:/numrelcvs \
     checkout AEIPhysics/Visualization/OpenDX
\end{verbatim}

Another Visualization option is to produce files in the standard
Xdmf~\cite{AHFinderDirect/Xdmf:web} file format which can be visualized for
example using VisIt~\cite{AHFinderDirect/VisIt:web}. Frank L\"offler has
written a python script \program{AH2xdmf.py}, which is included in this
thorn's code repository, which generates such files from
\thorn{AHFinderDirect}'s output from horizon shape files
\verb|h.t%d.ah%d.gp\|. Please see its help text for details.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Accuracy}

The apparent horizon positions are typically computed very accurately;
tests on Kerr spacetimes give typical errors of $10^{-4}m$ to $10^{-5}m$.

The various diagnostics printed to standard output and written to the
black hole diagnostics file(s), are typically computed to accuracies
on the order of a part per million or so.

Note, however, that the irreducible mass $m_{\text{e}}$
may differ considerably from the black hole's local mass or its
contribution to the slice's ADM mass.  For example, for Kerr spacetime
in Kerr-Schild coordinates,
$m_{\text{e}}/m_{\text{M}} = 0.949$, $0.894$, and $0.723$
for spin parameters $a \equiv J/m^2 = 0.6$, $0.8$, and $0.999$, respectively.
It would be better to (also) use the ``isolated horizons'' formalism of
\cite{AHFinderDirect/Dreyer-etal-2002-isolated-horizons};
at some point this thorn may be enhanced to do this.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Examples}
\label{AHFinderDirect/sect-examples}

There are a few example parameter files in the \code{par/} directory,
including Kerr initial data, Misner initial data, and Misner time-evolution
tests.  The \verb|Kerr-tiny.par| parameter file is close to a minimal
\thorn{AHFinderDirect} example:

\begin{verbatim}
# This parameter file sets up Kerr/Kerr-Schild initial data, then
# finds the apparent horizon in it.  The local coordinate system origin
# and the initial guess are both deliberately de-centered with respect
# to the black hole, to make this a non-trivial test for the apparent
# horizon finder.
#
# This parameter file is "tiny" in the sense that it sets only a
# small number of AHFinderDirect parameters.

# flesh
cactus::cctk_itlast = 0

ActiveThorns = "PUGH"
driver::ghost_size = 2
driver::global_nx = 31
driver::global_ny = 31
driver::global_nz = 19

ActiveThorns = "CoordBase CartGrid3D"
grid::domain = "bitant"
grid::avoid_origin = false
grid::type = "byspacing"
grid::dxyz = 0.2

ActiveThorns = "ADMBase ADMCoupling StaticConformal Spacemask CoordGauge Exact"
ADMBase::initial_lapse = "exact"
ADMBase::initial_shift = "exact"
ADMBase::initial_data = "exact"
ADMBase::lapse_evolution_method = "static"
ADMBase::shift_evolution_method = "static"
ADMBase::metric_type = "physical"
Exact::exact_model = "Kerr/Kerr-Schild"
Exact::Kerr_KerrSchild__mass = 1.0
Exact::Kerr_KerrSchild__spin = 0.6

########################################

ActiveThorns = "IOUtil"
IOUtil::parfile_write = "no"

########################################

ActiveThorns = "SphericalSurface"
ActiveThorns = "AEILocalInterp PUGHInterp PUGHReduce AHFinderDirect"
AHFinderDirect::h_base_file_name     = "Kerr-tiny.h"

AHFinderDirect::N_horizons = 1
AHFinderDirect::origin_x[1] = 0.5
AHFinderDirect::origin_y[1] = 0.7
AHFinderDirect::origin_z[1] = 0.0

AHFinderDirect::initial_guess_method[1] = "coordinate sphere"
AHFinderDirect::initial_guess__coord_sphere__x_center[1] = -0.2
AHFinderDirect::initial_guess__coord_sphere__y_center[1] =  0.3
AHFinderDirect::initial_guess__coord_sphere__z_center[1] =  0.0
AHFinderDirect::initial_guess__coord_sphere__radius[1] = 2.0
\end{verbatim}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Surfaces of Constant Expansion}

Surfaces of Constant Expansion (CE surfaces) are introduced in
\cite{AHFinderDirect/Schnetter03a} as a generalisation of
apparent horizons (AH).  On an AH surface, the expansion is zero
everywhere.  On a CE surfaces, the expansion is still everywhere the
same, but it need not be zero.  CE surfaces are also a generalisation
of Constant Mean Curvature surfaces (CMC surfaces); both are identical
when the extrinsic curvature vanishes.  As described in
\cite{AHFinderDirect/Schnetter03a}, it is likely that CE
surfaces foliate the spacelike hypersurface outside of some interior
region.  This interior region is inside the common apparent horizon,
if it exists.

CE surfaces can give some insight into the spacetime, because they can
be used to analyse the part of the spacelike hypersurface ``between
the horizons and infinity''.  Most notably, they can be used to look
at the region where a common horizon is about to (or believed to)
form.  Similarly, one can use them for collapsing stars where an
apparent horizon has not yet formed.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Pretracking}

Apparent horizon pretracking is introduced in
\cite{AHFinderDirect/Schnetter03a}.  This is an application
of CE surfaces.  Even when there is no common horizon, there are still
common CE surfaces surrounding multiple black holes.  Pretracking
consists of tracking in time the smallest common CE surface that can
be found.  It is reasonable to believe that this surface will evolve
into the common horizon at the time where this common horizon begins
to exist.  The expansion of this smallest CE surface is also an
indication of how close the spacelike hypersurface is to having a
common apparent horizon.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{How \thorn{AHFinderDirect} Works}
\label{AHFinderDirect/sect-how-ahfinderdirect-works}

\thorn{AHFinderDirect} uses the apparent horizon
(henceforth \defn{horizon}) finding algorithm of
\cite{AHFinderDirect/Thornburg95},
modified slightly to work with $g_\ij$ and $K_\ij$ on a Cartesian ($xyz$)
grid.  The algorithm is described in detail in
\cite{AHFinderDirect/Thornburg2003:AH-finding}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{General Description of the Algorithm}

As described above, I parameterizes the horizon shape by
$r = h(\text{angle})$ for some single-value function $h: S^2 \to \Re^+$.
The apparent horizon equation~\eqref{AHFinderDirect/eqn-horizon}
then becomes a 2-D elliptic PDE on $S^2$ for the function $h$.  I finite
difference this in angle to obtain a system of simultaneous nonlinear
algebraic equations for $h$ at the angular grid points, and solve this
system of equations by a global Newton's method (or a variant with
improved convergence).

Computationally, this algorithm has 3 main parts:
\begin{itemize}
\item	Computation of the ``horizon function'' $\Theta(h)$ given a trial
	surface defined by a trial horizon shape function $h$.  This is
	done by interpolating the Cactus geometry fields $g_\ij$ and
	$K_\ij$ (and optionally $\psi$) from the 3-D $xyz$ grid to the
	(2-D set of) trial-horizon-surface grid points (also computing
	$\partial_k g_\ij$ in the interpolation process), then doing
	all further computations with angular grid functions defined
	solely on $S^2$ (\ie{} at the horizon-surface grid points).
\item	Computation of the Jacobian matrix $\Jac[\Theta(h)]$ of $\Theta(h)$.
	This thorn incorporates the \defn{symbolic differentiation} technique
	described in \cite{AHFinderDirect/Thornburg95},
	so this computation is quite fast.  The Jacobian is a highly
	sparse matrix; \thorn{AHFinderDirect} has code to store it
	as either a dense matrix (for debugging purposes), or a sparse
	matrix (the default).  Which option is used is determined by
	a compile-time configuration in \verb|src/include/config.h|.
\item	Solving the nonlinear equations $\Theta(h) = 0$ by a global
	Newton's method or a variant.  How this is done depends on how
	the Jacobian is stored.  At present,
	\begin{itemize}
	\item	If \thorn{AHFinderDirect} is configured to store the
		Jacobian as a dense matrix, then LAPACK is used to solve
		the linear equations.
	\item	If \thorn{AHFinderDirect} is configured to store the
		Jacobian as a sparse matrix, then an
		incomplete-$\sf LU$-decomposition--conjugate-gradient
		solver is used.
	\end{itemize}
	By default only the sparse-matrix code is configured, so LAPACK
	isn't used and there's no need to link with the LAPACK library.
\end{itemize}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{The Multipatch System}
\label{AHFinderDirect/sect-multipatch-system}

Perhaps the most unusual feature of \thorn{AHFinderDirect} is the
``multipatch'' system used to cover $S^2$ without coordinate singularities.
In general there are 6~patches, one each covering a neighborhood of
the $\pm z$, $\pm x$, and $\pm y$ axes, but this may be reduced in
the presence of suitable symmetries.  For example,
figure~\ref{AHFinderDirect/fig-3patch}
on page~\pageref{AHFinderDirect/fig-3patch} shows a system
of 3~patches covering the $+xyz$~octant of $S^2$.  This would be
suitable for finding an apparent horizon with mirror symmetry about
the (local) $z=0$~plane, and either 90~degree periodic rotation symmetry
about the (local) $z$~axis, or mirror symmetry about each of the (local)
$x$~and $y$~axes.

\begin{figure}[htbp]
\begin{center}
\includegraphics{AEIThorns_AHFinderDirect_3patch}
\end{center}
\caption[Illustration of the Multipatch System]
	{
	This figure shows a multipatch system covering the
	$(+,+,+)$~octant of the unit sphere~$S^2$ with 3~patches.
	The angular resolution is 5~degrees.  Notice that the
	patches overlap by several ``ghost zone'' grid points.
	}
\label{AHFinderDirect/fig-3patch}
\end{figure}

To allow easy angular finite differencing within the patch system,
each patch is extended beyond its nominal extent by a ``ghost zone''%%%
\footnote{%%%
	 Note that this terminology differs somewhat
	 from that used by Cactus in general; Cactus
	 would call these ``patch zones'' or ``symmetry
	 zones''.
	 }%%%
{} (2~grid points wide in figure~\ref{AHFinderDirect/fig-3patch}).
Angular grid function values in the ghost zone can be obtained by
interpatch interpolation%%%
\footnote{%%%
	 Due to the way the patch coordinates are defined,
	 adjacent patches always share a common ``perpendicular''
	 angular coordinate, so only 1-D interpolation
	 is needed here.
	 }%%%
{} or by applying symmetry operations.  Once this is done, then angular
finite differencing within the nominal extent of each patch can proceed
normally, ignoring the patch boundaries.  \thorn{AHFinderDirect} can
be configured at compile time to use either 2nd~order or 4th~order
angular finite differencing (3~point or 5~point angular molecules);
the default is 4th~order (5~point).  This is configured at compile time
in \verb|src/include/config.h|.

By default \thorn{AHFinderDirect} will automagically choose a patch
system type for each apparent horizon searched for, based on the local
coordinate origin and the symmetries implicit in the Cactus grid type.
This generally works well, but if desired you can instead manually
specify the patch system type, the angular resolution, the width of
the ghost zones, etc.  See the \verb|param.ccl| file for details.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\subsection{Other Software Used}

\thorn{AHFinderDirect}'s \verb|src/sparse-matrix/| directory contains
various sparse-matrix libraries, which have their own copyrights and
licensing terms:

The \verb|src/sparse-matrix/umfpack/| directory contains a subset of the
files in UMFPACK version 4.0 (11.Apr.2002).  This code is
copyright~(\copyright)~2002 by Timothy A. Davis, and is subect to the
UMFPACK License:

\begin{verbatim}
Your use or distribution of UMFPACK or any modified version of
UMFPACK implies that you agree to this License.

THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.

Permission is hereby granted to use or copy this program, provided
that the Copyright, this License, and the Availability of the original
version is retained on all copies.  User documentation of any code that
uses UMFPACK or any modified version of UMFPACK code must cite the
Copyright, this License, the Availability note, and "Used by permission."
Permission to modify the code and to distribute modified code is granted,
provided the Copyright, this License, and the Availability note are
retained, and a notice that the code was modified is included.  This
software was developed with support from the National Science Foundation,
and is provided to you free of charge.
\end{verbatim}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Other Related Thorns}

If you're interested in \thorn{AHFinderDirect}, you might also be
interested in some other related thorns:

\begin{description}
\item[\thorn{EHFinder}] (in the \arrangement{AEIDevelopment} arrangement)
	was written by Peter Diener, and finds the {\em event\/} horizon(s)
	in a numerically computed spacetime.  It's described in detail in
	the paper~\cite{AHFinderDirect/Diener03a}.
\item[\thorn{AHFinder}] (in the \arrangement{CactusEinstein} arrangement)
	was written by Miguel Alcubierre, and includes two different
	algorithms for finding apparent horizons, a minimization method
	and a ``fast flow'' method based on \cite{AHFinderDirect/Gundlach97a}.
	Unfortunately, both methods are very slow in practice.
\item[\thorn{TGRapparentHorizon2D}] (in the \arrangement{TAT} arrangement)
	was written by Erik Schnetter, and is another apparent horizon
	finder.  It uses methods very similar to this thorn, and (like
	this thorn) is very fast and accurate.  However, it's no longer
	under active development.  It's described in detail in the
	papers~\cite{AHFinderDirect/Schnetter02a}
	and~\cite{AHFinderDirect/Schnetter03a}.
\item[\thorn{AHFinderDirect} (\cvsplace{Erik} branch)]
      (in the \arrangement{AEIThorns} arrangement)\\
	Erik Schnetter has added a number of new features to
	\thorn{AHFinderDirect} on a CVS branch with the tag \cvsplace{Erik},
	including horizon pretracking (to locate places where horizons
	are about to form), and the ability to find constant-expansion
	and constant-mean-curvature surfaces specified by their areal radius.
	We hope to integrate these into the main \thorn{AHFinderDirect}
	branch during the summer of 2004.
\end{description}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\section{Acknowledgments}

I thank Peter Diener, Ian Hawke, and Erik Schnetter for many valuable
conversations.  I think Thomas Radke for his work on the new interpolators.
I thank the whole Cactus crew for a great infrastructure!

Erik Schnetter originally implemented a number of improvements to
this thorn, notably the \thorn{SphericalSurface} interface and the
new features in the \cvsplace{Erik} branch.

I thank the Alexander von Humboldt foundation and the AEI visitors'
and postdoctoral fellowships programs for financial support.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% make LaTeX read in AHFinderDirect.bbl produced by bibtex
\bibliography{AHFinderDirect}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference answer:
src_code: // test_array.cc -- test driver for array.hh classes
// $Header$

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

#include "stdc.h"
#include "util.hh"
#include "array.hh"

using jtutil::fuzzy;
using jtutil::array1d;
using jtutil::array2d;
using jtutil::array3d;
#ifdef NOT_USED
using jtutil::array4d;
#endif

//
// prototypes for non-class functions defined in this file
//
double test_array1d_double(bool fancy_storage, bool print_flag);
double test_array2d_float(bool fancy_storage, bool print_flag);
double test_array3d_double(bool fancy_storage, bool print_flag);
#ifdef NOT_USED
double test_array4d_double(bool fancy_storage, bool print_flag);
#endif

//******************************************************************************

//
// Usage:
//	test_array  [ print ]
// If an argument is supplied (it doesn't matter what it is), then
// the array indices will be printed as they're tested.
//
int main(int argc, const char* const argv[])
{
const bool print_flag = (argc > 1);

double sum_RMS_diff = 0.0;

sum_RMS_diff += test_array1d_double(false, print_flag);
sum_RMS_diff += test_array1d_double(true,  print_flag);

sum_RMS_diff += test_array2d_float(false, print_flag);
sum_RMS_diff += test_array2d_float(true,  print_flag);

sum_RMS_diff += test_array3d_double(false, print_flag);
sum_RMS_diff += test_array3d_double(true,  print_flag);

#ifdef NOT_USED
sum_RMS_diff += test_array4d_double(false, print_flag);
sum_RMS_diff += test_array4d_double(true,  print_flag);
#endif

printf("\n");
printf("grand total RMS_diff = %g\n", sum_RMS_diff);
if (sum_RMS_diff == 0)
   then {
	printf("==> all ok!\n");
	return 0;
	}
   else {
	printf("==> ***** test(s) failed *****\n");
	return 1;
	}
}

//******************************************************************************

//
// This function tests the  array1d<double>  class.  It returns the
// "RMS difference" error measure (should be 0.0 if all is working ok).
//
double test_array1d_double(bool fancy_storage, bool print_flag)
{
const int min_i = 11;		const int max_i = 13;
const double delta = 1.0/7.0;
const double change_value = 144.025036146;

double *array;
array1d<double> *Aptr;
int stride;

// create the array
printf("\n");
printf("testing array1d<double>");
if (fancy_storage)
   then {
	printf(" with noncontiguous non-owned storage array...\n");
	const int N_i = jtutil::how_many_in_range(min_i, max_i);
	stride = 4;
	const int N = N_i*stride;
	printf(
   "allocating %d * stride=%d = %d underlying storage array...\n",
	       N_i, stride, N);
	array = new double[N];
	printf("constructing...\n");
	Aptr = new array1d<double>(min_i, max_i,
				   array,
				   stride);
	}
   else {
	printf(" with its own storage array...\n");
	Aptr = new array1d<double>(min_i, max_i);
	stride = 1;
	}
array1d<double>& A = *Aptr;

assert(A.min_i() == min_i);	assert(A.max_i() == max_i);
assert(A.N_i() == jtutil::how_many_in_range(min_i, max_i));

printf("assigning values...\n");
#define VALUE_1D(ix)	\
		double(1000.0 + ix + delta)
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	if (print_flag)
	   then printf("   assigning %d\n", i);
	A(i) = VALUE_1D(i);
	}
	  }

printf("checking N-D vs 1-D addresses...\n");
const double* array_ptr = A.data_array();
int sub = 0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	if (print_flag)
	   then printf("   checking %d\n", i);
	assert( &A(i) == &array_ptr[sub] );
	sub += stride;
	}
	  }
assert( A.N_array() == sub );
assert( A.subscript_stride_i() == &A(min_i+1) - &A(min_i) );

printf("checking what changes when we assign an array element...\n");
double sumsq_of_diff = 0.0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	if (print_flag)
	   then printf("   changing %d\n", i);
	double save_a = A(i);
	A(i) = change_value;

		for (int ii = min_i ; ii <= max_i ; ++ii)
		{
		if (print_flag)
		   then printf("      checking %d\n", ii);

		double should_be = (ii == i)
				   ? change_value : VALUE_1D(ii);
		assert( fuzzy<double>::EQ(A(ii), should_be) );

		double diff = A(ii) - should_be;
		sumsq_of_diff += diff*diff;
		}
	A(i) = save_a;
	}
	  }
double RMS_diff = sqrt(sumsq_of_diff / A.N_array());
printf("==> everything looks ok (RMS_diff=%.3g)\n", double(RMS_diff));

delete Aptr;

if (fancy_storage)
   then {
	printf("deleting underlying storage array...\n");
	delete[] array;
	}

return RMS_diff;
}

//******************************************************************************

//
// This function tests the  array2d<float>  class.  It returns the
// "RMS difference" error measure (should be 0.0 if all is working ok).
//
double test_array2d_float(bool fancy_storage, bool print_flag)
{
const int min_i = 11;		const int max_i = 13;
const int min_j = 21;		const int max_j = 24;
const float delta = 1.0/7.0;
const float change_value = 144.025036146;

float *array;
array2d<float> *Aptr;
int stride;

// create the array
printf("\n");
printf("testing array2d<float>");
if (fancy_storage)
   then {
	printf(" with noncontiguous non-owned storage array...\n");
	const int N_i = jtutil::how_many_in_range(min_i, max_i);
	const int N_j = jtutil::how_many_in_range(min_j, max_j);
	stride = 3;
	const int N = N_i*N_j*stride;
	printf(
   "allocating %d*%d * stride=%d = %d underlying storage array...\n",
	       N_i,N_j, stride, N);
	array = new float[N];
	printf("constructing...\n");
	Aptr = new array2d<float>(min_i, max_i,
				  min_j, max_j,
				  array,
				  N_j*stride, stride);
	}
   else {
	printf(" with its own storage array...\n");
	Aptr = new array2d<float>(min_i, max_i,
				  min_j, max_j);
	stride = 1;
	}
array2d<float>& A = *Aptr;

assert(A.min_i() == min_i);	assert(A.max_i() == max_i);
assert(A.min_j() == min_j);	assert(A.max_j() == max_j);
assert(A.N_i() == jtutil::how_many_in_range(min_i, max_i));
assert(A.N_j() == jtutil::how_many_in_range(min_j, max_j));

printf("assigning values...\n");
#define VALUE_2D(ix,jx)	\
		float(1000.0 + 10.0*jx + ix + delta)
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	if (print_flag)
	   then printf("   assigning %d %d\n", i, j);
	A(i,j) = VALUE_2D(i,j);
	}
	}
	  }

printf("checking N-D vs 1-D addresses...\n");
const float* array_ptr = A.data_array();
int sub = 0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	if (print_flag)
	   then printf("   checking %d %d\n", i, j);
	assert( &A(i,j) == &array_ptr[sub] );
	sub += stride;
	}
	}
	  }
assert( A.N_array() == sub );
assert( A.subscript_stride_i() == &A(min_i+1,min_j) - &A(min_i,min_j) );
assert( A.subscript_stride_j() == &A(min_i,min_j+1) - &A(min_i,min_j) );

printf("checking what changes when we assign an array element...\n");
double sumsq_of_diff = 0.0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	if (print_flag)
	   then printf("   changing %d %d\n", i, j);
	float save_a = A(i,j);
	A(i,j) = change_value;

		for (int ii = min_i ; ii <= max_i ; ++ii)
		{
		for (int jj = min_j ; jj <= max_j ; ++jj)
		{
		if (print_flag)
		   then printf("      checking %d %d\n", ii, jj);

		float should_be = ((ii == i) && (jj == j))
				  ? change_value : VALUE_2D(ii,jj);
		assert( fuzzy<float>::EQ(A(ii,jj), should_be) );

		double diff = A(ii,jj) - should_be;
		sumsq_of_diff += diff*diff;
		}
		}
	A(i,j) = save_a;
	}
	}
	  }
double RMS_diff = sqrt(sumsq_of_diff / A.N_array());
printf("==> everything looks ok (RMS_diff=%.3g)\n", double(RMS_diff));

delete Aptr;

if (fancy_storage)
   then {
	printf("deleting underlying storage array...\n");
	delete[] array;
	}

return RMS_diff;
}

//******************************************************************************

//
// This function tests the  array3d<double>  class.
//
double test_array3d_double(bool fancy_storage, bool print_flag)
{
const int min_i = 11;		const int max_i = 13;
const int min_j = 21;		const int max_j = 24;
const int min_k = 31;		const int max_k = 35;
const double delta = 1.0/7.0;
const double change_value = 144.025036146;

double *array;
array3d<double> *Aptr;
int stride;

// create the array
printf("\n");
printf("testing array3d<double>");
if (fancy_storage)
   then {
	printf(" with noncontiguous non-owned storage array...\n");
	const int N_i = jtutil::how_many_in_range(min_i, max_i);
	const int N_j = jtutil::how_many_in_range(min_j, max_j);
	const int N_k = jtutil::how_many_in_range(min_k, max_k);
	stride = 4;
	const int N = N_i*N_j*N_k*stride;
	printf(
   "allocating %d*%d*%d * stride=%d = %d   underlying storage array...\n",
	       N_i,N_j,N_k, stride, N);
	array = new double[N];
	printf("constructing...\n");
	Aptr = new array3d<double>(min_i, max_i,
				   min_j, max_j,
				   min_k, max_k,
				   array,
				   N_j*N_k*stride,N_k*stride, stride);
	}
   else {
	printf(" with its own storage array...\n");
	Aptr = new array3d<double>(min_i, max_i,
				   min_j, max_j,
				   min_k, max_k);
	stride = 1;
	}
array3d<double>& A = *Aptr;

assert(A.min_i() == min_i);	assert(A.max_i() == max_i);
assert(A.min_j() == min_j);	assert(A.max_j() == max_j);
assert(A.min_k() == min_k);	assert(A.max_k() == max_k);
assert(A.N_i() == jtutil::how_many_in_range(min_i, max_i));
assert(A.N_j() == jtutil::how_many_in_range(min_j, max_j));
assert(A.N_k() == jtutil::how_many_in_range(min_k, max_k));

printf("assigning values...\n");
#define VALUE_3D(ix,jx,kx)	\
		double(1000.0 + 100.0*kx + 10.0*jx + ix + delta)
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	if (print_flag)
	   then printf("   assigning %d %d %d\n", i, j, k);
	A(i,j,k) = VALUE_3D(i,j,k);
	}
	}
	}
	  }

printf("checking N-D vs 1-D addresses...\n");
const double* array_ptr = A.data_array();
int sub = 0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	if (print_flag)
	   then printf("   checking %d %d %d\n", i, j, k);
	assert( &A(i,j,k) == &array_ptr[sub] );
	sub += stride;
	}
	}
	}
	  }
assert(sub == A.N_array());
assert( A.subscript_stride_i()
	== &A(min_i+1,min_j,min_k) - &A(min_i,min_j,min_k) );
assert( A.subscript_stride_j()
	== &A(min_i,min_j+1,min_k) - &A(min_i,min_j,min_k) );
assert( A.subscript_stride_k()
	== &A(min_i,min_j,min_k+1) - &A(min_i,min_j,min_k) );

printf("checking which things change when we assign an array element...\n");
double sumsq_of_diff = 0.0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	if (print_flag)
	   then printf("   changing %d %d %d\n", i, j, k);
	double save_a = A(i,j,k);
	A(i,j,k) = change_value;

		for (int ii = min_i ; ii <= max_i ; ++ii)
		{
		for (int jj = min_j ; jj <= max_j ; ++jj)
		{
		for (int kk = min_k ; kk <= max_k ; ++kk)
		{
		if (print_flag)
		   then printf("      checking %d %d %d\n", ii, jj, kk);

		double should_be = ((ii == i) && (jj == j) && (kk == k))
				   ? change_value : VALUE_3D(ii,jj,kk);
		assert( fuzzy<double>::EQ(A(ii,jj,kk), should_be) );

		double diff = A(ii,jj,kk) - should_be;
		sumsq_of_diff += diff*diff;
		}
		}
		}
	A(i,j,k) = save_a;
	}
	}
	}
	  }
double RMS_diff = sqrt(sumsq_of_diff / A.N_array());
printf("==> everything looks ok (RMS_diff=%.3g)\n", RMS_diff);

if (fancy_storage)
   then {
	printf("deleting underlying storage array...\n");
	delete[] array;
	}

return RMS_diff;
}

//******************************************************************************

#ifdef NOT_USED
//
// This function tests the  array4d<double>  class.
//
double test_array4d_double(bool fancy_storage, bool print_flag)
{
const int min_i = 11;		const int max_i = 13;
const int min_j = 21;		const int max_j = 24;
const int min_k = 31;		const int max_k = 35;
const int min_l = 41;		const int max_l = 46;
const double delta = 1.0/7.0;
const double change_value = 144.025036146;

double *array;
array4d<double> *Aptr;
int stride;

// create the array
printf("\n");
printf("testing array4d<double>");
if (fancy_storage)
   then {
	printf(" with noncontiguous non-owned storage array...\n");
	const int N_i = jtutil::how_many_in_range(min_i, max_i);
	const int N_j = jtutil::how_many_in_range(min_j, max_j);
	const int N_k = jtutil::how_many_in_range(min_k, max_k);
	const int N_l = jtutil::how_many_in_range(min_l, max_l);
	stride = 3;
	const int N = N_i*N_j*N_k*N_l*stride;
	printf(
   "allocating %d*%d*%d*%d * stride=%d = %d   underlying storage array...\n",
	       N_i,N_j,N_k,N_l, stride, N);
	array = new double[N];
	printf("constructing...\n");
	Aptr = new array4d<double>(min_i, max_i,
				   min_j, max_j,
				   min_k, max_k,
				   min_l, max_l,
				   array,
				   N_j*N_k*N_l*stride, N_k*N_l*stride,
				   N_l*stride, stride);
	}
   else {
	printf(" with its own storage array...\n");
	Aptr = new array4d<double>(min_i, max_i,
				   min_j, max_j,
				   min_k, max_k,
				   min_l, max_l);
	stride = 1;
	}
array4d<double>& A = *Aptr;

assert(A.min_i() == min_i);	assert(A.max_i() == max_i);
assert(A.min_j() == min_j);	assert(A.max_j() == max_j);
assert(A.min_k() == min_k);	assert(A.max_k() == max_k);
assert(A.min_l() == min_l);	assert(A.max_l() == max_l);
assert(A.N_i() == jtutil::how_many_in_range(min_i, max_i));
assert(A.N_j() == jtutil::how_many_in_range(min_j, max_j));
assert(A.N_k() == jtutil::how_many_in_range(min_k, max_k));
assert(A.N_l() == jtutil::how_many_in_range(min_l, max_l));

printf("assigning values...\n");
#define VALUE_4D(ix,jx,kx,lx)	\
		double(10000.0 + 1000.0*kx + 100.0*jx + 10.0*ix + lx + delta)
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	for (int l = min_l ; l <= max_l ; ++l)
	{
	if (print_flag)
	   then printf("   assigning %d %d %d %d\n", i, j, k, l);
	A(i,j,k,l) = VALUE_4D(i,j,k,l);
	}
	}
	}
	}
	  }

printf("checking N-D vs 1-D addresses...\n");
const double* array_ptr = A.data_array();
int sub = 0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	for (int l = min_l ; l <= max_l ; ++l)
	{
	if (print_flag)
	   then printf("   checking %d %d %d %d\n", i, j, k, l);
	assert( &A(i,j,k,l) == &array_ptr[sub] );
	sub += stride;
	}
	}
	}
	}
	  }
assert(sub == A.N_array());
assert( A.subscript_stride_i()
	== &A(min_i+1,min_j,min_k,min_l) - &A(min_i,min_j,min_k,min_l) );
assert( A.subscript_stride_j()
	== &A(min_i,min_j+1,min_k,min_l) - &A(min_i,min_j,min_k,min_l) );
assert( A.subscript_stride_k()
	== &A(min_i,min_j,min_k+1,min_l) - &A(min_i,min_j,min_k,min_l) );
assert( A.subscript_stride_l()
	== &A(min_i,min_j,min_k,min_l+1) - &A(min_i,min_j,min_k,min_l) );

printf("checking which things change when we assign an array element...\n");
double sumsq_of_diff = 0.0;
	  {
	for (int i = min_i ; i <= max_i ; ++i)
	{
	for (int j = min_j ; j <= max_j ; ++j)
	{
	for (int k = min_k ; k <= max_k ; ++k)
	{
	for (int l = min_l ; l <= max_l ; ++l)
	{
	if (print_flag)
	   then printf("   changing %d %d %d %d\n", i, j, k, l);
	double save_a = A(i,j,k,l);
	A(i,j,k,l) = change_value;

		for (int ii = min_i ; ii <= max_i ; ++ii)
		{
		for (int jj = min_j ; jj <= max_j ; ++jj)
		{
		for (int kk = min_k ; kk <= max_k ; ++kk)
		{
		for (int ll = min_l ; ll <= max_l ; ++ll)
		{
		if (print_flag)
		   then printf("      checking %d %d %d %d\n", ii, jj, kk, ll);

		double should_be = ((ii == i) && (jj == j)
				     && (kk == k) && (ll == l))
				   ? change_value : VALUE_4D(ii,jj,kk,ll);
		assert( fuzzy<double>::EQ(A(ii,jj,kk,ll), should_be) );

		double diff = A(ii,jj,kk,ll) - should_be;
		sumsq_of_diff += diff*diff;
		}
		}
		}
		}
	A(i,j,k,l) = save_a;
	}
	}
	}
	}
	  }
double RMS_diff = sqrt(sumsq_of_diff / A.N_array());
printf("==> everything looks ok (RMS_diff=%.3g)\n", RMS_diff);

if (fancy_storage)
   then {
	printf("deleting underlying storage array...\n");
	delete[] array;
	}

return RMS_diff;
}
#endif	/* NOT_USED */