Task: Implement gr/Schwarzschild_EF.cc for EinsteinAnalysis/AHFinderDirect thorn

thorn_name: EinsteinAnalysis/AHFinderDirect
src_filename: gr/Schwarzschild_EF.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: 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/test_array.cc:
```
// 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 */

```

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;

```

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

```

driver/horizon_sequence.cc:
```
// horizon_sequence.cc -- describes sequence of horizons a processor works on
// $Header$

//
// horizon_sequence::horizon_sequence
// horizon_sequence::~horizon_sequence
// horizon_sequence::sequence_string
// horizon_sequence::append_hn
// horizon_sequence::next_posn
// horizon_sequence::is_hn_genuine
//

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

#include "util_String.h"
#include "../include/stdc.h"
#include "../jtutil/util.hh"

#include "horizon_sequence.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// This function constructs an horizon sequence, which can hold a maximum
// of N_horizons horizon numbers.
//
horizon_sequence::horizon_sequence(int N_horizons_in)
	: N_horizons_(N_horizons_in),
	  my_N_horizons_(0),		// sequence starts out empty
	  posn_(-1),
	  my_hn_(new int[N_horizons_in])
{ }

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

//
// This function destroys a horizon sequence.
//
horizon_sequence::~horizon_sequence()
{
delete[] my_hn_;
}

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

//
// This function returns a (pointer to a) C-style string showing all
// the horizon numbers in the sequence, separated by the C-style string
//  sep , eg. "2,3,5".
//
// Note the result points into a private static buffer.
//
char* horizon_sequence::sequence_string(const char sep[]) const
{
const int N_hn_buffer = 10;
char hn_buffer[N_hn_buffer];

const int N_buffer = 100;
static char buffer[N_buffer];

buffer[0] = '\0';
	for (int pos = 0 ; pos < my_N_horizons_ ; ++pos)
	{
	if (pos > 0)
	   then Util_Strlcat(buffer, sep, N_buffer);
	snprintf(hn_buffer, N_hn_buffer, "%d", my_hn_[pos]);
	Util_Strlcat(buffer, hn_buffer, N_buffer);
	}

return buffer;
}

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

//
// This function appends  hn  to the sequence.  It returns the new value
// of my_N_horizons().
//
int horizon_sequence::append_hn(int hn)
{
assert( hn > 0 );			// can only append genuine horizons
assert( my_N_horizons_ < N_horizons_ );	// make sure there's space for it
my_hn_[my_N_horizons_++] = hn;
posn_ = 0;
return my_N_horizons_;
}

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

//
// This function computes the internal position immediately following
// a given internal position in the sequence.
//
// Arguments:
// p = (in) The current internal position, with posn_ semantics
//
// Results:
// This function returns the next internal position after p.
//
int horizon_sequence::next_posn(int pos)
	const
{
return   (pos < 0) ? pos-1
       : (pos+1 < my_N_horizons_) ? pos+1
       : -1;
}

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

//
// This function determines whether or not a given  hn  is genuine.
//
bool horizon_sequence::is_hn_genuine(int hn)
	const
{
	for (int pos = 0 ; pos < my_N_horizons_ ; ++pos)
	{
	if (my_hn_[pos] == hn)
	   then return true;
	}

return false;
}

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

	  }	// namespace AHFinderDirect

```

driver/announce.cc:
```
// announce.cc -- annnounce apparent horizon info to other thorns
// $Header$
//
// <<<access to persistent data>>>
// AHFinderDirect_announce - top-level driver for announce stuff
//

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

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// This function is called by the Cactus scheduler, to announce any
// desired apparent horizon info to any other thorns that may be interested.
// At present the only info we announce is the centroid position of a
// single selected apparent horizon; if the SetAHCentroid() aliased
// function has been defined then we announce by calling that.
//
extern "C"
  void AHFinderDirect_announce(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

const struct verbose_info& verbose_info = state.verbose_info;

// which horizon to announce?
const int hn = which_horizon_to_announce_centroid;
if (hn == 0)
   then return;						// *** NO-OP RETURN ***

if (! ((hn >= 1) && (hn <= N_horizons)) )
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   AHFinderDirect_announce():\n"
"        invalid horizon number %d to announce\n"
"        (valid range is [1,N_horizons=%d])!\n"
		   ,
		   hn, int(N_horizons));			/*NOTREACHED*/

assert(state.AH_data_array[hn] != NULL);
const struct AH_data& AH_data = *state.AH_data_array[hn];

// only try to announce AH info if we've found AHs at this time level
if (! AH_data.search_flag)
   then return;						// *** NO-OP RETURN ***

// did we actually *find* this horizon?
if (! AH_data.found_flag)
   then return;						// *** NO-OP RETURN ***

// is there anyone to announce it to?
if (CCTK_IsFunctionAliased("SetDriftCorrectPosition"))
   then {
	const struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;
	const CCTK_REAL xx = BH_diagnostics.centroid_x;
	const CCTK_REAL yy = BH_diagnostics.centroid_y;
	const CCTK_REAL zz = BH_diagnostics.centroid_z;
	if (verbose_info.print_physics_details)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "horizon %d centroid (%g,%g,%g) --> DriftCorrect",
			   hn, double(xx), double(yy), double(zz));
	SetDriftCorrectPosition(cctkGH, xx, yy, zz);
	}
}

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

//
// This function is called by the Cactus scheduler, to copy any
// desired apparent horizon info to Cactus variables.
//
extern "C"
  void AHFinderDirect_store(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

for (int hn = 1; hn <= N_horizons; ++ hn)
  {

  // Store in spherical surface
  const int sn = sf_IdFromName(which_surface_to_store_info[hn], 
                               which_surface_to_store_info_by_name[hn]);
  if (sn == -1)
    then continue;

  if (sn < 0 || sn >= nsurfaces)
    then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   AHFinderDirect_store():\n"
"        invalid surface number %d for horizon number %d\n"
"        (valid range is [0,nsurfaces-1=%d])!\n"
		   ,
		   sn, hn,
                   int(nsurfaces-1));			/*NOTREACHED*/
  
  const struct AH_data& AH_data = *state.AH_data_array[hn];
  const struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;
  BH_diagnostics.store(cctkGH, hn, sn);

  }
}

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

//
// This function is called by the Cactus scheduler, to copy any
// desired apparent horizon info to Cactus variables.
//
extern "C"
  void AHFinderDirect_save(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

for (int hn = 1; hn <= N_horizons; ++ hn)
  {

  const struct AH_data& AH_data = *state.AH_data_array[hn];
  const struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;

  // Save in grid array
  BH_diagnostics.save(cctkGH, hn);

  }
}

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

//
// This function is called by the Cactus scheduler, to copy any
// desired apparent horizon info from Cactus variables.
//
extern "C"
  void AHFinderDirect_recover(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

for (int hn = 1; hn <= N_horizons; ++ hn)
  {

  struct AH_data& AH_data = *state.AH_data_array[hn];
  struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;

  // Load from grid array
  BH_diagnostics.load(cctkGH, hn);

  }
}

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

	  }	// namespace AHFinderDirect

```

driver/state.cc:
```
// state.cc -- persistent state information (data) for this thorn
// $Header$

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

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// The following data persists across Cactus scheduler calls.
// The top-level drivers all share it.
//
struct state state;

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

	  }	// namespace AHFinderDirect

```

driver/misc-driver.cc:
```
// misc-driver.cc -- misc support routines
// $Header$
//
// Cactus_gridfn_varindex - get Cactus gridfn variable index
//

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

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// This function gets the Cactus variable index of a given gridfn, and
// checks to make sure this is valid (i.e. that it's not an error code).
//
int Cactus_gridfn_varindex(const char gridfn_name[])
{
const int varindex = CCTK_VarIndex(gridfn_name);
if (varindex < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   Cactus_gridfn_varindex(): error return from CCTK_VarIndex()\n"
"                             for Cactus gridfn!\n"
"                             name=\"%s\" status=%d"
		   ,
		   gridfn_name, varindex);			/*NOTREACHED*/

return varindex;
}

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

	  }	// namespace AHFinderDirect

```

driver/setup.cc:
```
// setup.cc -- top level driver to setup our persistent data structures
// $Header$
//
// <<<prototypes for functions local to this file>>>
// <<<access to persistent data>>>
//
// AHFinderDirect_setup - top-level driver to setup persistent data structures
///
/// decode_method - decode the  method  parameter
/// decode_verbose_level - decode the  verbose_level  parameter
///
/// allocate_horizons_to_processor - choose which horizons this proc will find
///
/// choose_patch_system_type - choose patch system type
///

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

#include <vector>

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

#include "SpaceMask.h"			// from thorn SpaceMask

#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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** prototypes for functions local to this file *****
//

namespace {
enum method
  decode_method(const char method_string[]);
enum verbose_level
  decode_verbose_level(const char verbose_level_string[]);

int allocate_horizons_to_processor(int N_procs, int my_proc,
				   int N_horizons, bool multiproc_flag,
                                   const CCTK_INT depends_on[],
				   horizon_sequence& my_hs,
				   const struct verbose_info& verbose_info);

enum patch_system::patch_system_type
  choose_patch_system_type(const char grid_domain[],
			   const char grid_bitant_plane[],
			   const char grid_quadrant_direction[],
			   const char grid_rotation_axis[],
			   fp origin_x, fp origin_y, fp origin_z);
	  }

void set_initial_guess_parameters(struct AH_data& AH_data, const int hn,
                                  const fp ini_origin_x, const fp ini_origin_y, const fp ini_origin_z);





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

//
// This function is used to setup initial guesses either from 
// the corresponding parameters, or from a custom ini_origin_*.
// The latter is necessary when tracking with a grid scalar.
//
//

void set_initial_guess_parameters(struct AH_data& AH_data, const int hn,
                                  const fp ini_origin_x, const fp ini_origin_y, const fp ini_origin_z)
{
DECLARE_CCTK_PARAMETERS;

                AH_data.initial_guess_info.method
			= decode_initial_guess_method(initial_guess_method[hn]);
                AH_data.initial_guess_info.reset_horizon_after_not_finding
                        = reset_horizon_after_not_finding[hn];
		// ... read from named file
		AH_data.initial_guess_info.read_from_named_file_info.file_name
			= initial_guess__read_from_named_file__file_name[hn];

if (!track_origin_from_grid_scalar[hn]) {

		// ... Kerr/Kerr
		AH_data.initial_guess_info.Kerr_Kerr_info.x_posn
			= initial_guess__Kerr_Kerr__x_posn[hn];
		AH_data.initial_guess_info.Kerr_Kerr_info.y_posn
			= initial_guess__Kerr_Kerr__y_posn[hn];
		AH_data.initial_guess_info.Kerr_Kerr_info.z_posn
			= initial_guess__Kerr_Kerr__z_posn[hn];
		AH_data.initial_guess_info.Kerr_Kerr_info.mass
			= initial_guess__Kerr_Kerr__mass[hn];
		AH_data.initial_guess_info.Kerr_Kerr_info.spin
			= initial_guess__Kerr_Kerr__spin[hn];
		// ... Kerr/Kerr-Schild
		AH_data.initial_guess_info.Kerr_KerrSchild_info.x_posn
			= initial_guess__Kerr_KerrSchild__x_posn[hn];
		AH_data.initial_guess_info.Kerr_KerrSchild_info.y_posn
			= initial_guess__Kerr_KerrSchild__y_posn[hn];
		AH_data.initial_guess_info.Kerr_KerrSchild_info.z_posn
			= initial_guess__Kerr_KerrSchild__z_posn[hn];
		AH_data.initial_guess_info.Kerr_KerrSchild_info.mass
			= initial_guess__Kerr_KerrSchild__mass[hn];
		AH_data.initial_guess_info.Kerr_KerrSchild_info.spin
			= initial_guess__Kerr_KerrSchild__spin[hn];
		// ... coordinate sphere
		AH_data.initial_guess_info.coord_sphere_info.x_center
			= initial_guess__coord_sphere__x_center[hn];
		AH_data.initial_guess_info.coord_sphere_info.y_center
			= initial_guess__coord_sphere__y_center[hn];
		AH_data.initial_guess_info.coord_sphere_info.z_center
			= initial_guess__coord_sphere__z_center[hn];
		AH_data.initial_guess_info.coord_sphere_info.radius
			= initial_guess__coord_sphere__radius[hn];
		// ... coordinate ellipsoid
		AH_data.initial_guess_info.coord_ellipsoid_info.x_center
			= initial_guess__coord_ellipsoid__x_center[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.y_center
			= initial_guess__coord_ellipsoid__y_center[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.z_center
			= initial_guess__coord_ellipsoid__z_center[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.x_radius
			= initial_guess__coord_ellipsoid__x_radius[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.y_radius
			= initial_guess__coord_ellipsoid__y_radius[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.z_radius
			= initial_guess__coord_ellipsoid__z_radius[hn];

} else {

		// ... Kerr/Kerr
		AH_data.initial_guess_info.Kerr_Kerr_info.x_posn
			= ini_origin_x;
		AH_data.initial_guess_info.Kerr_Kerr_info.y_posn
			= ini_origin_y;
		AH_data.initial_guess_info.Kerr_Kerr_info.z_posn
			= ini_origin_z;
		AH_data.initial_guess_info.Kerr_Kerr_info.mass
			= initial_guess__Kerr_Kerr__mass[hn];
		AH_data.initial_guess_info.Kerr_Kerr_info.spin
			= initial_guess__Kerr_Kerr__spin[hn];
		// ... Kerr/Kerr-Schild
		AH_data.initial_guess_info.Kerr_KerrSchild_info.x_posn
			= ini_origin_x;
		AH_data.initial_guess_info.Kerr_KerrSchild_info.y_posn
			= ini_origin_y;
		AH_data.initial_guess_info.Kerr_KerrSchild_info.z_posn
			= ini_origin_z;
		AH_data.initial_guess_info.Kerr_KerrSchild_info.mass
			= initial_guess__Kerr_KerrSchild__mass[hn];
		AH_data.initial_guess_info.Kerr_KerrSchild_info.spin
			= initial_guess__Kerr_KerrSchild__spin[hn];
		// ... coordinate sphere
		AH_data.initial_guess_info.coord_sphere_info.x_center
			= ini_origin_x;
		AH_data.initial_guess_info.coord_sphere_info.y_center
			= ini_origin_y;
		AH_data.initial_guess_info.coord_sphere_info.z_center
			= ini_origin_z;
		AH_data.initial_guess_info.coord_sphere_info.radius
			= initial_guess__coord_sphere__radius[hn];
		// ... coordinate ellipsoid
		AH_data.initial_guess_info.coord_ellipsoid_info.x_center
			= ini_origin_x;
		AH_data.initial_guess_info.coord_ellipsoid_info.y_center
			= ini_origin_y;
		AH_data.initial_guess_info.coord_ellipsoid_info.z_center
			= ini_origin_z;
		AH_data.initial_guess_info.coord_ellipsoid_info.x_radius
			= initial_guess__coord_ellipsoid__x_radius[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.y_radius
			= initial_guess__coord_ellipsoid__y_radius[hn];
		AH_data.initial_guess_info.coord_ellipsoid_info.z_radius
			= initial_guess__coord_ellipsoid__z_radius[hn];

}

}

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// This function is called by the Cactus scheduler to set up all our
// persistent data structures.  (These are stored in  struct state .)
//
extern "C"
  void AHFinderDirect_setup(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

CCTK_VInfo(CCTK_THORNSTRING,
	   "setting up AHFinderDirect data structures");


//
// check parameters
//
int need_zones = 0;
for (int n=1; n<N_horizons; ++n) {
  need_zones = jtutil::max(need_zones, int(N_zones_per_right_angle[n]));
}
if (need_zones > max_N_zones_per_right_angle) {
  CCTK_VWarn (FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
              "AHFinderDirect_setup(): "
              "The parameter max_N_zones_per_right_angle must be at least the maximum of all N_zones_per_right_angle[] parameters.  "
              "Set max_N_zones_per_right_angle to %d or higher to continue.",
              need_zones);      /*NOTREACHED*/
 }
for (int n=1; n<N_horizons; ++n) {
  if (depends_on[n] != 0) {
    assert (depends_on[n] >= 1 && depends_on[n] < n);
    if (N_zones_per_right_angle[n] != N_zones_per_right_angle[depends_on[n]]) {
      CCTK_VWarn (FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
                  "AHFinderDirect_setup(): "
                  "The parameter N_zones_per_right_angle must be the same for a horizon as for the horizon on which it depends.  "
                  "Horizon %d depends on horizon %d, but they have different resolutions.",
                  n, int(depends_on[n])); /*NOTREACHED*/
    }
  }
}

bool find_individual_is_set = false;
for (int n = 1 ; n < N_horizons ; ++n)
{
if (find_every_individual[n] > 0)
   then find_individual_is_set = true;
}
if (move_origins && find_individual_is_set)
   then {
	CCTK_VWarn (CCTK_WARN_ALERT, __LINE__, __FILE__, CCTK_THORNSTRING,
"Find_every_individual is currently not compatible with moving origins via the move_origins parameter.  "
"Make sure simultaneous moving horizons are not being calculated at different frequencies." );
	}

//
// basic setup
//
state.method = decode_method(method);

state.error_info.warn_level__point_outside__initial
   = warn_level__point_outside__initial;
state.error_info.warn_level__point_outside__subsequent
   = warn_level__point_outside__subsequent;
state.error_info.warn_level__skipping_finite_check
   = warn_level__skipping_finite_check;
state.error_info.warn_level__nonfinite_geometry
   = warn_level__nonfinite_geometry;
state.error_info.warn_level__gij_not_positive_definite__initial
   = warn_level__gij_not_positive_definite__initial;
state.error_info.warn_level__gij_not_positive_definite__subsequent
   = warn_level__gij_not_positive_definite__subsequent;

struct verbose_info& verbose_info = state.verbose_info;
verbose_info.verbose_level = decode_verbose_level(verbose_level);
verbose_info.print_physics_highlights
   = (state.verbose_info.verbose_level >= verbose_level__physics_highlights);
verbose_info.print_physics_details
   = (state.verbose_info.verbose_level >= verbose_level__physics_details);
verbose_info.print_algorithm_highlights
   = (state.verbose_info.verbose_level >= verbose_level__algorithm_highlights);
verbose_info.print_algorithm_details
   = (state.verbose_info.verbose_level >= verbose_level__algorithm_details);
verbose_info.print_algorithm_debug
   = (state.verbose_info.verbose_level >= verbose_level__algorithm_debug);

state.timer_handle = (print_timing_stats != 0) ? CCTK_TimerCreate("finding apparent horizons") : -1;

state.N_procs = CCTK_nProcs(cctkGH);
state.my_proc = CCTK_MyProc(cctkGH);

state.N_horizons = N_horizons;
state.N_active_procs = 0;	// dummy value, will be set properly later
CCTK_VInfo(CCTK_THORNSTRING,
           "           to search for %d horizon%s on %d processor%s",
	   state.N_horizons, ((state.N_horizons == 1) ? "" : "s"),
	   state.N_procs, ((state.N_procs == 1) ? "" : "s"));


//
// Cactus grid info
//
if (verbose_info.print_algorithm_highlights)
   then CCTK_VInfo(CCTK_THORNSTRING, "   setting up Cactus grid info");
struct cactus_grid_info& cgi = state.cgi;
cgi.GH = cctkGH;
cgi.coord_system_handle = CCTK_CoordSystemHandle(coordinate_system_name);
if (cgi.coord_system_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): can't find Cactus coordinate system \"%s\"!",
		   coordinate_system_name);			/*NOTREACHED*/
cgi.use_Cactus_conformal_metric = false;	// dummy value, may change later

cgi.mask_varindex    = Cactus_gridfn_varindex("AHFinderDirect::ahmask");
cgi.g_dd_11_varindex = Cactus_gridfn_varindex("ADMBase::gxx");
cgi.g_dd_12_varindex = Cactus_gridfn_varindex("ADMBase::gxy");
cgi.g_dd_13_varindex = Cactus_gridfn_varindex("ADMBase::gxz");
cgi.g_dd_22_varindex = Cactus_gridfn_varindex("ADMBase::gyy");
cgi.g_dd_23_varindex = Cactus_gridfn_varindex("ADMBase::gyz");
cgi.g_dd_33_varindex = Cactus_gridfn_varindex("ADMBase::gzz");
cgi.K_dd_11_varindex = Cactus_gridfn_varindex("ADMBase::kxx");
cgi.K_dd_12_varindex = Cactus_gridfn_varindex("ADMBase::kxy");
cgi.K_dd_13_varindex = Cactus_gridfn_varindex("ADMBase::kxz");
cgi.K_dd_22_varindex = Cactus_gridfn_varindex("ADMBase::kyy");
cgi.K_dd_23_varindex = Cactus_gridfn_varindex("ADMBase::kyz");
cgi.K_dd_33_varindex = Cactus_gridfn_varindex("ADMBase::kzz");
cgi.psi_varindex     = Cactus_gridfn_varindex("StaticConformal::psi");


//
// geometry info
//
if (verbose_info.print_algorithm_highlights)
   then CCTK_VInfo(CCTK_THORNSTRING, "   setting up geometry interpolator");
struct geometry_info& gi = state.gi;
gi.hardwire_Schwarzschild_EF_geometry
	= (hardwire_Schwarzschild_EF_geometry != 0);

gi.operator_handle = CCTK_InterpHandle(geometry_interpolator_name);
if (gi.operator_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): couldn't find interpolator \"%s\"!",
		   geometry_interpolator_name);		/*NOTREACHED*/
gi.param_table_handle = Util_TableCreateFromString(geometry_interpolator_pars);
if (gi.param_table_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): bad geometry-interpolator parameter(s) \"%s\"!",
		   geometry_interpolator_pars);		/*NOTREACHED*/

gi.geometry__Schwarzschild_EF__mass     = geometry__Schwarzschild_EF__mass;
gi.geometry__Schwarzschild_EF__x_posn   = geometry__Schwarzschild_EF__x_posn;
gi.geometry__Schwarzschild_EF__y_posn   = geometry__Schwarzschild_EF__y_posn;
gi.geometry__Schwarzschild_EF__z_posn   = geometry__Schwarzschild_EF__z_posn;
gi.geometry__Schwarzschild_EF__epsilon  = geometry__Schwarzschild_EF__epsilon;
gi.geometry__Schwarzschild_EF__Delta_xyz= geometry__Schwarzschild_EF__Delta_xyz;

gi.check_that_h_is_finite        = (check_that_h_is_finite        != 0);
gi.check_that_geometry_is_finite = (check_that_geometry_is_finite != 0);
gi.mask_is_noshrink		 = (mask_is_noshrink != 0);

//
// Jacobian info
//
struct Jacobian_info& Jac_info = state.Jac_info;
Jac_info.Jacobian_compute_method
	= decode_Jacobian_compute_method(Jacobian_compute_method);
Jac_info.Jacobian_store_solve_method
	= decode_Jacobian_store_solve_method(Jacobian_store_solve_method);
Jac_info.perturbation_amplitude = Jacobian_perturbation_amplitude;


//
// solver info
//
struct solver_info& solver_info = state.solver_info;
solver_info.debugging_output_at_each_Newton_iteration
			= (debugging_output_at_each_Newton_iteration != 0);
solver_info.linear_solver_pars.ILUCG_pars.error_tolerance
	= ILUCG__error_tolerance;
solver_info.linear_solver_pars.ILUCG_pars.limit_CG_iterations
	= (ILUCG__limit_CG_iterations != 0);
solver_info.linear_solver_pars.UMFPACK_pars.N_II_iterations
	= UMFPACK__N_II_iterations;
solver_info.max_Newton_iterations__initial
	= max_Newton_iterations__initial;
solver_info.max_Newton_iterations__subsequent
	= max_Newton_iterations__subsequent;
solver_info.max_allowable_Delta_h_over_h = max_allowable_Delta_h_over_h;
solver_info.Theta_norm_for_convergence   = Theta_norm_for_convergence;
solver_info.max_allowable_Theta          = max_allowable_Theta;
solver_info.max_allowable_Theta_growth_iterations
                                       = max_allowable_Theta_growth_iterations;
solver_info.max_allowable_Theta_nonshrink_iterations
                                    = max_allowable_Theta_nonshrink_iterations;
// ... horizon numbers run from 1 to N_horizons inclusive
//     so the array size is N_horizons+1
solver_info.max_allowable_horizon_radius = new fp[state.N_horizons+1];
	  {
	for (int hn = 0 ; hn <= N_horizons ; ++hn)
	{
	solver_info.max_allowable_horizon_radius[hn]
		= max_allowable_horizon_radius[hn];
	}
	  }
solver_info.want_expansion_gradients = want_expansion_gradients;


//
// I/O info
//
struct IO_info& IO_info = state.IO_info;
IO_info.output_ASCII_files = (output_ASCII_files != 0);
IO_info.output_HDF5_files = (output_HDF5_files != 0);
IO_info.output_initial_guess = (output_initial_guess != 0);
IO_info.output_h_every     = output_h_every;
IO_info.output_Theta_every = output_Theta_every;
IO_info.output_mean_curvature_every = output_mean_curvature_every;
IO_info.output_h     = false;	// dummy value
IO_info.output_Theta = false;	// dummy value
IO_info.output_mean_curvature = false;	// dummy value

IO_info.output_BH_diagnostics              = (output_BH_diagnostics != 0);
IO_info.BH_diagnostics_directory
	= (strlen(BH_diagnostics_directory) == 0)
	  ? /* IO:: */ out_dir
	  : BH_diagnostics_directory;
IO_info.BH_diagnostics_base_file_name      = BH_diagnostics_base_file_name;
IO_info.BH_diagnostics_file_name_extension = BH_diagnostics_file_name_extension;

IO_info.output_ghost_zones_for_h  = (output_ghost_zones_for_h != 0);
IO_info.ASCII_gnuplot_file_name_extension = ASCII_gnuplot_file_name_extension;
IO_info.HDF5_file_name_extension          = HDF5_file_name_extension;
IO_info.h_directory
	= (strlen(h_directory) == 0)
	  ? /* IO:: */ out_dir
	  : h_directory;
IO_info.h_base_file_name         = h_base_file_name;
IO_info.Theta_base_file_name     = Theta_base_file_name;
IO_info.mean_curvature_base_file_name     = mean_curvature_base_file_name;
IO_info.Delta_h_base_file_name   = Delta_h_base_file_name;
IO_info.h_min_digits             = h_min_digits;
IO_info.Jacobian_base_file_name  = Jacobian_base_file_name;
IO_info.output_OpenDX_control_files  = (output_OpenDX_control_files != 0);
IO_info.OpenDX_control_file_name_extension = OpenDX_control_file_name_extension;
IO_info.time_iteration = 0;
IO_info.time           = 0.0;


//
// other misc setup
//
state.BH_diagnostics_info.integral_method
   = patch::decode_integration_method(integral_method);


//
// mask parameters
//
struct mask_info& mask_info = state.mask_info;
mask_info.set_mask_for_any_horizon = false;
// ... horizon numbers run from 1 to N_horizons inclusive
//     so the array size is N_horizons+1
mask_info.set_mask_for_this_horizon = new bool[N_horizons+1];
	  {
	for (int hn = 1 ; hn <= N_horizons ; ++hn)
	{
	mask_info.set_mask_for_this_horizon[hn]
		= (set_mask_for_all_horizons != 0)
		  || (set_mask_for_individual_horizon[hn] != 0);
	mask_info.set_mask_for_any_horizon
		|= mask_info.set_mask_for_this_horizon[hn];
	}
	  }
if (mask_info.set_mask_for_any_horizon)
   then {
	mask_info.radius_multiplier  = mask_radius_multiplier;
	mask_info.radius_offset      = mask_radius_offset;
	mask_info.buffer_thickness   = mask_buffer_thickness;
	mask_info.mask_is_noshrink   = mask_is_noshrink;
	mask_info.min_horizon_radius_points_for_mask
				     = min_horizon_radius_points_for_mask;
	mask_info.set_old_style_mask = (set_old_style_mask != 0);
	mask_info.set_new_style_mask = (set_new_style_mask != 0);
	if (mask_info.set_old_style_mask)
	   then {
		struct mask_info::old_style_mask_info& osmi
			= mask_info.old_style_mask_info;
		osmi.gridfn_name     = old_style_mask_gridfn_name;
		osmi.gridfn_varindex = Cactus_gridfn_varindex(osmi.gridfn_name);
		osmi.gridfn_dataptr  = NULL;	// dummy value; fixup later
		osmi.inside_value  = old_style_mask_inside_value;
		osmi.buffer_value  = old_style_mask_buffer_value;
		osmi.outside_value = old_style_mask_outside_value;
		}
	if (mask_info.set_new_style_mask)
	   then {
		struct mask_info::new_style_mask_info& nsmi
			= mask_info.new_style_mask_info;
		nsmi.gridfn_name     = new_style_mask_gridfn_name;
		nsmi.gridfn_varindex = Cactus_gridfn_varindex(nsmi.gridfn_name);
		nsmi.gridfn_dataptr  = NULL;	// dummy value; fixup later
		nsmi.bitfield_name   = new_style_mask_bitfield_name;
		nsmi.bitfield_bitmask = 0;	// dummy value; fixup later
		nsmi.inside_value    = new_style_mask_inside_value;
		nsmi.buffer_value    = new_style_mask_buffer_value;
		nsmi.outside_value   = new_style_mask_outside_value;
		nsmi.inside_bitvalue = 0;	// dummy value; fixup later
		nsmi.buffer_bitvalue = 0;	// dummy value; fixup later
		nsmi.outside_bitvalue = 0;	// dummy value; fixup later
		}
	}


//
// (genuine) horizon sequence for this processor
//
state.my_hs = new horizon_sequence(state.N_horizons);
horizon_sequence& hs = *state.my_hs;

//
// if we're going to actually find horizons
//    we spread the horizons over multiple processors for maximum efficiency,
// otherwise (we're just doing testing/debugging computations, so)
//    we allocate all the horizons to processor #0 for simplicity
//
const bool multiproc_flag = (state.method == method__find_horizons);
state.N_active_procs
   = allocate_horizons_to_processor(state.N_procs, state.my_proc,
				    state.N_horizons, multiproc_flag,
                                    depends_on,
				    hs,
				    verbose_info);

// ... horizon numbers run from 1 to N_horizons inclusive
//     so the array size is N_horizons+1
state.AH_data_array = new AH_data*[N_horizons+1];
	  {
	for (int hn = 0 ; hn <= N_horizons ; ++hn)
	{
	state.AH_data_array[hn] = NULL;
	}
	  }


//
// horizon-specific info for each horizon
//

// set up the interpatch interpolator
if (verbose_info.print_algorithm_highlights)
   then CCTK_VInfo(CCTK_THORNSTRING, "   setting up interpatch interpolator");
const int ip_interp_handle = CCTK_InterpHandle(interpatch_interpolator_name);
if (ip_interp_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): couldn't find interpatch interpolator \"%s\"!",
		   interpatch_interpolator_name);		/*NOTREACHED*/
const int ip_interp_param_table_handle
	= Util_TableCreateFromString(interpatch_interpolator_pars);
if (ip_interp_param_table_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): bad interpatch-interpolator parameter(s) \"%s\"!",
		   interpatch_interpolator_pars);		/*NOTREACHED*/

// set up the surface interpolator if it's going to be used
int surface_interp_handle = -1;
int surface_interp_param_table_handle = -1;
if (strlen(surface_interpolator_name) > 0)
   then {
	if (verbose_info.print_algorithm_highlights)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   setting up surface interpolator");
	surface_interp_handle = CCTK_InterpHandle(surface_interpolator_name);
	if (surface_interp_handle < 0)
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): couldn't find surface interpolator \"%s\"!",
			   surface_interpolator_name);		/*NOTREACHED*/
	surface_interp_param_table_handle
		= Util_TableCreateFromString(surface_interpolator_pars);
	if (surface_interp_param_table_handle < 0)
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_setup(): bad surface-interpolator parameter(s) \"%s\"!",
			   surface_interpolator_pars);		/*NOTREACHED*/
	}

// setup all horizons on this processor,
// with full-fledged patch systems for genuine horizons
// and skeletal patch systems for others
	  {
	for (int hn = 1 ; hn <= hs.N_horizons() ; ++hn)
	{
	const bool genuine_flag = hs.is_hn_genuine(hn);
	state.AH_data_array[hn] = new AH_data;
	struct AH_data& AH_data = *state.AH_data_array[hn];

	if (verbose_info.print_algorithm_highlights)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   setting up %s data structures for horizon %d",
			   (genuine_flag ? "full-fledged" : "skeletal"),
			   hn);

	// decide what type of patch system this one should be
	const enum patch_system::patch_system_type ps_type
	   = STRING_EQUAL(patch_system_type[hn], "match Cactus grid symmetry")
	     ? // choose a patch system type based on grid:: parameters
	       // ... we inherit from grid, and we ask for some of its
	       //     parameters in our param.ccl file; these appear as
	       //     ordinary Cactus parameters here, so (eg)
	       //     grid::domain is just "domain" here
	       choose_patch_system_type(/* grid:: */ domain,
					/* grid:: */ bitant_plane,
					/* grid:: */ quadrant_direction,
					/* grid:: */ rotation_axis,
					origin_x[hn],
					origin_y[hn],
					origin_z[hn])
	     : patch_system::type_of_name(patch_system_type[hn]);

	// create the patch system
	AH_data.ps_ptr
	   = new patch_system(origin_x[hn], origin_y[hn], origin_z[hn],
			      ps_type,
			      ghost_zone_width, patch_overlap_width,
			      N_zones_per_right_angle[hn],
			      gfns::nominal_min_gfn,
			      (genuine_flag ? gfns::nominal_max_gfn
					    : gfns::skeletal_nominal_max_gfn),
			      gfns::ghosted_min_gfn, gfns::ghosted_max_gfn,
			      ip_interp_handle, ip_interp_param_table_handle,
			      surface_interp_handle,
			      surface_interp_param_table_handle,
			      true, verbose_info.print_algorithm_details);
	patch_system& ps = *AH_data.ps_ptr;
	if (genuine_flag)
	   then ps.set_gridfn_to_constant(0.0, gfns::gfn__zero);
	if (genuine_flag)
	   then ps.set_gridfn_to_constant(1.0, gfns::gfn__one);

	AH_data.Jac_ptr = genuine_flag
			  ? new_Jacobian(Jac_info.Jacobian_store_solve_method,
					 ps,
					 verbose_info.print_algorithm_details)
			  : NULL;

        AH_data.compute_info.surface_definition =
          STRING_EQUAL(surface_definition[hn], "expansion")
          ? definition_expansion
          : STRING_EQUAL(surface_definition[hn], "inner expansion")
          ? definition_inner_expansion
          : STRING_EQUAL(surface_definition[hn], "mean curvature")
          ? definition_mean_curvature
          : STRING_EQUAL(surface_definition[hn], "expansion product")
          ? definition_expansion_product
          : (CCTK_WARN (0, "internal error"), definition_error);
        AH_data.compute_info.surface_modification =
          STRING_EQUAL(surface_modification[hn], "none")
          ? modification_none
          : STRING_EQUAL(surface_modification[hn], "radius")
          ? modification_radius
          : STRING_EQUAL(surface_modification[hn], "radius^2")
          ? modification_radius2
#if 0
          : STRING_EQUAL(surface_modification[hn], "mean radius")
          ? modification_mean_radius
          : STRING_EQUAL(surface_modification[hn], "areal radius")
          ? modification_areal_radius
#endif
          : (CCTK_WARN (0, "internal error"), modification_error);
        AH_data.compute_info.surface_selection = 
          STRING_EQUAL(surface_selection[hn], "definition")
          ? selection_definition
          : STRING_EQUAL(surface_selection[hn], "mean coordinate radius")
          ? selection_mean_coordinate_radius
          : STRING_EQUAL(surface_selection[hn], "areal radius")
          ? selection_areal_radius
          : STRING_EQUAL(surface_selection[hn], "expansion times mean coordinate radius")
          ? selection_expansion_mean_coordinate_radius
          : STRING_EQUAL(surface_selection[hn], "expansion times areal radius")
          ? selection_expansion_areal_radius
          : (CCTK_WARN (0, "internal error"), selection_error);
	AH_data.compute_info.desired_value = desired_value[hn];

        AH_data.move_origins               = move_origins;

        AH_data.use_pretracking            = use_pretracking[hn];
        AH_data.pretracking_max_iterations = pretracking_max_iterations[hn];

        AH_data.pretracking_value          = pretracking_value[hn];
        AH_data.pretracking_minimum_value  = pretracking_minimum_value[hn];
        AH_data.pretracking_maximum_value  = pretracking_maximum_value[hn];
        AH_data.pretracking_delta          = pretracking_delta[hn];
        AH_data.pretracking_minimum_delta  = pretracking_minimum_delta[hn];
        AH_data.pretracking_maximum_delta  = pretracking_maximum_delta[hn];

        AH_data.depends_on           = depends_on[hn];
        AH_data.desired_value_factor = desired_value_factor[hn];
        AH_data.desired_value_offset = desired_value_offset[hn];

        AH_data.shiftout_factor = shiftout_factor[hn];
        AH_data.smoothing_factor = smoothing_factor[hn];

	// AH_data.initial_find_flag = genuine_flag;
	// AH_data.really_initial_find_flag = AH_data.initial_find_flag;
	AH_data.initial_find_flag = true;
	AH_data.really_initial_find_flag = AH_data.initial_find_flag;

	if (genuine_flag)
	   then {
		if (verbose_info.print_algorithm_details)
		   then CCTK_VInfo(CCTK_THORNSTRING,
			   "      setting initial guess parameters etc");
		set_initial_guess_parameters(AH_data, hn, /* irrelevant here; leave at zero */0, 0, 0);
		}

	AH_data.search_flag = false;
	AH_data.found_flag = false;
	AH_data.h_files_written = false;
	AH_data.BH_diagnostics_fileptr = NULL;
	}
	  }

  // Initialise the centroids.  These values may later be overwritten
  // when they are recovered from a checkpoint.  However, if new
  // horizons are enabled during recovery, they are then correctly
  // initialised.
  for (int n = 0; n < N_horizons; ++ n) {
    // Horizon centroids are not valid
    ah_centroid_x[n] = 0.0;
    ah_centroid_y[n] = 0.0;
    ah_centroid_z[n] = 0.0;
    ah_centroid_t[n] = 0.0;
    ah_centroid_valid[n] = 0;
    ah_centroid_iteration[n] = -1;
    
    ah_centroid_x_p[n] = 0.0;
    ah_centroid_y_p[n] = 0.0;
    ah_centroid_z_p[n] = 0.0;
    ah_centroid_t_p[n] = 0.0;
    ah_centroid_valid_p[n] = 0;
    ah_centroid_iteration_p[n] = -1;
    
    struct AH_data& AH_data = *state.AH_data_array[n+1];
    ah_initial_find_flag[n]        = AH_data.initial_find_flag;
    ah_really_initial_find_flag[n] = AH_data.really_initial_find_flag;
    ah_search_flag[n]              = AH_data.search_flag;
    ah_found_flag[n]               = AH_data.found_flag;
    if (verbose_info.print_algorithm_details) {
      printf ("AHF setup %d initial_find_flag=%d\n",        n+1, (int) AH_data.initial_find_flag);
      printf ("AHF setup %d really_initial_find_flag=%d\n", n+1, (int) AH_data.really_initial_find_flag);
      printf ("AHF setup %d search_flag=%d\n",              n+1, (int) AH_data.search_flag);
      printf ("AHF setup %d found_flag=%d\n",               n+1, (int) AH_data.found_flag);
    }
  }

  // Save in grid array in case a recovery only recovers some horizons
  for (int n = 0; n < N_horizons; ++ n) {
    struct AH_data& AH_data = *state.AH_data_array[n+1];
    const struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;
    BH_diagnostics.save(cctkGH, n+1);
  }
}


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

//
// This function decodes the  method  parameter (string) into an
// internal enum for future use.
//
namespace {
enum method
  decode_method(const char method_string[])
{
if	(STRING_EQUAL(method_string, "evaluate expansions"))
   then return method__evaluate_expansions;
else if (STRING_EQUAL(method_string, "test expansion Jacobians"))
   then return method__test_expansion_Jacobians;
else if (STRING_EQUAL(method_string, "find horizons"))
   then return method__find_horizons;
else	CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
		    "decode_method(): unknown method_string=\"%s\"!",
		    method_string);				/*NOTREACHED*/
}
	  }

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

//
// This function decodes the  verbose_level  parameter (string) into an
// internal enum for future use.
//
namespace {
enum verbose_level
  decode_verbose_level(const char verbose_level_string[])
{
if	(STRING_EQUAL(verbose_level_string, "physics highlights"))
   then return verbose_level__physics_highlights;
else if (STRING_EQUAL(verbose_level_string, "physics details"))
   then return verbose_level__physics_details;
else if (STRING_EQUAL(verbose_level_string, "algorithm highlights"))
   then return verbose_level__algorithm_highlights;
else if (STRING_EQUAL(verbose_level_string, "algorithm details"))
   then return verbose_level__algorithm_details;
else if (STRING_EQUAL(verbose_level_string, "algorithm debug"))
   then return verbose_level__algorithm_debug;
else	CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
"decode_verbose_level(): unknown verbose_level_string=\"%s\"!",
		   verbose_level_string);			/*NOTREACHED*/
}
	  }

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

//
// This function allocates horizons to a processor.  That is, it chooses
// which horizons a given processor (in practice, the current processor)
// will attempt to find.  It records this choice in a  horizon_sequence
// object.
//
// Arguments:
// N_procs = The total number of processors.
// my_proc = My processor number (0-origin).
// N_horizons = The total number of (genuine) horizons to be found.
// multiproc_flag = true to spread the horizons over multiple processors,
//		    false to allocate all horizons to processor #0.
// my_hs = (out) This will be set to the sequence of (genuine) horizons
//		 allocated to the specified processor.
// verbose_info = Specifies what information to print about the allocation.
//
// Results:
// This function returns the total number of active processors, i.e. the
// total number of processors which are allocated one or more genuine
// horizons allocated.
//
namespace {
int allocate_horizons_to_processor(int N_procs, int my_proc,
				   int N_horizons, bool multiproc_flag,
                                   const CCTK_INT depends_on[],
				   horizon_sequence& my_hs,
				   const struct verbose_info& verbose_info)
{
const int N_active_procs = multiproc_flag ? jtutil::min(N_procs, N_horizons)
					  : 1;

//
// Implementation note:
// We allocate the horizons to active processors in round-robin order.
//
std::vector<int> proc_of_horizon (N_horizons+1);
	for (int hn = 1 ; hn <= N_horizons ; ++hn)
        {
        proc_of_horizon.at(hn) = -1;
        }

int proc = 0;
	for (int hn = 1 ; hn <= N_horizons ; ++hn)
	{
        if (depends_on[hn] < 0 || depends_on[hn] > N_horizons) {
          CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
                     "horizon %d depends on a horizon with the illegal index %d",
                     hn, int(depends_on[hn]));
        } else if (depends_on[hn] == hn) {
          CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
                     "horizon %d depends on itself",
                     hn);
        } else if (depends_on[hn] > hn) {
          CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
                     "horizon %d depends on a horizon with a larger index %d",
                     hn, int(depends_on[hn]));
        }
        const int this_horizons_proc
          = depends_on[hn] == 0 ? proc : proc_of_horizon.at(depends_on[hn]);
        assert (this_horizons_proc >= 0 && this_horizons_proc < N_procs);
        proc_of_horizon.at(hn) = this_horizons_proc;
	if (verbose_info.print_algorithm_highlights)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   allocating horizon %d to processor #%d",
			   hn, this_horizons_proc);
	if (this_horizons_proc == my_proc)
           then my_hs.append_hn(hn);
	if (++proc >= N_active_procs)
	   then proc = 0;
	}

return N_active_procs;
}
	  }

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

//
// This function chooses a patch system type based on the Cactus grid
// symmetry and the patch system's origin position.
//
// Arguments:
// grid_* = The values of the Cactus parameters
//		grid::domain
//		grid::bitant_plane
//		grid::quadrant_direction
//		grid::rotation_axis
// origin_[xyz] = The origin position for this patch system.
//
namespace {
enum patch_system::patch_system_type
  choose_patch_system_type(const char grid_domain[],
			   const char grid_bitant_plane[],
			   const char grid_quadrant_direction[],
			   const char grid_rotation_axis[],
			   fp origin_x, fp origin_y, fp origin_z)
{
if	(STRING_EQUAL(grid_domain, "full"))
   then return patch_system::patch_system__full_sphere;

else if ( STRING_EQUAL(grid_domain, "bitant")
	  && STRING_EQUAL(grid_bitant_plane, "xy") )
   then {
	if (origin_z == 0.0)
	   then return patch_system::patch_system__plus_z_hemisphere;
	   else {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "      Cactus has bitant mode about xy plane");
		CCTK_VInfo(CCTK_THORNSTRING,
			   "      but patch system origin_z=%g != 0",
			   double(origin_z));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "      ==> using \"full sphere\" patch system");
		return patch_system::patch_system__full_sphere;
		}
	}

else if ( STRING_EQUAL(grid_domain, "quadrant")
	  && STRING_EQUAL(grid_quadrant_direction, "z") )
   then {
	if ((origin_x == 0.0) && (origin_y == 0.0))
	   then return patch_system::patch_system__plus_xy_quadrant_mirrored;
	   else {
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has quadrant mode about z axis");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_(x,y)=(%g,%g) != (0,0)",
		   double(origin_x), double(origin_y));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"full sphere\" patch system");
		return patch_system::patch_system__full_sphere;
		}
	}

else if ( STRING_EQUAL(grid_domain, "quadrant_reflect_rotate")
	  && STRING_EQUAL(grid_quadrant_direction, "z")
	  && STRING_EQUAL(grid_rotation_axis, "z") )
   then {
	if ((origin_x == 0.0) && (origin_y == 0.0))
	   then return patch_system::patch_system__plus_xy_quadrant_rotating;
	   else {
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has rotating quadrant mode about z axis");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_(x,y)=(%g,%g) != (0,0)",
		   double(origin_x), double(origin_y));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"full sphere\" patch system");
		return patch_system::patch_system__full_sphere;
		}
	}

else if (STRING_EQUAL(grid_domain, "octant"))
   then {
	if	((origin_x == 0.0) && (origin_y == 0.0) && (origin_z == 0.0))
	   then return patch_system::patch_system__plus_xyz_octant_mirrored;
	else if ((origin_x == 0.0) && (origin_y == 0.0))
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has mirrored octant mode");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_z=%g != 0",
		   double(origin_z));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"+xy quadrant (mirrored)\" patch system");
		return patch_system::patch_system__plus_xy_quadrant_mirrored;
		}
	else if ((origin_x == 0.0) && (origin_z == 0.0))
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has mirrored octant mode");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_y=%g != 0",
		   double(origin_z));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"+xz quadrant (mirrored)\" patch system");
		return patch_system::patch_system__plus_xz_quadrant_mirrored;
		}
	else if ((origin_y == 0.0) && (origin_z == 0.0))
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has mirrored octant mode");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_x=%g != 0",
		   double(origin_z));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"+yz quadrant (mirrored)\" patch system");
		//return patch_system::patch_system__plus_yz_quadrant_mirrored;
                CCTK_WARN (0, "This patch system type is not implemented");
		return patch_system::patch_system__full_sphere;
		}
	else	{
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      Cactus has mirrored octant mode");
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      but patch system origin_(x,y,z)=(%g,%g,%g) != (0,0,0)",
		   double(origin_x), double(origin_y), double(origin_z));
		CCTK_VInfo(CCTK_THORNSTRING,
		   "      ==> using \"full sphere\" patch system");
		return patch_system::patch_system__full_sphere;
		}
	}

else	{
	CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   choose_patch_system_type()\n"
"        grid::domain = \"%s\" not supported!\n"
"        ==> will try using \"full sphere\" patch system\n"
"            but this may or may not work..."
,
		   grid_domain);
	return patch_system::patch_system__full_sphere;
	}
}
	  }

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

	  }	// namespace AHFinderDirect

```

driver/find_horizons.cc:
```
// find_horizons.cc -- top level driver for finding apparent horizons
// $Header$
//
// <<<access to persistent data>>>
// <<<prototypes for functions local to this file>>>
// AHFinderDirect_find_horizons - top-level driver to find apparent horizons
///
/// find_horizon - find a horizon
/// do_evaluate_expansions
/// do_test_expansion_Jacobian
///

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

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// ***** prototypes for functions local to this file
//
namespace {
void do_evaluate_expansions(int my_proc, int N_horizons,
			    horizon_sequence& hs,
			       struct AH_data* const AH_data_array[],
			    const struct cactus_grid_info& cgi,
			    const struct geometry_info& gi,
			    const struct IO_info& IO_info,
			    const struct error_info& error_info,
			    const struct verbose_info& verbose_info,
			    int timer_handle);
void do_test_expansion_Jacobians(int my_proc, int N_horizons,
				 struct AH_data* const AH_data_array[],
				 const struct cactus_grid_info& cgi,
				 const struct geometry_info& gi,
				       struct Jacobian_info& Jac_info,
				 bool test_all_Jacobian_compute_methods,
				 const struct IO_info& IO_info,
				 const struct error_info& error_info,
				 const struct verbose_info& verbose_info,
				 int timer_handle);
	  }

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

//
// This function is called by the Cactus scheduler to import
// the excision mask.
//
extern "C"
  void AHFinderDirect_import_mask(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

for (int k=0; k<cctk_lsh[2]; ++k)
for (int j=0; j<cctk_lsh[1]; ++j)
for (int i=0; i<cctk_lsh[0]; ++i)
{
        const int ind = CCTK_GFINDEX3D(cctkGH,i,j,k);
        // zero means: point can be used,
        // non-zero means: point must be avoided
        ahmask[ind] = 0;
        if (use_mask)
           // grid points with mask values of 1.0 can be used,
           // values of 0.0 and 0.5 must be avoided.
           // the excision boundary cannot be used because
           // (a) it is inaccurate
           // (b) it does not respect the symmetries e.g. in Kerr.
           then ahmask[ind] = fabs(emask[ind] - 1.0) > 0.01;
}
}

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

//
// This function is called by the Cactus scheduler to find the apparent
// horizon or horizons in the current slice.
//
extern "C"
  void AHFinderDirect_find_horizons(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

// determine whether a horizon should be found at this iteration
bool find_any = false;
for (int hn = 1; hn <= state.my_hs->N_horizons(); ++ hn)
{
  // only try to find horizons every  find_every  time steps
  const int my_find_after = find_after_individual[hn];
  const int my_dont_find_after = dont_find_after_individual[hn];
  const fp my_find_after_time = find_after_individual_time[hn];
  const fp my_dont_find_after_time = dont_find_after_individual_time[hn];
  const int my_find_every = (find_every_individual[hn] >= 0
                             ? find_every_individual[hn]
                             : find_every);
  const bool find_this =    cctk_iteration >= my_find_after
                         && (my_dont_find_after < 0
                             ? true
                             : cctk_iteration <= my_dont_find_after)
                         && cctk_time >= my_find_after_time
                         && (my_dont_find_after_time <= my_find_after_time
                             ? true
                             : cctk_time <= my_dont_find_after_time)
                         && my_find_every > 0
                         && cctk_iteration % my_find_every == 0
                         && ! disable_horizon[hn];
  struct AH_data& AH_data = *state.AH_data_array[hn];
  AH_data.search_flag = find_this;
  find_any = find_any || find_this;
}
if (! find_any) return;

if (state.timer_handle >= 0)
   then CCTK_TimerResetI(state.timer_handle);

const int my_proc = state.my_proc;
horizon_sequence& hs = *state.my_hs;
const bool active_flag = hs.has_genuine_horizons();
const bool broadcast_horizon_shape = true;

      struct cactus_grid_info&          cgi = state.cgi;
const struct    geometry_info&           gi = state.gi;
      struct    Jacobian_info&     Jac_info = state.Jac_info;
      struct          IO_info&      IO_info = state.IO_info;
const struct       error_info&   error_info = state.error_info;
const struct     verbose_info& verbose_info = state.verbose_info;

// what are the semantics of the Cactus gxx variables? (these may
// change from one call to another, so we have to re-check each time)
if      (CCTK_Equals(metric_type, "physical"))
   then cgi.use_Cactus_conformal_metric = false;
else if (CCTK_Equals(metric_type, "static conformal"))
   then cgi.use_Cactus_conformal_metric = (*conformal_state > 0);
else	CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_find_horizons(): unknown metric_type=\"%s\"!",
		   metric_type);				/*NOTREACHED*/

// update parameters
IO_info.output_ASCII_files = (output_ASCII_files != 0);
IO_info.output_HDF5_files = (output_HDF5_files != 0);
IO_info.output_initial_guess = (output_initial_guess != 0);
IO_info.output_h_every     = output_h_every;
IO_info.output_Theta_every = output_Theta_every;
IO_info.output_mean_curvature_every = output_mean_curvature_every;
IO_info.output_h     = false;	// dummy value
IO_info.output_Theta = false;	// dummy value
IO_info.output_mean_curvature = false;	// dummy value

IO_info.output_BH_diagnostics              = (output_BH_diagnostics != 0);
IO_info.BH_diagnostics_directory
	= (strlen(BH_diagnostics_directory) == 0)
	  ? /* IO:: */ out_dir
	  : BH_diagnostics_directory;
IO_info.BH_diagnostics_base_file_name      = BH_diagnostics_base_file_name;
IO_info.BH_diagnostics_file_name_extension = BH_diagnostics_file_name_extension;

IO_info.output_ghost_zones_for_h  = (output_ghost_zones_for_h != 0);
IO_info.ASCII_gnuplot_file_name_extension = ASCII_gnuplot_file_name_extension;
IO_info.HDF5_file_name_extension          = HDF5_file_name_extension;
IO_info.h_directory
	= (strlen(h_directory) == 0)
	  ? /* IO:: */ out_dir
	  : h_directory;
IO_info.h_base_file_name         = h_base_file_name;
IO_info.Theta_base_file_name     = Theta_base_file_name;
IO_info.mean_curvature_base_file_name     = mean_curvature_base_file_name;
IO_info.Delta_h_base_file_name   = Delta_h_base_file_name;
IO_info.h_min_digits             = h_min_digits;
IO_info.Jacobian_base_file_name  = Jacobian_base_file_name;
IO_info.output_OpenDX_control_files  = (output_OpenDX_control_files != 0);
IO_info.OpenDX_control_file_name_extension = OpenDX_control_file_name_extension;
IO_info.time_iteration = 0;
IO_info.time           = 0.0;

// get the Cactus time step and decide if we want to output h and/or Theta now
IO_info.time_iteration = cctk_iteration;
IO_info.time           = cctk_time;
IO_info.output_h
   = (IO_info.output_h_every > 0)
     && ((IO_info.time_iteration % IO_info.output_h_every) == 0);
IO_info.output_Theta
   = (IO_info.output_Theta_every > 0)
     && ((IO_info.time_iteration % IO_info.output_Theta_every) == 0);
IO_info.output_mean_curvature
   = (IO_info.output_mean_curvature_every > 0)
     && ((IO_info.time_iteration % IO_info.output_mean_curvature_every) == 0);

// set initial guess for any (genuine) horizons that need it,
// i.e. for any (genuine) horizons where we didn't find the horizon previously
	for (int hn = hs.init_hn() ; hs.is_genuine() ; hn = hs.next_hn())
	{
	assert( state.AH_data_array[hn] != NULL );
	struct AH_data& AH_data = *state.AH_data_array[hn];
        if (verbose_info.print_algorithm_details) {
          printf ("AHF find_horizons[%d] initial_find_flag=%d\n", hn, (int) AH_data.initial_find_flag);
          printf ("AHF find_horizons[%d] really_initial_find_flag=%d\n", hn, (int) AH_data.really_initial_find_flag);
          printf ("AHF find_horizons[%d] search_flag=%d\n", hn, (int) AH_data.search_flag);
          printf ("AHF find_horizons[%d] found_flag=%d\n", hn, (int) AH_data.found_flag);
        }
	if (AH_data.found_flag)
           then {
                AH_data.initial_find_flag = false;
                AH_data.really_initial_find_flag = false;
                }
	   else {
                if (AH_data.really_initial_find_flag
                    || AH_data.initial_guess_info.reset_horizon_after_not_finding)
                   then {
		        patch_system& ps = *AH_data.ps_ptr;
                        if (verbose_info.print_algorithm_details) {
                          printf ("AHF find_horizons[%d] setup_initial_guess\n", hn);
                        }
                        if (track_origin_from_grid_scalar[hn] && state.method == method__find_horizons) {
                           track_origin(cctkGH, ps, &AH_data, hn, verbose_info.print_algorithm_details);
                           set_initial_guess_parameters(AH_data, hn, 
                                                        ps.origin_x(), ps.origin_y(), ps.origin_z());
                        }
        		setup_initial_guess(ps,
        		          	    AH_data.initial_guess_info,
        				    IO_info,
        				    hn, N_horizons, verbose_info);
        		if (active_flag && IO_info.output_initial_guess)
        		   then output_gridfn(ps, gfns::gfn__h,
                                              "h", cgi.GH,
        				      IO_info, IO_info.h_base_file_name,
                                              IO_info.h_min_digits,
        				      hn, verbose_info
        				      .print_algorithm_highlights);
        		AH_data.initial_find_flag = true;
        		}
                }
	}

//
// now the main horizon finding (or other computation)
//
switch	(state.method)
	{
case method__evaluate_expansions:
	do_evaluate_expansions(my_proc, N_horizons,
			       *state.my_hs, state.AH_data_array,
			       cgi, gi, IO_info,
			       error_info, verbose_info,
			       state.timer_handle);
	break;

case method__test_expansion_Jacobians:
	do_test_expansion_Jacobians(my_proc, N_horizons,
				    state.AH_data_array,
				    cgi, gi, Jac_info,
				    (test_all_Jacobian_compute_methods != 0),
				    IO_info, error_info, verbose_info,
				    state.timer_handle);
	break;

case method__find_horizons:
	  {
	if (state.timer_handle >= 0)
	   then CCTK_TimerStartI(state.timer_handle);
	Newton(cctkGH,
	       state.N_procs, state.N_active_procs, my_proc,
	       *state.my_hs, state.AH_data_array,
	       cgi, gi, Jac_info, state.solver_info,
	       IO_info, state.BH_diagnostics_info, broadcast_horizon_shape,
	       error_info, verbose_info,
	       state.isb);
	if (state.timer_handle >= 0)
	   then CCTK_TimerStopI(state.timer_handle);
	break;
	  }

default:
	CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   find_horizons(): unknown method=(int)%d!\n"
"                    (this should never happen!)"
		   ,
		   int(state.method));				/*NOTREACHED*/
	}

if (state.timer_handle >= 0)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "timer stats for computation:");
	CCTK_TimerPrintDataI(state.timer_handle, -1);
	}
}

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

//
// This function implements  AHFinderDirect::method == "horizon function":
// On processor #0 it evaluates the Theta(h) function for each apparent
// horizon (and does any I/O desired); on other processors it does N_horizons
// dummy evaluations on horizon #0.
//
// Note that if we decide to output h, we output it *after* any Theta(h)
// evaluation or horizon finding has been done, to ensure that all the
// ghost zones are filled in in case we need to print them.
//
// Arguments:
// timer_handle = a valid Cactus timer handle if we want to time the
//		  apparent horizon process, or -ve to skip this
//		  (we only time the computation, not the file I/O)
//
namespace {
void do_evaluate_expansions(int my_proc, int N_horizons,
			    horizon_sequence& hs,
			       struct AH_data* const AH_data_array[],
			    const struct cactus_grid_info& cgi,
			    const struct geometry_info& gi,
			    const struct IO_info& IO_info,
			    const struct error_info& error_info,
			    const struct verbose_info& verbose_info,
			    int timer_handle)
{
const bool active_flag = (my_proc == 0);

if (active_flag)
   then {
	assert( hs.N_horizons() == N_horizons );
	assert( hs.my_N_horizons() == N_horizons );

		for (int hn = hs.init_hn() ;
		     hs.is_genuine() ;
		     hn = hs.next_hn())
		{
		assert( AH_data_array[hn] != NULL );
		struct AH_data& AH_data = *AH_data_array[hn];
		patch_system& ps = *AH_data.ps_ptr;

		if (timer_handle >= 0)
		   then CCTK_TimerStartI(timer_handle);
		jtutil::norm<fp> Theta_norms;
		const bool Theta_ok = expansion(&ps,
                                                AH_data.compute_info,
						cgi, gi,
						error_info, true,// initial eval
						false,	// no Jacobian coeffs
						true,	// yes, print msgs
						&Theta_norms);
		if (timer_handle >= 0)
		   then CCTK_TimerStopI(timer_handle);

		if (IO_info.output_h)
		   then output_gridfn(ps, gfns::gfn__h,
                                      "h", cgi.GH,
				      IO_info, IO_info.h_base_file_name,
                                      IO_info.h_min_digits,
				      hn, verbose_info.print_algorithm_details);

		if (Theta_ok)
		   then {
			CCTK_VInfo(CCTK_THORNSTRING,
			   "   Theta(h) rms-norm %.2e, infinity-norm %.2e",
			   Theta_norms.rms_norm(), Theta_norms.infinity_norm());
			if (IO_info.output_Theta)
			   then output_gridfn(ps, gfns::gfn__Theta,
                                              "Theta", cgi.GH,
					      IO_info, IO_info
						       .Theta_base_file_name,
                                              IO_info.h_min_digits,
					      hn, verbose_info
						  .print_algorithm_details);
			if (IO_info.output_mean_curvature)
			   then output_gridfn(ps, gfns::gfn__mean_curvature,
                                              "mean_curvature", cgi.GH,
					      IO_info, IO_info
						       .mean_curvature_base_file_name,
                                              IO_info.h_min_digits,
					      hn, verbose_info
						  .print_algorithm_details);
			}
		}
	}
   else {
                struct what_to_compute new_compute_info;
		for (int i = 0 ; i < N_horizons ; ++i)
		{
                expansion(NULL, new_compute_info,
			  cgi, gi,
			  error_info, true);	// initial evaluation
		}
	}
}
	  }

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

//
// This function implements
//  AHFinderDirect::method == "test expansion Jacobians":
// On processor #0 it computes and prints the Jacobian matrix J[Theta(h)]
// function for horizon #1; on other processors it does dummy Jacobian
// computations.
//
// The Jacobian computation may optionally be done in several different
// ways, in which case all the resulting Jacobian matrices are printed,
// as are their differences.  Alternatively, only
// the numerical perturbation computation may be done/printed.
//
// Arguments:
// timer_handle = a valid Cactus timer handle if we want to time the
//		  apparent horizon process, or -ve to skip this
//		  (we only time the computation, not the file I/O)
// test_all_Jacobian_compute_methods
//	= true ==> Test all known methods of computing the Jacobian
//		   matrix, and print all the resulting Jacobian matrices
//		   and their differences.
//	  false ==> Just test/print the numerical perturbation calculation.
//		    (This may be useful if one or more of the other methods
//		    is broken.)
//
namespace {
void do_test_expansion_Jacobians(int my_proc, int N_horizons,
				 struct AH_data* const AH_data_array[],
				 const struct cactus_grid_info& cgi,
				 const struct geometry_info& gi,
				       struct Jacobian_info& Jac_info,
				 bool test_all_Jacobian_compute_methods,
				 const struct IO_info& IO_info,
				 const struct error_info& error_info,
				 const struct verbose_info& verbose_info,
				 int timer_handle)
{
const bool active_flag = (my_proc == 0);
assert(N_horizons >= 1);

const bool print_msg_flag = true;
const int hn = 1;

struct AH_data* const AH_data_ptr = active_flag ? AH_data_array[hn]   : NULL;
patch_system*   const      ps_ptr = active_flag ? AH_data_ptr->ps_ptr : NULL;
struct what_to_compute dummy_compute_info;
struct what_to_compute & compute_info =
	active_flag
	? AH_data_ptr->compute_info
	: dummy_compute_info;

//
// numerical-perturbation Jacobian
//
Jacobian* Jac_NP_ptr = active_flag ? AH_data_ptr->Jac_ptr : NULL;
expansion(ps_ptr, compute_info,
	  cgi, gi,
	  error_info, true);		// initial evaluation
Jac_info.Jacobian_compute_method = Jacobian__numerical_perturbation;
expansion_Jacobian(ps_ptr, Jac_NP_ptr,
                   compute_info,
		   cgi, gi, Jac_info,
		   error_info, true,	// initial evaluation
		   print_msg_flag);

Jacobian* Jac_SD_FDdr_ptr = NULL;
if (test_all_Jacobian_compute_methods)
   then {
	// symbolic differentiation with finite diff d/dr
	Jac_SD_FDdr_ptr = active_flag
			  ? new_Jacobian(Jac_info.Jacobian_store_solve_method,
					 *ps_ptr,
					 verbose_info.print_algorithm_details)
			  : NULL;
	expansion(ps_ptr, compute_info,
		  cgi, gi,
		  error_info, true,	// initial evaluation
		  true);		// compute SD Jacobian coeffs
	Jac_info.Jacobian_compute_method = Jacobian__symbolic_diff_with_FD_dr;
	expansion_Jacobian(ps_ptr, Jac_SD_FDdr_ptr,
                           compute_info,
			   cgi, gi, Jac_info,
			   error_info, true,	// initial evaluation
			   print_msg_flag);
	}

if (active_flag)
   then output_Jacobians(*ps_ptr,
			 Jac_NP_ptr, Jac_SD_FDdr_ptr,
			 IO_info, IO_info.Jacobian_base_file_name,
			 IO_info.h_min_digits,
			 hn, print_msg_flag);
}
	  }

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

	  }	// namespace AHFinderDirect

```

driver/ellipsoid.c:
```
fp t1, t2, t3, t5, t6, t7, t9, t10, t12, t28;
fp t30, t33, t35, t36, t40, t42, t43, t48, t49, t52;
fp t55;
      t1 = a*a;
      t2 = b*b;
      t3 = t1*t2;
      t5 = t3*zcos*CW;
      t6 = c*c;
      t7 = t1*t6;
      t9 = t7*ycos*BV;
      t10 = t2*t6;
      t12 = t10*xcos*AU;
      t28 = xcos*xcos;
      t30 = CW*CW;
      t33 = BV*BV;
      t35 = t10*t28;
      t36 = ycos*ycos;
      t40 = AU*AU;
      t42 = t7*t36;
      t43 = zcos*zcos;
      t48 = t3*t43;
      t49 = -2.0*t1*zcos*CW*ycos*BV-2.0*t2*zcos*CW*xcos*AU-2.0*t6*ycos*BV*xcos*
AU+t2*t28*t30+t6*t28*t33-t35+t1*t36*t30+t6*t36*t40-t42+t1*t43*t33+t2*t43*t40-
t48;
      t52 = sqrt(-t3*t6*t49);
      t55 = 1/(t35+t42+t48);
      r_plus = (t5+t9+t12+t52)*t55;
      r_minus = (t5+t9+t12-t52)*t55;

```

driver/ellipsoid.maple:
```
# ellipsoid.maple -- compute equations for offset ellipsoid setup
# $Header$

#
# This program finds the intersection of an ellipsoid with an offset ray.
#
# ellipsoid has center (A,B,C), radius (a,b,c)
# angular coordinate system has center (U,V,W)
#
# direction cosines wrt angular coordinate center are (alpha,beta,gamma)
# but Maple predefines gamma = Euler's constant, so we use (xcos,ycos,zcos)
# instead, i.e. a point has coordinates (U+xcos*r, V+ycos*r, W+zcos*r)
#
# then the equation of the ellipsoid is
#	(U+xcos*r - A)^2     (V+ycos*r - B)^2     (W+zcos*r - C)^2
#	-----------------  +  ----------------  +  -----------------  =  1
#	        a^2                  b^2                   c^2
#
# to solve this, we introduce intermediate variables
#	AU = A - U
#	BV = B - V
#	CW = C - W
#
eqn := (xcos*r - AU)^2/a^2 + (ycos*r - BV)^2/b^2 + (zcos*r - CW)^2/c^2 = 1;

read "../maple/util.mm";
read "../maple/codegen2.mm";

[solve(eqn, r)];
map(simplify, %);
[r_plus = %[1], r_minus = %[2]];
solnlist := [codegen[optimize](%)];

ftruncate("ellipsoid.c");
print_name_list_dcl(temps_in_eqnlist(solnlist, [r_plus,r_minus]),
		    "fp", "ellipsoid.c");
codegen[C](solnlist, filename="ellipsoid.c");

```

driver/initial_guess.cc:
```
// initial_guess.cc -- set up the initial guess
// $Header$
//
// <<<access to persistent data>>>
// <<<prototypes for functions local to this file>>>
// setup_initial_guess - set up initial guess in h
// decode_initial_guess_method - decode the  initial_guess_method  parameter
/// setup_Kerr_horizon - set up Kerr horizon in h (Kerr or Kerr-Schild coords)
/// setup_coord_ellipsoid - setup up a coordinate ellipsoid in 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 "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** prototypes for functions local to this file *****
//

namespace {
void setup_Kerr_horizon(patch_system& ps,
			fp x_posn, fp y_posn, fp z_posn,
			fp m, fp a,
			bool Kerr_Schild_flag,
			const struct verbose_info& verbose_info);
void setup_coord_ellipsoid(patch_system& ps,
			   fp x_center, fp y_center, fp z_center,
			   fp x_radius, fp y_radius, fp z_radius,
			   bool print_msg_flag);
	  }

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

//
// This function sets up the initial guess for a single apparent horizon,
// in the  h  angular gridfn.
//
void setup_initial_guess(patch_system& ps,
			 const struct initial_guess_info& igi,
			 const struct IO_info& IO_info,
			 int hn, int N_horizons,
			 const struct verbose_info& verbose_info)
{
if (verbose_info.print_algorithm_highlights)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "setting initial guess for horizon %d/%d",
		   hn, N_horizons);

switch	(igi.method)
	{
case initial_guess__read_from_named_file:
	input_gridfn__explicit_name(ps, gfns::gfn__h,
				    IO_info,
				    igi.read_from_named_file_info.file_name,
				    verbose_info.print_algorithm_highlights);
	break;

case initial_guess__read_from_h_file:
	input_gridfn(ps, gfns::gfn__h,
		     IO_info, IO_info.h_base_file_name, IO_info.h_min_digits,
		     hn, verbose_info.print_algorithm_highlights);
	break;

case initial_guess__Kerr_Kerr:
	setup_Kerr_horizon(ps,
			   igi.Kerr_Kerr_info.x_posn,
			   igi.Kerr_Kerr_info.y_posn,
			   igi.Kerr_Kerr_info.z_posn,
			   igi.Kerr_Kerr_info.mass,
			   igi.Kerr_Kerr_info.spin,
			   false,		// Kerr coordinates
			   verbose_info);
	break;

case initial_guess__Kerr_KerrSchild:
	setup_Kerr_horizon(ps,
			   igi.Kerr_KerrSchild_info.x_posn,
			   igi.Kerr_KerrSchild_info.y_posn,
			   igi.Kerr_KerrSchild_info.z_posn,
			   igi.Kerr_KerrSchild_info.mass,
			   igi.Kerr_KerrSchild_info.spin,
			   true,		// Kerr-Schild coordinates
			   verbose_info);
	break;

case initial_guess__coord_sphere:
	setup_coord_ellipsoid(ps,
			      igi.coord_sphere_info.x_center,
			      igi.coord_sphere_info.y_center,
			      igi.coord_sphere_info.z_center,
			      igi.coord_sphere_info.radius,
			      igi.coord_sphere_info.radius,
			      igi.coord_sphere_info.radius,
			      verbose_info.print_algorithm_highlights);
	break;

case initial_guess__coord_ellipsoid:
	setup_coord_ellipsoid(ps,
			      igi.coord_ellipsoid_info.x_center,
			      igi.coord_ellipsoid_info.y_center,
			      igi.coord_ellipsoid_info.z_center,
			      igi.coord_ellipsoid_info.x_radius,
			      igi.coord_ellipsoid_info.y_radius,
			      igi.coord_ellipsoid_info.z_radius,
			      verbose_info.print_algorithm_highlights);
	break;

default:
	CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "unknown initial guess method=(int)%d!",
		   int(igi.method));				/*NOTREACHED*/
	}
}

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

//
// This function decodes the  initial_guess_method  parameter (string)
// into an internal enum for future use.
//
enum initial_guess_method
  decode_initial_guess_method(const char initial_guess_method_string[])
{
if	(STRING_EQUAL(initial_guess_method_string, "read from named file"))
   then return initial_guess__read_from_named_file;
else if (STRING_EQUAL(initial_guess_method_string, "read from h file"))
   then return initial_guess__read_from_h_file;
else if (STRING_EQUAL(initial_guess_method_string, "Kerr/Kerr"))
   then return initial_guess__Kerr_Kerr;
else if (STRING_EQUAL(initial_guess_method_string, "Kerr/Kerr-Schild"))
   then return initial_guess__Kerr_KerrSchild;
else if (STRING_EQUAL(initial_guess_method_string, "coordinate sphere"))
   then return initial_guess__coord_sphere;
else if (STRING_EQUAL(initial_guess_method_string, "coordinate ellipsoid"))
   then return initial_guess__coord_ellipsoid;
else	CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   decode_initial_guess_method():\n"
"        unknown initial_guess_method_string=\"%s\"!",
		   initial_guess_method_string);		/*NOTREACHED*/
}

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

//
// This function sets up the horizon of a Kerr black hole in Kerr or
// Kerr-Schild coordinates, on the nominal grid, in the  h  gridfn.
//
// Kerr-Schild coordinates are described in MTW Exercise 33.8, page 903,
// and the horizon is worked out on page 13.2 of my AHFinderDirect notes.
//
// Arguments:
// [xyz]_posn = The global-coordinate position of the Kerr black hole.
// (m,a) = Describe the Kerr black hole.  Note that my convention has
//	   a=J/m^2 dimensionless, while MTW take a=J/m=m*(my a).
// Kerr_Schild_flag = false to use Kerr coordinates,
//		      true to use Kerr-Schild coordinates
// verbose_info = controls what messages we print
//
namespace {
void setup_Kerr_horizon(patch_system& ps,
			fp x_posn, fp y_posn, fp z_posn,
			fp m, fp a,
			bool Kerr_Schild_flag,
			const struct verbose_info& verbose_info)
{
const char* const name = Kerr_Schild_flag ? "Kerr-Schild" : "Kerr";

if (verbose_info.print_algorithm_highlights)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "   setting Kerr/%s horizon shape",
		   name);
	CCTK_VInfo(CCTK_THORNSTRING,
		   "           posn=(%g,%g,%g) mass=%g spin=J/m^2=%g",
		   double(x_posn), double(y_posn), double(z_posn),
		   double(m), double(a));
	}

// horizon in Kerr coordinates is coordinate sphere
const fp r = m * (1.0 + sqrt(1.0 - a*a));

// horizon in Kerr-Schild coordinates is coordinate ellipsoid
const fp  z_radius = r;
const fp xy_radius = Kerr_Schild_flag ? r * sqrt(1.0 + a*a*m*m/(r*r)) : r;

if (verbose_info.print_algorithm_details)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   setting coordinate %s",
		   Kerr_Schild_flag ? "ellipsoid" : "sphere");
setup_coord_ellipsoid(ps,
		      x_posn, y_posn, z_posn,
		      xy_radius, xy_radius, z_radius,
		      verbose_info.print_algorithm_details);
}
	  }

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

//
// This function sets up an ellipsoid initial guess, using the formulas
// in "ellipsoid.maple" and the Maple-generated C code in "ellipsoid.c":
//
// ellipsoid has global-coordinates center (A,B,C), radius (a,b,c)
// angular coordinate system has center (U,V,W)
//
// direction cosines wrt angular coordinate center are (xcos,ycos,zcos)
// i.e. a point has coordinates (U+xcos*r, V+ycos*r, W+zcos*r)
//
// then the equation of the ellipsoid is
//	(U+xcos*r - A)^2     (V+ycos*r - B)^2     (W+zcos*r - C)^2
//	-----------------  +  ----------------  +  -----------------  =  1
//	        a^2                  b^2                   c^2
//
// to solve this, we introduce intermediate variables
//	AU = A - U
//	BV = B - V
//	CW = C - W
//
namespace {
void setup_coord_ellipsoid(patch_system& ps,
			   fp x_center, fp y_center, fp z_center,
			   fp x_radius, fp y_radius, fp z_radius,
			   bool print_msg_flag)
{
if (print_msg_flag)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "   setting ellipsoid: center=(%g,%g,%g)",
		   double(x_center), double(y_center), double(z_center));
	CCTK_VInfo(CCTK_THORNSTRING,
		   "                      radius=(%g,%g,%g)",
		   double(x_radius), double(y_radius), double(z_radius));
	}

	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 rho = p.rho_of_irho(irho);
		const fp sigma = p.sigma_of_isigma(isigma);
		fp xcos, ycos, zcos;
		p.xyzcos_of_rho_sigma(rho,sigma, xcos,ycos,zcos);

		// set up variables used by Maple-generated code
		const fp AU = x_center - ps.origin_x();
		const fp BV = y_center - ps.origin_y();
		const fp CW = z_center - ps.origin_z();
		const fp a = x_radius;
		const fp b = y_radius;
		const fp c = z_radius;

		// compute the solutions r_plus and r_minus
		fp r_plus, r_minus;
		#include "ellipsoid.c"

		// exactly one of the solutions (call it r) should be positive
		fp r;
		if      ((r_plus > 0.0) && (r_minus < 0.0))
		   then r = r_plus;
		else if ((r_plus < 0.0) && (r_minus > 0.0))
		   then r = r_minus;
		else    CCTK_VWarn(FATAL_ERROR,
				   __LINE__, __FILE__, CCTK_THORNSTRING,
				   "\n"
"   setup_coord_ellipsoid():\n"
"        expected exactly one r>0 solution to quadratic, got 0 or 2!\n"
"        %s patch (irho,isigma)=(%d,%d) ==> (rho,sigma)=(%g,%g)\n"
"        direction cosines (xcos,ycos,zcos)=(%g,%g,%g)\n"
"        r_plus=%g r_minus=%g\n"
"        ==> this probably means the initial guess surface doesn't contain\n"
"            the local origin point, or more generally that the initial\n"
"            guess surface isn't a Strahlkoerper (\"star-shaped region\")\n"
"            with respect to the local origin point\n"
				   ,
				   p.name(), irho, isigma,
				   double(rho), double(sigma),
				   double(xcos), double(ycos), double(zcos),
				   double(r_plus), double(r_minus));
		   						/*NOTREACHED*/

		// r = horizon radius at this grid point
		p.ghosted_gridfn(gfns::gfn__h, irho,isigma) = r;
		}
		}
	}
}
	  }

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

	  }	// namespace AHFinderDirect

```

driver/driver.hh:
```
// driver.hh -- header file for driver code
// $Header$

//
// prerequisites:
//	<stdio.h>
//	"horizon_sequence.hh"
//	"BH_diagnostics.hh"
//

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

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

// Cactus likes 3-element arrays for xyz axes
enum	{ X_AXIS=0, Y_AXIS=1, Z_AXIS=2 };

//
// this enum holds the decoded  method  parameter, i.e. it specifies
// our top-level method
//
enum	method
	{
	method__evaluate_expansions,
	method__test_expansion_Jacobians,
	method__find_horizons // no comma
	};

//
// this enum holds the decoded  verbose_method  parameter, i.e. it
// specifies which (how many) informational messages we should print
//
enum	verbose_level
	{
	verbose_level__physics_highlights,
	verbose_level__physics_details,
	verbose_level__algorithm_highlights,
	verbose_level__algorithm_details,
	verbose_level__algorithm_debug // no comma
	};

//
// this enum holds the (a) decoded  initial_guess_method  parameter,
// i.e.  it specifies how we should set up the initial guess for a
// single apparent horizon
//
enum	initial_guess_method
	{
	initial_guess__read_from_named_file,
	initial_guess__read_from_h_file,
	initial_guess__Kerr_Kerr,
	initial_guess__Kerr_KerrSchild,
	initial_guess__coord_sphere,
	initial_guess__coord_ellipsoid // no comma
	};

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

//
// This struct holds parameters for setting up the initial guess
// for a single apparent horizon.
//
struct	initial_guess_info
	{
	enum initial_guess_method method;
        bool reset_horizon_after_not_finding;

	// parameters for method == initial_guess__read_from_named_file
	struct	{
		const char* file_name;
		} read_from_named_file_info;

	// parameters for method == initial_guess__Kerr_Kerr
	struct	{
		fp x_posn, y_posn, z_posn;
		fp mass, spin;
		} Kerr_Kerr_info;

	// parameters for method == initial_guess__Kerr_KerrSchild
	struct	{
		fp x_posn, y_posn, z_posn;
		fp mass, spin;
		} Kerr_KerrSchild_info;

	// parameters for method == initial_guess__coord_sphere
	struct	{
		fp x_center, y_center, z_center;
		fp radius;
		} coord_sphere_info;

	// parameters for method == initial_guess__coord_ellipsoid
	struct	{
		fp x_center, y_center, z_center;
		fp x_radius, y_radius, z_radius;
		} coord_ellipsoid_info;
	};

//
// This struct holds parameters for solving the Theta(h) = 0 equations.
//
struct	solver_info
	{
	bool debugging_output_at_each_Newton_iteration;
	struct linear_solver_pars linear_solver_pars;
	int max_Newton_iterations__initial,
	    max_Newton_iterations__subsequent;
	fp max_allowable_Delta_h_over_h;
	fp Theta_norm_for_convergence;
	fp max_allowable_Theta;
        fp max_allowable_Theta_growth_iterations;
        fp max_allowable_Theta_nonshrink_iterations;
	fp *max_allowable_horizon_radius;	// --> new[]-allocated array
						//     of size  N_horizons+1 ,
						//     subscripted by hn
	bool want_expansion_gradients;
	};

//
// This struct holds info for I/O
//
struct	IO_info
	{
	// buffer size for file names
	// ... file names longer than this will be truncated, but
	//     they will NOT overflow the buffer (we always use snprintf(3))
	enum { file_name_buffer_size = 512 };

	// default permissions for newly created directories
	// = full access to everyone; the user's umask
	//   should cut this down to something reasonable
	enum { default_directory_permission = 0777 };

        bool output_ASCII_files;
        bool output_HDF5_files;
	bool output_initial_guess;
	int output_h_every, output_Theta_every;
	int output_mean_curvature_every;
	// based on the above, do we want to output things now (this time step)?
	bool output_h, output_Theta, output_mean_curvature;

	bool output_BH_diagnostics;
	const char* BH_diagnostics_directory;
	const char* BH_diagnostics_base_file_name;
	const char* BH_diagnostics_file_name_extension;

	bool output_ghost_zones_for_h;
	const char* ASCII_gnuplot_file_name_extension;
	const char* HDF5_file_name_extension;
	const char* h_directory;
	const char* h_base_file_name;
	const char* Theta_base_file_name;
	const char* mean_curvature_base_file_name;
	const char* Delta_h_base_file_name;
        int h_min_digits;

	const char* Jacobian_base_file_name;

	bool output_OpenDX_control_files;
	const char* OpenDX_control_file_name_extension;

	// this is used to choose file names
	int time_iteration;	// the Cactus time interation number
				// (cctk_iteration)
	fp time;		// the Cactus time coordinate (cctk_time)
	};

//
// This struct holds info describing how verbose we should be
//
struct	verbose_info
	{
	// decoded from verbose_level parameter
	enum verbose_level verbose_level;

	// derived Boolean flags saying whether or not
	// verbose_level is >= the appropriate level
	bool print_physics_highlights;
	bool print_physics_details;
	bool print_algorithm_highlights;
	bool print_algorithm_details;
	bool print_algorithm_debug;
	};

//
// This struct holds info for setting a mask grid function
// based on each apparent horizon shape.
//
struct	mask_info
	{
	bool  set_mask_for_any_horizon;
	bool* set_mask_for_this_horizon;
	CCTK_REAL radius_multiplier, radius_offset;
	CCTK_REAL buffer_thickness;
	bool mask_is_noshrink;
	CCTK_REAL min_horizon_radius_points_for_mask;
	bool set_old_style_mask, set_new_style_mask;
	struct	old_style_mask_info
		{
		const char* gridfn_name;
		int         gridfn_varindex;
		CCTK_REAL*  gridfn_dataptr;
		CCTK_REAL   inside_value, buffer_value, outside_value;
		} old_style_mask_info;
	struct	new_style_mask_info
		{
		const char* gridfn_name;
		int         gridfn_varindex;
		CCTK_INT*   gridfn_dataptr;
		const char* bitfield_name;
		CCTK_INT    bitfield_bitmask;
		const char* inside_value;
		const char* buffer_value;
		const char* outside_value;
		CCTK_INT    inside_bitvalue, buffer_bitvalue, outside_bitvalue;
		} new_style_mask_info;
	};

//
// This struct holds interprocessor-communication buffers for broadcasting
// status information from each active processor to all processors.
//
struct	iteration_status_buffers
	{
	// --> high-level buffers for broadcast-level semantics in Newton()
	// ... broadcast_status() [in Newton.c] sets these all to point to
	//     new-allocated arrays of size N_active_procs on its first call
	int* hn_buffer;
	int* iteration_buffer;
	enum expansion_status* expansion_status_buffer;
	fp* mean_horizon_radius_buffer;
	fp* Theta_infinity_norm_buffer;
	bool* found_horizon_buffer;

	// --> low-level buffers for CCTK_Reduce()
	// ... broadcast_status() [in Newton.c] sets these to point to
	//     new-allocated objects on its first call
	jtutil::array2d<CCTK_REAL> *send_buffer_ptr;
	jtutil::array2d<CCTK_REAL> *receive_buffer_ptr;

	iteration_status_buffers()
		: hn_buffer(NULL), iteration_buffer(NULL),
		  expansion_status_buffer(NULL),
		  mean_horizon_radius_buffer(NULL),
		  Theta_infinity_norm_buffer(NULL),
		  found_horizon_buffer(NULL),
		  send_buffer_ptr(NULL), receive_buffer_ptr(NULL)
		{ }
	};

//
// This struct holds interprocessor-communication buffers for broadcasting
// the BH diagnostics and horizon shape from the processor which finds a
// given horizon, to all processors.
//
struct	horizon_buffers
	{
	int N_buffer;		// number of CCTK_REAL values in each buffer
	CCTK_REAL* send_buffer;
	CCTK_REAL* receive_buffer;

	horizon_buffers()
		: N_buffer(0),
		  send_buffer(NULL),
		  receive_buffer(NULL)
		{ }
	};

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

//
// (A single copy of) this struct holds all of our information about
// a single apparent horizon.
//
struct	AH_data
	{
	//
	// Any given horizon is allocated to a single processor.
	// On that processor (where we actually find the horizon)
	// we keep a "full-fledged" patch system and a Jacobian.
	// On other processors (where we only use the horizon shape
	// to (optionally) set the BH excision mask), we keep only a
	// "skeletal" patch system, and no Jacobian.
	//
	patch_system* ps_ptr;
	Jacobian* Jac_ptr;
        what_to_compute compute_info;

        bool move_origins;

        bool use_pretracking;
        int pretracking_max_iterations;

        fp pretracking_value;
        fp pretracking_minimum_value;
        fp pretracking_maximum_value;
        fp pretracking_delta;
        fp pretracking_minimum_delta;
        fp pretracking_maximum_delta;

        int depends_on;
        fp desired_value_factor;
        fp desired_value_offset;

        fp shiftout_factor;
        fp smoothing_factor;

	// are we finding this horizon "from scratch"?
	// ... true if this is the first time we've tried to find it,
	//          or if we've tried before but failed to find it the
	//          last time
	//     false if we've tried before and succeeded the last time
	//           (so we have that position as a very good initial guess)
	// ... also false if we're not finding this horizon on this processor
	bool initial_find_flag;
        // is this really the first time in this simulation that we are
        // trying to find a horizon?
        // ... true initially if this is a genuine horizon,
        //     false after the first time that a horizon has been found
	bool really_initial_find_flag;

	// used only if we're finding this horizon on this processor
	struct initial_guess_info initial_guess_info;

	bool search_flag;	// did we search for this horizon
	bool found_flag;	// did we find this horizon (successfully)
	bool h_files_written;	// have we written horizon-shape or similar
				// files for this horizon yet?

	struct BH_diagnostics BH_diagnostics;
	FILE *BH_diagnostics_fileptr;

	// interprocessor-communication buffers
	// for this horizon's BH diagnostics and (optionally) horizon shape
	struct horizon_buffers horizon_buffers;
	};

//
// (A single copy of) this struct holds all of our state on this processor
// that's persistent across Cactus scheduler calls.  This copy lives in
// "state.cc".
//
struct	state
	{
	enum method method;
	struct error_info error_info;
	struct verbose_info verbose_info;
	int timer_handle;
	int N_procs;			// total number of processors
	int my_proc;			// processor number of this processor
					// (0 to N_procs-1)

	int N_horizons;			// total number of genuine horizons
					// being searched for
	int N_active_procs;		// total number of active processors
					// (the active processors are processor
					//  numbers 0 to N_active_procs-1)

	struct cactus_grid_info cgi;
	struct geometry_info gi;
	struct Jacobian_info Jac_info;
	struct solver_info solver_info;
	struct IO_info IO_info;

	struct BH_diagnostics_info BH_diagnostics_info;
	struct mask_info mask_info;

	// interprocessor-communication buffers for broadcasting
	// Newton-iteration status from active processors to all processors
	struct iteration_status_buffers isb;

	horizon_sequence *my_hs;	// --> new-allocated object describing
					//     the sequence of genuine horizons
					//     assigned to this processor

	// horizon numbers ("hn") run from 1 to N_horizons inclusive
	struct AH_data** AH_data_array;	// --> new[]-allocated array of size
					//     N_horizons+1, subscripted by hn,
					//     of --> info
	};

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

//
// prototypes for functions visible outside their source files
//

// setup.cc
// ... called from Cactus Scheduler
extern "C"
  void AHFinderDirect_setup(CCTK_ARGUMENTS);

// find_horizons.cc
// ... called from Cactus Scheduler
extern "C"
  void AHFinderDirect_find_horizons(CCTK_ARGUMENTS);

// announce.cc
// ... called from Cactus Scheduler
extern "C"
  void AHFinderDirect_announce(CCTK_ARGUMENTS);

// mask.cc
// ... called from Cactus Scheduler
extern "C"
  void AHFinderDirect_maybe_do_masks(CCTK_ARGUMENTS);

// aliased_functions.cc
// ... called from other thorns via the Cactus flesh function-aliasing mechanism
extern "C"
  CCTK_INT AHFinderDirect_local_coordinate_origin
    (CCTK_INT horizon_number,
     CCTK_REAL* origin_x_ptr, CCTK_REAL* origin_y_ptr, CCTK_REAL* origin_z_ptr);
extern "C"
  CCTK_INT AHFinderDirect_horizon_was_found(CCTK_INT horizon_number);
extern "C"
  CCTK_INT AHFinderDirect_radius_in_direction
    (CCTK_INT horizon_number,
     CCTK_INT N_points,
     const CCTK_REAL* const x, const CCTK_REAL* const y, const CCTK_REAL* const 
z,
     CCTK_REAL* const radius);

// initial_guess.cc
void setup_initial_guess(patch_system& ps,
			 const struct initial_guess_info& igi,
			 const struct IO_info& IO_info,
			 int hn, int N_horizons,
			 const struct verbose_info& verbose_info);
enum initial_guess_method
  decode_initial_guess_method(const char initial_guess_method_string[]);


void set_initial_guess_parameters(struct AH_data& AH_data, const int hn,
                                  const fp origin_x, const fp origin_y, const fp origin_z);

// Newton.cc
// returns true for success, false for failure to converge
void Newton(const cGH* GH,
	    int N_procs, int N_active_procs, int my_proc,
	    horizon_sequence& hs, struct AH_data* const AH_data_array[],
	    const struct cactus_grid_info& cgi,
	    const struct geometry_info& gi,
	    const struct Jacobian_info& Jacobian_info,
	    const struct solver_info& solver_info,
	    const struct IO_info& IO_info,
	    const struct BH_diagnostics_info& BH_diagnostics_info,
	    bool broadcast_horizon_shape,
	    const struct error_info& error_info,
	    const struct verbose_info& verbose_info,
	    struct iteration_status_buffers& isb);

// Tracks coordinate origin
void track_origin(const cGH* const cctkGH, patch_system& ps, 
                  struct AH_data* const AH_data_ptr, 
                  const int hn, const bool print_algorithm_details);

// io.cc
void input_gridfn(patch_system& ps, int unknown_gfn,
		  const struct IO_info& IO_info, const char base_file_name[],
		  int min_digits,
		  int hn, bool print_msg_flag, int AHF_iteration = 0);
void input_gridfn__explicit_name(patch_system& ps, int unknown_gfn,
				 const struct IO_info& IO_info,
				 const char file_name[], bool print_msg_flag);
void setup_h_files(patch_system& ps, const struct IO_info& IO_info, int hn);
void output_gridfn(patch_system& ps, int unknown_gfn,
                   const char gfn_name[], const cGH *cctkGH,
		   const struct IO_info& IO_info, const char base_file_name[],
                   int min_digits,
		   int hn, bool print_msg_flag, int AHF_iteration = 0);
void output_Jacobians(const patch_system& ps,
		      const Jacobian* Jac_NP_ptr,
		      const Jacobian* Jac_SD_FDdr_ptr,
		      const struct IO_info& IO_info, const char base_file_name[],
                      int min_digits,
		      int hn, bool print_msg_flag, int AHF_iteration = 0);

// misc-driver.cc
int Cactus_gridfn_varindex(const char gridfn_name[]);

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

	  }	// namespace AHFinderDirect

```

driver/aliased_functions.cc:
```
// horizon_radius.cc -- provide horizon radius & other info for other thorns
// $Header$
//
// <<<access to persistent data>>>
// AHFinderDirect_local_coordinate_origin - provide our local coordinate origin
// AHFinderDirect_horizon_was_found - query if a given horizon was found
// AHFinderDirect_horizon_centroid - query horizon centroid & if it was found
// AHFinderDirect_radius_in_direction - provide r(angle) function
//

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

#include <vector>

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// This function is called (via the magic of function aliasing) by
// other thorns to find out our local coordinate origin for a given AH.
//
// Results:
// This function returns 0 for ok, or -1 if the horizon number is invalid.
//
extern "C"
  CCTK_INT AHFinderDirect_local_coordinate_origin
    (CCTK_INT horizon_number,
     CCTK_REAL* p_origin_x, CCTK_REAL* p_origin_y, CCTK_REAL* p_origin_z)
{
const struct verbose_info& verbose_info = state.verbose_info;

if (!  ((horizon_number >= 1) && (horizon_number <= state.N_horizons))  )
   then {
	CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_local_coordinate_origin():\n"
"        horizon_number=%d must be in the range [1,N_horizons=%d]!\n"
		   ,
		   int(horizon_number), state.N_horizons);
	return -1;					// *** ERROR RETURN ***
	}

assert(state.AH_data_array[horizon_number] != NULL);
const struct AH_data& AH_data = *state.AH_data_array[horizon_number];

assert(AH_data.ps_ptr != NULL);
const patch_system& ps = *AH_data.ps_ptr;

assert(p_origin_x != NULL);
assert(p_origin_y != NULL);
assert(p_origin_z != NULL);
*p_origin_x = ps.origin_x();
*p_origin_y = ps.origin_y();
*p_origin_z = ps.origin_z();

return 0;						// *** NORMAL RETURN ***
}

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

//
// This function is called (via the Cactus flesh function-aliasing mechanism)
// by other thorns to query whether or not the specified horizon was found
// the last time we searched for it.
//
// Results:
// This function returns
//  1 if the horizon was found
//  0 if the horizon was not found
//  -1 if the horizon number is invalid.
//
extern "C"
  CCTK_INT AHFinderDirect_horizon_was_found(CCTK_INT horizon_number)
{
const struct verbose_info& verbose_info = state.verbose_info;

if (!  ((horizon_number >= 1) && (horizon_number <= state.N_horizons))  )
   then {
	CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_horizon_was_found():\n"
"        horizon_number=%d must be in the range [1,N_horizons=%d]!\n"
		   ,
		   int(horizon_number), state.N_horizons);
	return -1;					// *** ERROR RETURN ***
	}

assert(state.AH_data_array[horizon_number] != NULL);
const struct AH_data& AH_data = *state.AH_data_array[horizon_number];

return AH_data.found_flag ? 1 : 0;
}

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

//
// This function is called (via the Cactus flesh function-aliasing mechanism)
// by other thorns to query whether or not the specified horizon was found
// the last time we searched for it, and if so, to determine the horizon
// centroid.
//
// Results:
// This function returns:
//  1 if the horizon was found; in this case  *centroid_[xyz]_ptr
//    are set to the centroid position 
//  0 if the horizon was not found; in this case  *centroid_[xyz]_ptr
//    set to zeros
//  negative for an error
//
extern "C"
  CCTK_INT AHFinderDirect_horizon_centroid
    (CCTK_INT horizon_number,
     CCTK_REAL* p_centroid_x, CCTK_REAL* p_centroid_y, CCTK_REAL* p_centroid_z)
{
const struct verbose_info& verbose_info = state.verbose_info;

if (!  ((horizon_number >= 1) && (horizon_number <= state.N_horizons))  )
   then {
	CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
"AHFinderDirect_horizon_centroid():\n"
"        horizon_number=%d must be in the range [1,N_horizons=%d]!\n"
		   ,
		   int(horizon_number), state.N_horizons);
	return -1;					// *** ERROR RETURN ***
	}

assert(state.AH_data_array[horizon_number] != NULL);
const struct AH_data& AH_data = *state.AH_data_array[horizon_number];
const struct BH_diagnostics& BH_diagnostics = AH_data.BH_diagnostics;

assert(p_centroid_x != NULL);
assert(p_centroid_y != NULL);
assert(p_centroid_z != NULL);
if (AH_data.found_flag)
   then {
	*p_centroid_x = BH_diagnostics.centroid_x;
	*p_centroid_y = BH_diagnostics.centroid_y;
	*p_centroid_z = BH_diagnostics.centroid_z;
	return 1;
	}
   else {
	*p_centroid_x = 0.0;
	*p_centroid_y = 0.0;
	*p_centroid_z = 0.0;
	return 0;
	}
}

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

//
// This function is called (via the Cactus flesh function-aliasing mechanism)
// by other thorns to find out a given AH's radius in the direction from
// its local coordinate origin to a given (x,y,z) coordinate or coordinates.
//
// Arguments:
// horizon_number = must be in the range 1 to N_horizons
// N_points = should be >= 0
// x[], y[], z[] = these give the (x,y,z) coordinates
// radius[] = this is set to the horizon radius values (Euclidean distance
//	      from the local coordinate origin), or to all -1.0 if we didn't
//	      find this horizon the last time we looked for it
//
// Results:
// This function returns 0 for ok, or -1 if the horizon number is invalid.
//
extern "C"
  CCTK_INT AHFinderDirect_radius_in_direction
    (CCTK_INT horizon_number,
     CCTK_INT N_points,
     const CCTK_REAL* const x, const CCTK_REAL* const y, const CCTK_REAL* const z,
     CCTK_REAL* const radius)
{
  const struct verbose_info& verbose_info = state.verbose_info;
  
  if (! ((horizon_number >= 1) && (horizon_number <= state.N_horizons)) ) {
    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
               "AHFinderDirect_distance_outside_thorn():\n"
               "        horizon_number=%d must be in the range [1,N_horizons=%d]!\n"
               ,
               int(horizon_number), state.N_horizons);
    return -1;					// *** ERROR RETURN ***
  }
  
  assert(state.AH_data_array[horizon_number] != NULL);
  const struct AH_data& AH_data = *state.AH_data_array[horizon_number];
  
  if (AH_data.found_flag) {
    
    assert(AH_data.ps_ptr != NULL);
    const patch_system& ps = *AH_data.ps_ptr;
    
    std::vector<fp> local_xs(N_points);
    std::vector<fp> local_ys(N_points);
    std::vector<fp> local_zs(N_points);
    
    for (int point = 0 ; point < N_points ; ++point) {
      
      local_xs.at(point) = x[point] - ps.origin_x();
      local_ys.at(point) = y[point] - ps.origin_y();
      local_zs.at(point) = z[point] - ps.origin_z();
      
    }
    
    ps.radii_in_local_xyz_directions (gfns::gfn__h,
                                      N_points,
                                      & local_xs.front(),
                                      & local_ys.front(),
                                      & local_zs.front(),
                                      radius);
    
  } else {
    // if not found
    
    for (int point = 0 ; point < N_points ; ++point) {
      radius[point] = -1.0;
    }
    
  } // if not found

return 0;						// *** NORMAL RETURN ***
}

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

	  }	// namespace AHFinderDirect

```

driver/BH_diagnostics.cc:
```
// BH_diagnostics.cc -- compute/print BH diagnostics
// $Header$
//
// BH_diagnostics::BH_diagnostics - initialize a  struct BH_diagnostics
//
// BH_diagnostics::copy_to_buffer - copy diagnostics to buffer
// BH_diagnostics::copy_from_buffer - copy buffer to diagnostics
//
// BH_diagnostics::compute - compute BH diagnostics after an AH has been found
// BH_diagnostics::surface_integral - integrate gridfn over the 2-sphere
//
// print - print a line or two summarizing the diagnostics
// setup_output_file - create/open output file, write header describing fields
// output - write a (long) line of all the diagnostics
// store - copy the surface and the diagnostics into the SphericalSurface
//         variables
// save - copy the surface and the diagnostics into the Cactus variables
// load - set the surface and the diagnostics from the Cactus variables
//

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

#include <vector>

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// This function initializes a  struct BH_diagnostics  to all zeros.
//
BH_diagnostics::BH_diagnostics()
	: origin_x(0.0), origin_y(0.0), origin_z(0.0),
	  centroid_x(0.0), centroid_y(0.0), centroid_z(0.0),
          quadrupole_xx(0.0), quadrupole_xy(0.0), quadrupole_xz(0.0),
          quadrupole_yy(0.0), quadrupole_yz(0.0), quadrupole_zz(0.0),
	  min_radius(0.0), max_radius(0.0), mean_radius(0.0),
	  min_x(0.0), max_x(0.0),
	  min_y(0.0), max_y(0.0),
	  min_z(0.0), max_z(0.0),
	  circumference_xy(0.0), circumference_xz(0.0), circumference_yz(0.0),
	  area(1.0),
          expansion(0.0),
          inner_expansion(0.0),
          product_expansion(0.0),
          mean_curvature(0.0),
          area_gradient(0.0),
          expansion_gradient(0.0),
          inner_expansion_gradient(0.0),
          product_expansion_gradient(0.0),
          mean_curvature_gradient(0.0),
          mean_curvature_minimum(0.0),
          mean_curvature_maximum(0.0),
          mean_curvature_integral(0.0)
{ }

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

//
// This function copies the diagnostics to a user-supplied buffer.
//
void BH_diagnostics::copy_to_buffer(CCTK_REAL buffer[N_buffer])
	const
{
buffer[posn__origin_x] = this->origin_x;
buffer[posn__origin_y] = this->origin_y;
buffer[posn__origin_z] = this->origin_z;

buffer[posn__centroid_x] = centroid_x;
buffer[posn__centroid_y] = centroid_y;
buffer[posn__centroid_z] = centroid_z;

buffer[posn__quadrupole_xx] = quadrupole_xx;
buffer[posn__quadrupole_xy] = quadrupole_xy;
buffer[posn__quadrupole_xz] = quadrupole_xz;
buffer[posn__quadrupole_yy] = quadrupole_yy;
buffer[posn__quadrupole_xz] = quadrupole_yz;
buffer[posn__quadrupole_zz] = quadrupole_zz;

buffer[posn__min_radius]  = min_radius;
buffer[posn__max_radius]  = max_radius;
buffer[posn__mean_radius] = mean_radius;

buffer[posn__min_x] = min_x;
buffer[posn__max_x] = max_x;
buffer[posn__min_y] = min_y;
buffer[posn__max_y] = max_y;
buffer[posn__min_z] = min_z;
buffer[posn__max_z] = max_z;

buffer[posn__circumference_xy]  = circumference_xy;
buffer[posn__circumference_xz]  = circumference_xz;
buffer[posn__circumference_yz]  = circumference_yz;
buffer[posn__area]              = area;
buffer[posn__expansion]         = expansion;
buffer[posn__inner_expansion]   = inner_expansion;
buffer[posn__product_expansion] = product_expansion;
buffer[posn__mean_curvature]    = mean_curvature;

buffer[posn__area_gradient]              = area_gradient;
buffer[posn__expansion_gradient]         = expansion_gradient;
buffer[posn__inner_expansion_gradient]   = inner_expansion_gradient;
buffer[posn__product_expansion_gradient] = product_expansion_gradient;
buffer[posn__mean_curvature_gradient]    = mean_curvature_gradient;

buffer[posn__mean_curvature_minimum]    = mean_curvature_minimum;
buffer[posn__mean_curvature_maximum]    = mean_curvature_maximum;
buffer[posn__mean_curvature_integral]   = mean_curvature_integral;
}

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

//
// This function copies a user-supplied buffer to the diagnostics.
//
void BH_diagnostics::copy_from_buffer(const CCTK_REAL buffer[N_buffer])
{
this->origin_x = buffer[posn__origin_x];
this->origin_y = buffer[posn__origin_y];
this->origin_z = buffer[posn__origin_z];

centroid_x = buffer[posn__centroid_x];
centroid_y = buffer[posn__centroid_y];
centroid_z = buffer[posn__centroid_z];

quadrupole_xx = buffer[posn__quadrupole_xx];
quadrupole_xy = buffer[posn__quadrupole_xy];
quadrupole_xz = buffer[posn__quadrupole_xz];
quadrupole_yy = buffer[posn__quadrupole_yy];
quadrupole_yz = buffer[posn__quadrupole_yz];
quadrupole_zz = buffer[posn__quadrupole_zz];

 min_radius = buffer[posn__min_radius];
 max_radius = buffer[posn__max_radius];
mean_radius = buffer[posn__mean_radius];

min_x = buffer[posn__min_x];
max_x = buffer[posn__max_x];
min_y = buffer[posn__min_y];
max_y = buffer[posn__max_y];
min_z = buffer[posn__min_z];
max_z = buffer[posn__max_z];

 circumference_xy = buffer[posn__circumference_xy];
 circumference_xz = buffer[posn__circumference_xz];
 circumference_yz = buffer[posn__circumference_yz];
             area = buffer[posn__area];
        expansion = buffer[posn__expansion];
  inner_expansion = buffer[posn__inner_expansion];
product_expansion = buffer[posn__product_expansion];
   mean_curvature = buffer[posn__mean_curvature];

             area_gradient = buffer[posn__area_gradient];
        expansion_gradient = buffer[posn__expansion_gradient];
  inner_expansion_gradient = buffer[posn__inner_expansion_gradient];
product_expansion_gradient = buffer[posn__product_expansion_gradient];
   mean_curvature_gradient = buffer[posn__mean_curvature_gradient];

   mean_curvature_minimum  = buffer[posn__mean_curvature_minimum];
   mean_curvature_maximum  = buffer[posn__mean_curvature_maximum];
   mean_curvature_integral = buffer[posn__mean_curvature_integral];
}

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

//
// Given that an apparent horizon has been found, this function computes
// various black hole diagnostics.
//
// Inputs (gridfns)
// h		# ghosted
// one		# nominal
// global_[xyz]	# nominal
//
// Bugs:
// The computation is rather inefficient -- we make many passes over the
// angular grid, instead of doing everything in one pass.
//
void BH_diagnostics::compute
	(const patch_system& ps,
         const fp the_area,
         const fp mean_expansion,
         const fp mean_inner_expansion,
         const fp mean_product_expansion,
         const fp mean_mean_curvature,
         const fp the_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)
{
//
// min/max radius of horizon
//
jtutil::norm<fp> h_norms;
ps.ghosted_gridfn_norms(gfns::gfn__h, h_norms);
min_radius = h_norms.min_abs_value();
max_radius = h_norms.max_abs_value();


//
// xyz bounding box of horizon
//

// compute bounding box of nominal grid
// ... this is only the stored part of the horizon if there are symmetries
jtutil::norm<fp> x_norms;
ps.gridfn_norms(gfns::gfn__global_x, x_norms);
min_x = x_norms.min_value();
max_x = x_norms.max_value();

jtutil::norm<fp> y_norms;
ps.gridfn_norms(gfns::gfn__global_y, y_norms);
min_y = y_norms.min_value();
max_y = y_norms.max_value();

jtutil::norm<fp> z_norms;
ps.gridfn_norms(gfns::gfn__global_z, z_norms);
min_z = z_norms.min_value();
max_z = z_norms.max_value();

// adjust the bounding box for the symmetries
#define REFLECT(origin_, max_)	(origin_ - (max_ - origin_))
switch	(ps.type())
	{
case patch_system::patch_system__full_sphere:
	break;
case patch_system::patch_system__plus_z_hemisphere:
	min_z = REFLECT(ps.origin_z(), max_z);
	break;
case patch_system::patch_system__plus_xy_quadrant_mirrored:
case patch_system::patch_system__plus_xy_quadrant_rotating:
	min_x = REFLECT(ps.origin_x(), max_x);
	min_y = REFLECT(ps.origin_y(), max_y);
	break;
case patch_system::patch_system__plus_xz_quadrant_mirrored:
case patch_system::patch_system__plus_xz_quadrant_rotating:
	min_x = REFLECT(ps.origin_x(), max_x);
	min_z = REFLECT(ps.origin_z(), max_z);
	break;
case patch_system::patch_system__plus_xyz_octant_mirrored:
case patch_system::patch_system__plus_xyz_octant_rotating:
	min_x = REFLECT(ps.origin_x(), max_x);
	min_y = REFLECT(ps.origin_y(), max_y);
	min_z = REFLECT(ps.origin_z(), max_z);
	break;
default:
	error_exit(PANIC_EXIT,
"***** BH_diagnostics::compute(): unknown patch system type()=(int)%d!\n"
"                                 (this should never happen!)\n",
		   int(ps.type()));				/*NOTREACHED*/
	}


//
// surface integrals
//
const fp integral_one = surface_integral(ps,
					 gfns::gfn__one, true, true, true,
					 BH_diagnostics_info.integral_method);
const fp integral_h = surface_integral(ps,
				       gfns::gfn__h, true, true, true,
				       BH_diagnostics_info.integral_method);
const fp integral_x = surface_integral(ps,
				       gfns::gfn__global_x, true, true, false,
				       BH_diagnostics_info.integral_method);
const fp integral_y = surface_integral(ps,
				       gfns::gfn__global_y, true, false, true,
				       BH_diagnostics_info.integral_method);
const fp integral_z = surface_integral(ps,
				       gfns::gfn__global_z, false, true, true,
				       BH_diagnostics_info.integral_method);
const fp integral_xx = surface_integral(ps,
                                        gfns::gfn__global_xx, true, true, true,
                                        BH_diagnostics_info.integral_method);
const fp integral_xy = surface_integral(ps,
                                        gfns::gfn__global_xy, true, false, false,
                                        BH_diagnostics_info.integral_method);
const fp integral_xz = surface_integral(ps,
                                        gfns::gfn__global_xz, false, true, false,
                                        BH_diagnostics_info.integral_method);
const fp integral_yy = surface_integral(ps,
                                        gfns::gfn__global_yy, true, true, true,
                                        BH_diagnostics_info.integral_method);
const fp integral_yz = surface_integral(ps,
                                        gfns::gfn__global_yz, false, false, true,
                                        BH_diagnostics_info.integral_method);
const fp integral_zz = surface_integral(ps,
                                        gfns::gfn__global_zz, true, true, true,
                                        BH_diagnostics_info.integral_method);


//
// originds
//
this->origin_x = ps.origin_x();
this->origin_y = ps.origin_y();
this->origin_z = ps.origin_z();


//
// centroids
//
centroid_x = integral_x / integral_one;
centroid_y = integral_y / integral_one;
centroid_z = integral_z / integral_one;


//
// quadrupoles
//
quadrupole_xx = integral_xx / integral_one;
quadrupole_xy = integral_xy / integral_one;
quadrupole_xz = integral_xz / integral_one;
quadrupole_yy = integral_yy / integral_one;
quadrupole_yz = integral_yz / integral_one;
quadrupole_zz = integral_zz / integral_one;


//
// area, mean radius, and mass
//
mean_radius = integral_h / integral_one;


//
// expansion
//
area              = the_area;
expansion         = mean_expansion;
inner_expansion   = mean_inner_expansion;
product_expansion = mean_product_expansion;
mean_curvature    = mean_mean_curvature;

area_gradient              = the_area_gradient;
expansion_gradient         = mean_expansion_gradient;
inner_expansion_gradient   = mean_inner_expansion_gradient;
product_expansion_gradient = mean_product_expansion_gradient;
mean_curvature_gradient    = mean_mean_curvature_gradient;

//
// minimum, maximum and the integral of the mean curvature
//
jtutil::norm<fp> mean_curvature_norms;
ps.gridfn_norms(gfns::gfn__mean_curvature, mean_curvature_norms);
mean_curvature_minimum = mean_curvature_norms.min_value();
mean_curvature_maximum = mean_curvature_norms.max_value();
mean_curvature_integral = surface_integral(ps,
                                           gfns::gfn__mean_curvature,
                                           true, true, true,
                                           BH_diagnostics_info.integral_method);


//
// circumferences
//
circumference_xy
  = ps.circumference("xy", 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,
		     BH_diagnostics_info.integral_method);
circumference_xz
  = ps.circumference("xz", 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,
		     BH_diagnostics_info.integral_method);
circumference_yz
  = ps.circumference("yz", 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,
		     BH_diagnostics_info.integral_method);
}

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

//
// This function computes the surface integral of a gridfn over the
// horizon.
//
//static
  fp BH_diagnostics::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)
{
return ps.integrate_gridfn
	   (src_gfn, src_gfn_is_even_across_xy_plane,
		     src_gfn_is_even_across_xz_plane,
		     src_gfn_is_even_across_yz_plane,
	    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);
}

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

//
// This function prints a line or two summarizing the diagnostics,
// using CCTK_VInfo().
//
void BH_diagnostics::print(int N_horizons, int hn)
	const
{
const fp m_irreducible = sqrt(area / (16*PI));
CCTK_VInfo(CCTK_THORNSTRING,
	   "AH %d/%d: r=%g at (%f,%f,%f)",
	   hn, N_horizons,
	   double(mean_radius),
	   double(centroid_x), double(centroid_y), double(centroid_z));
CCTK_VInfo(CCTK_THORNSTRING,
	   "AH %d/%d: area=%.10g m_irreducible=%.10g",
	   hn, N_horizons,
	   double(area), double(m_irreducible));
}

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

//
// This function creates a BH-diagnostics output file, writes a suitable
// header comment identifying the fields to be written by  output() ,
// flushes the stream (to help in examining the output while Cactus is
// still running), and finally returns a stdio file pointer which can be
// used by  output()  to output data to the file.
//
FILE* BH_diagnostics::setup_output_file(const struct IO_info& IO_info,
					int N_horizons, int hn)
	const
{
char file_name_buffer[IO_info::file_name_buffer_size];

const char* directory = IO_info.BH_diagnostics_directory;
const int status = CCTK_CreateDirectory(IO_info.default_directory_permission,
					directory);
if (status < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   BH_diagnostics::setup_output_file():\n"
"        error %d trying to create output directory\n"
"        \"%s\"!"
		   ,
		   status,
		   directory);					/*NOTREACHED*/

snprintf(file_name_buffer, IO_info::file_name_buffer_size,
	 "%s/%s.ah%d.%s",
	 directory, IO_info.BH_diagnostics_base_file_name,
	 hn, IO_info.BH_diagnostics_file_name_extension);

const char *openMode;
if (IO_TruncateOutputFiles(state.cgi.GH) == 1)
   openMode = "w";
else
   openMode = "a";

FILE *fileptr = fopen(file_name_buffer, openMode);
if (fileptr == NULL)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   BH_diagnostics::setup_output_file():\n"
"        can't open BH-diagnostics output file\n"
"        \"%s\"!"
		   ,
		   file_name_buffer);				/*NOTREACHED*/

fprintf(fileptr, "# apparent horizon %d/%d\n", hn, N_horizons);
fprintf(fileptr, "#\n");
fprintf(fileptr, "# column  1 = cctk_iteration\n");
fprintf(fileptr, "# column  2 = cctk_time\n");
fprintf(fileptr, "# column  3 = centroid_x\n");
fprintf(fileptr, "# column  4 = centroid_y\n");
fprintf(fileptr, "# column  5 = centroid_z\n");
fprintf(fileptr, "# column  6 = min radius\n");
fprintf(fileptr, "# column  7 = max radius\n");
fprintf(fileptr, "# column  8 = mean radius\n");
fprintf(fileptr, "# column  9 = quadrupole_xx\n");
fprintf(fileptr, "# column 10 = quadrupole_xy\n");
fprintf(fileptr, "# column 11 = quadrupole_xz\n");
fprintf(fileptr, "# column 12 = quadrupole_yy\n");
fprintf(fileptr, "# column 13 = quadrupole_yz\n");
fprintf(fileptr, "# column 14 = quadrupole_zz\n");
fprintf(fileptr, "# column 15 = min x\n");
fprintf(fileptr, "# column 16 = max x\n");
fprintf(fileptr, "# column 17 = min y\n");
fprintf(fileptr, "# column 18 = max y\n");
fprintf(fileptr, "# column 19 = min z\n");
fprintf(fileptr, "# column 20 = max z\n");
fprintf(fileptr, "# column 21 = xy-plane circumference\n");
fprintf(fileptr, "# column 22 = xz-plane circumference\n");
fprintf(fileptr, "# column 23 = yz-plane circumference\n");
fprintf(fileptr, "# column 24 = ratio of xz/xy-plane circumferences\n");
fprintf(fileptr, "# column 25 = ratio of yz/xy-plane circumferences\n");
fprintf(fileptr, "# column 26 = area\n");
fprintf(fileptr, "# column 27 = m_irreducible\n");
fprintf(fileptr, "# column 28 = areal radius\n");
fprintf(fileptr, "# column 29 = expansion Theta_(l)\n");
fprintf(fileptr, "# column 30 = inner expansion Theta_(n)\n");
fprintf(fileptr, "# column 31 = product of the expansions\n");
fprintf(fileptr, "# column 32 = mean curvature\n");
fprintf(fileptr, "# column 33 = gradient of the areal radius\n");
fprintf(fileptr, "# column 34 = gradient of the expansion Theta_(l)\n");
fprintf(fileptr, "# column 35 = gradient of the inner expansion Theta_(n)\n");
fprintf(fileptr, "# column 36 = gradient of the product of the expansions\n");
fprintf(fileptr, "# column 37 = gradient of the mean curvature\n");
fprintf(fileptr, "# column 38 = minimum  of the mean curvature\n");
fprintf(fileptr, "# column 39 = maximum  of the mean curvature\n");
fprintf(fileptr, "# column 40 = integral of the mean curvature\n");
fflush(fileptr);

return fileptr;
}

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

//
// This function outputs a BH-diagnostics line to a stdio stream, then
// flushes the stream (to help in examining the output while Cactus is
// still running).
//
// Arguments:
// BH_diagnostics = The BH diagnostics to be written
// fileptr = The stdio file pointer to append to
//
void BH_diagnostics::output(FILE*fileptr, const struct IO_info& IO_info)
	const
{
assert(fileptr != NULL);

fprintf(fileptr,
     //  cctk_iteration        min radius      mean radius
     //  ==  cctk_time         ======  max radius
     //  ==  ====  centroid_[xyz]      ======  ======
     //  ==  ====  ==========  ======  ======  ======
	"%d\t%.3f\t%f\t%f\t%f\t%#.10g\t%#.10g\t%#.10g\t",
	IO_info.time_iteration, double(IO_info.time),
	double(centroid_x), double(centroid_y), double(centroid_z),
	double(min_radius), double(max_radius), double(mean_radius));

fprintf(fileptr,
     //  quadrupole_{xx,xy,xz,yy,yz,zz}
     //  ================================================
	"%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t",
	double(quadrupole_xx - centroid_x*centroid_x),
        double(quadrupole_xy - centroid_x*centroid_y),
	double(quadrupole_xz - centroid_x*centroid_z),
        double(quadrupole_yy - centroid_y*centroid_y),
	double(quadrupole_yz - centroid_y*centroid_z),
        double(quadrupole_zz - centroid_z*centroid_z));

fprintf(fileptr,
     //  {min,max}_x     {min,max}_y     {min,max}_z
     //  ==============  ==============  ==============
	"%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t",
	double(min_x), double(max_x),
	double(min_y), double(max_y),
	double(min_z), double(max_z));

fprintf(fileptr,
     //  {xy,xz,yz}-plane         xz/xy  yz/xy
     //  circumferences          circumference
     //                          ratios
     //  ======================  ==============
	"%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t",
	double(circumference_xy),
	double(circumference_xz),
	double(circumference_yz),
	double(circumference_xz / circumference_xy),
	double(circumference_yz / circumference_xy));

const fp m_irreducible = sqrt(area / (16*PI));;
const fp areal_radius = sqrt(area / (4*PI));
const fp areal_radius_gradient = sqrt(1 / (16*PI*area)) * area_gradient;
fprintf(fileptr,
     //  area    m_irre- areal   expan-  inner   prod.   mean    areal   expan-  inner   prod.   mean    mean    mean    mean
     //          ducible radius  sion    expan-  of the  curva-  radius  sion    expan-  of the  curva-	 curva-  curva-  curva-
     //                                  sion    expan-  ture    grad.   grad.   sion    exp.s   ture    ture    ture    ture
     //                                          sions                           grad.   grad.   grad.   min.    max.    integ.
     //  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======
     //                                                                                                
     //  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======  ======
	"%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\n",
	double(area), double(m_irreducible), double(areal_radius),
        double(expansion), double(inner_expansion), double(product_expansion), double(mean_curvature),
        double(areal_radius_gradient),
        double(expansion_gradient), double(inner_expansion_gradient), double(product_expansion_gradient), double(mean_curvature_gradient),
	double(mean_curvature_minimum), double(mean_curvature_maximum), double(mean_curvature_integral));

fflush(fileptr);
}

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

//
// This function copies the BH-diagnostics into the SphericalSurface variables.
//
// Arguments:
// CCTK_ARGUMENTS
//
void BH_diagnostics::store(CCTK_ARGUMENTS,
                           const int horizon_number, const int surface_number)
	const
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  assert (surface_number >= 0 && surface_number < nsurfaces);
  
  assert(state.AH_data_array[horizon_number] != NULL);
  const struct AH_data& AH_data = *state.AH_data_array[horizon_number];
  
  // tell the world if we don't look for this horizon any more
  const int my_dont_find_after = dont_find_after_individual[horizon_number];
  const fp my_find_after_time = find_after_individual_time[horizon_number];
  const fp my_dont_find_after_time = dont_find_after_individual_time[horizon_number];
  if ((my_dont_find_after >= 0 and cctk_iteration > my_dont_find_after) or
      (my_dont_find_after_time > my_find_after_time and cctk_time > my_dont_find_after_time))
  {
    assert (! AH_data.search_flag);
    sf_active[surface_number] = 0;
  }
  
  // only try to copy AH info if we've found AHs at this time level
  if (! AH_data.search_flag) {
    sf_valid[surface_number] = 0;
    return;
  }
  
  // did we actually *find* this horizon?
  if (! AH_data.found_flag) {
    sf_valid[surface_number] = -1;
    return;
  }
  
  sf_active       [surface_number] = 1;
  sf_valid        [surface_number] = 1;
  sf_origin_x     [surface_number] = this->origin_x;
  sf_origin_y     [surface_number] = this->origin_y;
  sf_origin_z     [surface_number] = this->origin_z;
  sf_mean_radius  [surface_number] = mean_radius;
  sf_min_radius   [surface_number] = min_radius;
  sf_max_radius   [surface_number] = max_radius;
  sf_centroid_x   [surface_number] = centroid_x;
  sf_centroid_y   [surface_number] = centroid_y;
  sf_centroid_z   [surface_number] = centroid_z;
  sf_quadrupole_xx[surface_number] = quadrupole_xx - centroid_x*centroid_x;
  sf_quadrupole_xy[surface_number] = quadrupole_xy - centroid_x*centroid_y;
  sf_quadrupole_xz[surface_number] = quadrupole_xz - centroid_x*centroid_z;
  sf_quadrupole_yy[surface_number] = quadrupole_yy - centroid_y*centroid_y;
  sf_quadrupole_yz[surface_number] = quadrupole_yz - centroid_y*centroid_z;
  sf_quadrupole_zz[surface_number] = quadrupole_zz - centroid_z*centroid_z;
  sf_min_x        [surface_number] = min_x;
  sf_max_x        [surface_number] = max_x;
  sf_min_y        [surface_number] = min_y;
  sf_max_y        [surface_number] = max_y;
  sf_min_z        [surface_number] = min_z;
  sf_max_z        [surface_number] = max_z;
  sf_area         [surface_number] = area;
  
  std::vector<CCTK_REAL> xx, yy, zz, rr;
  xx.resize (sf_ntheta[surface_number] * sf_nphi[surface_number]);
  yy.resize (sf_ntheta[surface_number] * sf_nphi[surface_number]);
  zz.resize (sf_ntheta[surface_number] * sf_nphi[surface_number]);
  rr.resize (sf_ntheta[surface_number] * sf_nphi[surface_number]);
  size_t n;
  n = 0;
  for (int j=0; j<sf_nphi[surface_number]; ++j) {
    for (int i=0; i<sf_ntheta[surface_number]; ++i) {
      const CCTK_REAL theta
        = sf_origin_theta[surface_number] + i * sf_delta_theta[surface_number];
      const CCTK_REAL phi
        = sf_origin_phi[surface_number] + j * sf_delta_phi[surface_number];
      xx[n] = sf_origin_x[surface_number] + sin(theta) * cos(phi);
      yy[n] = sf_origin_y[surface_number] + sin(theta) * sin(phi);
      zz[n] = sf_origin_z[surface_number] + cos(theta);
      ++n;
    }
  }
  AHFinderDirect_radius_in_direction
    (horizon_number, sf_ntheta[surface_number] * sf_nphi[surface_number],
     &xx[0], &yy[0], &zz[0], &rr[0]);
  n = 0;
  for (int j=0; j<sf_nphi[surface_number]; ++j) {
    for (int i=0; i<sf_ntheta[surface_number]; ++i) {
      sf_radius[i + maxntheta * (j + maxnphi * surface_number)] = rr[n];
      ++n;
    }
  }
}

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

//
// This function copies the BH-diagnostics into the Cactus variables.
//
// Arguments:
// CCTK_ARGUMENTS
//
void BH_diagnostics::save(CCTK_ARGUMENTS,
                          const int horizon_number)
	const
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  assert(state.AH_data_array[horizon_number] != NULL);
  const struct verbose_info& verbose_info = state.verbose_info;
  const struct AH_data& AH_data = *state.AH_data_array[horizon_number];
  patch_system& ps = *AH_data.ps_ptr;
  
  if (AH_data.search_flag &&
      AH_data.found_flag &&
      cctk_iteration > ah_centroid_iteration[horizon_number-1])
  {
    ah_centroid_x_p[horizon_number-1] = ah_centroid_x[horizon_number-1];
    ah_centroid_y_p[horizon_number-1] = ah_centroid_y[horizon_number-1];
    ah_centroid_z_p[horizon_number-1] = ah_centroid_z[horizon_number-1];
    ah_centroid_t_p[horizon_number-1] = ah_centroid_t[horizon_number-1];
    ah_centroid_valid_p[horizon_number-1] = ah_centroid_valid[horizon_number-1];
    ah_centroid_iteration_p[horizon_number-1] =
      ah_centroid_iteration[horizon_number-1];
  
    ah_centroid_x[horizon_number-1] = centroid_x;
    ah_centroid_y[horizon_number-1] = centroid_y;
    ah_centroid_z[horizon_number-1] = centroid_z;
    ah_centroid_t[horizon_number-1] = cctk_time;
    ah_centroid_valid[horizon_number-1] = AH_data.found_flag;
    ah_centroid_iteration[horizon_number-1] = cctk_iteration;
  }
  
  ah_origin_x[horizon_number-1] = ps.origin_x();
  ah_origin_y[horizon_number-1] = ps.origin_y();
  ah_origin_z[horizon_number-1] = ps.origin_z();
  
  for (int pn = 0; pn < ps.N_patches(); ++pn) {
    assert (pn < 6);
    patch& p = ps.ith_patch(pn);
    for (int i = 0, irho = p.min_irho(); irho <= p.max_irho(); ++i, ++irho) {
      assert (i <= max_N_zones_per_right_angle);
      for (int j = 0, isigma = p.min_isigma(); isigma <= p.max_isigma(); ++j, ++isigma) {
        assert (j <= max_N_zones_per_right_angle);
        ah_radius[i + (max_N_zones_per_right_angle+1) * (j + (max_N_zones_per_right_angle+1) * (pn + 6 * (horizon_number-1)))]
          = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
      }
    }
  }
  
  ah_initial_find_flag       [horizon_number-1] = AH_data.initial_find_flag;
  ah_really_initial_find_flag[horizon_number-1] = AH_data.really_initial_find_flag;
  ah_search_flag             [horizon_number-1] = AH_data.search_flag;
  ah_found_flag              [horizon_number-1] = AH_data.found_flag;
  if (verbose_info.print_algorithm_details) {
    printf ("AHF BH_diagnostics::save[%d] initial_find_flag=%d\n",        horizon_number, (int) AH_data.initial_find_flag);
    printf ("AHF BH_diagnostics::save[%d] really_initial_find_flag=%d\n", horizon_number, (int) AH_data.really_initial_find_flag);
    printf ("AHF BH_diagnostics::save[%d] search_flag=%d\n",              horizon_number, (int) AH_data.search_flag);
    printf ("AHF BH_diagnostics::save[%d] found_flag=%d\n",               horizon_number, (int) AH_data.found_flag);
  }
}

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

//
// This function copies the BH-diagnostics from the Cactus variables.
//
// Arguments:
// CCTK_ARGUMENTS
//
void BH_diagnostics::load(CCTK_ARGUMENTS,
                          const int horizon_number)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  assert(state.AH_data_array[horizon_number] != NULL);
  const struct verbose_info& verbose_info = state.verbose_info;
  struct AH_data& AH_data = *state.AH_data_array[horizon_number];
  patch_system& ps = *AH_data.ps_ptr;
  
  // only use stored origins if horizon had not yet been found!
  if (ah_found_flag[horizon_number-1]) {
    ps.origin_x(ah_origin_x[horizon_number-1]);
    ps.origin_y(ah_origin_y[horizon_number-1]);
    ps.origin_z(ah_origin_z[horizon_number-1]);
  }
  
  for (int pn = 0; pn < ps.N_patches(); ++pn) {
    assert (pn < 6);
    patch& p = ps.ith_patch(pn);
    for (int i = 0, irho = p.min_irho(); irho <= p.max_irho(); ++i, ++irho) {
      assert (i <= max_N_zones_per_right_angle);
      for (int j = 0, isigma = p.min_isigma(); isigma <= p.max_isigma(); ++j, ++isigma) {
        assert (j <= max_N_zones_per_right_angle);
        p.ghosted_gridfn(gfns::gfn__h, irho,isigma) =
          ah_radius[i + (max_N_zones_per_right_angle+1) * (j + (max_N_zones_per_right_angle+1) * (pn + 6 * (horizon_number-1)))];
      }
    }
  }
  
  // recover the full ghosted-grid horizon shape
  // (we only save and load the nominal-grid shape)
  ps.synchronize();
  
  AH_data.initial_find_flag        = ah_initial_find_flag       [horizon_number-1];
  AH_data.really_initial_find_flag = ah_really_initial_find_flag[horizon_number-1];
  AH_data.search_flag              = ah_search_flag             [horizon_number-1];
  AH_data.found_flag               = ah_found_flag              [horizon_number-1];
  if (verbose_info.print_algorithm_details) {
    printf ("AHF BH_diagnostics::load[%d] initial_find_flag=%d\n",        horizon_number, (int) AH_data.initial_find_flag);
    printf ("AHF BH_diagnostics::load[%d] really_initial_find_flag=%d\n", horizon_number, (int) AH_data.really_initial_find_flag);
    printf ("AHF BH_diagnostics::load[%d] search_flag=%d\n",              horizon_number, (int) AH_data.search_flag);
    printf ("AHF BH_diagnostics::load[%d] found_flag=%d\n",               horizon_number, (int) AH_data.found_flag);
  }
}

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

	  }	// namespace AHFinderDirect

```

driver/horizon_sequence.hh:
```
// horizon_sequence.hh -- describes sequence of horizons a processor works on
// $Header$

// everything in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// A  horizon_sequence  object describes the sequence of horizons a
// (the current) procesor works on.  This is some sequence of genuine
// horizons, followed by a dummy horizon, the latter repeating indefinitely.
//
// A horizon is specified by its (globally unique) "horizon number",
// which is 0 for a dummy horizon, or [1,N_horizons] for a genuine horizon.
//
// Thus a typical sequence of horizon numbers might be
//	1, 3, 4, 0, 0, 0, 0, ...
//
class	horizon_sequence
	{
public:
	//
	// ***** query functions *****
	//

	// how many (genuine) horizons are there in total?
	int N_horizons() const { return N_horizons_; }

	// how many genuine horizons are in the sequence (for this processor)?
	int my_N_horizons() const { return my_N_horizons_; }

	// are there any genuine horizons in the sequence (for this processor)?
	bool has_genuine_horizons() const { return my_N_horizons_ > 0; }

	// C-style string showing all horizon numbers,
	// separated by the C-style string sep, eg. "2,3,5"
	// ... result points into a private static buffer
	char* sequence_string(const char sep[]) const;

	// is the current horizon in the sequence dummy/genuine?
	bool is_dummy  () const { return posn_is_dummy  (posn_); }
	bool is_genuine() const { return posn_is_genuine(posn_); }

	// what will  is_genuine()  return after  next_hn()  is called?
	// i.e. is this *not* the final genuine  hn  in the sequence?
	bool is_next_genuine() const
		{ return posn_is_genuine( next_posn(posn_) ); }

	// return 0 if current hn is genuine,
	// or 1-origin ordinal number of dummy if it's dummy,
	//    i.e. 1 for 1st dummy, 2 for 2nd dummy, 3 for 3rd dummy, ...
	int dummy_number() const { return is_genuine() ? 0 : -posn_; }

	// get current hn in sequence
	int get_hn() const
		{ return posn_is_genuine(posn_) ? my_hn_[posn_] : 0; }

	// is a given hn genuine?
	bool is_hn_genuine(int hn) const;

	//
	// ***** traverse the sequence *****
	//
	// the idiom to traverse the genuine horizons is
	//    for (int hn = hs.init_hn() ; hs.is_genuine() ; hn = hs.next_hn())
	//    {
	//    }
	//
	// the idiom to traverse the genuine horizons, followed by
	// infinite repetition of the dummy horizon, is
	//    for (int hn = hs.init_hn() ; ; hn = hs.next_hn())
	//    {
	//    }
	//

	// reset sequence, return starting genuine hn
	int init_hn()
		{
		posn_ = (my_N_horizons_ == 0) ? -1 : 0;
		return get_hn();
		}

	// get next hn in sequence
	int next_hn() { posn_ = next_posn(posn_); return get_hn(); }


	//
	// ***** set up the sequence *****
	//

	// construct an empty horizon sequence
	// which can hold <= N_horizons horizon numbers
	horizon_sequence(int N_horizons);
	~horizon_sequence();

	// append hn to the sequence
	// ... returns new my_N_horizons()
	int append_hn(int hn);

private:
	// is a specified posn dummy/genuine
	bool posn_is_genuine(int pos) const
		{ return (pos >= 0) && (pos < my_N_horizons_); }
	bool posn_is_dummy(int pos) const
		{ return !posn_is_genuine(pos); }

	// what is the next posn in the sequence
	int next_posn(int pos) const;

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

private:
	const int N_horizons_;
	int my_N_horizons_;

	// "internal position" in sequence
	// this is a [0,my_N_horizons_) index into my_hn_[]
	//           for genuine horizons,
	//         or < 0 for the dummy horizon, with the absolute value
	//            counting the number of times we've returned hn=0
	int posn_;

	int* my_hn_;	// --> new[]-allocated array of genuine horizon numbers
	};

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

	  }	// namespace AHFinderDirect

```

driver/README:
```
This directory contains top-level routines to find the apparent horizon
and interface with the rest of Cactus.

The main source files in this directory are as follows:

README.parallel
	design notes for the parallel/multiprocessor algorithms
	and data structures

driver.hh
	overall header file for routines in this directory

state.cc
	state information (data structures) kept across Cactus scheduler calls

setup.cc		# sees CCTK_ARGUMENTS, CCTK_PARAMETERS
	this is called from the scheduler to setup our data structures

find_horizons.cc	# sees CCTK_ARGUMENTS, CCTK_PARAMETERS
	this is called from the scheduler to find the apparent horizon(s)
	in a slice

announce.cc		# sees CCTK_ARGUMENTS, CCTK_PARAMETERS
	this is called from the scheduler to announce apparent horizon
	info to other thorns

mask.cc			# sees CCTK_ARGUMENTS, CCTK_PARAMETERS
	this is called from the scheduler to set an excision mask or masks

initial_guess.cc
	this sets up the initial guess(es) for the horizon position(s)

Newton.cc		# sees cGH (for interprocessor broadcasts)
			# uses CCTK_ReduceLocArrayToArray1D() for
			#   interprocessor broadcast/synchronization
	this solves the Theta(h) = 0 equations by Newton's method

io.cc
	I/O routines

ellipsoid.maple
	this is a Maple script to compute the intersection of a given
	ray with an ellipsoid; this is used in setting up the initial guess
ellipsoid.c
	this is the Maple-generated code from "ellipsoid.maple"
ellipsoid.log
	this is the standard output from running "ellipsoid.maple"

```

driver/Newton.cc:
```
// Newton.cc -- solve Theta(h) = 0 via Newton's method
// $Header$
//
// Newton_solve - driver to solve Theta(h) = 0 for all our horizons
//
/// broadcast_status - broadcast status from active processors to all processors
/// broadcast_horizon_data - broadcast AH data to all processors
///
/// print_status - print Newton-iteration status on each active proc
/// Newton_step - take the Newton step, scaling it down if it's too large
//

#include <iostream>

#include <stdio.h>
#include <assert.h>
#include <limits.h>
#include <float.h>
#include <math.h>
#include <string.h>

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// prototypes for functions local to this file
//

namespace {
bool broadcast_status(const cGH* GH,
		      int N_procs, int N_active_procs,
		      int my_proc, bool my_active_flag,
		      int hn, int iteration,
		      enum expansion_status expansion_status,
		      fp mean_horizon_radius, fp infinity_norm,
		      bool found_this_horizon, bool I_need_more_iterations,
		      struct iteration_status_buffers& isb);
void broadcast_horizon_data(const cGH* GH,
			    bool broadcast_flag, bool broadcast_horizon_shape,
                            struct AH_data& AH_data,
			    struct BH_diagnostics& BH_diagnostics,
			    patch_system& ps,
			    struct horizon_buffers& horizon_buffers);

void print_status(int N_active_procs,
		  const struct iteration_status_buffers& isb);
void Newton_step(patch_system& ps,
		 fp mean_horizon_radius, fp max_allowable_Delta_h_over_h,
		 const struct verbose_info& verbose_info);
	  }

void track_origin(const cGH* const cctkGH, patch_system& ps, 
                  struct AH_data* const AH_data_ptr, 
                  const int hn, const bool print_algorithm_details);


//******************************************************************************
//
// This function reads a coordinate origin from a grid scalar, 
// and sets the patch system's origin to that new value
//
//
void track_origin(const cGH* const cctkGH, patch_system& ps, 
                  struct AH_data* const AH_data_ptr, 
                  const int hn, const bool print_algorithm_details)
{
DECLARE_CCTK_ARGUMENTS;
DECLARE_CCTK_PARAMETERS;

if (AH_data_ptr->depends_on == 0) {
        // move the origin as specified in the grid scalars
        fp const * const ox =
          static_cast<CCTK_REAL const *>
          (CCTK_VarDataPtr (cctkGH, 0, track_origin_source_x[hn]));
        assert (ox);
        fp const * const oy =
          static_cast<CCTK_REAL const *>
          (CCTK_VarDataPtr (cctkGH, 0, track_origin_source_y[hn]));
        assert (oy);
        fp const * const oz =
          static_cast<CCTK_REAL const *>
          (CCTK_VarDataPtr (cctkGH, 0, track_origin_source_z[hn]));
        assert (oz);
        if (print_algorithm_details) {
          std::cout << "AHF tracked position ox " << *ox << " oy " << *oy << " oz " << *oz << std::endl;
        }
        ps.origin_x (*ox);
        ps.origin_y (*oy);
        ps.origin_z (*oz);
}

}


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

//
// This function tries to finds each horizon assigned to this processor,
// by solving Theta(h) = 0 via Newton's method.  For each horizon found,
// it computes the BH diagnostics, optionally prints them (via CCTK_VInfo()),
// and optionally writes them to a BH diagnostics output file.  It also
// optionally writes the horizon shape itself to a data file.
//
// This function must be called synchronously across all processors,
// and it operates synchronously, returning only when every processor
// is done with all its horizons.  See ./README.parallel for a discussion
// of the parallel/multiprocessor issues and algorithm.
//
void Newton(const cGH* GH,
	    int N_procs, int N_active_procs, int my_proc,
	    horizon_sequence& hs, struct AH_data* const AH_data_array[],
	    const struct cactus_grid_info& cgi,
	    const struct geometry_info& gi,
	    const struct Jacobian_info& Jacobian_info,
	    const struct solver_info& solver_info,
	    const struct IO_info& IO_info,
	    const struct BH_diagnostics_info& BH_diagnostics_info,
	    bool broadcast_horizon_shape,
	    const struct error_info& error_info,
	    const struct verbose_info& verbose_info,
	    struct iteration_status_buffers& isb)
{
cGH const * const cctkGH = GH;
DECLARE_CCTK_ARGUMENTS;
DECLARE_CCTK_PARAMETERS;

const bool my_active_flag = hs.has_genuine_horizons();

// print out which horizons we're finding on this processor
if (hs.has_genuine_horizons())
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "proc %d: searching for horizon%s %s/%d",
		   my_proc,
		   (hs.my_N_horizons() > 1 ? "s" : ""),
		   hs.sequence_string(","), int(N_horizons));
   else CCTK_VInfo(CCTK_THORNSTRING,
		   "proc %d: dummy horizon(s) only",
		   my_proc);

    //
    // each pass through this loop finds a single horizon,
    // or does corresponding dummy-horizon calls
    //
    // note there is no explicit exit test, rather we exit from the middle
    // of the loop (only) when all processors are done with all their genuine
    // horizons
    //
    for (int hn = hs.init_hn() ; ; hn = hs.next_hn())
    {
    if (verbose_info.print_algorithm_details)
       then CCTK_VInfo(CCTK_THORNSTRING,
		       "Newton_solve(): processor %d working on horizon %d",
		       my_proc, hn);

    // only try to find horizons every  find_every  time steps
    const bool horizon_is_genuine =
      hs.is_genuine() && AH_data_array[hn]->search_flag;
    // this is only a pessimistic approximation
    const bool there_is_another_genuine_horizon = hs.is_next_genuine();
    if (verbose_info.print_algorithm_details)
       then {
	    CCTK_VInfo(CCTK_THORNSTRING,
		       "                horizon_is_genuine=%d",
		       int(horizon_is_genuine));
	    CCTK_VInfo(CCTK_THORNSTRING,
		       "                there_is_another_genuine_horizon=%d",
		       int(there_is_another_genuine_horizon));
	    }

    struct AH_data* AH_data_ptr
	                  = horizon_is_genuine ? AH_data_array[hn]   : NULL;

    patch_system* const  ps_ptr = horizon_is_genuine
				  ? AH_data_ptr->ps_ptr : NULL;
    Jacobian*     const Jac_ptr = horizon_is_genuine
				  ? AH_data_ptr->Jac_ptr: NULL;

    if (horizon_is_genuine) {
      // deal with dependent horizons
      if (AH_data_ptr->depends_on > 0) {
        assert (AH_data_ptr->depends_on != hn);
        assert (AH_data_ptr->depends_on < hn);
        // check that the other horizon is on the same processor!
        AH_data *AH_other_ptr = AH_data_array[AH_data_ptr->depends_on];
        assert (AH_other_ptr);
        AH_data_ptr->compute_info.desired_value
          = AH_other_ptr->compute_info.desired_value
          * AH_data_ptr->desired_value_factor
          + AH_data_ptr->desired_value_offset;
        const int gnp = ps_ptr->ghosted_N_grid_points();
        assert (AH_other_ptr->ps_ptr->ghosted_N_grid_points() == gnp);
        memcpy (ps_ptr->ghosted_gridfn_data(gfns::gfn__h),
                AH_other_ptr->ps_ptr->ghosted_gridfn_data(gfns::gfn__h),
                gnp * sizeof(fp));
        ps_ptr->origin_x (AH_other_ptr->ps_ptr->origin_x());
        ps_ptr->origin_y (AH_other_ptr->ps_ptr->origin_y());
        ps_ptr->origin_z (AH_other_ptr->ps_ptr->origin_z());
      }
    }

    if (horizon_is_genuine) {
      if (AH_data_ptr->move_origins
          && AH_data_ptr->depends_on == 0
          && AH_data_ptr->found_flag)
      {
        // move the origin to the centre
        patch_system& ps = *ps_ptr;
        fp cx=0, cy=0, cz=0;    // change of origin
        fp sx=0, sy=0, sz=0;    // change of shape
        if (! predict_origin_movement) {
          size_t N=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) {
                const fp rho = p.rho_of_irho (irho);
                const fp sigma = p.sigma_of_isigma (isigma);
                const fp r = p.ghosted_gridfn (gfns::gfn__h, irho, isigma);
                fp x, y, z;
                p.xyz_of_r_rho_sigma (r, rho, sigma, x, y, z);
                cx += x;
                cy += y;
                cz += z;
                ++N;
              }
            }
          }
          assert (N > 0);
          cx /= N;
          cy /= N;
          cz /= N;
          sx=cx; sy=cy; sz=cz;
        } else {                // if predict_origin_movement
          if (ah_centroid_valid[hn-1]) {
            if (verbose_info.print_algorithm_details) {
              std::cout << "AHF centroid x " << (ah_centroid_x[hn-1]) << " y " << (ah_centroid_y[hn-1]) << " z " << (ah_centroid_z[hn-1]) << " t " << (ah_centroid_t[hn-1]) << std::endl;
            }
            if (ah_centroid_valid_p[hn-1]) {
              // have two previous origins: linear extrapolation
              if (verbose_info.print_algorithm_details) {
                std::cout << "AHF centroid_p x " << (ah_centroid_x_p[hn-1]) << " y " << (ah_centroid_y_p[hn-1]) << " z " << (ah_centroid_z_p[hn-1]) << " t " << (ah_centroid_t_p[hn-1]) << std::endl;
              }
              fp const dt   = ah_centroid_t[hn-1] - ah_centroid_t_p[hn-1];
              fp const dt_n = cctk_time - ah_centroid_t  [hn-1];
              fp const dt_p = cctk_time - ah_centroid_t_p[hn-1];
              fp const timescale =
                fabs (dt) + fabs (dt_p) + fabs (dt_n) +
                0.001 * fabs (cctk_delta_time);
              if (10 * fabs (dt  ) < timescale ||
                  10 * fabs (dt_p) < timescale ||
                  10 * fabs (dt_n) < timescale)
              {
                // the times are too similar
                if (verbose_info.print_algorithm_details) {
                  std::cout << "AHF toosim" << std::endl;
                }
                cx = ah_centroid_x[hn-1];
                cy = ah_centroid_y[hn-1];
                cz = ah_centroid_z[hn-1];
              } else {
                fp const fact_n = + dt_p / dt;
                fp const fact_p = - dt_n / dt;
                if (fabs (fact_n) > 5 || fabs (fact_p) > 5) {
                  // don't trust a large extrapolation
                  if (verbose_info.print_algorithm_details) {
                    std::cout << "AHF notrust" << std::endl;
                  }
                  cx = ah_centroid_x[hn-1];
                  cy = ah_centroid_y[hn-1];
                  cz = ah_centroid_z[hn-1];
                } else {
                  if (verbose_info.print_algorithm_details) {
                    std::cout << "AHF extrap fn " << fact_n << " fp " << fact_p << std::endl;
                  }
                  cx = fact_n * ah_centroid_x[hn-1] + fact_p * ah_centroid_x_p[hn-1];
                  cy = fact_n * ah_centroid_y[hn-1] + fact_p * ah_centroid_y_p[hn-1];
                  cz = fact_n * ah_centroid_z[hn-1] + fact_p * ah_centroid_z_p[hn-1];
                  if (verbose_info.print_algorithm_details) {
                    std::cout << "AHF xp " << (ah_centroid_x_p[hn-1]) << " x " << (ah_centroid_x[hn-1]) << " cx " << cx << std::endl;
                  }
                }
              }
            } else {
              // have one previous origin: constant extrapolation
              if (verbose_info.print_algorithm_details) {
                std::cout << "AHF const" << std::endl;
              }
              cx = ah_centroid_x[hn-1];
              cy = ah_centroid_y[hn-1];
              cz = ah_centroid_z[hn-1];
            }
            if (verbose_info.print_algorithm_details) {
              std::cout << "AHF predicted position cx " << cx << " cy " << cy << " cz " << cz << std::endl;
            }
            cx -= ps.origin_x();
            cy -= ps.origin_y();
            cz -= ps.origin_z();
          }
          sx = ah_centroid_x[hn-1] - ps.origin_x();
          sy = ah_centroid_y[hn-1] - ps.origin_y();
          sz = ah_centroid_z[hn-1] - ps.origin_z();
        } // if predict_origin_movement
        switch (ps.type()) {
        case patch_system::patch_system__full_sphere:
          break;                // do nothing
        case patch_system::patch_system__plus_z_hemisphere:
          cz = 0; sz = 0; break;
        case patch_system::patch_system__plus_xy_quadrant_mirrored:
          cx = cy = 0; sx = sy = 0; break;
        case patch_system::patch_system__plus_xy_quadrant_rotating:
          cx = cy = 0; sx = sy = 0; break;
        case patch_system::patch_system__plus_xz_quadrant_mirrored:
          cx = cz = 0; sx = sz = 0; break;
        case patch_system::patch_system__plus_xz_quadrant_rotating:
          cx = cz = 0; sx = sz = 0; break;
        case patch_system::patch_system__plus_xyz_octant_mirrored:
          cx = cy = cz = 0; sx = sy = sz = 0; break;
        case patch_system::patch_system__plus_xyz_octant_rotating:
          cx = cy = cz = 0; sx = sy = sz = 0; break;
        default: assert(0);
        }
        ps.origin_x (ps.origin_x() + cx);
        ps.origin_y (ps.origin_y() + cy);
        ps.origin_z (ps.origin_z() + cz);
        if (reshape_while_moving) {
          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 rho = p.rho_of_irho (irho);
                const fp sigma = p.sigma_of_isigma (isigma);
                fp & r = p.ghosted_gridfn (gfns::gfn__h, irho, isigma);
                fp x, y, z;
                p.xyz_of_r_rho_sigma (r, rho, sigma, x, y, z);
                fp const proj = (sx*x + sy*y + sz*z) / r;
                r -= proj;
              }
            }
          }
          ps.synchronize();
        }
      }
      if (track_origin_from_grid_scalar[hn]) {
         track_origin(cctkGH, *ps_ptr, AH_data_ptr, hn, verbose_info.print_algorithm_details);
      }
      
      // modify the initial guess
      jtutil::norm<fp> norms;
      ps_ptr->ghosted_gridfn_norms (gfns::gfn__h, norms);
      // smoothing:
      ps_ptr->scale_ghosted_gridfn
        (1.0 - AH_data_ptr->smoothing_factor, gfns::gfn__h);
      ps_ptr->add_to_ghosted_gridfn
        (AH_data_ptr->smoothing_factor * norms.mean(), gfns::gfn__h);
      // enlarging:
      ps_ptr->scale_ghosted_gridfn
        (AH_data_ptr->shiftout_factor, gfns::gfn__h);
    }

    bool I_am_pretracking = horizon_is_genuine && AH_data_ptr->use_pretracking;
    bool I_was_pretracking = false;
    bool pretracking_have_upper_bound = false;
    bool pretracking_have_lower_bound = false;
    bool pretracking_was_successful = false;
    fp const old_pretracking_value = I_am_pretracking ? AH_data_ptr->pretracking_value : 0.0;
    fp pretracking_upper_bound;
    fp pretracking_lower_bound;
    bool pretracking_have_horizon_info;
    fp pretracking_mean_expansion;
    for (int pretracking_iter = 0;
         I_am_pretracking
           ? pretracking_iter < AH_data_ptr->pretracking_max_iterations
           : true;
         ++pretracking_iter)
      {
        bool found_this_horizon;
        if (I_am_pretracking || I_was_pretracking) {
          CCTK_VInfo(CCTK_THORNSTRING,
                     "Pretracking: iteration %d", pretracking_iter);
          if (pretracking_have_lower_bound) {
            if (pretracking_have_upper_bound) {
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: looking for value %g in [%g,%g]",
                         double(AH_data_ptr->pretracking_value),
                           double(pretracking_lower_bound),
                         double(pretracking_upper_bound));
            } else {
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: looking for value %g in [%g,*]",
                         double(AH_data_ptr->pretracking_value),
                         double(pretracking_lower_bound));
            }
          } else {
            if (pretracking_have_upper_bound) {
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: looking for value %g in [*,%g]",
                         double(AH_data_ptr->pretracking_value),
                           double(pretracking_upper_bound));
            } else {
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: looking for value %g in [*,*]",
                         double(AH_data_ptr->pretracking_value));
            }
          }
          AH_data_ptr->compute_info.desired_value = AH_data_ptr->pretracking_value;
          ps_ptr->ghosted_gridfn_copy (gfns::gfn__h, gfns::gfn__save_h);
          pretracking_have_horizon_info = false;
        }

        if (! I_am_pretracking) {
          if (horizon_is_genuine) {
            if (! AH_data_ptr->initial_guess_info.reset_horizon_after_not_finding) {
              // save the surface for possible backtracking later
              ps_ptr->ghosted_gridfn_copy (gfns::gfn__h, gfns::gfn__save_h);
            }
          }
        }

	struct what_to_compute dummy_compute_info;
	struct what_to_compute & compute_info =
		horizon_is_genuine
		? AH_data_ptr->compute_info
		: dummy_compute_info;

    if (horizon_is_genuine) {
      if (ps_ptr->N_additional_points()) {
        const int gnp = ps_ptr->ghosted_N_grid_points();
        ps_ptr->ghosted_gridfn_data(gfns::gfn__h)[gnp] = 0;
      }
    }

    const int max_iterations
       = horizon_is_genuine
	 ? (AH_data_ptr->initial_find_flag
	    ? solver_info.max_Newton_iterations__initial
	    : solver_info.max_Newton_iterations__subsequent)
	 : INT_MAX;

    int num_Theta_growth_iterations = 0;
    fp previous_Theta_norm = 1.0e30;
    int num_Theta_nonshrink_iterations = 0;
    fp best_Theta_norm = 1.0e30;

	//
	// each pass through this loop does a single Newton iteration
	// on the current horizon (which might be either genuine or dummy)
	//
        bool do_return = false;
	for (int iteration = 1 ; ; ++iteration)
	{
	if (verbose_info.print_algorithm_debug)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "beginning iteration %d (horizon_is_genuine=%d)",
			   iteration, int(horizon_is_genuine));


	//
	// evaluate the expansion Theta(h) and its norms
	// *** this is a synchronous operation across all processors ***
	//
	if (horizon_is_genuine
	    && solver_info.debugging_output_at_each_Newton_iteration)
	   then output_gridfn(*ps_ptr, gfns::gfn__h,
                              "h", GH,
			      IO_info, IO_info.h_base_file_name,
                              IO_info.h_min_digits,
			      hn, verbose_info.print_algorithm_highlights,
			      iteration);

        // calculate the norms also for a surface a bit further out,
        // so that we know how they vary in space.
        // perform this calculation first, so that the real values
        // do not have to be saved.
        const fp epsilon = Jacobian_info.perturbation_amplitude;
	jtutil::norm<fp> shifted_Theta_norms;
        jtutil::norm<fp> shifted_expansion_Theta_norms;
        jtutil::norm<fp> shifted_inner_expansion_Theta_norms;
        jtutil::norm<fp> shifted_product_expansion_Theta_norms;
        jtutil::norm<fp> shifted_mean_curvature_Theta_norms;
        fp shifted_area;
	jtutil::norm<fp> shifted2_Theta_norms;
        jtutil::norm<fp> shifted2_expansion_Theta_norms;
        jtutil::norm<fp> shifted2_inner_expansion_Theta_norms;
        jtutil::norm<fp> shifted2_product_expansion_Theta_norms;
        jtutil::norm<fp> shifted2_mean_curvature_Theta_norms;
        fp shifted2_area;
        if (solver_info.want_expansion_gradients) {
          if (horizon_is_genuine) {
            ps_ptr->add_to_ghosted_gridfn(epsilon, gfns::gfn__h);
            // ps_ptr->scale_ghosted_gridfn(1.0+epsilon, gfns::gfn__h);
          }
          const enum expansion_status raw_shifted_expansion_status
            = expansion(ps_ptr, compute_info,
                        cgi, gi,
                        error_info, (iteration == 1),
                        false,	// no, we don't want Jacobian coeffs
                        false,
                        &shifted_Theta_norms,
                        &shifted_expansion_Theta_norms,
                        &shifted_inner_expansion_Theta_norms,
                        &shifted_product_expansion_Theta_norms,
                        &shifted_mean_curvature_Theta_norms);
          if (horizon_is_genuine) {
            shifted_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,
               BH_diagnostics_info.integral_method);
            ps_ptr->add_to_ghosted_gridfn(-epsilon, gfns::gfn__h);
            // ps_ptr->scale_ghosted_gridfn(1.0/(1.0+epsilon), gfns::gfn__h);
            
            ps_ptr->add_to_ghosted_gridfn(-epsilon, gfns::gfn__h);
            // ps_ptr->scale_ghosted_gridfn(1.0/(1.0+epsilon), gfns::gfn__h);
          }
          const enum expansion_status raw_shifted2_expansion_status
            = expansion(ps_ptr, compute_info,
                        cgi, gi,
                        error_info, (iteration == 1),
                        false,	// no, we don't want Jacobian coeffs
                        false,
                        &shifted2_Theta_norms,
                        &shifted2_expansion_Theta_norms,
                        &shifted2_inner_expansion_Theta_norms,
                        &shifted2_product_expansion_Theta_norms,
                        &shifted2_mean_curvature_Theta_norms);
          if (horizon_is_genuine) {
            shifted2_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,
               BH_diagnostics_info.integral_method);
            ps_ptr->add_to_ghosted_gridfn(epsilon, gfns::gfn__h);
            // ps_ptr->scale_ghosted_gridfn(1.0+epsilon, gfns::gfn__h);
          }
        } // if want_expansion_gradients

        // now calculate the real values.
	jtutil::norm<fp> Theta_norms;
        jtutil::norm<fp> expansion_Theta_norms;
        jtutil::norm<fp> inner_expansion_Theta_norms;
        jtutil::norm<fp> product_expansion_Theta_norms;
        jtutil::norm<fp> mean_curvature_Theta_norms;
	const enum expansion_status raw_expansion_status
               = expansion(ps_ptr, compute_info,
			   cgi, gi,
			   error_info, (iteration == 1),
			   true,	// yes, we want Jacobian coeffs
			   verbose_info.print_algorithm_details,
                           &Theta_norms,
                           &expansion_Theta_norms,
                           &inner_expansion_Theta_norms,
                           &product_expansion_Theta_norms,
                           &mean_curvature_Theta_norms);
        fp area;
        if (horizon_is_genuine)
	        {
	        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,
	                 BH_diagnostics_info.integral_method);
	        }
	const bool Theta_is_ok = (raw_expansion_status == expansion_success);
        const bool norms_are_ok = horizon_is_genuine && Theta_is_ok;

        if (norms_are_ok) {
          const fp this_norm = Theta_norms.infinity_norm();
          if (this_norm > previous_Theta_norm) {
            ++ num_Theta_growth_iterations;
          } else {
            num_Theta_growth_iterations = 0;
          }
          previous_Theta_norm = this_norm;
          
          if (this_norm >= best_Theta_norm) {
            ++ num_Theta_nonshrink_iterations;
          } else {
            num_Theta_nonshrink_iterations = 0;
            best_Theta_norm = this_norm;
          }
        }

        if (I_am_pretracking && norms_are_ok) {
          pretracking_mean_expansion = expansion_Theta_norms.mean();
          pretracking_have_horizon_info = true;
        }

	if (verbose_info.print_algorithm_debug)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "   Newton_solve(): Theta_is_ok=%d",
			   Theta_is_ok);
		if (norms_are_ok)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "   Theta rms-norm %.1e, infinity-norm %.1e",
				   double(Theta_norms.rms_norm()),
				   double(Theta_norms.infinity_norm()));
		}
	if (horizon_is_genuine && Theta_is_ok
	    && solver_info.debugging_output_at_each_Newton_iteration)
	   then {
		output_gridfn(*ps_ptr, gfns::gfn__Theta,
                              "Theta", GH,
			      IO_info, IO_info.Theta_base_file_name,
                              IO_info.h_min_digits,
			      hn, verbose_info.print_algorithm_highlights,
			      iteration);
		output_gridfn(*ps_ptr, gfns::gfn__mean_curvature,
                              "mean_curvature", GH,
			      IO_info, IO_info.mean_curvature_base_file_name,
                              IO_info.h_min_digits,
			      hn, verbose_info.print_algorithm_highlights,
			      iteration);
		}


	//
	// have we found this horizon?
	// if so, compute and output BH diagnostics
	//
        found_this_horizon
           = (norms_are_ok
              && (I_was_pretracking
                  ? pretracking_was_successful
                  : Theta_norms.infinity_norm() <= solver_info.Theta_norm_for_convergence));
	if (horizon_is_genuine)
	   then AH_data_ptr->found_flag = found_this_horizon;

	if (found_this_horizon && ! I_am_pretracking)
	   then {
		struct BH_diagnostics& BH_diagnostics
			= AH_data_ptr->BH_diagnostics;
                const fp mean_expansion       = expansion_Theta_norms.mean();
                const fp mean_inner_expansion = inner_expansion_Theta_norms.mean();
                const fp mean_product_expansion = product_expansion_Theta_norms.mean();
                const fp mean_mean_curvature  = mean_curvature_Theta_norms.mean();
                // const fp area_gradient                 = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_area                               - area                              ) / epsilon;
                // const fp mean_expansion_gradient       = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_expansion_Theta_norms.mean()       - expansion_Theta_norms.mean()      ) / epsilon;
                // const fp mean_inner_expansion_gradient = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_inner_expansion_Theta_norms.mean() - inner_expansion_Theta_norms.mean()) / epsilon;
                // const fp mean_product_expansion_gradient = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_product_expansion_Theta_norms.mean() - product_expansion_Theta_norms.mean()) / epsilon;
                // const fp mean_mean_curvature_gradient  = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_mean_curvature_Theta_norms.mean()  - mean_curvature_Theta_norms.mean() ) / epsilon;
                const fp area_gradient                 = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_area                               - shifted2_area                              ) / (2*epsilon);
                const fp mean_expansion_gradient       = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_expansion_Theta_norms.mean()       - shifted2_expansion_Theta_norms.mean()      ) / (2*epsilon);
                const fp mean_inner_expansion_gradient = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_inner_expansion_Theta_norms.mean() - shifted2_inner_expansion_Theta_norms.mean()) / (2*epsilon);
                const fp mean_product_expansion_gradient = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_product_expansion_Theta_norms.mean() - shifted2_product_expansion_Theta_norms.mean()) / (2*epsilon);
                const fp mean_mean_curvature_gradient  = ! solver_info.want_expansion_gradients ? 0.0 : (shifted_mean_curvature_Theta_norms.mean()  - shifted2_mean_curvature_Theta_norms.mean() ) / (2*epsilon);
		BH_diagnostics.compute(*ps_ptr,
                                       area,
                                       mean_expansion,
                                       mean_inner_expansion,
                                       mean_product_expansion,
                                       mean_mean_curvature,
                                       area_gradient,
                                       mean_expansion_gradient,
                                       mean_inner_expansion_gradient,
                                       mean_product_expansion_gradient,
                                       mean_mean_curvature_gradient,
                                       BH_diagnostics_info);
		if (IO_info.output_BH_diagnostics)
		   then {
			if (AH_data_ptr->BH_diagnostics_fileptr == NULL)
			   then AH_data_ptr->BH_diagnostics_fileptr
				  = BH_diagnostics.setup_output_file
					(IO_info, N_horizons, hn);
			BH_diagnostics.output(AH_data_ptr
					      ->BH_diagnostics_fileptr,
					      IO_info);
			}
		}


	//
	// see if the expansion is too big
	// (if so, we'll give up on this horizon)
	//
	const bool expansion_is_too_large
		= norms_are_ok
                  && (   Theta_norms.infinity_norm() > solver_info.max_allowable_Theta
                      || (   solver_info.max_allowable_Theta_growth_iterations > 0
                          && num_Theta_growth_iterations > solver_info.max_allowable_Theta_growth_iterations)
                      || (   solver_info.max_allowable_Theta_nonshrink_iterations > 0
                          && num_Theta_nonshrink_iterations > solver_info.max_allowable_Theta_nonshrink_iterations)
                         );


	//
	// compute the mean horizon radius, and if it's too large,
	// then pretend expansion() returned a "surface too large" error status
	//
	jtutil::norm<fp> h_norms;
	if (horizon_is_genuine) {
          ps_ptr->ghosted_gridfn_norms(gfns::gfn__h, h_norms);
        }
	const fp mean_horizon_radius
		= horizon_is_genuine ? h_norms.mean() : 0.0;
	const bool horizon_is_too_large
		= (mean_horizon_radius > solver_info
					 .max_allowable_horizon_radius[hn]);

	const enum expansion_status effective_expansion_status
		= horizon_is_too_large ? expansion_failure__surface_too_large
				       : raw_expansion_status;


	//
	// see if we need more iterations (either on this or another horizon)
	//

	// does *this* horizon need more iterations?
	// i.e. has this horizon's Newton iteration not yet converged?
        const bool this_horizon_needs_more_iterations
	   = horizon_is_genuine && Theta_is_ok
	     && !found_this_horizon
	     && !expansion_is_too_large
	     && !horizon_is_too_large
	     && (iteration < max_iterations);

	// do I (this processor) need to do more iterations
	// on this or a following horizon?
	const bool I_need_more_iterations
	   = this_horizon_needs_more_iterations
	     || there_is_another_genuine_horizon
             || I_am_pretracking;

	if (verbose_info.print_algorithm_details)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "   flags: found_this_horizon=%d",
			   int(found_this_horizon));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "          this_horizon_needs_more_iterations=%d",
			   int(this_horizon_needs_more_iterations));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "          I_need_more_iterations=%d",
			   int(I_need_more_iterations));
		}

	//
	// broadcast iteration status from each active processor
	// to all processors, and inclusive-or the "we need more iterations"
	// flags to see if *any* (active) processor needs more iterations
	//
	const bool any_proc_needs_more_iterations
	  = broadcast_status(GH,
			     N_procs, N_active_procs,
			     my_proc, my_active_flag,
			     hn, iteration, effective_expansion_status,
			     mean_horizon_radius,
			     (norms_are_ok ? Theta_norms.infinity_norm() : 0.0),
			     found_this_horizon, I_need_more_iterations,
			     isb);
	// set found-this-horizon flags
	// for all active processors' non-dummy horizons
		  {
		for (int found_proc = 0 ;
		     found_proc < N_active_procs ;
		     ++found_proc)
		{
		const int found_hn = isb.hn_buffer[found_proc];
		if (found_hn > 0)
		   then AH_data_array[found_hn]->found_flag
				= isb.found_horizon_buffer[found_proc];
		}
		  }
	if (verbose_info.print_algorithm_details)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "          ==> any_proc_needs_more_iterations=%d",
			   int(any_proc_needs_more_iterations));
		}


	//
	// print the iteration status info
	//
	if ((my_proc == 0) && verbose_info.print_algorithm_highlights)
	   then print_status(N_active_procs, isb);


	//
	// for each processor which found a horizon,
	// broadcast its horizon info to all processors
	// and print the BH diagnostics on processor 0
	//
		  {
		for (int found_proc = 0 ;
		     found_proc < N_active_procs ;
		     ++found_proc)
		{
		if (! isb.found_horizon_buffer[found_proc])
		   then continue;

		const int found_hn = isb.hn_buffer[found_proc];
		struct AH_data& found_AH_data = *AH_data_array[found_hn];

		if (verbose_info.print_algorithm_details)
		   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   broadcasting proc %d/horizon %d diagnostics%s",
				   found_proc, found_hn,
				   (broadcast_horizon_shape ? "+shape" : ""));

		broadcast_horizon_data(GH,
				       my_proc == found_proc,
				       broadcast_horizon_shape,
                                       found_AH_data,
				       found_AH_data.BH_diagnostics,
				       *found_AH_data.ps_ptr,
				       found_AH_data.horizon_buffers);

		if ((my_proc == 0) && verbose_info.print_physics_details)
		   then found_AH_data.BH_diagnostics
				     .print(N_horizons, found_hn);
		}
		  }


	//
	// if we found our horizon, maybe output the horizon shape?
	//
	if (found_this_horizon && ! I_am_pretracking)
	   then {
		// printf("will output h/Th/mc: %d/%d/%d\n", IO_info.output_h, IO_info.output_Theta, IO_info.output_mean_curvature); //xxxxxxxxxxxx
		if (IO_info.output_h)
		   then {
			// if this is the first time we've output h for this
			// horizon, maybe output an OpenDX control file?
			if (!AH_data_ptr->h_files_written)
			   then setup_h_files(*ps_ptr, IO_info, hn);
			output_gridfn(*ps_ptr, gfns::gfn__h,
                                      "h", GH,
				      IO_info, IO_info.h_base_file_name,
                                      IO_info.h_min_digits,
				      hn, verbose_info
					  .print_algorithm_highlights);
			}
		if (IO_info.output_Theta)
		   then output_gridfn(*ps_ptr, gfns::gfn__Theta,
                                      "Theta", GH,
				      IO_info, IO_info.Theta_base_file_name,
                                      IO_info.h_min_digits,
				      hn, verbose_info
					  .print_algorithm_highlights);
		if (IO_info.output_mean_curvature)
		   then output_gridfn(*ps_ptr, gfns::gfn__mean_curvature,
                                      "mean_curvature", GH,
				      IO_info, IO_info.mean_curvature_base_file_name,
                                      IO_info.h_min_digits,
				      hn, verbose_info
					  .print_algorithm_highlights);
		}


	//
	// are all processors done with all their genuine horizons?
	// or if this is a single-processor run, are we done with this horizon?
	//
	if (! any_proc_needs_more_iterations)
	   then {
		if (verbose_info.print_algorithm_details)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "==> all processors are finished!");
                do_return = true;
		break;					// *** LOOP EXIT ***
		}
	if ((N_procs == 1) && !this_horizon_needs_more_iterations)
	   then {
		if (verbose_info.print_algorithm_debug)
		   then CCTK_VInfo(CCTK_THORNSTRING,
			   "==> [single processor] Skipping to next horizon");
		break;					// *** LOOP EXIT ***
		}


	//
	// compute the Jacobian matrix
	// *** this is a synchronous operation across all processors ***
	//
	if (verbose_info.print_algorithm_debug)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   computing Jacobian: genuine/dummy flag %d",
			   int(this_horizon_needs_more_iterations));
	const enum expansion_status
	  Jacobian_status
	     = expansion_Jacobian
		 (this_horizon_needs_more_iterations ? ps_ptr : NULL,
		  this_horizon_needs_more_iterations ? Jac_ptr : NULL,
		  compute_info,
		  cgi, gi, Jacobian_info,
		  error_info, (iteration == 1),
		  verbose_info.print_algorithm_details);
	const bool Jacobian_is_ok = (Jacobian_status == expansion_success);


	//
	// skip to the next horizon unless
	// this is a genuine Jacobian computation, and it went ok
	//
	if (! (this_horizon_needs_more_iterations && Jacobian_is_ok))
	   then {
		if (verbose_info.print_algorithm_debug)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "   skipping to next horizon");
		break;					// *** LOOP EXIT ***
		}


	//
	// compute the Newton step
	//
	if (verbose_info.print_algorithm_details)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "solving linear system for Delta_h (%d unknowns)",
			   Jac_ptr->N_rows());
	const fp rcond
	   = Jac_ptr->solve_linear_system(gfns::gfn__Theta, gfns::gfn__Delta_h,
					  solver_info.linear_solver_pars,
					  verbose_info.print_algorithm_details);
	if	((rcond >= 0.0) && (rcond < 100.0*FP_EPSILON))
	   then {
		CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "Newton_solve: Jacobian matrix is numerically singular!");
		// give up on this horizon
		break;				// *** LOOP CONTROL ***
		}
	if (verbose_info.print_algorithm_details)
	   then {
		if (rcond > 0.0)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "done solving linear system (rcond=%.1e)",
				   double(rcond));
		   else CCTK_VInfo(CCTK_THORNSTRING,
				   "done solving linear system");
		}

	if (solver_info.debugging_output_at_each_Newton_iteration)
	   then output_gridfn(*ps_ptr, gfns::gfn__Delta_h,
                              "Delta_h", GH,
			      IO_info, IO_info.Delta_h_base_file_name,
                              IO_info.h_min_digits,
			      hn, verbose_info.print_algorithm_details,
			      iteration);


	//
	// take the Newton step (scaled if need be)
	//
	Newton_step(*ps_ptr,
		    mean_horizon_radius, solver_info
					 .max_allowable_Delta_h_over_h,
		    verbose_info);

	// end of this Newton iteration
	}

        if (! I_am_pretracking) {
          if (horizon_is_genuine) {
            if (! AH_data_ptr->initial_guess_info.reset_horizon_after_not_finding) {
              if (! found_this_horizon) {
                // the surface failed; backtrack and continue
                AH_data_ptr->ps_ptr->ghosted_gridfn_copy
                  (gfns::gfn__save_h, gfns::gfn__h);
              }
            }
          }
        }

        // exit
        if (do_return) return;				// *** NORMAL RETURN ***

        // break out of the pretracking loop if we are not pretracking
        if (! I_am_pretracking) break;
        
        if (! found_this_horizon) {
          // the surface failed; backtrack and continue
          CCTK_VInfo(CCTK_THORNSTRING,
                     "Pretracking: solving failed; backtracking");
          AH_data_ptr->ps_ptr->ghosted_gridfn_copy (gfns::gfn__save_h, gfns::gfn__h);
          if (pretracking_have_lower_bound) {
            assert (AH_data_ptr->pretracking_value >= pretracking_lower_bound - 1.0e-10 * fabs(pretracking_lower_bound));
          }
          pretracking_have_lower_bound = true;
          pretracking_lower_bound = AH_data_ptr->pretracking_value;
          if (pretracking_have_upper_bound) {
            AH_data_ptr->pretracking_delta = 0.5 * (pretracking_upper_bound - pretracking_lower_bound);
            AH_data_ptr->pretracking_value = pretracking_lower_bound + 0.5 * (pretracking_upper_bound - pretracking_lower_bound);
          } else {
            AH_data_ptr->pretracking_delta = fabs(AH_data_ptr->pretracking_delta);
            AH_data_ptr->pretracking_delta *= 2.0;
            if (AH_data_ptr->pretracking_delta > AH_data_ptr->pretracking_maximum_delta) {
              AH_data_ptr->pretracking_delta = AH_data_ptr->pretracking_maximum_delta;
            }
            AH_data_ptr->pretracking_value += AH_data_ptr->pretracking_delta;
            if (AH_data_ptr->pretracking_value > AH_data_ptr->pretracking_maximum_value) {
              AH_data_ptr->pretracking_value = AH_data_ptr->pretracking_maximum_value;
            }
          }
          CCTK_VInfo(CCTK_THORNSTRING,
                     "Pretracking: new value %g, delta %g",
                     double(AH_data_ptr->pretracking_value),
                     double(AH_data_ptr->pretracking_delta));
          if (pretracking_lower_bound >= AH_data_ptr->pretracking_maximum_value * 0.9999999999) {
            // give up
            CCTK_VInfo(CCTK_THORNSTRING,
                       "Pretracking: upper bound reached, giving up.");
            I_am_pretracking = false;
            I_was_pretracking = true;
            pretracking_was_successful = false;
            // restore old pretracking goal
            AH_data_ptr->pretracking_value = old_pretracking_value;
          } else if (AH_data_ptr->pretracking_delta < AH_data_ptr->pretracking_minimum_delta) {
            // give up
            CCTK_VInfo(CCTK_THORNSTRING,
                       "Pretracking: step size too small, giving up.");
            I_am_pretracking = false;
            I_was_pretracking = true;
            pretracking_was_successful = true;
          }
        } else {
          // the surface was okay
          // get mean expansion
          assert (pretracking_have_horizon_info);
          CCTK_VInfo(CCTK_THORNSTRING,
                     "Pretracking: solving succeeded; expansion is now %g",
                     double(pretracking_mean_expansion));
//           if (fabs(AH_data_ptr->pretracking_value) > 2.0 * AH_data_ptr->pretracking_minimum_delta) {
          if (AH_data_ptr->pretracking_value > AH_data_ptr->pretracking_minimum_value + 1.0e-10 * AH_data_ptr->pretracking_minimum_delta) {
            // it is not yet a horizon
            if (pretracking_have_upper_bound) {
              assert (AH_data_ptr->pretracking_value <= pretracking_upper_bound + 1.0e-10 * fabs(pretracking_upper_bound));
            }
            pretracking_have_upper_bound = true;
            pretracking_upper_bound = AH_data_ptr->pretracking_value;
            if (pretracking_have_lower_bound) {
#if 1
              // TODO
              // move lower bound further down
              pretracking_lower_bound -= pretracking_upper_bound - pretracking_lower_bound;
              if (pretracking_lower_bound < AH_data_ptr->pretracking_minimum_value) pretracking_lower_bound = AH_data_ptr->pretracking_minimum_value;
#endif
              AH_data_ptr->pretracking_delta = 0.5 * (pretracking_lower_bound - pretracking_upper_bound);
              AH_data_ptr->pretracking_value = pretracking_lower_bound + 0.5 * (pretracking_upper_bound - pretracking_lower_bound);
            } else {
              AH_data_ptr->pretracking_delta = - fabs(AH_data_ptr->pretracking_delta);
              AH_data_ptr->pretracking_delta *= 2.0;
              if (- AH_data_ptr->pretracking_delta > AH_data_ptr->pretracking_maximum_delta) {
                AH_data_ptr->pretracking_delta = - AH_data_ptr->pretracking_maximum_delta;
              }
              AH_data_ptr->pretracking_value += AH_data_ptr->pretracking_delta;
              if (AH_data_ptr->pretracking_value < AH_data_ptr->pretracking_minimum_value) {
                AH_data_ptr->pretracking_value = AH_data_ptr->pretracking_minimum_value;
              }
            }
            CCTK_VInfo(CCTK_THORNSTRING,
                       "Pretracking: new value radius %g, delta %g",
                       double(AH_data_ptr->pretracking_value),
                       double(AH_data_ptr->pretracking_delta));
            if (pretracking_upper_bound <= AH_data_ptr->pretracking_minimum_value * 1.00000000001) {
              // give up
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: lower bound reached, giving up.");
              I_am_pretracking = false;
              I_was_pretracking = true;
              pretracking_was_successful = false;
              // restore old pretracking goal
              AH_data_ptr->pretracking_value = old_pretracking_value;
            } else if (- AH_data_ptr->pretracking_delta < AH_data_ptr->pretracking_minimum_delta) {
              // give up
              CCTK_VInfo(CCTK_THORNSTRING,
                         "Pretracking: step size too small, giving up.");
              I_am_pretracking = false;
              I_was_pretracking = true;
              pretracking_was_successful = true;
            }
          } else {
            // a true horizon was found; we are done
            CCTK_VInfo(CCTK_THORNSTRING,
                       "Pretracking: done.");
            I_am_pretracking = false;
            I_was_pretracking = true;
            pretracking_was_successful = true;
          }
        } // if surface found

    // end of pretracking loop
    }
    I_am_pretracking = false;

    // end of this horizon
    }

// we should never get to here
assert( false );
}

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

//
// This function (which must be called on *every* processor) broadcasts
// the per-iteration status information from each active processor to
// all processors.
//
// The present implementation of this function uses the Cactus reduction
// API.  If AHFinderDirect is ported to some other software environment,
// it's probably best to re-implement this function on top of whatever
// interprocessor-broadcast facility that environment provides.
//
// Arguments:
// GH --> The Cactus grid hierarchy.
// N_procs = The total number of processors.
// N_active_procs = The number of active processors.
// my_active_flag = Is this processor an active processor?
// hn,iteration,effective_expansion_status,
// mean_horizon_radius,infinity_norm,
// found_this_horizon,I_need_more_iterations
//	= On an active processors, these are the values to be broadcast.
//	  On a dummy processors, these are ignored.
// isb = (out) Holds both user buffers (set to the broadcast results)
//	       and low-level buffers (used within this function).  If the
//	       buffer pointers are NULL then the buffers are allocated.
//
// Results:
// This function returns the inclusive-or over all active processors,
// of the broadcast I_need_more_iterations flags.
//
namespace {
bool broadcast_status(const cGH* GH,
		      int N_procs, int N_active_procs,
		      int my_proc, bool my_active_flag,
		      int hn, int iteration,
		      enum expansion_status effective_expansion_status,
		      fp mean_horizon_radius, fp infinity_norm,
		      bool found_this_horizon, bool I_need_more_iterations,
		      struct iteration_status_buffers& isb)
{
assert( my_proc >= 0 );
assert( my_proc < N_procs );

//
// We do the broadcast via a Cactus reduction operation (this is a KLUDGE,
// but until Cactus gets a generic interprocessor communications mechanism
// it's the best we can do without mucking with MPI ourself).  To do the
// gather via a reduction, we set up a 2-D buffer whose entries are all
// 0s, except that on each processor the [my_proc] row has the values we
// want to gather.  Then we do a sum-reduction of the buffers across
// processors.  For the actual reduction we treat the buffers as 1-D
// arrays on each processor (this slightly simplifies the code).
//
// To reduce overheads, we do the entire operation with a single (CCTK_REAL)
// Cactus reduce, casting values to CCTK_REAL as necessary (and encoding
// Boolean flags into signs of known-to-be-positive values.
//
// Alas MPI (and thus Cactus) requires the input and output reduce buffers
// to be distinct, so we need two copies of the buffers on each processor.
//

// the buffers are actually 2-D arrays; these are the column numbers
// ... if we wanted to, we could pack hn, iteration, and
//     effective_expansion_status all into a single (64-bit)
//     floating-point value, but it's not worth the trouble...
enum	{
	// CCTK_INT buffer
	buffer_var__hn = 0,	// also encodes found_this_horizon flag
				// in sign: +=true, -=false
	buffer_var__iteration,	// also encodes I_need_more_iterations flag
				// in sign: +=true, -=false
	buffer_var__expansion_status,
	buffer_var__mean_horizon_radius,
	buffer_var__Theta_infinity_norm,
	N_buffer_vars // no comma
	};

//
// allocate buffers if this is the first use
//
if (isb.hn_buffer == NULL)
   then {
	isb.hn_buffer                  = new int [N_active_procs];
	isb.iteration_buffer           = new int [N_active_procs];
	isb.expansion_status_buffer = new enum expansion_status[N_active_procs];
	isb.mean_horizon_radius_buffer = new fp  [N_active_procs];
	isb.Theta_infinity_norm_buffer = new fp  [N_active_procs];
	isb.found_horizon_buffer       = new bool[N_active_procs];

	isb.send_buffer_ptr    = new jtutil::array2d<CCTK_REAL>
						    (0, N_active_procs-1,
						     0, N_buffer_vars-1);
	isb.receive_buffer_ptr = new jtutil::array2d<CCTK_REAL>
						    (0, N_active_procs-1,
						     0, N_buffer_vars-1);
	}
jtutil::array2d<CCTK_REAL>& send_buffer    = *isb.send_buffer_ptr;
jtutil::array2d<CCTK_REAL>& receive_buffer = *isb.receive_buffer_ptr;

//
// pack this processor's values into the reduction buffer
//
jtutil::zero_C_array(send_buffer.N_array(), send_buffer.data_array());
if (my_active_flag)
   then {
	assert( send_buffer.is_valid_i(my_proc) );
	assert( hn >= 0 );		// encoding scheme assumes this
	assert( iteration > 0 );	// encoding scheme assumes this
	send_buffer(my_proc, buffer_var__hn)
		= found_this_horizon ? +hn : -hn;
	send_buffer(my_proc, buffer_var__iteration)
		= I_need_more_iterations ? +iteration : -iteration;
	send_buffer(my_proc, buffer_var__expansion_status)
		= int(effective_expansion_status);
	send_buffer(my_proc, buffer_var__mean_horizon_radius)
		= mean_horizon_radius;
	send_buffer(my_proc, buffer_var__Theta_infinity_norm)
		= infinity_norm;
	}

//
// do the reduction
//

// this name is appropriate for PUGHReduce, caveat user for other drivers :)
const int reduction_handle = CCTK_ReductionArrayHandle("sum");
if (reduction_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "broadcast_status(): can't get sum-reduction handle!");
								/*NOTREACHED*/

const int reduction_status
   = CCTK_ReduceLocArrayToArray1D(GH,
				  -1,	// broadcast results to all processors
				  reduction_handle,
				  static_cast<const void*>
					     (send_buffer   .data_array()),
				  static_cast<      void*>
					     (receive_buffer.data_array()),
				  send_buffer.N_array(),
				  CCTK_VARIABLE_REAL);
if (reduction_status < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "broadcast_status(): error status %d from reduction!",
		   reduction_status);				/*NOTREACHED*/

//
// unpack the reduction buffer back to the high-level result buffers and
// compute the inclusive-or of the broadcast I_need_more_iterations flags
//
bool any_proc_needs_more_iterations = false;
	for (int proc = 0 ; proc < N_active_procs ; ++proc)
	{
	const int hn_temp = static_cast<int>(
			      receive_buffer(proc, buffer_var__hn)
					    );
	isb.hn_buffer[proc] = jtutil::abs(hn_temp);
	isb.found_horizon_buffer[proc] = (hn_temp > 0);

	const int iteration_temp = static_cast<int>(
				     receive_buffer(proc, buffer_var__iteration)
						   );
	isb.iteration_buffer[proc] = jtutil::abs(iteration_temp);
	const bool proc_needs_more_iterations = (iteration_temp > 0);
	any_proc_needs_more_iterations |= proc_needs_more_iterations;

	isb.expansion_status_buffer[proc]
		= static_cast<enum expansion_status>(
		    static_cast<int>(
		      receive_buffer(proc, buffer_var__expansion_status)
				    )
						    );

	isb.mean_horizon_radius_buffer[proc]
		= receive_buffer(proc, buffer_var__mean_horizon_radius);
	isb.Theta_infinity_norm_buffer[proc]
		= receive_buffer(proc, buffer_var__Theta_infinity_norm);
	}

return any_proc_needs_more_iterations;
}
	  }

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

//
// This function (which must be called on *every* processor) broadcasts
// the BH diagnostics and (ghosted) horizon shape from a specified processor
// to all processors.
//
// The present implementation of this function uses the Cactus reduction
// API.  If AHFinderDirect is ported to some other software environment,
// it's probably best to re-implement this function on top of whatever
// interprocessor-broadcast facility that environment provides.
//
// Arguments:
// GH --> The Cactus grid hierarchy.
// broadcast_flag = true on the broadcasting processor,
//		    false on all other processors
// BH_diagnostics = On the broadcasting processor, this is the BH diagnostics
//		    to broadcast; on all other processors, it's set to the
//		    broadcast BH diagnostics.
// ps = On the broadcasting processor,  gfn__h  is broadcast;
//      on all other processors,  gfn__h  is set to the broadcast values.
// horizon_buffers = Internal buffers for use in the broadcast;
//		     if  N_buffer == 0  then we set N_buffer and allocate
//		     the buffers.
//
namespace {
void broadcast_horizon_data(const cGH* GH,
			    bool broadcast_flag, bool broadcast_horizon_shape,
                            struct AH_data& AH_data,
			    struct BH_diagnostics& BH_diagnostics,
			    patch_system& ps,
			    struct horizon_buffers& horizon_buffers)
{
//
// Implementation notes:
//
// We do the send via a Cactus sum-reduce where the data are 0 on
// all processors except the sending one.
//
// To reduce the interprocessor-communications cost, we actually only
// broadcast the nominal-grid horizon shape; we then do a synchronize
// operation on the patch system to recover the full ghosted-grid shape.
//

if (horizon_buffers.N_buffer == 0)
   then {
	// allocate the buffers
	horizon_buffers.N_buffer
		= BH_diagnostics::N_buffer
		  + (broadcast_horizon_shape ? ps.N_grid_points() : 0)
                  + 4;
	horizon_buffers.send_buffer
		= new CCTK_REAL[horizon_buffers.N_buffer];
	horizon_buffers.receive_buffer
		= new CCTK_REAL[horizon_buffers.N_buffer];
	}

if (broadcast_flag)
   then {
	// pack the data to be broadcast into the send buffer
	BH_diagnostics.copy_to_buffer(horizon_buffers.send_buffer);
        int posn = BH_diagnostics::N_buffer;
	if (broadcast_horizon_shape)
	   then {
			for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
			{
			const 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)
				{
				assert( posn < horizon_buffers.N_buffer );
				horizon_buffers.send_buffer[posn++]
				  = p.ghosted_gridfn(gfns::gfn__h, irho,isigma);
				}
				}
			}
		}
        horizon_buffers.send_buffer[posn++] = AH_data.initial_find_flag;
        horizon_buffers.send_buffer[posn++] = AH_data.really_initial_find_flag;
        horizon_buffers.send_buffer[posn++] = AH_data.search_flag;
        horizon_buffers.send_buffer[posn++] = AH_data.found_flag;
        assert( posn == horizon_buffers.N_buffer );
	}
   else jtutil::zero_C_array(horizon_buffers.N_buffer,
			     horizon_buffers.send_buffer);

// this name is appropriate for PUGHReduce, caveat user for other drivers :)
const int reduction_handle = CCTK_ReductionArrayHandle("sum");
if (reduction_handle < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "broadcast_horizon_data(): can't get sum-reduction handle!");
								/*NOTREACHED*/

const int status
   = CCTK_ReduceLocArrayToArray1D(GH,
				  -1,	// result broadcast to all processors
				  reduction_handle,
				  static_cast<const void*>
					     (horizon_buffers.send_buffer),
				  static_cast<      void*>
					     (horizon_buffers.receive_buffer),
				  horizon_buffers.N_buffer,
				  CCTK_VARIABLE_REAL);
if (status < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "broadcast_horizon_data(): error status %d from reduction!",
		   status);					/*NOTREACHED*/

if (!broadcast_flag)
   then {
	// unpack the data from the receive buffer
	BH_diagnostics.copy_from_buffer(horizon_buffers.receive_buffer);
        ps.origin_x(BH_diagnostics.origin_x);
        ps.origin_y(BH_diagnostics.origin_y);
        ps.origin_z(BH_diagnostics.origin_z);
	int posn = BH_diagnostics::N_buffer;
	if (broadcast_horizon_shape)
	   then {
			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)
				{
				assert( posn < horizon_buffers.N_buffer );
				p.ghosted_gridfn(gfns::gfn__h, irho,isigma)
				   = horizon_buffers.receive_buffer[posn++];
				}
				}
			}

		// recover the full ghosted-grid horizon shape
		// (we only broadcast the nominal-grid shape)
		ps.synchronize();
		}
        AH_data.initial_find_flag        = horizon_buffers.receive_buffer[posn++];
        AH_data.really_initial_find_flag = horizon_buffers.receive_buffer[posn++];
        AH_data.search_flag              = horizon_buffers.receive_buffer[posn++];
        AH_data.found_flag               = horizon_buffers.receive_buffer[posn++];
	assert( posn == horizon_buffers.N_buffer );
	}
}
	  }

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

//
// This function is called on processor #0 to print the status of the
// Newton iteration on each active processor.
//
// Arguments:
// N_active_procs = The number of active processors.
// isb = The high-level buffers here give the information to be printed.
//
namespace {
void print_status(int N_active_procs,
		  const struct iteration_status_buffers& isb)
{
	for (int proc = 0 ; proc < N_active_procs ; ++proc)
	{
	// don't print anything for processors doing dummy evaluations
	if (isb.hn_buffer[proc] == 0)
	   then continue;

	if (isb.expansion_status_buffer[proc] == expansion_success)
	   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   proc %d/horizon %d:it %d r_grid=%#.3g ||Theta||=%.1e",
			   proc, isb.hn_buffer[proc],
			   isb.iteration_buffer[proc],
			   double(isb.mean_horizon_radius_buffer[proc]),
			   double(isb.Theta_infinity_norm_buffer[proc]));
	   else CCTK_VInfo(CCTK_THORNSTRING,
		   "   proc %d/horizon %d: %s",
			   proc, isb.hn_buffer[proc],
			   expansion_status_string(
			     isb.expansion_status_buffer[proc]
						  ));
	}
}
	  }

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

//
// This function takes the Newton step, scaling it down if it's too large.
//
// Arguments:
// ps = The patch system containing the gridfns h and Delta_h.
// mean_horizon_radius = ||h||_mean
// max_allowable_Delta_h_over_h = The maximum allowable
//				     ||Delta_h||_infinity / ||h||_mean
//				  Any step over this is internally clamped
//				  (scaled down) to this size.
//
namespace {
void Newton_step(patch_system& ps,
		 fp mean_horizon_radius, fp max_allowable_Delta_h_over_h,
		 const struct verbose_info& verbose_info)
{
//
// compute scale factor (1 for small steps, <1 for large steps)
//

const fp max_allowable_Delta_h
	= max_allowable_Delta_h_over_h * mean_horizon_radius;

jtutil::norm<fp> Delta_h_norms;
ps.gridfn_norms(gfns::gfn__Delta_h, Delta_h_norms);
const fp max_Delta_h = Delta_h_norms.infinity_norm();

const fp scale = (max_Delta_h <= max_allowable_Delta_h)
		 ? 1.0
		 : max_allowable_Delta_h / max_Delta_h;

if (verbose_info.print_algorithm_details)
   then {

	if (scale == 1.0)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "h += Delta_h (rms-norm=%.1e, infinity-norm=%.1e)",
			   Delta_h_norms.rms_norm(),
			   Delta_h_norms.infinity_norm());
	   else CCTK_VInfo(CCTK_THORNSTRING,
			   "h += %g * Delta_h (infinity-norm clamped to %.2g)",
			   scale,
			   scale * Delta_h_norms.infinity_norm());
	}


//
// take the Newton step (scaled if necessary)
//
	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)
		{
		p.ghosted_gridfn(gfns::gfn__h, irho,isigma)
			-= scale * p.gridfn(gfns::gfn__Delta_h, irho,isigma);
		}
		}
	}

if (ps.N_additional_points())
	{
	const int np = ps.N_grid_points();
	const int gnp = ps.ghosted_N_grid_points();
	ps.ghosted_gridfn_data(gfns::gfn__h)[gnp]
		-= scale * ps.gridfn_data(gfns::gfn__Delta_h)[np];
	}
}
	  }

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

	  }	// namespace AHFinderDirect

```

driver/Makefile.standalone:
```
# Makefile for driver code
# $Header$

#
# Targets:
#	ellipsoid	==> compute ellipsoid equations
#	test		==> build standalone test drivers
#	clean		==> remove standalone test drivers
#

CXXFLAGS := -g $(STD_GXX_FLAGS)

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

# 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		: ellipsoid
ellipsoid	:
	maple <ellipsoid.maple >ellipsoid.log

.PHONY		: test
test		: test_horizon_sequence

.PHONY			: test_horizon_sequence
test_horizon_sequence	:
	$(CC) $(CFLAGS) -c \
               -DSTANDALONE_TEST -I../../../../../src/include \
               ../../../../../src/util/String.c \
               ../../../../../src/util/snprintf.c
	$(CXX) $(CXXFLAGS) -o $@ \
               -I../../../../../src/include \
               test_horizon_sequence.cc horizon_sequence.cc \
               String.o snprintf.o
.PHONY		: clean
clean		:
	-rm *.o test_horizon_sequence

```

driver/io.cc:
```
// io.cc -- I/O routines for this thorn
// $Header$
//
// input_gridfn - read an angular grid function from an input file
// input_gridfn__explicit_name - ... with the input file explicitly named
//
// setup_h_files - set up to write horizon-shape and similar output files
/// output_OpenDX_control_file - write an OpenDX control file for an output file
// output_gridfn - write an angular grid function to an output file
// output_Jacobians - write a Jacobian matrix or matrices to an output file
//
/// io_ASCII_file_name - compute file name for angular-gridfn I/O file
/// io_HDF5_file_name - compute file name for angular-gridfn I/O file
//

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

#include "util_Table.h"
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// prototypes for functions local to this file
//

namespace {
void output_OpenDX_control_file(const patch_system& ps,
				const struct IO_info& IO_info,
				int hn);
const char* io_ASCII_file_name(const struct IO_info& IO_info,
                               const char base_file_name[],
                               int min_digits,
                               int hn, int AHF_iteration = 0);
const char* io_HDF5_file_name(const struct IO_info& IO_info,
                              const char base_file_name[],
                              int min_digits,
                              int hn, int AHF_iteration = 0);
void create_h_directory(const struct IO_info& IO_info);
	  }

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

//
// This function inputs a gridfn from a data file, with the file name
// chosen automagically.
//
// We assume that this gridfn is ghosted, but the ghost zones are *not*
// present in the data file.
//
void input_gridfn(patch_system& ps, int unknown_gfn,
		  const struct IO_info& IO_info, const char base_file_name[],
		  int min_digits,
		  int hn, bool print_msg_flag, int AHF_iteration /* = 0 */)
{
const char* file_name = io_ASCII_file_name(IO_info, base_file_name, min_digits,
                                           hn, AHF_iteration);

input_gridfn__explicit_name(ps, unknown_gfn,
			    IO_info, base_file_name, print_msg_flag);
}

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

//
// This function inputs a gridfn from a data file, with the file name
// specified explicitly.
//
// We assume that this gridfn is ghosted, but the ghost zones are *not*
// present in the data file.
//
void input_gridfn__explicit_name(patch_system& ps, int unknown_gfn,
				 const struct IO_info& IO_info,
				 const char file_name[], bool print_msg_flag)
{
if (print_msg_flag)
   then {
	if (unknown_gfn == gfns::gfn__h)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "   reading initial guess from \"%s\"", file_name);
	}

if (IO_info.output_ASCII_files)
   then	{
	ps.read_ghosted_gridfn(unknown_gfn,
			       file_name,
			       false);		// no ghost zones in data file
	}

else if (IO_info.output_HDF5_files)
   then {
	CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"input_gridfn__explicit_name(): reading from HDF5 data files not implemented yet!");
	}

else
	{
	CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   input_gridfn__explicit_name():\n"
"        (this should never happen!)");				/*NOTREACHED*/
	}
}

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

//
// This function sets up to output horizon-shape or similar data files:
// - it creates the output directory if this doesn't already exist
// - it writes the OpenDX control files if this is desired
//
void setup_h_files(patch_system& ps, const struct IO_info& IO_info, int hn)
{
// create the output directory (if it doesn't already exist)
create_h_directory(IO_info);
output_OpenDX_control_file(ps, IO_info, hn);
}

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

//
// This function creates the h ooutput directory if it does not exist
//
namespace {
void create_h_directory(const struct IO_info& IO_info)
{
// create the output directory (if it doesn't already exist)
const int status = CCTK_CreateDirectory(IO_info.default_directory_permission,
					IO_info.h_directory);
if (status < 0)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"   setup_h_files():\n"
"        error %d trying to create output directory\n"
"        \"%s\"!"
		   ,
		   status,
		   IO_info.h_directory);			/*NOTREACHED*/
}
	  }

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

//
// This function outputs an OpenDX control file to allow Thomas Radke's
// OpenDX macros to read in a "ASCII (gnuplot)" data file produced by
//  output_gridfn() .
//
namespace {
void output_OpenDX_control_file(const patch_system& ps,
				const struct IO_info& IO_info,
				int hn)
{
if (! IO_info.output_OpenDX_control_files) return;
static char file_name_buffer[IO_info::file_name_buffer_size];
snprintf(file_name_buffer, IO_info::file_name_buffer_size,
	 "%s/%s.ah%d.%s",
	 IO_info.h_directory, IO_info.h_base_file_name,
         hn, IO_info.OpenDX_control_file_name_extension);

FILE *fileptr = fopen(file_name_buffer, "w");
if (fileptr == NULL)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		"output_OpenDX_control_file(): can't open output file \"%s\"!",
		   file_name_buffer);				/*NOTREACHED*/

fprintf(fileptr, "# list the size of each patch (N_rho x N_sigma)\n");
	for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
	{
	const patch& p = ps.ith_patch(pn);
	fprintf(fileptr, "object \"%s patch\" class array ", p.name());
	fprintf(fileptr, "type int rank 1 shape 2 items 1 data follows %d %d\n",
		p.effective_N_irho(IO_info.output_ghost_zones_for_h),
		p.effective_N_isigma(IO_info.output_ghost_zones_for_h));
	}
fprintf(fileptr, "\n");

fprintf(fileptr, "# collect all patch sizes into a single OpenDX group\n");
fprintf(fileptr, "# for the ImportAHFinderDirectGnuplot macro to read\n");
fprintf(fileptr, "object \"patchsizes\" class group\n");
	for (int pn = 0 ; pn < ps.N_patches() ; ++pn)
	{
	const patch& p = ps.ith_patch(pn);
	fprintf(fileptr, "member %d value \"%s patch\"\n", pn, p.name());
	}

fclose(fileptr);
}
	  }

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

//
// This function outputs a gridfn from a data file.
//
// If the gridfn is h, then we also write out the xyz positions of the
// horizon surface points.
//
// FIXME: if the gridfn is not h, we assume that it's nominal-grid.
//
void output_gridfn(patch_system& ps, int unknown_gfn,
                   const char gfn_name[], const cGH *cctkGH,
		   const struct IO_info& IO_info, const char base_file_name[],
                   int min_digits,
		   int hn, bool print_msg_flag, int AHF_iteration /* = 0 */)
{

if (IO_info.output_ASCII_files)
   then	{
	const char* file_name
		= io_ASCII_file_name(IO_info, base_file_name, min_digits,
				     hn, AHF_iteration);
	// create the output directory (if it doesn't already exist)
	create_h_directory(IO_info);

	switch	(unknown_gfn)
		{
	case gfns::gfn__h:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing h to \"%s\"", file_name);
		ps.print_ghosted_gridfn_with_xyz
		      (unknown_gfn,
		       true, gfns::gfn__h,
		       file_name,
		       IO_info.output_ghost_zones_for_h); // should we include
							  // ghost zones?
		break;
	case gfns::gfn__Theta:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing Theta to \"%s\"", file_name);
		ps.print_gridfn(unknown_gfn, file_name);
		break;
	case gfns::gfn__mean_curvature:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing mean curvature to \"%s\"", file_name);
		ps.print_gridfn(unknown_gfn, file_name);
		break;
	case gfns::gfn__Delta_h:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing Delta_h to \"%s\"", file_name);
		ps.print_gridfn(unknown_gfn, file_name);
		break;
	default:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing gfn=%d to \"%s\"",
				   unknown_gfn, file_name);
		ps.print_gridfn(unknown_gfn, file_name);
		break;
		}
	}

if (IO_info.output_HDF5_files)
   then	{
	const char* file_name
		= io_HDF5_file_name(IO_info, base_file_name, min_digits,
				     hn, AHF_iteration);
	// create the output directory (if it doesn't already exist)
	create_h_directory(IO_info);

	switch	(unknown_gfn)
		{
	case gfns::gfn__h:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing h to \"%s\"", file_name);
		ps.output_ghosted_gridfn_with_xyz
		      (unknown_gfn, gfn_name, cctkGH,
		       true, gfns::gfn__h,
		       file_name,
		       IO_info.output_ghost_zones_for_h); // should we include
							  // ghost zones?
		break;
	case gfns::gfn__Theta:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing Theta to \"%s\"", file_name);
		ps.output_gridfn(unknown_gfn, gfn_name, cctkGH,
                                 file_name);
		break;
	case gfns::gfn__Delta_h:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing Delta_h to \"%s\"", file_name);
		ps.output_gridfn(unknown_gfn, gfn_name, cctkGH,
                                 file_name);
		break;
	default:
		if (print_msg_flag)
		   then CCTK_VInfo(CCTK_THORNSTRING,
				   "writing gfn=%d to \"%s\"",
				   unknown_gfn, file_name);
		ps.output_gridfn(unknown_gfn, gfn_name, cctkGH,
                                 file_name);
		break;
		}
	}
}

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

//
// This function prints one or two Jacobian matrices (and their difference
// in the latter case) to a named output file.
//
// Bugs:
// - The file format is hardwired to ASCII.
//
// Arguments:
// A null Jacobian pointer means to skip that Jacobian.
//
void output_Jacobians(const patch_system& ps,
                      const Jacobian* Jac_NP_ptr,
                      const Jacobian* Jac_SD_FDdr_ptr,
		      const struct IO_info& IO_info, const char base_file_name[],
                      int min_digits,
		      int hn, bool print_msg_flag, int AHF_iteration /* = 0 */)
{
if (Jac_NP_ptr == NULL)
   then {
	CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "output_Jacobians(): Jac_NP_ptr == NULL is not (yet) supported!");
	return;						// *** ERROR RETURN ***
	}

const char* file_name = io_ASCII_file_name(IO_info, base_file_name, min_digits,
                                           hn, AHF_iteration);
// create the output directory (if it doesn't already exist)
create_h_directory(IO_info);

if (print_msg_flag)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   writing %s to \"%s\"",
		   ((Jac_SD_FDdr_ptr == NULL) ? "NP Jacobian"
					      : "NP and SD_FDdr Jacobians"),
		   file_name);

FILE *fileptr = fopen(file_name, "w");
if (fileptr == NULL)
   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
		   "output_Jacobians(): can't open output file \"%s\"!",
		   file_name);					/*NOTREACHED*/

fprintf(fileptr, "# column 1 = x patch name\n");
fprintf(fileptr, "# column 2 = x patch number\n");
fprintf(fileptr, "# column 3 = x irho\n");
fprintf(fileptr, "# column 4 = x isigma\n");
fprintf(fileptr, "# column 5 = x II\n");
fprintf(fileptr, "# column 6 = y patch name\n");
fprintf(fileptr, "# column 7 = y patch number\n");
fprintf(fileptr, "# column 8 = y irho\n");
fprintf(fileptr, "# column 9 = y isigma\n");
fprintf(fileptr, "# column 10 = y JJ\n");
fprintf(fileptr, "# column 11 = Jac_NP.element(II,JJ)\n");
if (Jac_SD_FDdr_ptr != NULL)
   then {
	fprintf(fileptr, "# column 12 = Jac_SD_FDdr.element(II,JJ)\n");
	fprintf(fileptr, "# column 13 = abs error in Jac_SD_FDdr\n");
	fprintf(fileptr, "# column 14 = rel error in Jac_SD_FDdr\n");
	}

    for (int xpn = 0 ; xpn < ps.N_patches() ; ++xpn)
    {
    const 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);

	for (int ypn = 0 ; ypn < ps.N_patches() ; ++ypn)
	{
	const patch& yp = ps.ith_patch(ypn);

	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);

	if (! Jac_NP_ptr->is_explicitly_stored(II,JJ))
	   then continue;			// skip sparse points

	const fp NP = Jac_NP_ptr->element(II,JJ);
	const fp SD_FDdr = (Jac_SD_FDdr_ptr == NULL)
			   ? 0.0
			   : Jac_SD_FDdr_ptr->element(II,JJ);

	if ((NP == 0.0) && (SD_FDdr == 0.0))
	   then continue;		// skip zero values (if == )

	fprintf(fileptr,
		"%s %d %d %d %d\t%s %d %d %d %d\t%#.10g",
		xp.name(), xpn, x_irho, x_isigma, II,
		yp.name(), ypn, y_irho, y_isigma, JJ,
		double(NP));

	if (Jac_SD_FDdr_ptr != NULL)
	   then {
		const fp abs_NP      = jtutil::abs(NP     );
		const fp abs_SD_FDdr = jtutil::abs(SD_FDdr);
		const fp max_abs = jtutil::max(abs_SD_FDdr, abs_NP);
		const fp SD_FDdr_abs_error = SD_FDdr - NP;
		const fp SD_FDdr_rel_error = SD_FDdr_abs_error / max_abs;

		fprintf(fileptr,
			"\t%#.10g\t%e\t%e",
			double(SD_FDdr),
			double(SD_FDdr_abs_error), double(SD_FDdr_rel_error));
		}

	fprintf(fileptr, "\n");
	}
	}
	}
    }
    }
    }

fclose(fileptr);
}

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

//
// This function encapsulates our file-naming conventions for angular-gridfn
// output files (those used for h, H, and other angular grid functions).
//
// Arguments:
// base_file_name[] = from the parameter file
// hn = the horizon number
// AHF_iteration = the apparent horizon finder's internal iteration
//		   number (>= 1) if this is an intermediate iterate,
//		   or the default (0) if this is a final computed
//		   horizon position
//
// Results:
// This function returns (a pointer to) the file name.  The returned
// result points into a private static buffer; the usual caveats apply.
//
namespace {
const char* io_ASCII_file_name(const struct IO_info& IO_info,
                               const char base_file_name[], int min_digits,
                               int hn, int AHF_iteration /* = 0 */)
{
static char file_name_buffer[IO_info::file_name_buffer_size];

const char* file_name_extension
	= IO_info.ASCII_gnuplot_file_name_extension;

if (AHF_iteration == 0)
   then snprintf(file_name_buffer, IO_info::file_name_buffer_size,
		 "%s/%s.t%0*d.ah%d.%s",
		 IO_info.h_directory, base_file_name,
		 min_digits, IO_info.time_iteration, hn,
		 file_name_extension);
   else snprintf(file_name_buffer, IO_info::file_name_buffer_size,
		 "%s/%s.t%0*d.ah%d.it%d.%s",
		 IO_info.h_directory, base_file_name,
		 min_digits, IO_info.time_iteration, hn, AHF_iteration,
		 file_name_extension);

return file_name_buffer;
}
	  }

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

//
// This function encapsulates our file-naming conventions for angular-gridfn
// output files (those used for h, H, and other angular grid functions).
//
// Arguments:
// base_file_name[] = from the parameter file
// hn = the horizon number
// AHF_iteration = the apparent horizon finder's internal iteration
//		   number (>= 1) if this is an intermediate iterate,
//		   or the default (0) if this is a final computed
//		   horizon position
//
// Results:
// This function returns (a pointer to) the file name.  The returned
// result points into a private static buffer; the usual caveats apply.
//
namespace {
const char* io_HDF5_file_name(const struct IO_info& IO_info,
                              const char base_file_name[], int min_digits,
                              int hn, int AHF_iteration /* = 0 */)
{
static char file_name_buffer[IO_info::file_name_buffer_size];

const char* file_name_extension
	= IO_info.HDF5_file_name_extension;

if (AHF_iteration == 0)
   then snprintf(file_name_buffer, IO_info::file_name_buffer_size,
		 "%s/%s.ah%d.%s",
		 IO_info.h_directory, base_file_name,
		 hn,
		 file_name_extension);
   else snprintf(file_name_buffer, IO_info::file_name_buffer_size,
		 "%s/%s.ah%d.it%d.%s",
		 IO_info.h_directory, base_file_name,
		 hn, AHF_iteration,
		 file_name_extension);

return file_name_buffer;
}
	  }

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

	  }	// namespace AHFinderDirect

```

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

# Source files in this directory
SRCS = state.cc \
       setup.cc find_horizons.cc \
       initial_guess.cc Newton.cc \
       io.cc misc-driver.cc \
       BH_diagnostics.cc horizon_sequence.cc \
       mask.cc announce.cc aliased_functions.cc

# Subdirectories containing source files
SUBDIRS =

```

driver/README.parallel:
```
Design notes for the parallel/multiprocessor algorithms and data structures
===========================================================================

$Header$

The Problem
-----------
Doing horizon finding on multiple processors is difficult, because when
we interpolate the geometry to the trial horizon surface, we must use a
global interpolator (CCTK_InterpGridArrays()), which is (necessarily) a
a collective operation, i.e. the interpolator must be called synchronously
on every processor, with identical arguments except for the number of
interpolation points, the interpolation coordinates, and the output
array pointers.  It's quite tricky to arrange this synchronicity when
different processors are locating different horizons.


Newton's Method
---------------
We find the apparent horizon by solving   Theta(h) = 0   by a global
Newton's-method iteration.  ("global" meaning we update all the horizon
surface points simultaneously at each iteration.)  That is, the basic
uniprocessor solution algorithm is

	while (true)
	{
	compute Theta(h)
	if (||Theta(h)|| small or too many iterations)
		exit
	compute Jacobian[Theta(h)]
	solve linear system J.dh = -Theta
	update h += dh
	}

As mentioned above, the computation of Theta(h) must be done synchronously
(across all processors).  It turns out that the evaluation of the Jacobian
matrix must also be done synchronously -- it too involves a geometry
interpolation.


High-Level Outline of the Solution
----------------------------------
We use the following design to do this:

Horizons are identified by an integer "horizon number".  This runs from
1 to N_horizons for the "genuine" horizons we want to find, or 0 for a
"dummy" horizon used if there are more processors than horizons to find.
	[We actually implement the dummy horizon as
	passing NULL horizon and/or Jacobian pointers
	to expansion() and expansion_Jacobian(), but
	this is an implementation detail which doesn't
	matter here.]

Each processor is assigned the dummy horizon, and zero or more genuine
horizons; each genuine horizon is assigned to exactly one procesor.
A processor with one or more genuine horizons is called an "active"
processor; a processor with only the dummy horizon is called a "dummy"
processor.  The assignment of horizons to processors is static for the
whole Cactus run.
	[A dynamic assignment might be more efficient,
	but then we'd have to move our state for a horizon
	from one processor to processor.]

All the processors do their Newton iteration synchronously, working on
genuine horizons if they have any, or dummy horizons if not.  If any
error occurs when computing Theta or the Jacobian, or in solving the
linear equations, we treat this as failing to find this horizon.

For example, suppose we have 3 horizons, which are found (the Newton
iteration converges) after respectively 3, 5, and 4 iterations.  Then
with 2 processors the iterations would look like this (where h1/2/3
means horizon 1/2/3, -- means the dummy horizon, and a * after Theta
means convergence):

	processor #0	processor #1
	------------	------------
1	h1 Theta	h2 Theta
2	h1 Jacobian	h2 Jacobian
3	h1 Theta	h2 Theta
4	h1 Jacobian	h2 Jacobian
5	h1 Theta*	h2 Theta
6	-- Jacobian	h2 Jacobian
7	h3 Theta	h2 Theta
8	h3 Jacobian	h2 Jacobian
9	h3 Theta	h2 Theta*
10	h3 Jacobian	-- Jacobian
11	h3 Theta	-- Theta
12	h3 Jacobian	-- Jacobian
13	h3 Theta*	-- Theta

(Notice that at line 6, processor #0 does a dummy-horizon Jacobian
computation before starting its next genuine horizon.  This is to keep
the Theta and Jacobian computations synchronized across all processors.
In a single-processor run we'd skip this and go directly to the next
genuine horizon.)

With 3 processors this same example would look like this:

	processor #0	processor #1	processor #2
	------------	------------	------------
1	h1 Theta	h2 Theta	h3 Theta
2	h1 Jacobian	h2 Jacobian	h3 Jacobian
3	h1 Theta	h2 Theta	h3 Theta
4	h1 Jacobian	h2 Jacobian	h3 Jacobian
5	h1 Theta*	h2 Theta	h3 Theta
6	-- Jacobian	h2 Jacobian	h3 Jacobian
7	-- Theta	h2 Theta	h3 Theta*
8	-- Jacobian	h2 Jacobian	-- Jacobian
9	-- Theta	h2 Theta*	-- Theta

With 4 processors it would look like this:

	processor #0	processor #1	processor #2	processor #3
	------------	------------	------------	------------
1	h1 Theta	h2 Theta	h3 Theta	-- Theta
2	h1 Jacobian	h2 Jacobian	h3 Jacobian	-- Jacobian
3	h1 Theta	h2 Theta	h3 Theta	-- Theta
4	h1 Jacobian	h2 Jacobian	h3 Jacobian	-- Jacobian
5	h1 Theta*	h2 Theta	h3 Theta	-- Theta
6	-- Jacobian	h2 Jacobian	h3 Jacobian	-- Jacobian
7	-- Theta	h2 Theta	h3 Theta*	-- Theta
8	-- Jacobian	h2 Jacobian	-- Jacobian	-- Jacobian
9	-- Theta	h2 Theta*	-- Theta	-- Theta

Any additional processors would similarly do all Theta and Jacobian
computations on the dummy horizon.


Interprocessor Synchronization
------------------------------

To implement this algorithm, after each Theta evaluation each active
processor computes a "I need more iterations (either on this or another
genuine horizon)" flag, and all the processors do an inclusive-or--reduction
of these flags, with the result broadcast to all processors.  Each
processor then uses the inclusive-or-reduction result to determine
whether or not to continue iterating.


Broadcasting the Iteration Status
---------------------------------

After each Theta evaluation each active processor also sends
* which horizon it's working on
* the iteration number
* the expansion() status
* its error norms
to processor 0, which uses this information to print a status report
of how the iterations are converging.

If an (active) processor finds a horizon, it computes the BH diagnostics
and broadcasts them, and optionally the horizon shape, to all processors.
Processor 0 uses this to print the BH diagnostics, and (optionally) all
processors use the diagnostics and the horizon shape to set the drift
correction information and/or the BH excision mask.

	[All the processors actually need the ghosted horizon
	shape in order to be able to do angular interpolations
	to test if a given point is inside/outside the horizon.
	But since interprocessor communication is probably
	expensive, we only broadcast the horizon shape on the
	nominal grid, then recover the ghost-zone values on
	each processor.]

Since all processors must participate in a broadcast, all processors
must somehow know that that horizon was just found.  Thus, after each
Theta iteration, we broadcast a "which horizon I've just found, or none"
integer from each active processor to all processors.


Optimizing the Interprocessor Communication
-------------------------------------------

In practice interprocessor communication is expensive.  Moreover, in
practice, given that we're doing synchronous operations across all
processors (i.e. the inclusive-or--reduction with result broadcast to
all processors), latency is probably more important than bandwidth.

Thus for implementation, we group the different interprocessor
communications described above, into two operations:

After each Theta evaluation each active processor broadcasts
* which horizon it's working on
* the iteration number
* the expansion() status
* its error norms
* a Boolean "I have just found a horizon" flag
* a Boolean "I need more iterations" flag
to all processors.  All processors do the inclusive-or--reduce of
the "I need more iterations" flags locally, on the values received
from the broadcast.

All processors then go through the "I have just found a horizon" flags
received from the broadcast, and for each flag which is true, all
processors then know to participate in the broadcast of the BH diagnostics
and (optionally) the horizon shape from the just-found-it processor
to all processors.

```

driver/test_horizon_sequence.cc:
```
// test_horizon_sequence.cc -- test driver for horizon_sequence class
// $Header$

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

#include "../include/stdc.h"
#include "horizon_sequence.hh"

using namespace AHFinderDirect;

// prototypes for functions local to this file
namespace {
void test0();
void test1();
void test2();
void test345();
	  }

int main(void)
{
test0();
test1();
test2();
test345();

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

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

namespace {
void test0()
{
printf("capacity 0 ...\n");
horizon_sequence hs0(0);
assert( hs0.N_horizons() == 0 );
assert( hs0.my_N_horizons() == 0 );
assert( ! hs0.has_genuine_horizons() );
assert( STRING_EQUAL(hs0.sequence_string(","), "") );
assert( hs0.is_dummy() );
assert( ! hs0.is_genuine() );
assert( ! hs0.is_next_genuine() );
assert( hs0.dummy_number() == 1 );
assert( hs0.init_hn() == 0 );
	assert( hs0.get_hn() == 0 );
	assert( hs0.dummy_number() == 1 );
assert( hs0.next_hn() == 0 );
	assert( hs0.get_hn() == 0 );
	assert( hs0.dummy_number() == 2 );
assert( hs0.next_hn() == 0 );
	assert( hs0.get_hn() == 0 );
	assert( hs0.dummy_number() == 3 );
assert( hs0.next_hn() == 0 );
	assert( hs0.get_hn() == 0 );
	assert( hs0.dummy_number() == 4 );
assert( hs0.N_horizons() == 0 );
assert( hs0.my_N_horizons() == 0 );
assert( ! hs0.is_hn_genuine(-1) );
assert( ! hs0.is_hn_genuine(0) );
assert( ! hs0.is_hn_genuine(1) );
assert( ! hs0.is_hn_genuine(42) );
}
	  }

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

namespace {
void test1()
{
printf("capacity 1 ...\n");
horizon_sequence hs1(1);
assert( hs1.N_horizons() == 1 );
assert( hs1.my_N_horizons() == 0 );
assert( ! hs1.has_genuine_horizons() );
assert( ! hs1.is_hn_genuine(-1) );
assert( ! hs1.is_hn_genuine(0) );
assert( ! hs1.is_hn_genuine(1) );
assert( ! hs1.is_hn_genuine(42) );
assert( hs1.append_hn(42) == 1 );
assert( hs1.N_horizons() == 1 );
assert( hs1.my_N_horizons() == 1 );
assert( hs1.has_genuine_horizons() );
assert( STRING_EQUAL(hs1.sequence_string(","), "42") );
assert( hs1.is_genuine() );
assert( ! hs1.is_next_genuine() );
assert( hs1.dummy_number() == 0 );
assert( ! hs1.is_hn_genuine(-1) );
assert( ! hs1.is_hn_genuine(0) );
assert( ! hs1.is_hn_genuine(1) );
assert(   hs1.is_hn_genuine(42) );
assert( hs1.init_hn() == 42 );
	assert( hs1.get_hn() == 42 );
	assert( hs1.is_genuine() );
	assert( ! hs1.is_next_genuine() );
	assert( hs1.dummy_number() == 0 );
assert( hs1.next_hn() == 0 );
	assert( hs1.get_hn() == 0 );
	assert( ! hs1.is_genuine() );
	assert( ! hs1.is_next_genuine() );
	assert( hs1.dummy_number() == 1 );
assert( hs1.next_hn() == 0 );
	assert( hs1.get_hn() == 0 );
	assert( ! hs1.is_genuine() );
	assert( ! hs1.is_next_genuine() );
	assert( hs1.dummy_number() == 2 );
assert( hs1.next_hn() == 0 );
	assert( hs1.get_hn() == 0 );
	assert( ! hs1.is_genuine() );
	assert( ! hs1.is_next_genuine() );
	assert( hs1.dummy_number() == 3 );
assert( hs1.next_hn() == 0 );
	assert( hs1.get_hn() == 0 );
	assert( ! hs1.is_genuine() );
	assert( ! hs1.is_next_genuine() );
	assert( hs1.dummy_number() == 4 );
assert( hs1.N_horizons() == 1 );
assert( hs1.my_N_horizons() == 1 );
}
	  }

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

namespace {
void test2()
{
printf("capacity 2 ...\n");
horizon_sequence hs2(2);
assert( hs2.N_horizons() == 2 );
assert( hs2.my_N_horizons() == 0 );
assert( ! hs2.has_genuine_horizons() );
assert( ! hs2.is_hn_genuine(-1) );
assert( ! hs2.is_hn_genuine(0) );
assert( ! hs2.is_hn_genuine(1) );
assert( ! hs2.is_hn_genuine(42) );
assert( ! hs2.is_hn_genuine(69) );
assert( hs2.append_hn(42) == 1 );
assert( hs2.append_hn(69) == 2 );
assert( hs2.N_horizons() == 2 );
assert( hs2.my_N_horizons() == 2 );
assert( hs2.has_genuine_horizons() );
assert( ! hs2.is_hn_genuine(-1) );
assert( ! hs2.is_hn_genuine(0) );
assert( ! hs2.is_hn_genuine(1) );
assert(   hs2.is_hn_genuine(42) );
assert(   hs2.is_hn_genuine(69) );
assert( ! hs2.is_hn_genuine(1000) );
assert( STRING_EQUAL(hs2.sequence_string(","), "42,69") );
assert( hs2.is_genuine() );
assert( hs2.is_next_genuine() );
assert( hs2.dummy_number() == 0 );
assert( hs2.init_hn() == 42 );
	assert( hs2.get_hn() == 42 );
	assert( hs2.is_genuine() );
	assert( hs2.is_next_genuine() );
	assert( hs2.dummy_number() == 0 );
assert( ! hs2.is_hn_genuine(-1) );
assert( ! hs2.is_hn_genuine(0) );
assert( ! hs2.is_hn_genuine(1) );
assert(   hs2.is_hn_genuine(42) );
assert(   hs2.is_hn_genuine(69) );
assert( ! hs2.is_hn_genuine(1000) );
assert( hs2.next_hn() == 69 );
	assert( hs2.get_hn() == 69 );
	assert( hs2.is_genuine() );
	assert( ! hs2.is_next_genuine() );
	assert( hs2.dummy_number() == 0 );
assert( hs2.next_hn() == 0 );
	assert( hs2.get_hn() == 0 );
	assert( ! hs2.is_genuine() );
	assert( ! hs2.is_next_genuine() );
	assert( hs2.dummy_number() == 1 );
assert( hs2.next_hn() == 0 );
	assert( hs2.get_hn() == 0 );
	assert( ! hs2.is_genuine() );
	assert( ! hs2.is_next_genuine() );
	assert( hs2.dummy_number() == 2 );
assert( hs2.next_hn() == 0 );
	assert( hs2.get_hn() == 0 );
	assert( ! hs2.is_genuine() );
	assert( ! hs2.is_next_genuine() );
	assert( hs2.dummy_number() == 3 );
assert( hs2.N_horizons() == 2 );
assert( hs2.my_N_horizons() == 2 );
assert( ! hs2.is_hn_genuine(-1) );
assert( ! hs2.is_hn_genuine(0) );
assert( ! hs2.is_hn_genuine(1) );
assert(   hs2.is_hn_genuine(42) );
assert(   hs2.is_hn_genuine(69) );
assert( ! hs2.is_hn_genuine(1000) );
}
	  }

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

namespace {
void test345()
{
	for (int capacity = 3 ; capacity <= 5 ; ++capacity)
	{
	printf("capacity %d ...\n", capacity);
	horizon_sequence hs(capacity);
	assert( hs.N_horizons() == capacity );
	assert( hs.my_N_horizons() == 0 );
	assert( ! hs.has_genuine_horizons() );

	assert( hs.init_hn() == 0 );
	assert( hs.dummy_number() == 1 );

	assert( hs.next_hn() == 0 );
	assert( hs.dummy_number() == 2 );

	assert( hs.next_hn() == 0 );
	assert( hs.dummy_number() == 3 );

	assert( ! hs.is_hn_genuine(-1) );
	assert( ! hs.is_hn_genuine(0) );
	assert( ! hs.is_hn_genuine(1) );
	assert( ! hs.is_hn_genuine(42) );
	assert( ! hs.is_hn_genuine(69) );
	assert( ! hs.is_hn_genuine(1000) );

	assert( hs.append_hn(42) == 1 );
	assert( hs.append_hn(69) == 2 );
	assert( hs.append_hn(105) == 3 );
	assert( hs.N_horizons() == capacity );
	assert( hs.my_N_horizons() == 3 );
	assert( hs.has_genuine_horizons() );
	assert( hs.is_genuine() );
	assert( hs.is_next_genuine() );
	assert( hs.dummy_number() == 0 );

	assert( ! hs.is_hn_genuine(-1) );
	assert( ! hs.is_hn_genuine(0) );
	assert( ! hs.is_hn_genuine(1) );
	assert(   hs.is_hn_genuine(42) );
	assert(   hs.is_hn_genuine(69) );
	assert( ! hs.is_hn_genuine(100) );
	assert(   hs.is_hn_genuine(105) );
	assert( ! hs.is_hn_genuine(1000) );

	assert( STRING_EQUAL(hs.sequence_string(","), "42,69,105") );

		for (int i = 1 ; i <= 4 ; ++i)
		{
		printf("   try %d...\n", i);
		assert( hs.N_horizons() == capacity );
		assert( hs.my_N_horizons() == 3 );
		assert( hs.init_hn() == 42 );
			assert( hs.get_hn() == 42 );
			assert( hs.is_genuine() );
			assert( hs.is_next_genuine() );
			assert( hs.dummy_number() == 0 );

		assert( ! hs.is_hn_genuine(-1) );
		assert( ! hs.is_hn_genuine(0) );
		assert( ! hs.is_hn_genuine(1) );
		assert(   hs.is_hn_genuine(42) );
		assert(   hs.is_hn_genuine(69) );
		assert( ! hs.is_hn_genuine(100) );
		assert(   hs.is_hn_genuine(105) );
		assert( ! hs.is_hn_genuine(1000) );

		assert( hs.next_hn() == 69 );
			assert( hs.get_hn() == 69 );
			assert( hs.is_genuine() );
			assert( hs.is_next_genuine() );
			assert( hs.dummy_number() == 0 );
		assert( hs.next_hn() == 105 );
			assert( hs.get_hn() == 105 );
			assert( hs.is_genuine() );
			assert( ! hs.is_next_genuine() );
			assert( hs.dummy_number() == 0 );
		assert( hs.next_hn() == 0 );
			assert( hs.get_hn() == 0 );
			assert( ! hs.is_genuine() );
			assert( ! hs.is_next_genuine() );
			assert( hs.dummy_number() == 1 );
		assert( hs.next_hn() == 0 );
			assert( hs.get_hn() == 0 );
			assert( ! hs.is_genuine() );
			assert( ! hs.is_next_genuine() );
			assert( hs.dummy_number() == 2 );
		assert( hs.next_hn() == 0 );
			assert( hs.get_hn() == 0 );
			assert( ! hs.is_genuine() );
			assert( ! hs.is_next_genuine() );
			assert( hs.dummy_number() == 3 );

		assert( ! hs.is_hn_genuine(-1) );
		assert( ! hs.is_hn_genuine(0) );
		assert( ! hs.is_hn_genuine(1) );
		assert(   hs.is_hn_genuine(42) );
		assert(   hs.is_hn_genuine(69) );
		assert( ! hs.is_hn_genuine(100) );
		assert(   hs.is_hn_genuine(105) );
		assert( ! hs.is_hn_genuine(1000) );
		}
	}
}
	  }

```

driver/mask.cc:
```
// mask.cc -- set a mask gridfn based on each horizon shape
// $Header$
//
// <<<access to persistent data>>>
/// <<<data structures local to this file>>>
/// <<<prototypes for functions local to this file>>>
// AHFinderDirect_do_masks - top-level driver for all mask stuff
/// setup_mask_grid_info - setup mask grid origin/delta etc
/// setup_mask_dataptrs_and_bitfields - map gridfn/bitfield names to ptr/bitmask
/// set_mask_gridfn - set mask gridfn(s) based on each horizon's shape
/// set_mask_gridfn_to_outside_value - ... "outside" value
/// set_mask_gridfn_to_inside_and_buffer_values - "inside"/"buffer" values
/// inner_mask_radius - compute inner mask radius r_inner given r_horizon
/// outer_mask_radius - compute outer mask radius r_outer given r_inner
//

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

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

#include "SpaceMask.h"			// from thorn SpaceMask

#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"

#include "horizon_sequence.hh"
#include "BH_diagnostics.hh"
#include "driver.hh"

// define this to get extra debugging on the mask grid origin/delta etc
#undef DEBUG_MASK_GRID

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// ***** access to persistent data *****
//
extern struct state state;

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

//
// ***** data structures local to this file *****
//

//
// This structure holds all the information we need about the (Cactus)
// grid where the mask gridfn(s) is/are stored.
//
namespace {
struct	mask_grid_info
	{
	const cGH *GH;			// --> Cactus grid hierarchy

	// Cactus coordinate system
	// (for the *current* grid if we are doing mesh refinement)
	fp proc_coord_origin[N_GRID_DIMS];	// global (x,y,z) of
						// *this processor's*
						// (i,j,k) = (0,0,0)
						// grid point
	fp coord_delta[N_GRID_DIMS];		// (x,y,z) grid spacing

	// maximum of x,y,z grid spacings
	fp max_coord_delta;

	// geometric mean of x,y,z grid spacings,
	// on the *base* grid if we are doing mesh refinement
	// (we need the base-grid semantics to make excision consistent
	//  across refinement levels)
	fp base_grid_mean_coord_delta;

	// dimensions of gridfn data on this processor, viewed as a 3-D array
	// n.b. storage ordering is Fortran,
	//	i.e. i is contiguous, j has stride Ni, k has stride Ni*Nj
	CCTK_INT proc_gridfn_dims[N_GRID_DIMS];


	//
	// coordinate conversion functions
	//
	// here ijk = gridfn array indices on this processor
	//      xyz = floating-point global coordinates
	//

	// convert integer ijk --> floating-point global xyz coordinates
	fp global_xyz_of_ijk(int axis, int ijk) const
		{ return proc_coord_origin[axis] + ijk*coord_delta[axis]; }
	// convert floating-point global xyz --> integer ijk coordinates
	// ... but as a floating-point number
	fp fp_ijk_of_global_xyz(int axis, fp xyz) const
		{ return (xyz - proc_coord_origin[axis]) / coord_delta[axis]; }
	// convert floating-point global_xyz --> integer ijk coordinates
	// ... rounding down/up to the next integer (= to the next grid point)
	int ijk_floor_of_global_xyz(int axis, fp xyz) const
		{ return jtutil::ifloor(fp_ijk_of_global_xyz(axis, xyz)); }
	int ijk_ceil_of_global_xyz (int axis, fp xyz) const
		{ return jtutil::iceil(fp_ijk_of_global_xyz(axis, xyz)); }
	};
	  }

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

//
// ***** prototypes for functions local to this file *****
//

namespace {
void setup_mask_grid_info(CCTK_ARGUMENTS, struct mask_grid_info& mgi);
void setup_mask_dataptrs_and_bitfields(const cGH *GH,
				       struct mask_info& mask_info);
void set_mask_gridfn(int N_horizons,
		     const struct AH_data* const AH_data_array[],
		     const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     const struct verbose_info& verbose_info);

void set_mask_gridfn_to_outside_value(const struct mask_grid_info& mgi,
				      const struct mask_info& mask_info,
				      const struct verbose_info& verbose_info);
void set_mask_gridfn_to_inside_and_buffer_values
	(const struct mask_grid_info& mgi,
	 int use_min_i, int use_max_i,
	 int use_min_j, int use_max_j,
	 int use_min_k, int use_max_k,
	 const struct mask_info& mask_info,
	 const patch_system& ps,
	 const struct verbose_info& verbose_info);
fp inner_mask_radius(const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     fp r_horizon);
fp outer_mask_radius(const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     fp r_inner);
	  }

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

//
// This function is called by the Cactus scheduler after we find any
// apparent horizons, to do all this thorn's mask processing.
//
extern "C"
  void AHFinderDirect_maybe_do_masks(CCTK_ARGUMENTS)
{
DECLARE_CCTK_ARGUMENTS
DECLARE_CCTK_PARAMETERS

const struct verbose_info& verbose_info = state.verbose_info;
      struct    mask_info&    mask_info = state.mask_info;

// optionally set the mask gridfn based on each horizon's shape
if (mask_info.set_mask_for_any_horizon)
   then {
	//
	// this setup has to be done each time we're called, and
	// the  mask_grid_info  structure can't live in  struct state ,
	// because if mesh refinement is in effect we'll be called
	// separately for each separate locally-uniform grid patch
	//
	mask_grid_info mgi;
	setup_mask_grid_info(CCTK_PASS_CTOC, mgi);

	setup_mask_dataptrs_and_bitfields(cctkGH, mask_info);
	set_mask_gridfn(state.N_horizons, state.AH_data_array,
			mgi, mask_info,
			verbose_info);
	}
}

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

//
// This function sets up the  mask_grid_info  structure to describe
// the (current) Cactus grid where the mask gridfn(s) live.
//
namespace {
void setup_mask_grid_info(CCTK_ARGUMENTS, struct mask_grid_info& mgi)
{
DECLARE_CCTK_ARGUMENTS

mgi.GH = cctkGH;

// Cactus grid spacing on *this* grid
mgi.coord_delta[X_AXIS] = CCTK_DELTA_SPACE(X_AXIS);
mgi.coord_delta[Y_AXIS] = CCTK_DELTA_SPACE(Y_AXIS);
mgi.coord_delta[Z_AXIS] = CCTK_DELTA_SPACE(Z_AXIS);
mgi.max_coord_delta = jtutil::max(mgi.coord_delta[X_AXIS],
		      jtutil::max(mgi.coord_delta[Y_AXIS],
				  mgi.coord_delta[Z_AXIS]));

// Cactus grid spacings on the *base* grid
const fp base_grid_delta_product =   cctk_delta_space[X_AXIS]
				   * cctk_delta_space[Y_AXIS]
				   * cctk_delta_space[Z_AXIS];
mgi.base_grid_mean_coord_delta = pow(base_grid_delta_product, 1.0/3.0);

// get global/local Cactus grid origin
// KLUDGE -- is this the right way to get this??
mgi.proc_coord_origin[X_AXIS] = CCTK_ORIGIN_SPACE(X_AXIS)
				 + cctk_lbnd[X_AXIS] * mgi.coord_delta[X_AXIS];
mgi.proc_coord_origin[Y_AXIS] = CCTK_ORIGIN_SPACE(Y_AXIS)
				 + cctk_lbnd[Y_AXIS] * mgi.coord_delta[Y_AXIS];
mgi.proc_coord_origin[Z_AXIS] = CCTK_ORIGIN_SPACE(Z_AXIS)
				 + cctk_lbnd[Z_AXIS] * mgi.coord_delta[Z_AXIS];
mgi.proc_gridfn_dims[X_AXIS] = cctk_lsh[X_AXIS];
mgi.proc_gridfn_dims[Y_AXIS] = cctk_lsh[Y_AXIS];
mgi.proc_gridfn_dims[Z_AXIS] = cctk_lsh[Z_AXIS];

#ifdef DEBUG_MASK_GRID
printf("mask.cc:: cctk_lsh[] = [%d,%d,%d]\n",
	int(cctk_lsh[X_AXIS]),
	int(cctk_lsh[Y_AXIS]),
	int(cctk_lsh[Z_AXIS]));
printf("mask.cc:: mgi.coord_delta[] = [%g,%g,%g]\n",
	double(mgi.coord_delta[X_AXIS]),
	double(mgi.coord_delta[Y_AXIS]),
	double(mgi.coord_delta[Z_AXIS]));
printf("mask.cc:: mgi.proc_coord_origin[] = [%g,%g,%g]\n",
	double(mgi.proc_coord_origin[X_AXIS]),
	double(mgi.proc_coord_origin[Y_AXIS]),
	double(mgi.proc_coord_origin[Z_AXIS]));
#endif
}
	  }

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

//
// This function maps the character-string names of the mask gridfn(s)
// and/or bitfield(s) into internal data pointers and/or bit masks/values:
//
//	mask_info.old_style_mask_info
//		 .gridfn_varindex --> .gridfn_dataptr
//	mask_info.new_style_mask_info
//		 .gridfn_varindex --> .gridfn_dataptr
//		 .bitfield_name   --> .bitfield_bitmask
//		 .inside_value    --> .inside_bitvalue
//		 .buffer_value    --> .buffer_bitvalue
//		 .outside_value   --> .outside_bitvalue
//
namespace {
void setup_mask_dataptrs_and_bitfields(const cGH *GH,
				       struct mask_info& mask_info)
{
const int mask_time_level = 0;
const int SPACEMASK_ERROR = -1;

struct mask_info::old_style_mask_info& osmi = mask_info.old_style_mask_info;
if (mask_info.set_old_style_mask)
   then {
	osmi.gridfn_dataptr = static_cast<CCTK_REAL*>(
				CCTK_VarDataPtrI(GH, mask_time_level,
						 osmi.gridfn_varindex)
						     );
	if (osmi.gridfn_dataptr == NULL)
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"setup_mask_dataptrs_and_bitfields():\n"
"        couldn't get data pointer for old-style mask \"%s\"!\n"
			   ,
			   osmi.gridfn_name);			/*NOTREACHED*/
	}

if (mask_info.set_new_style_mask)
   then {
	struct mask_info::new_style_mask_info& nsmi
		= mask_info.new_style_mask_info;
	nsmi.gridfn_dataptr = static_cast<CCTK_INT*>(
				CCTK_VarDataPtrI(GH, mask_time_level,
						 nsmi.gridfn_varindex)
						    );
	if (nsmi.gridfn_dataptr == NULL)
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"setup_mask_dataptrs_and_bitfields():\n"
"        couldn't get data pointer for new-style mask \"%s\"!\n"
			   ,
			   nsmi.gridfn_name);			/*NOTREACHED*/

	nsmi.bitfield_bitmask = SpaceMask_GetTypeBits(nsmi.bitfield_name);
	if (nsmi.bitfield_bitmask == SPACEMASK_ERROR)
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"setup_mask_dataptrs_and_bitfields():\n"
"        couldn't get bit mask for new-style mask bit field \"%s\"!\n"
"        (this almost certainly means this bit field was never registered\n"
"         with SpaceMask; remember that AHFinderDirect doesn't do this\n"
"         registration, rather you need to arrange for some other thorn(s)\n"
"         to do it)\n"
		   ,
		   nsmi.bitfield_name);				/*NOTREACHED*/

	nsmi.inside_bitvalue  = SpaceMask_GetStateBits(nsmi.bitfield_name,
						       nsmi.inside_value);
	nsmi.buffer_bitvalue  = SpaceMask_GetStateBits(nsmi.bitfield_name,
						       nsmi.buffer_value);
	nsmi.outside_bitvalue = SpaceMask_GetStateBits(nsmi.bitfield_name,
						       nsmi.outside_value);
	if (    (nsmi.inside_bitvalue == SPACEMASK_ERROR)
	     || (nsmi.buffer_bitvalue == SPACEMASK_ERROR)
	     || (nsmi.outside_bitvalue == SPACEMASK_ERROR)    )
	   then CCTK_VWarn(FATAL_ERROR, __LINE__, __FILE__, CCTK_THORNSTRING,
"\n"
"setup_mask_dataptrs_and_bitfields():\n"
"        couldn't get bit value(s) for one or more of the new-style mask\n"
"        inside/buffer/outside values \"%s\"/\"%s\"/\"%s\"!\n"
"        (this almost certainly means one or more of the values was/were\n"
"         never registered with SpaceMask; remember that AHFinderDirect\n"
"         doesn't do this registration, rather you need to arrange for\n"
"         some other thorn(s) to do it)\n"
			   ,
			   nsmi.inside_value,
			   nsmi.buffer_value,
			   nsmi.outside_value);			/*NOTREACHED*/
	}
}
	  }

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

//
// This function sets the mask grid function specified by  mask_info
// based on each horizon's shape.
//
namespace {
void set_mask_gridfn(int N_horizons,
		     const struct AH_data* const AH_data_array[],
		     const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     const struct verbose_info& verbose_info)
{
const bool set_old_style_mask = mask_info.set_old_style_mask;
const bool set_new_style_mask = mask_info.set_new_style_mask;
const struct mask_info::old_style_mask_info& osmi = mask_info.old_style_mask_info;
const struct mask_info::new_style_mask_info& nsmi = mask_info.new_style_mask_info;

if (verbose_info.print_algorithm_highlights)
   then {
	if (set_old_style_mask)
	   then CCTK_VInfo(CCTK_THORNSTRING,
			   "setting old-style (CCTK_REAL) mask grid function %s",
			   osmi.gridfn_name);
	if (set_new_style_mask)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "setting new-style (CCTK_INT) mask grid function %s",
			   nsmi.gridfn_name);
		CCTK_VInfo(CCTK_THORNSTRING,
			   "                                  bit field %s",
			   nsmi.bitfield_name);
		}
	}

if (verbose_info.print_algorithm_debug)
   then {
	CCTK_VInfo(CCTK_THORNSTRING,
		   "      grid on this processor has x=[%g,%g]",
		   double(mgi.global_xyz_of_ijk(X_AXIS, 0)),
		   double(mgi.global_xyz_of_ijk(X_AXIS, mgi.proc_gridfn_dims[X_AXIS]-1)));
	CCTK_VInfo(CCTK_THORNSTRING,
		   "                                 y=[%g,%g]",
		   double(mgi.global_xyz_of_ijk(Y_AXIS, 0)),
		   double(mgi.global_xyz_of_ijk(Y_AXIS, mgi.proc_gridfn_dims[Y_AXIS]-1)));
	CCTK_VInfo(CCTK_THORNSTRING,
		   "                                 z=[%g,%g]",
		   double(mgi.global_xyz_of_ijk(Z_AXIS, 0)),
		   double(mgi.global_xyz_of_ijk(Z_AXIS, mgi.proc_gridfn_dims[Z_AXIS]-1)));
	}


//
// set the mask to the outside value everywhere in
// (this processor's chunk of) the grid
//
set_mask_gridfn_to_outside_value(mgi,
				 mask_info,
				 verbose_info);


//
// loop over each horizon's xyz bounding box
// (intersected with (this processor's chunk of) the grid)
// to set the mask accurately (or skip this horizon if it's too small)
//
	for (int hn = 1 ; hn <= N_horizons ; ++hn)
	{
	if (! mask_info.set_mask_for_this_horizon[hn])
	   then continue;				// *** LOOP CONTROL ***

	const struct AH_data& AH_data = *AH_data_array[hn];
	if (! AH_data.found_flag)
	   then continue;				// *** LOOP CONTROL ***

	const patch_system& ps                      = *AH_data.ps_ptr;
	const struct BH_diagnostics& BH_diagnostics =  AH_data.BH_diagnostics;

	//
	// skip this horizon if it's too small
	//
	// ... The condition is documented as using the minimum over angle
	//     of r_inner(r_horizon(angle)).  But this is trivially equivalent
	//     to r_inner(the minimum over angle of r_horizon), i.e. to
	//     r_inner(BH_diagnostics.min_radius); this latter form is what
	//     we actually compute.
	//
	const fp r_inner_min
		= inner_mask_radius(mgi, mask_info, BH_diagnostics.min_radius);
	if (r_inner_min
	    < mask_info.min_horizon_radius_points_for_mask*mgi.max_coord_delta)
	   then {
		if (verbose_info.print_algorithm_details)
		   then CCTK_VInfo(CCTK_THORNSTRING,
   "   r_inner_min=%g < %g grid points ==> skipping mask for horizon %d",
				   r_inner_min,
				   mask_info.min_horizon_radius_points_for_mask,
				   hn);
		continue;				// *** LOOP CONTROL ***
		}

	//
	// get to here ==> normal mask processing for this horizon
	//

	if (verbose_info.print_algorithm_details)
	   then CCTK_VInfo(CCTK_THORNSTRING,
   "   setting mask grid function to \"buffer\"/\"inside\" for horizon %d",
			   hn);


	// horizon bounding box, rounded "out" to the next grid point
	const int AH_min_i = mgi.ijk_floor_of_global_xyz(X_AXIS, BH_diagnostics.min_x);
	const int AH_max_i = mgi.ijk_ceil_of_global_xyz (X_AXIS, BH_diagnostics.max_x);
	const int AH_min_j = mgi.ijk_floor_of_global_xyz(Y_AXIS, BH_diagnostics.min_y);
	const int AH_max_j = mgi.ijk_ceil_of_global_xyz (Y_AXIS, BH_diagnostics.max_y);
	const int AH_min_k = mgi.ijk_floor_of_global_xyz(Z_AXIS, BH_diagnostics.min_z);
	const int AH_max_k = mgi.ijk_ceil_of_global_xyz (Z_AXIS, BH_diagnostics.max_z);
	if (verbose_info.print_algorithm_debug)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "      horizon bounding box is x=[%g,%g]",
			   double(BH_diagnostics.min_x),
			   double(BH_diagnostics.max_x));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "                              y=[%g,%g]",
			   double(BH_diagnostics.min_y),
			   double(BH_diagnostics.max_y));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "                              z=[%g,%g]",
			   double(BH_diagnostics.min_z),
			   double(BH_diagnostics.max_z));
		}

	//
	// compute intersection of horizon bounding box with
	// (this processor's chunk of) the grid
	//
	// as can be seen from the following picture, the intersection
	// has the max/min of the min/max coordinate as its min/max:
	//
	//	           +--------------------+
	//	           |                    |
	//	+----------+--------------+     |
	//	|          |XXXXXXXXXXXXXX|     |
	//	|          |XXXXXXXXXXXXXX|     |
	//	|          |XXXXXXXXXXXXXX|     |
	//	|          +--------------+-----+
	//	|                         |
	//	|                         |
	//	+-------------------------+
	//
	const int use_min_i = jtutil::max(AH_min_i, 0);
	const int use_max_i = jtutil::min(AH_max_i, int(mgi.proc_gridfn_dims[X_AXIS]-1));
	const int use_min_j = jtutil::max(AH_min_j, 0);
	const int use_max_j = jtutil::min(AH_max_j, int(mgi.proc_gridfn_dims[Y_AXIS]-1));
	const int use_min_k = jtutil::max(AH_min_k, 0);
	const int use_max_k = jtutil::min(AH_max_k, int(mgi.proc_gridfn_dims[Z_AXIS]-1));

	if (verbose_info.print_algorithm_debug)
	   then {
		CCTK_VInfo(CCTK_THORNSTRING,
			   "      use bounding box is x=[%g,%g]",
			   double(mgi.global_xyz_of_ijk(X_AXIS, use_min_i)),
			   double(mgi.global_xyz_of_ijk(X_AXIS, use_max_i)));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "                          y=[%g,%g]",
			   double(mgi.global_xyz_of_ijk(Y_AXIS, use_min_j)),
			   double(mgi.global_xyz_of_ijk(Y_AXIS, use_max_j)));
		CCTK_VInfo(CCTK_THORNSTRING,
			   "                          z=[%g,%g]",
			   double(mgi.global_xyz_of_ijk(Z_AXIS, use_min_k)),
			   double(mgi.global_xyz_of_ijk(Z_AXIS, use_max_k)));
		}

	set_mask_gridfn_to_inside_and_buffer_values(mgi,
						    use_min_i, use_max_i,
						    use_min_j, use_max_j,
						    use_min_k, use_max_k,
						    mask_info,
						    ps,
						    verbose_info);
	}
}
	  }

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

//
// For each Cactus grid point in (this processor's chunk of) the Cactus
// grid, this function sets the mask grid function specified by  mask_info
// to the appropriate value for the "outside" region (possibly leaving
// the mask unchanged at its previous value if the  mask_is_noshrink
// option is set).
//
namespace {
void set_mask_gridfn_to_outside_value(const struct mask_grid_info& mgi,
				      const struct mask_info& mask_info,
				      const struct verbose_info& verbose_info)
{
const bool set_old_style_mask = mask_info.set_old_style_mask;
const bool set_new_style_mask = mask_info.set_new_style_mask;
const struct mask_info::old_style_mask_info& osmi = mask_info.old_style_mask_info;
const struct mask_info::new_style_mask_info& nsmi = mask_info.new_style_mask_info;


if (verbose_info.print_algorithm_details)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "   setting mask grid function to \"outside\"");

	for (int k = 0 ; k < mgi.proc_gridfn_dims[Z_AXIS] ; ++k)
	{
	for (int j = 0 ; j < mgi.proc_gridfn_dims[Y_AXIS] ; ++j)
	{
	for (int i = 0 ; i < mgi.proc_gridfn_dims[X_AXIS] ; ++i)
	{
	const int posn = CCTK_GFINDEX3D(mgi.GH, i,j,k);
	if (set_old_style_mask)
	   then {
		const CCTK_REAL old_value = osmi.gridfn_dataptr[posn];
		if ( mask_info.mask_is_noshrink
		     && (    (old_value == osmi.inside_value)
			  || (old_value == osmi.buffer_value)    ) )
		   then {
			// we're in "noshrink mode"
			// and this point was previously "inside" or "buffer"
			// ==> no-op here
			}
		   else osmi.gridfn_dataptr[posn] = osmi.outside_value;
		}
	if (set_new_style_mask)
	   then {
		if ( mask_info.mask_is_noshrink
		     && (    SpaceMask_CheckStateBits(nsmi.gridfn_dataptr, posn,
						      nsmi.bitfield_bitmask,
						      nsmi.inside_bitvalue)
			  || SpaceMask_CheckStateBits(nsmi.gridfn_dataptr, posn,
						      nsmi.bitfield_bitmask,
						      nsmi.buffer_bitvalue)    ) )
		   then {
			// we're in "noshrink mode"
			// and this point was previously "inside" or "buffer"
			// ==> no-op here
			}
		   else SpaceMask_SetStateBits(nsmi.gridfn_dataptr, posn,
					       nsmi.bitfield_bitmask,
					       nsmi.outside_bitvalue);
		}
	}
	}
	}
}
	  }

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

//
// For each Cactus grid point in a specified region of the Cactus grid,
// and for a specified (single) horizon, this function either sets the
// mask grid function specified by  mask_info to the appropriate value
// if the point is in the "inside" or "buffer" region for a specified
// horizon (possibly leaving the mask unchanged at its previous value
// if the  mask_is_noshrink  option is set), or leaves the mask grid
// function unchanged if the point is actually outside this horizon.
//
// Arguments:
// ps = The patch system for this horizon.
// use_{min,max}_{i,j,k} = Specifies the region of the Cactus grid.
//
// FIXME:
// The current implementation is quite inefficient: it does a full 2-D
// interpolation (to find the horizon radius) for each xyz grid point
// in the specified region.  It would be more efficient to batch the
// interpolations, and maybe also use r_min/r_max tests for early-out.
//
namespace {
void set_mask_gridfn_to_inside_and_buffer_values
	(const struct mask_grid_info& mgi,
	 int use_min_i, int use_max_i,
	 int use_min_j, int use_max_j,
	 int use_min_k, int use_max_k,
	 const struct mask_info& mask_info,
	 const patch_system& ps,
	 const struct verbose_info& verbose_info)
{
const bool set_old_style_mask = mask_info.set_old_style_mask;
const bool set_new_style_mask = mask_info.set_new_style_mask;
const struct mask_info::old_style_mask_info& osmi = mask_info.old_style_mask_info;
const struct mask_info::new_style_mask_info& nsmi = mask_info.new_style_mask_info;

long inside_count = 0;
long buffer_count = 0;

	for (int k = use_min_k ; k <= use_max_k ; ++k)
	{
	for (int j = use_min_j ; j <= use_max_j ; ++j)
	{
	for (int i = use_min_i ; i <= use_max_i ; ++i)
	{
	const int posn = CCTK_GFINDEX3D(mgi.GH, i,j,k);

	const fp global_x = mgi.global_xyz_of_ijk(X_AXIS, i);
	const fp global_y = mgi.global_xyz_of_ijk(Y_AXIS, j);
	const fp global_z = mgi.global_xyz_of_ijk(Z_AXIS, k);
	const fp local_x = global_x - ps.origin_x();
	const fp local_y = global_y - ps.origin_y();
	const fp local_z = global_z - ps.origin_z();

	const fp r = jtutil::hypot3(local_x, local_y, local_z);

	// interpolate to find r_horizon in this direction
	//
	// FIXME:
	// it would be more efficient here to compute the
	// radii of a whole batch of points at once
	const fp r_horizon = ps.radius_in_local_xyz_direction
				   (gfns::gfn__h,
				    local_x, local_y, local_z);

	const fp r_inner = inner_mask_radius(mgi, mask_info, r_horizon);
	const fp r_outer = outer_mask_radius(mgi, mask_info, r_inner);

	if	(r <= r_inner)
	   then {
		// set the mask to the "inside" value
		++inside_count;
		if (set_old_style_mask)
		   then osmi.gridfn_dataptr[posn] = osmi.inside_value;
		if (set_new_style_mask)
		   then SpaceMask_SetStateBits(nsmi.gridfn_dataptr, posn,
					       nsmi.bitfield_bitmask,
					       nsmi.inside_bitvalue);
		}
	else if (r <= r_outer)
	   then {
		// set the mask to the "buffer" value
		// ... except that if the  mask_is_noshrink  option is set
		//     and the mask is already set to the "inside" value
		//     then we need to leave it unchanged
		//     (at the "inside" value)
		++buffer_count;
		if (set_old_style_mask)
		   then {
			if ( mask_info.mask_is_noshrink
			     && (osmi.gridfn_dataptr[posn] == osmi.inside_value) )
			   then {
				// we're in "noshrink mode"
				// and this point was previously "inside"
				// ==> no-op here
				}
			   else osmi.gridfn_dataptr[posn] = osmi.buffer_value;
			}
		if (set_new_style_mask)
		   then {
			if ( mask_info.mask_is_noshrink
			     && SpaceMask_CheckStateBits(nsmi.gridfn_dataptr, posn,
							 nsmi.bitfield_bitmask,
							 nsmi.inside_bitvalue) )
			   then {
				// we're in "noshrink mode"
				// and this point was previously "inside"
				// ==> no-op here
				}
			   else SpaceMask_SetStateBits(nsmi.gridfn_dataptr, posn,
						       nsmi.bitfield_bitmask,
						       nsmi.buffer_bitvalue);
			}
		}
	else	{
		// it's "outside" ==> no-op here
		}
	}
	}
	}

if (verbose_info.print_algorithm_details)
   then CCTK_VInfo(CCTK_THORNSTRING,
		   "      %ld \"inside\" points, %ld \"buffer\" points on this processor",
		   inside_count, buffer_count);
}
	  }

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

//
// This function computes the inner mask radius  r_inner  for a given
// horizon radius  r_horizon .
//
namespace {
fp inner_mask_radius(const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     fp r_horizon)
{
const fp Cactus_dx = mgi.base_grid_mean_coord_delta;
return mask_info.radius_multiplier*r_horizon
       + mask_info.radius_offset*Cactus_dx;
}
	  }

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

//
// This function computes the outer mask radius  r_outer  for a given
// inner mask radius  r_inner .
//
namespace {
fp outer_mask_radius(const struct mask_grid_info& mgi,
		     const struct mask_info& mask_info,
		     fp r_inner)
{
const fp Cactus_dx = mgi.base_grid_mean_coord_delta;
return r_inner + mask_info.buffer_thickness*Cactus_dx;
}
	  }

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

	  }	// namespace AHFinderDirect

```

include/config.h:
```
/* config.h -- compile-time configuration for AHFinderDirect */
/* $Header$ */

#ifndef AHFINDERDIRECT__CONFIG_H
#define AHFINDERDIRECT__CONFIG_H

/*
 * This header file is #included by C++ and C files, and also by
 * Fortran 77 files which are run through a C-like preprocessor.  Alas,
 * due to a Cactus bug on some systems, this means that all preprocessor
 * commands must start in column 1. :( :( :(
 */

/*
 * prerequisites:
 *	"cctk.h" or "fake_cctk.h"
 */

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

/*
 * definitions for C/C++ only
 */

#ifdef CCODE
typedef CCTK_REAL fp;

/* Fortran 'integer' type */
typedef int integer;
#endif	/* CCODE */

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

/*
 * definitions for C++, C, and Fortran
 */

/* CCTK_VWarn() "warning level" for fatal errors (terminate execution) */
/* note low-level software uses error_exit() instead of CCTK_VWarn(), */
/* with exit codes defined in "stdc.h" */
#define FATAL_ERROR	(-1)

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

/*
 * ***** definitions for integer and floating point datatypes *****
 */

/*
 * FIXME: this assumes fp == C 'double'
 * CCTK_REAL_PRECISION_{4,8,16} are helpful, but not quite enough)
 */
#include <cctk.h>
#undef  FP_IS_FLOAT
#undef  FP_IS_DOUBLE
#ifdef CCTK_REAL_PRECISION_4
#define FP_IS_FLOAT
#endif
#ifdef CCTK_REAL_PRECISION_8
#define FP_IS_DOUBLE
#endif

#if   defined(FP_IS_FLOAT)
#define FP_SCANF_FORMAT "%f"
#define FP_EPSILON	FLT_EPSILON	/* from <float.h> */
#elif defined(FP_IS_DOUBLE)
#define FP_SCANF_FORMAT "%lf"
#define FP_EPSILON	DBL_EPSILON	/* from <float.h> */
#else
#error "don't know fp datatype!"
#endif

/*
 * FIXME: this should be set somehow at configure time
 */
#define FORTRAN_INTEGER_IS_INT
#undef  FORTRAN_INTEGER_IS_LONG

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

/*
 * The angular finite differencing in our multipatch system can be
 * either 2nd order or 4th order, configurable here.
 */
#ifdef FINITE_DIFF_ORDER
/* someone (probably a Makefile) has already defined this */
/* ==> leave it alone */
#else
#define FINITE_DIFF_ORDER	4
#endif

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

/*
 * What types of Jacobian matrix storage and linear solvers do we want to
 * compile in support for?  Note that each of these requires linking with
 * the corresponding linear-solver library; see "../elliptic/Jacobian.hh"
 * for details on the storage formats, or "../make.configuration.defn"
 * (if it exists) for details on the libraries.
 */

/* store as (Fortran) dense matrix, solve with LAPACK */
#undef  HAVE_DENSE_JACOBIAN__LAPACK

/* store as row-oriented sparse matrix, solve with ILUCG */
#define HAVE_ROW_SPARSE_JACOBIAN__ILUCG

/* store as row-oriented sparse matrix, solve with UMFPACK */
#define HAVE_ROW_SPARSE_JACOBIAN__UMFPACK

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

/*
 * The following #ifdefs and #defines shouldn't need changing; they
 * decode the previous set of Jacobian storage format and linear solver
 * #defines to determine which storage formats we are using.
 */
#ifdef HAVE_DENSE_JACOBIAN__LAPACK
#define HAVE_DENSE_JACOBIAN
#endif

#ifdef HAVE_ROW_SPARSE_JACOBIAN__ILUCG
#define HAVE_ROW_SPARSE_JACOBIAN
#endif

#ifdef HAVE_ROW_SPARSE_JACOBIAN__UMFPACK
#define HAVE_ROW_SPARSE_JACOBIAN
#endif

#endif	/* AHFINDERDIRECT__CONFIG_H */

```

include/README:
```
This directory holds header files common to all of this thorn.

fake_cctk.h
	is a fake version of "cctk.h" for non-Cactus standalone test
	compilations, containing typedefs for CCTK_INT, CCTK_REAL, etc

stdc.h
	is a low-level file defining Jonathan Thornburg's "dialect" of C,
	including the "then" pseudo-keyword you'll see all through the
	source code

config.hh
	defines compile-time configuration for this thorn, eg the "fp"
	typedef (= CCTK_REAL), the choice of 2nd vs 4th order finite
	differencing, etc etc

```

include/stdc.h:
```
/* stdc.h -- JT standard C/C++ header file, cut-down for modern code only */
/* $Header$ */

#ifndef AHFINDERDIRECT__STDC_H
#define AHFINDERDIRECT__STDC_H

/*
 * ***** THIS VERSION IS FOR ANSI/ISO C AND C++ *****
 */

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

/*
 * I use this macro in all if statements -- I like the symmetry between
 * the two branches of an if statement.
 *
 *	if (foo)
 *	   then bar;
 *
 *	if (foo)
 *	   then bar;
 *	   else baz;
 */
#define then	/* empty */

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

/*
 * misc stuff
 */

#ifdef M_PI		/* usually defined in <math.h> */
  #define PI	M_PI
#endif

#define STRING_EQUAL(s_,t_)	(strcmp(s_,t_) == 0)

/* C library uses abs() for integer absolute value; I prefer iabs() */
#define iabs(x_)	abs(x_)

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

/*
 * misc sentinal values
 */

/* n.b. this value is usually 10...0 binary for 2's-complement arithmetic */
#define INT_SENTINAL_VALUE	(~ INT_MAX)	/* from <limits.h> */

#define FLOAT_SENTINAL_VALUE	(- FLT_MAX)	/* from <float.h> */
#define DOUBLE_SENTINAL_VALUE	(- DBL_MAX)	/* from <float.h> */

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

#ifdef __cplusplus
namespace jtutil
	  {
#endif

/*
 * Low-level code in this thorn is done with  error_exit() .  In this
 * this thorn it's a wrapper around  CCTK_VWarn(msg_level, ...) .  It's
 * declared to return  int  so it may be easily used in conditional
 * expressions like
 *	foo = bar_ok ? baz(bar) : error_exit(...);
 */
#ifdef __cplusplus
  extern "C"
#endif
int error_exit(int msg_level, const char *format, ...)
  #ifdef __GNUC__
  __attribute__ ((noreturn))
  __attribute__ ((format(printf,2,3)))
  #endif
;

/*
 * error_exit() uses the following  msg_level  codes:
 *	ERROR_EXIT	==> something bad has happened
 *			    (eg inconsistent user input)
 *	PANIC_EXIT	==> diasaster (eg internal consistency check failed)
 *			==> we'd like to force (eg) a core dump or stack trace
 *			    (but at present this isn't implemented; we just
 *			     do a  CCTK_VWarn()  just like for  ERROR_EXIT)
 */
#define ERROR_EXIT	(-1)
#define PANIC_EXIT	(-2)

#ifdef __cplusplus
	  }	/* namespace jtutil */
#endif

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

#endif	/* AHFINDERDIRECT__STDC_H */

```

include/fake_cctk.h:
```
/* fake_cctk.h -- fake "cctk.h" for non-Cactus standalone compilations */
/* $Header$ */

#ifndef AHFINDERDIRECT__FAKE_CCTK_H
#define AHFINDERDIRECT__FAKE_CCTK_H

#define CCODE
typedef int    CCTK_INT;
typedef double CCTK_REAL;

#endif	/* AHFINDERDIRECT__FAKE_CCTK_H */

```

maple/setup.maple:
```
# setup.maple -- top-level Maple input file to set up PDE compiler system
# $Header$

#
# Note not all files here actually *use* the preprocessor, but for
# convenience we preprocess everything (this way we don't have to keep
# track of which files should be used as .maple and which as .mm).
#

#
# Note paths are evaluated relative to where read command gets executed,
# not relative to this directory, so we use ../maple/ to try and avoid
# ambiguities in case this file gets read from another directory.
#

read "../maple/util.mm";

read "../maple/coords.mm";
setup_coords();

read "../maple/Diff.mm";

read "../maple/gfa.mm";

read "../maple/coeffs.mm";
setup_coeff_gfas();

read "../maple/codegen2.mm";

```

maple/Makefile:
```
# Makefile for maple code
# $Header: /usr/local/svn/cvs-repositories/numrelcvs/AEIThorns/AHFinderDirect/src/maple/Makefile,v 1.4.2.1 2004-04-06 21:04:22 schnetter Exp $

#
# 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:
#	mm		==> preprocess all *.maple files to produce *.mm files
#	clean		==> delete *.mm (mpp Maple preprocessor output)
#	run		==> load all the code into Maple
#

ifneq ($(MAPLE_VERSION),)
MPP_FLAGS := -D$(MAPLE_VERSION)
endif

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

.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

.PHONY	: run
run	: mm
	maple <setup.mm >maple.log

```

maple/util.maple:
```
# util.maple -- Maple utility functions
# $Header$

#
# msum - multiple-index sum()
# arctan_xy - 2-argument arctan() function
# ssqrt - symbolic sqrt()
#
# indices_in_order - list of indices of table/array, in lexicographic order
# lexorder_integer_list - lexorder() for lists
# sort_var_list - sort a list of variables into a canonical order
# lexorder_vars - lexorder() for "interesting" variables
#
# gensym - generate a "new" symbol name
# gensym/init - reinitialize the gensym() global naming counter
#
# saveit - optionally save variables for debugging
#

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

#
# This function is identical to the standard Maple library function  sum()
# except that it allows multiple summation indices.  It's usage is best
# illustrated by a series of examples:
#
#	msum('f', 'k'=m..n)
#		= sum('f', 'k'=m..n)
#
#	msum('f', 'k1'=m1..n1, 'k2'=m2..n2)
#		= sum( 'sum('f', 'k1'=m1..n1)' , 'k2'=m2..n2 )
#
#	msum('f', 'k1'=m1..n1, 'k2'=m2..n2, 'k3'=m3..n3)
#		= sum(
#			 'sum( 'sum('f', 'k1'=m1..n1)' , 'k2'=m2..n2 )'
#		       ,
#			 'k3'=m3..n3
#		     )
#
# Note, in particular, that the summation indices are nested with the
# innermost summation appearing first.  This is the same nesting convention
# as Fortran I/O statement's implicit do loops use.
#
# Bugs:
# - The quoting in the code is pretty obscure...
#
msum :=
proc(fn::algebraic)			# varargs
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
	# loop invariant:
	# msum(fn, <args processed so far>) = sum(expr, sum_index)
	expr; sum_index; expr:= 'sum'(''%%'', ''%'');
	end do;

return eval(expr);
end proc;

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

#
# This function computes the 4-quadrant arctangent of  arctan(y/x) .
# It's "just" a wrapper around the Maple 2-argument arctan function,
# providing the what-I-find-natural (x,y) argument
#
# Arguments:
# (x,y) = (In) The x,y coordinates.
#
arctan_xy :=
proc(x::algebraic, y::algebraic)
arctan(y,x);		# !!! reversedargument order !!!
end proc;

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

#
# This function computes the square root of its argument with the
# symbolic option ==> fewer branch-cut problems.
#
ssqrt :=
proc(x::algebraic)
sqrt(x, 'symbolic');
end proc;

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

#
# This function is identical to Maple's  indices()  built-in function,
# except that (a) it returns a list, not an expression sequence, and
# (b) the indices are returned in lexicographic order rather than in
# Maple's internal hash ordering.
#
# Arguments:
# T = (in) A table or array with (only) integer-sequence indices.
#
# Results:
# The lexicographic-ordered expression sequence of indices is returned
# as the function result.
#
# Bugs:
# - The function fails if the indices aren't a list of numbers.
#
indices_in_order :=
proc(T::table)
return sort([indices(T)], lexorder_integer_list);
end;

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

#
# This function lexicographically orders lists of integers.
#
# Arguments:
# list1 = list of integers to be sorted
# list2 = list of integers to be sorted
#
# Results:
# The function returns  true  iff  list1 < list2  lexicographically,
# with the [1] list elements being most significant.
#
lexorder_integer_list :=
proc(list1::list(numeric), list2::list(numeric))
local len1, len2, k;

len1 := nops(list1);
len2 := nops(list2);

	for k from 1 to min(len1,len2)
	do
	if   (list1[k] < list2[k])
	   then return true;
	elif (list1[k] > list2[k])
	   then return false;
	fi;
	end do;

# get to here ==> the shorter list is an exact prefix of the longer one
#             ==> order the shorter one < the longer one
return evalb(len1 < len2);
end;

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

#
# This function sorts a list of names (in practice, a list of coordinates)
# into a canonical order.
#
sort_var_list :=
proc(var_list::list(name))
option remember;		# performance optimization
global lexorder_vars;

# only get to here the first time we see a given variable list
# (i.e. if it's not in the remember table)
return sort(var_list, lexorder_vars);
end;

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

#
# This function defines a lexical ordering on variable names.
#
# Arguments:
# x, y = Two names to be compared.
#
# Results:
# This function returns true iff a < b, false otherwise.
#
lexorder_vars :=
proc(x::name, y::name)
option remember;		# performance optimization
local xposn, yposn;
global
  @include "../maple/coords.minc";

if (member(x, xy_all_list, 'xposn') and member(y, xy_all_list, 'yposn'))
   then return evalb(xposn < yposn);
   else return lexorder(x, y);
fi;

end;

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

#
# This procedure generates a (presumably) new symbol name of the
# form
#	cat(base_name,count)
# where  base_name  is passed as an (optional, with a default value
# supplied if it's omitted) argument, and  count  is the current
# value of the global variable
#	`gensym/counter`
# which is postincremented after being used.  If the counter is
# unassigned on entry to this function,  `gensym/init`()  is first
# called to initialize it.
#
# `gensym/init`() may be used to (re)initialize the counter as
# desired, or `gensym/counter` may be examined or altered directly
# to otherwise modify the name sequence generated by this function.
#
# Arguments:
# base_name = (in) (optional) The base name for the name generation.
#			      This argument defaults to `temp_` ifo
#			      omitted.
#
# Bugs:
# No checks are made for whether the names in question are indeed
# unassigned.
#
gensym :=
proc(opt_base_name::string)
global `gensym/counter`;		# in out
local base_name, tn;

if (nargs >= 1)
   then base_name := opt_base_name;
   else base_name := '`temp_`';
end if;

# force an initialization if it hasn't been done before
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;

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

#
# This procedure (re)initializes the gensym() global naming counter.
#
# Arguments:
# initial_counter = (in) (optional)
#			 The naming counter value to (re)initialize with.
#			 This argument defaults to 1 if omitted.
#
`gensym/init` :=
proc(opt_initial_counter::integer)
global `gensym/counter`;		# in out
local initial_counter;

if (nargs >= 1)
   then initial_counter := opt_initial_counter;
   else initial_counter := 1;
end if;

`gensym/counter` := initial_counter;
NULL;
end proc;

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

#
# This function optionally saves a local variable to a global variable
# for later examination.  This is useful for debugging purposes, since
# Maple doesn't have a proper debugger :-( .
#
# Arguments (explicit):
# n = (in) An integer controlling how important this saveit() call is;
#	   the saving will only be done if `saveit/level` >= n, i.e.
#	   smaller values of n make the saving more likely.
# fn = (in) The calling function or subsystem's name.
# label = (in) A string identifying this saveit() call among all those
#	       within the calling function.
# expr = (in) The temporary result to save.
#
# Arguments (implicit, as global variables)
# `saveit/level` = (in) (optional) If this name is assigned (as determined
#				  by the  assigned()  function), this
#				  function does the saving.  Otherwise,
#				  this function is a nop.
#
saveit :=
proc(n::integer, fn::{procedure,string}, label::string, expr::anything)
global `saveit/level`;
local save_name;

if ( assigned(`saveit/level`)
     and type(`saveit/level`, integer)
     and (`saveit/level` >= n) )
   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;

```

maple/gfa.maple:
```
# gfa.maple -- low-level gridfn array "database"
# $Header$
#
# ***** gridfn arrays *****
# ***** functional dependences *****
# make_gfa - construct a new gridfn array
# assert_fnd_exists - assert (verify) that a given gridfn array fnd form exists
# Maple_name - Maple name of functional-dependence form
#
# index/symmetric3_23 - Maple indexing fn for rank 3 array sym on axes 23
#
# print_symmetric3_23 - prettyprint a symmetric3_23 array
#

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

#
# ***** gridfn arrays *****
#

#
# The basic data objects for the Maple code are grid function arrays,
# a.k.a. gridfn arrays, such as the metric g_dd, the Christoffel symbols
# Gamma_udd, etc etc.
#
# By convention, the name of a nonscalar geometric object ends with an 
# underscore ("_") followed by a sequence of "d" or "u" specifying whether
# the indices are down (covariant) or up (contravariant).  Thus, for
# example, g_dd is the covariant metric, while g_uu is the inverse metric.
#
# Scalar geometric objects are represented by Maple scalars, while
# nonscalar objects (often but not necessarily tensors) are represented
# by Maple arrays, using Maple indexing functions for any symmetries
# or sparsity.  For example, the metric  g_dd  is represented by an
# array
#	array(1..N, 1..N, symmetric)
# By convention, for a symmetric array of this type, we only compute
# the upper triangle.
#

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

#
# ***** functional dependences *****
#

#
# Within the Maple code, we distinguish between two distinct forms
# that a gridfn array may take:
# - The "inert" form of a gridfn array represents (only) the symmetries,
#   zero (or nonzero but constant) elements, and indexing semantics of
#   the gridfn array.
# - The "functional dependence" form of a gridfn array additionally
#   represents how that gridfn array is computed from other gridfn
#   arrays.
#
# For example, consider the inverse metric  g_uu .  It's inert form
# is a 3*3 symmetric array, with all elements being unassigned symbols
# (i.e. evaluating to themselves, as is usual in Maple).  It's functional
# dependence form, in contrast, is also a 3*3 symmetric array, but its
# elements are expressions giving the inverse-metric elements in terms
# of components of the metric and/or the metric determinant.
#
# Any given gridfn array may exist in either or (the usual case) both
# an inert form and a functional dependence forms.  There may also be
# multiple functional dependence forms, corresponding to alternative
# formulas for its computation.)
#
# The inert form of a gridfn array is represented by a Maple variable
# or array (see below) of the same name (eg  g_uu ), unassigned except
# for any symmetries and/or zero components the gridfn array has.
#
# The functional dependence form of a gridfn array is represented by
# a Maple array (see below) with a name formed by appending "__fnd"
# to the gridfn array's name (eg  g_uu__fnd ); this array has the same
# symmetries as the corresponding inert Maple array, but only those
# elements needed will be assigned.  If there are multiple functional
# dependence forms, by convention each uses a name beginning in "__"
# and ending in "fnd", eg  H__ps_fnd .
#
# The PDE compiler normally generates C code referring to the (inert)
# gridfn array names, so these should be valid C variable names.
#

#
# To allow some run-time error checking, we keep a global table
# of all the gridfn array functional-dependence forms:
#	`gfa/fnd_table`
#	... table index is  gfa__fnd_name
#	... table value is  true
# assert_fnd_exists() uses this table to verify that a given gridfn
# array functional-dependence form does indeed exist.
#

#
# Functional-dependence forms may be multilevel, as in (eg)
#  g_dd__Kerr_fnd__ps_fnd .  cat() may be used to combine names in
# this manner.
#

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

#
# This function makes the Maple representation of a single gridfn array.
#
# Arguments:
# gfa_name = (out*) The Maple variable to be created for the gridfn
#		    array.  This argument should be passed as an
#		    unevaluated (quoted) name.
# fnd_name_set = (in) A set of functional dependence types the gridfn
#		      array is to have.  The set's members should be
#		      drawn from from {inert, fnd, ...} as appropriate,
#		      where the special value  inert  refers to the
#		      inert form.
# index_bounds = (in) The list of index bounds for the gridfn array,
# index_fn = (in) The name of the array indexing function, if any, or
#		  'none' if the gridfn array has no symmetries and thus
#		  should be represented by a Maple array with the standard
#		  "ordinary array" indexing semantics.
#
# Thus, for example, the calls
#	make_gfa('g', {inert, fnd}, [], none);
#	make_gfa('g_dd', {inert}, [1..N, 1..N], symmetric);
#	make_gfa('R_dd', {inert, fnd}, [1..N, 1..N], symmetric);
#	make_gfa('Gamma_udd', {inert, fnd}, [1..N, 1..N, 1..N], symmetric3_23);
# would set up the Maple representations of the metric determinant,
# the metric, the Ricci tensor, and the Christoffel symbols respectively.
#
make_gfa :=
proc(gfa_name::name,
     fnd_name_set::set(name),
     index_bounds::list(integer..integer),
     index_fn::{identical(none), name})	# note "name" here, not "procedure",
					# since we'll get the name of the
					# indexing fn, which may not have
					# been assigned its procedure yet
global N, `gfa/fnd_table`;
local fnd_name, var_name, index_fn_seq;

# firewall checks
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;

# create the Maple variable(s)
	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 # scalar
		unassign(  eval(var_name,1)  );
	   else # array
		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;

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

#
# This function checks that a given gridfn array functional-dependence
# form exists.  If so, this function is a no-op; if not, this function
# calls ERROR().  Hence after calling this function, the caller can assume
# that the given functional-dependence form does indeed exist.
#
# This function may be called with either 1 or 2 arguments (the two
# types of calls are equivalent).
#
# Arguments (1-argument form):
# gfa_name = The name of the gridfn array itself.  In this case the
#	     fnd name defaults to `fnd`.
#
# Arguments (2-argument form):
# gfa_name = The name of the gridfn array itself, eg `g_dd`.
# fnd_name = The name of the fnd itself, eg `fnd`.
#
assert_fnd_exists :=
proc(gfa_name::name, fnd_name::name)
global `gfa/fnd_table`;
local var_name;

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;

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

#
# This function computes the Maple name corresponding to a given
# gridfn array and functional dependence form.
#
# Arguments:
# gfa_name = The name of the gridfn array itself, eg `g_dd`.
# fnd_name = (optional)
#	     The name of the functional-dependence form, eg `fnd`,
#	     or the special name 'inert'.  If this argument is omitted
#	     it defaults to 'inert'.
#
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;

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

#
# This function is a Maple indexing function for a rank 3 table/array
# which is symmetric in the 2nd and 3rd indices.  This function is
# called automagically by Maple whenever a component of such an array
# is referenced.
#
# The ordering is done using the Maple  sort()  function, which sorts
# numbers numerically, strings lexicographically, and "other things"
# by machine address.
#
# Arguments:
# ilist = (in) The indices to be used.  There must be exactly 3 of these.
# tab = (in out) The table/array to be indexed.  This uses any remaining
#		 indexing methods.
# vlist = (optional)
#	  If present, this is a list of the values to be assigned to
#	  the (lvalue) table entry.
#
`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;

# ... note we need eval() here to get actual integers,
#     rather than variable names whose values are integers
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];		# rvalue
   else tab[index_seq] := op(vlist);	# lvalue
end if;
end proc;

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

#
# This function prettyprints a symmetric3_23 array
#
# Arguments:
# A = (in) The array to be prettyprinted
#
# Results:
# There is no explicit result; the array is prettyprinted as a side effect.
#
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)		# only need upper triangle in (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;

```

maple/gfa.minc:
```
# gfa.minc -- global variables for gridfn array system and other misc stuff
# $Header$

# arguments to make_gfa
inert, none,
fnd,

# indexing functions
symmetric3_23,

# coordinate-transformation coefficient gfas
X_ud, X_ud__fnd,
X_udd, X_udd__fnd
		# no comma

```

maple/README:
```
This directory holds Maple code for manipulating tensor differential
operators and converting them into C/C++ code.  This code doesn't itself
know any physics, but it does have a few bits of knowledge of our
coordinate systems:
coords.*	define all the coordinates
gfa.minc	defines the X_ud and X_udd coordinate-transformation
		coefficients

```

maple/coords.maple:
```
# coords.maple -- set up and covert between coordinates, gridfn arrays, etc
# $Header$

#
# setup_coords - set up coordinates
#

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

#
# This function sets up the coordinates.
#
setup_coords :=
proc()
global
  @include "../maple/coords.minc";

N := 3;					# number of spatial coordinates,
					# i.e. spatial coordinate indices
					#      are 1..N
N_ang := 2;				# number of angular spatial coordinates

# Kronecker delta
delta := array(1..N, 1..N, identity);

# (x,y,z) coordinates
# n.b. individual coordinates are (xx,yy,zz) to avoid confusion with
#      local variables x, y, etc
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 := {xx, yy, zz};

# r coordinate
r__fnd := ssqrt(xx^2 + yy^2 + zz^2);

# (rho,sigma) coordinates
y_rs := array(1..N_ang);
y_rs[1] := rho;
y_rs[2] := sigma;
y_rs_list := [rho, sigma];
y_rs_set := {rho, sigma};

# list of all coordinates (for sorting things into "nice" order)
xy_all_list := [op(x_xyz_list), op(y_rs_list)];
xy_all_set := {op(xy_all_list)};

NULL;
end proc;

```

maple/coeffs.maple:
```
# coeffs.maple - set up coordinate coefficients
# $Header$
#
# setup_coeff_gfas - create the coordinate-transformation coefficient gfas
#

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

#
# This function sets up the coordinate-transformation gfas.
# At present these are only inert -- Maple doesn't worry about
# their fnd expressions (ugly trig functions).
#
setup_coeff_gfas :=
proc()
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc";

# 1st ($X^u_i$) and 2nd ($X^u_{ij}$) partial derivs
# of (r,rho,sigma) wrt (xx,yy,zz)
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;

```

maple/coords.minc:
```
# coords.minc -- global variables for coordinates
# $Header$

# Kronecker delta
delta,

# number of coordinates
N,				# number of spatial coordinates
N_ang,				# number of angular spatial coordinates

# coordinates
xx, yy, zz,			# Cartesian coordinates
x_xyz, x_xyz_list, x_xyz_set,	# ... array/list/set of these
r, r__fnd,			# radial coordinate,
				# ... inert and as fn(xx,yy,zz) coords
rho, sigma,			# generic patch coordinates
y_rs, y_rs_list, y_rs_set,	# array and list of generic patch coordinates
xy_all_list, xy_all_set		# union of Cartesian and generic patch coords
			# no comma

```

maple/codegen2.maple:
```
# codegen2.maple -- generate C code from Maple expressions
# $Header$
#
# codegen2 - generate C code from Maple expressions
#
# cvt_to_eqnlist - convert an expression to an equation list
# fix_Diff - convert Diff() calls to PARTIAL_*() calls
#   fix_Diff/remap_table - remapping table for fix_Diff()
# temps_in_eqnlist - find temporaries used by an equation list
# is_result - is a name equal to a "result" or an array/table component of it?
# deindex_names - remove indices from indexed names
# unindex_names - convert indexed names to scalars
# fix_rationals - convert numbers to RATIONAL() calls
# print_name_list_dcl - print a C declaration for a list of names
#

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

#
# This function is a high-level driver to generate C code for a Maple
# expression.  It does the following:
# - convert the input into a list of equations of the form  name = expression
# - rewrite Diff(...) calls to DIFF_RHO_RHO(...) etc calls
# - generate an "optimized" form of the computation sequence with
#   codegen[optimize, tryhard]
# - determine which temporary variables have been introduced by the
#   codegen[optimize] library
# - "unindex" all array accesses, eg R_dd[2,3] becomes R_dd_23.
# - convert rational numbers to RATIONAL(p,q) calls
# - print C declarations for the temporary variables
# - print C code for the the optimized computation sequence
#
# Note that "codegen" is a Maple package; this function is called "codegen2".
#
# Sample usage:
#	codegen2([R_dd__fnd, R__fnd], ['R_dd', 'R'], "Ricci.c");
#
# Arguments:
# expr = (in) The expression or list of expressions for which code is to
#	      be generated.  This will typically be the name of a gridfn
#	      array functional-dependence form, or a list of such names,
#	      but this isn't required.
# lhs_name = (in) The name or list of names to be used for the results in
#		  the generated C code, eg R_dd.
# output_file_name = (in) The name of the file to which the generated
#			  code is to be written.
#
# Arguments (as global variables)
# `saveit/level`
#	= (in) (optional)
#	       If this global variable is assigned, intermediate results
#	       are saved for debugging purposes.  If it's assigned an
#	       integral value, making this value larger may increase the
#	       level of debugging output.  (10 is a good number for typical
#	       debugging.)
#
codegen2 :=
proc(expr_in::{algebraic, list(algebraic)},
     lhs_name::{name, list(name)},
     output_file_name::string)
global
  @include "../maple/coords.minc",
  @include "../maple/gfa.minc";
local expr, expr_temps, input_set, output_set, expr_cost;

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)];
##expr := [codegen[optimize](expr, tryhard)];
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);

#
# write the C code
#
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;

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

#
# This function converts an expression or list of expressions into an
# equation list.  That is, given an expression  expr , this function
# computes an equation list of the form
#
# if type(expr, algebraic)
#	[ lhs_name = expr ]
#
# if type(expr, array)			# illustrated here for a rank-1 array
#	[
#	lhs_name[1] = expr[1],		# note equations are in lexicographic
#	lhs_name[2] = expr[2],		# order of the indices, and include
#	lhs_name[3] = expr[3],		# only those array elements that are
#	    ...				# explicitly stored (as reported by
#	lhs_name[N] = expr[N]		#  indices() )
#	]
#
# if type(expr, list)
#	then concatenate the equations lists from expr's elements
#
# Arguments:
# expr = (in) The expression to be converted.
# lhs_name = (in) The unevaluated name or list of names to use for the
#		  left hand side(s) in the equation list.
#
# Results:
# The equation list is returned as the function result.
#
cvt_to_eqnlist :=
proc(expr::{algebraic, array, list({algebraic, array})},
     lhs_name::{name, list(name)})

# ... test for array first since otherwise expr itself is a "name",
#     which would match type "algebraic" as well
if (type(expr, array) and type(lhs_name, name))
   then return map(
		      proc(ii)
		      return lhs_name[op(ii)] = expr[op(ii)];
		      end
		    ,
		      indices_in_order(expr)
		  );
fi;

if (type(expr, algebraic) and type(lhs_name, name))
   then return [lhs_name = expr];
fi;

if (type(expr, list({algebraic, array})) and type(lhs_name, list(name)))
   then return zip(op @ cvt_to_eqnlist, expr, lhs_name);
fi;

error "unknown type for expression!\n"
      "   expr=%1\n"
      "   whattype(expr)=%2\n"
      ,
      expr, whattype(expr);
end;

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

#
# This function converts  Diff()  calls into  PARTIAL_*()  calls, eg
# Diff(src, rho, sigma) --> PARTIAL_RHO_SIGMA(src).
#
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`;

# recurse over lists
if (type(expr, list))
   then return map(fix_Diff, expr);
fi;

# recurse over equation right hand sides
if (type(expr, name = algebraic))
   then return lhs(expr) = fix_Diff(rhs(expr));
fi;

nn := nops(expr);

# recurse over sums
if (type(expr, `+`))
   then return sum('fix_Diff(op(k,expr))', 'k'=1..nn);
fi;

# recurse over products
if (type(expr, `*`))
   then return product('fix_Diff(op(k,expr))', 'k'=1..nn);
fi;

# recurse over powers
if (type(expr, `^`))
   then 
	base := op(1, expr);
	power := op(2, expr);

	return fix_Diff(base) ^ power;
	fi;

# recurse over non-Diff functions
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)) );
fi;

# remap derivatives
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;
	fi;
fi;

# otherwise, the identity function
return expr;
end;

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

#
# this table defines the remapping of Diff() calls for  fix_Diff()  (above)
# n.b. Diff() should already have canonicalized the order of variables
#
`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';

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

#
# Given an equation list, this function finds all the temporaries
# assigned by it.  A "temporary" is defined here to be a name on the
# left hand side of an equation, which isn't the result or a component
# of it.
#
# Arguments:
# expr = (in) The equation list to operate on.
# result_name = (in) The result name or list/set of result names.
#
# Results:
# The function returns the list of temporaries assigned.
#
temps_in_eqnlist :=
proc(expr::list(name = algebraic),
     result_name::{name, list(name), set(name)})

# "temporary" = lhs name which isn't a result
return remove(is_result, map(lhs,expr), result_name);
end;

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

#
# This function tests whether or not a name is a "result" name or
# an array/table component of it.  Either a single result name, or a
# list/set of these, may be specified; in the latter case the function
# tests whether or not a name matches *any* of the result names.
#
# Arguments:
# try_name = (in) The name to test.
# result_name = (in) The name or list/set of names of the result to test
#		     against.
#
# Results:
# The function returns  true  if the name is equal to the result or an
# array/table component of it,  false  otherwise.
#
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;
fi;

	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;
	fi;
	end do;

return false;
end;

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

#
# This function removes all indices from indexed names, eg
#	A[1,2,3] --> A .
#
# Arguments:
# expr = (in) The expression to be converted.
#
# Results:
# The converted expression is returned as the function result.
#
deindex_names :=
proc(expr::{name, function, list({name,function}), set({name,function})})
local fn, fn_args_list;

# recurse over lists and sets
if (type(expr, {list, set}))
   then return map(deindex_names, expr);
fi;

# recurse over function calls
if (type(expr, function))
   then
	fn := op(0, expr);
	fn_args_list := [op(expr)];
	fn; return '%'(op(map(deindex_names, fn_args_list)));
fi;

# convert indexed names
if (type(expr, indexed))
   then return op(0, expr);
fi;

# return non-indexed names and numbers unchanged
if (type(expr, {name, numeric}))
   then return expr;
fi;

# unknown type
error "expr has unknown type!\n"
      "whattype(expr)=%1\n"
      ,
      whattype(expr);
end;

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

#
# This function converts all occurence of indexed names in an expression
# to new non-indexed "scalar names" of the form
#	A[1,2,3] --> A_123 .
#
# Arguments:
# expr = (in) The expression to be converted.
#
# Results:
# The converted expression is returned as the function result.
#
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;

# recurse over lists and sets
if (type(expr, {list, set}))
   then return map(unindex_names, expr);
fi;

# recurse over equations (both lhs and rhs)
if (type(expr, `=`))
   then return unindex_names(lhs(expr))  =  unindex_names(rhs(expr));
fi;

nn := nops(expr);

# recurse over sums
if (type(expr, `+`))
   then return sum('unindex_names(op(k,expr))', 'k'=1..nn);
fi;

# recurse over products
if (type(expr, `*`))
   then return product('unindex_names(op(k,expr))', 'k'=1..nn);
fi;

# recurse over powers
if (type(expr, `^`))
   then
	base := op(1, expr);
	power := op(2, expr);
	return unindex_names(base) ^ power;
fi;

# recurse over function calls
if (type(expr, function))
   then
	fn := op(0, expr);
	fn_args_list := [op(expr)];
	fn; return '%'(op(map(unindex_names, fn_args_list)));
fi;

# convert indexed names
if (type(expr, indexed))
   then
	base_name := op(0, expr);
	index_seq := op(expr);
	return cat(base_name,"_",index_seq);
fi;

# return numbers and non-indexed names
if (type(expr, {numeric, name}))
   then return expr;
fi;

# unknown type
error "expr has unknown type!\n"
      "whattype(expr)=%1\n"
      ,
      whattype(expr);
end;

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

#
# This function converts all integer or rational subexpressions of its
# input except integer exponents and integer factors in products, into
# function calls  RATIONAL(num,den)  with  num  and  den  integers.
#
# This is useful in conjunction with the  C() library function, since
#
#	C( (1/3) * foo * bar )
#		t0 = foo*bar/3;
#
# generates a (slow) division (and runs the risk of mixed-mode-arithmetic
# problems).  In contrast, with this function
#
#	fix_rationals((1/3) * foo * bar);
#	     RATIONAL(1,3) foo bar
#	codegen[C](%);
#	     t0 = RATIONAL(1.0,3.0)*foo*bar;
#
# which a C preprocessor macro can easily convert to the desired
#
#	     t0 = (1.0/3.0)*foo*bar;
#
# Arguments:
# expr = (in) The expression to be converted.
#
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;

# recurse over lists
if (type(expr, list))
   then return map(fix_rationals, expr);
fi;

# recurse over equation right hand sides
if (type(expr, name = algebraic))
   then return lhs(expr) = fix_rationals(rhs(expr));
fi;

# recurse over functions other than  RATIONAL()
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)));
	fi;
fi;

nn := nops(expr);

# recurse over sums
if (type(expr, `+`))
   then return sum('fix_rationals(op(k,expr))', 'k'=1..nn);
fi;

# recurse over products
# ... leaving integer factors intact
if (type(expr, `*`))
   then
	# compute lists of all integer/non-integer factors
	int_factors,nonint_factors := selectremove(type, expr, integer);

	if (nops(int_factors) > 0)
	   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);
	fi;
fi;

# recurse over powers
# ... leaving integer exponents intact
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);
	fi;
	return fbase ^ fpower;;
fi;

# fix integers and fractions
if (type(expr, integer))
   then return 'RATIONAL'(expr, 1);
fi;
if (type(expr, fraction))
   then
	num := op(1, expr);
	den := op(2, expr);
	return 'RATIONAL'(num, den);
fi;

# turn Maple floating-point into integer fraction, then recursively fix that
if (type(expr, float))
   then
	mult := op(1, expr);
	power := op(2, expr);
	return fix_rationals(mult * 10^power);
fi;

# identity op on names
if (type(expr, name))
   then return expr;
fi;

# unknown type
error "expr has unknown type!\n"
      "whattype(expr)=%1\n"
      "expr=%2\n"
      ,
      whattype(expr), expr;
end;

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

#
# This function prints C declarations for a list of names.
#
# Argument:
# name_list = A list of the names.
# name_type = The C type of the names, eg. "double".
# file_name = The file name to write (append) the declaration to.
#
print_name_list_dcl :=
proc( name_list::list({name,string}),
      name_type::string,
      file_name::string )
local nn;

nn := nops(name_list);

# print up to 10 declarations on one line
if (nn <= 10)
   then
	map(convert, name_list, string);
	ListTools[Join](%, ", ");
	cat(op(%));
	fprintf(file_name,
		"%s %s;\n",
		name_type, %);
	NULL;
	return;
fi;

# recurse for larger numbers of declarations
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;

```

maple/Diff.maple:
```
# Diff.maple -- Diff() and friends
# $Header$

#
# simplify/Diff - simplify(...) function for expressions containing Diff()
# Diff - "inert" derivative function (low-level simplifications)
# Diff/gridfn - simplifications that know about gridfns
#

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

#
# This function is called automatically by  simplify()  whenever
#  simplify()'s  argument contains a  Diff()  call.  This interface
# to  simplify()  is described in
#	Michael B. Monagan
#	"Tips for Maple Users"
#	The Maple Technical Newsletter
#	Issue 10 (Fall 1993), p.10-18, especially p.17-18
# but not in the Maple library manual or the online help, which both
# imply that  simplify(..., Diff)  is needed for this procedure to be
# invoked).
#
# This function recurses over the expression structure.  For each
#  Diff() call, it calls  Diff()  itself to do "basic" derivative
# simplifications, then calls `Diff/gridfn`() to do further simplifications
# based on gridfn properties.
#
# expr = (in) An expression to be simplified.
#
# Results:
# The function returns the "simplified" expression.
#
`simplify/Diff` :=
proc(expr)
option remember;		# performance optimization
local temp;

# recurse on tables, equations, lists, sets, sums, products, powers
if type(expr, {table, `=`, list, set, `+`, `*`, `^`})
   then return map(simplify, expr);
end if;

# return unchanged on numbers, names, procedures
if type(expr, {numeric, name, procedure})
   then return expr;
end if;

# function call ==> simplify  Diff()  calls, recurse on others
if type(expr, function)
   then
	if (op(0, expr) = 'Diff')
	   then return Diff(op(expr));	# "basic" derivative simplifications
	   else
		temp := map(simplify, [op(expr)]);
		op(0,expr); return '%'(op(temp));
	end if;
end if;

# unknown type
ERROR(`expr has unknown type`, `whattype(expr)=`, whattype(expr));

end proc;

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

#
# This function implements some of the more useful simplification
# rules of algebra and calculus for Maple's "inert" differentiation
# function  Diff() .  It then calls  `Diff/gridfn`()  to do any
# further simplifications based on gridfn properties.
#
# In particular:
# - It distributes over sums.
# - It distributes over leading numeric factors.  (Maple's built-in
#   simplifier will always make numeric factors leading.)
# - It knows that derivatives of numeric constants are zero.
# - It knows that the derivative of a name with respect to itself is one.
# - It knows the product rule
#	Diff(f*g,x) = Diff(f,x)*g + f*Diff(g,x)
# - It knows the power rule
#	Diff(f^n,x) = n * f^(n-1) * Diff(f,x)
# - It flattens multi-level "Diff() trees", i.e. it makes the transformation
#	Diff(Diff(f,x),y) = Diff(f,x,y);
# - It canonicalizes the order of the things we're differentiating with
#   respect to, so that  simplify()  will recognize that derivatives
#   commute, i.e. that
#	Diff(f,x,y) = Diff(f,y,x)
#
# Arguments:
# operand = (in) The thing to be differentiated.
# var_seq = (in) (varargs) An expression sequence of the variables to
#			   differentiate with respect to.
#
unprotect('Diff');
Diff :=
proc(operand)			# varargs
option remember;		# performance optimization
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;

var_list := [args[2..nargs]];

nn := nops(operand);
nderiv := nops(var_list);

##print(`Diff():  nn=`,nn,`  nderiv=`,nderiv,
##      `  operand=`,operand,`  var_list=`,var_list);

# distribute (recurse) over sums
if (type(operand, `+`))
   then return simplify(
		  sum('Diff(op(k, operand), op(var_list))', 'k'=1..nn)
		       );
end if;

# distribute (recurse) over leading numeric factors
if (type(operand, `*`) and (nn >= 1) 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;

# derivatives of numbers are zero
if (type(operand, numeric))
   then return 0;
end if;

# derivative of a name with respect to itself is one
if (type(operand, name) and (var_list = [operand]))
   then return 1;
end if;

# implement the product rule
# ... we actually implement it only for a 1st derivative of the
#     product of two factors; for fancier cases we recurse
if (type(operand, `*`))
   then
	if (nn = 0)
	   then # empty product = 1
		return 0;		# ==> Diff(1) = 0

	elif (nn = 1)
	   then # singleton product is equal to the single factor
		return simplify(  Diff(op(1,operand), op(var_list))  );

	elif (nn >= 2)
	   then # nontrivial product rule case

		# note that if we have more than 2 factors, g will
		# be the product of the cdr of the factor list, so
		# our later  Diff(g,...)  calls will recurse as
		# necessary to handle this case

		f := op(1,operand);
		g := product('op(k,operand)', 'k'=2..nn);

		if (nderiv = 1)
		   then # product rule for 1st derivatives:
			#   Diff(f*g,x) = Diff(f,x)*g + f*Diff(g,x)
			x := var_list[1];

			return simplify(  Diff(f,x)*g  +  f*Diff(g,x)  );

		   else # product rule for 2nd (and higher) derivatives
			# ==> recurse on derivatives
			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;

# implement the power rule
# ... we actually implement it only for 1st derivatives; for higher
#     derivatives we recurse
if (type(operand, `^`))
   then
	f := op(1,operand);
	n := op(2,operand);

	if (nderiv = 1)
	   then # power rule for 1st derivatives:
		#   Diff(f^n,x) = n * f^(n-1) * Diff(f,x)
		x := var_list[1];

		return simplify(  n * f^(n-1) * Diff(f, x)  );

	   else # power rule for 2nd (and higher) derivatives:
		# ==> recurse on derivatives
		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;

# flatten (recurse on) multi-level "Diff() trees"
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;

# canonicalize ordering of derivatives
sorted_var_list := sort_var_list(var_list);

# simplifications based on gridfn properties known here...
temp := `Diff/gridfn`(operand, op(sorted_var_list));

# more simplifications based on gridfn properties known in other directories
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);
fi;

return temp;
end proc;

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

#
# This function implements further simplification rules for  Diff()
# based on gridfn properties (or at least those known here).
#
# It currently knows about the following simplifications:
# - Diff(X_ud[u,i], x_xyz[j]) --> X_udd[u,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/gridfn` :=
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) = '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;

# unevaluated return to avoid infinite recursion
return 'Diff'(operand, op(var_list));
end proc;

```

patch/patch_info.cc:
```
// patch_info.cc -- POD struct of minimal info varying from one patch to another
// $Header$

//
// patch_info::grid_array_pars
// patch_info::grid_pars
/// patch_info::verify_grid_spacing_ok
//

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

#include "cctk.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 "coords.hh"
#include "grid.hh"
#include "patch_info.hh"

// all the code in this file is inside this namespace
namespace AHFinderDirect
	  {

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

//
// This function computes, and returns a reference to, a
//  struct grid_arrays::grid_array_pars  from the info in a
//  struct patch_info  and the additional information in the arguments.
//
// The result refers to an internal static buffer in this function; the
// usual caveats about lifetimes/overwriting apply.
//
// Arguments:
// ghost_zone_width = Width in grid points of all ghost zones.
// patch_extend_width = Number of grid points to extend each patch past
//		     "just touching" so as to overlap neighboring patches.
//		     Thus patches overlap by
//			patch_overlap_width = 2*patch_extend_width + 1
//		     grid points.  For example, with patch_extend_width == 2,
//		     here are the grid points of two neighboring patches:
//			x   x   x   x   x   X   X
//                                      |
//			        O   O   o   o   o   o   o
//		     Here | marks the "just touching" boundary,
//		     x and o the grid points before this extension,
//		     and X and O the extra grid points added by this
//		     extension.
// N_zones_per_right_angle = This sets the grid spacing (same in both
//			     directions) to 90.0 / N_zones_per_right_angle.
//			     It's a fatal error (error_exit()) if this
//			     doesn't evenly divide the grid sizes in both
//			     directions.
//
const grid_arrays::grid_array_pars&
  patch_info::grid_array_pars(int ghost_zone_width, int patch_extend_width,
			      int N_zones_per_right_angle)
	const
{
static
  struct grid_arrays::grid_array_pars grid_array_pars_buffer;

//
// the values of min_(irho,isigma) are actually arbitrary, but for
// debugging convenience it's handy to have (irho,isigma) ranges map
// one-to-one with (rho,sigma) ranges across all patches; the assignments
// here have this property
//
const fp delta_drho_dsigma = 90.0 / fp(N_zones_per_right_angle);
grid_array_pars_buffer.min_irho
	= jtutil::round<fp>::to_integer(min_drho  /delta_drho_dsigma);
grid_array_pars_buffer.min_isigma
	= jtutil::round<fp>::to_integer(min_dsigma/delta_drho_dsigma);

verify_grid_spacing_ok(N_zones_per_right_angle);
const int N_irho_zones
	= jtutil::round<fp>::to_integer(
		   fp(N_zones_per_right_angle) * (max_drho  -min_drho  ) / 90.0
				       );
const int N_isigma_zones
	= jtutil::round<fp>::to_integer(
		   fp(N_zones_per_right_angle) * (max_dsigma-min_dsigma) / 90.0
				       );

grid_array_pars_buffer.max_irho
	= grid_array_pars_buffer.min_irho   + N_irho_zones;
grid_array_pars_buffer.max_isigma
	= grid_array_pars_buffer.min_isigma + N_isigma_zones;

grid_array_pars_buffer.min_irho   -= patch_extend_width;
grid_array_pars_buffer.min_isigma -= patch_extend_width;
grid_array_pars_buffer.max_irho   += patch_extend_width;
grid_array_pars_buffer.max_isigma += patch_extend_width;

grid_array_pars_buffer.min_rho_ghost_zone_width = ghost_zone_width;
grid_array_pars_buffer.max_rho_ghost_zone_width = ghost_zone_width;
grid_array_pars_buffer.min_sigma_ghost_zone_width = ghost_zone_width;
grid_array_pars_buffer.max_sigma_ghost_zone_width = ghost_zone_width;

return grid_array_pars_buffer;
}

//******************************************************************************
//
//
// This function computes, and returns a reference to, a
//  struct grid_arrays::grid_pars  from the info in a  struct patch_info
// and the additional information in the arguments.
//
// The result refers to an internal static buffer in this function; the
// usual caveats about lifetimes/overwriting apply.
//
// Arguments:
// patch_extend_width = Number of grid points to extend each patch past
//		     "just touching" so as to overlap neighboring patches.
//		     Thus patches overlap by  2*patch_extend_width + 1  grid
//		     points.  For example, with patch_extend_width == 2, here
//		     are the grid points of two neighboring patches:
//			x   x   x   x   x   X   X
//                                      |
//			        O   O   o   o   o   o   o
//		     Here | marks the "just touching" boundary,
//		     x and o the grid points before this extension,
//		     and X and O the extra grid points added by this
//		     extension.
// N_zones_per_right_angle = This sets the grid spacing (same in both
//			     directions) to 90.0 / N_zones_per_right_angle.
//			     It's a fatal error (error_exit()) if this
//			     doesn't evenly divide the grid sizes in both
//			     directions.
//
const grid::grid_pars& patch_info::grid_pars(int patch_extend_width,
					     int N_zones_per_right_angle)
	const
{
static
  struct grid::grid_pars grid_pars_buffer;

verify_grid_spacing_ok(N_zones_per_right_angle);
const fp delta_drho_dsigma = 90.0 / fp(N_zones_per_right_angle);
const fp extend_drho_dsigma = fp(patch_extend_width) * delta_drho_dsigma;

grid_pars_buffer.  min_drho   = min_drho   - extend_drho_dsigma;
grid_pars_buffer.delta_drho   = delta_drho_dsigma;
grid_pars_buffer.  max_drho   = max_drho   + extend_drho_dsigma;
grid_pars_buffer.  min_dsigma = min_dsigma - extend_drho_dsigma;
grid_pars_buffer.delta_dsigma = delta_drho_dsigma;
grid_pars_buffer.  max_dsigma = max_dsigma + extend_drho_dsigma;

return grid_pars_buffer;
}

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

//
// This function verifies that the grid spacing evenly divides the
// grid sizes in both directions, and does an  error_exit()  if not.
//
// Arguments:
// N_zones_per_right_angle = This sets the grid spacing (same in both
//			     directions) to 90.0 / N_zones_per_right_angle.
//
void patch_info::verify_grid_spacing_ok(int N_zones_per_right_angle)
	const
{
const fp N_irho_zones_fp
	= fp(N_zones_per_right_angle) * (max_drho  -min_drho  ) / 90.0;
const fp N_isigma_zones_fp
	= fp(N_zones_per_right_angle) * (max_dsigma-min_dsigma) / 90.0;

if (! (    jtutil::fuzzy<fp>::is_integer(N_irho_zones_fp)
	&& jtutil::fuzzy<fp>::is_integer(N_isigma_zones_fp)    ) )
   then error_exit(ERROR_EXIT,
"***** patch_info::verify_grid_spacing_ok():\n"
"        N_zones_per_right_angle=%d gives grid spacing which\n"
"        doesn't evenly divide grid sizes!\n"
"        [min,max]_drho=[%g,%g] [min,max]_dsigma=[%g,%g]\n"
"        ==> N_irho_zones_fp=%g N_isigma_zones_fp=%g\n"
		   ,
		   N_zones_per_right_angle,
		   double(min_drho), double(max_drho),
		   double(min_dsigma), double(max_dsigma),
		   double(N_irho_zones_fp), double(N_isigma_zones_fp));
								/*NOTREACHED*/
}

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

	  }	// namespace AHFinderDirect

```

patch/test_patch_system.maple:
```
# test_patch_system.maple -- test function for  test_fd_grid
# $Header$

# test function
fn := exp(sin(1.38*rho)) * tanh(0.17+0.83*sin(sigma)^2);

# 1st derivatives
diff(fn, rho);			codegen[C](%);
diff(fn, sigma);		codegen[C](%);

# 2nd derivatives
diff(fn, rho,rho);		codegen[C](%);
diff(fn, rho,sigma);		codegen[C](%);
diff(fn, sigma,sigma);		codegen[C](%);

```


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: // 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