Task: Implement sparse-matrix/y12m/y12m/y12mcf.f for EinsteinAnalysis/AHFinderDirect thorn

thorn_name: EinsteinAnalysis/AHFinderDirect
src_filename: sparse-matrix/y12m/y12m/y12mcf.f
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: sparse-matrix/umfpack/umfpack_free_symbolic.h:
```
/* ========================================================================== */
/* === umfpack_free_symbolic ================================================ */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

void umfpack_di_free_symbolic
(
    void **Symbolic
) ;

void umfpack_dl_free_symbolic
(
    void **Symbolic
) ;

void umfpack_zi_free_symbolic
(
    void **Symbolic
) ;

void umfpack_zl_free_symbolic
(
    void **Symbolic
) ;

/*
double int Syntax:

    #include "umfpack.h"
    void *Symbolic ;
    umfpack_di_free_symbolic (&Symbolic) ;

double long Syntax:

    #include "umfpack.h"
    void *Symbolic ;
    umfpack_dl_free_symbolic (&Symbolic) ;

complex int Syntax:

    #include "umfpack.h"
    void *Symbolic ;
    umfpack_zi_free_symbolic (&Symbolic) ;

complex long Syntax:

    #include "umfpack.h"
    void *Symbolic ;
    umfpack_zl_free_symbolic (&Symbolic) ;

Purpose:

    Deallocates the Symbolic object and sets the Symbolic handle to NULL.
    This routine is the only valid way of destroying the Symbolic object;
    any other action (such as using "free (Symbolic) ;" or not freeing Symbolic
    at all) will lead to memory leaks.

Arguments:

    void **Symbolic ;		Input argument, deallocated and Symbolic is
				set to (void *) NULL on output.

	Symbolic must point to a valid Symbolic object, computed by
	umfpack_*_symbolic.  No action is taken if Symbolic is a (void *) NULL
	pointer.
*/

```

sparse-matrix/umfpack/umf_mem_alloc_element.c:
```
/* ========================================================================== */
/* === UMF_mem_alloc_element ================================================ */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/* The UMF_mem_* routines manage the Numeric->Memory memory space. */

/* Allocate a nrows-by-ncols element, and initialize it. */
/* Returns the index into Numeric->Memory if successful, or 0 on failure. */

#include "umf_internal.h"
#include "umf_mem_alloc_tail_block.h"

GLOBAL Int UMF_mem_alloc_element
(
    NumericType *Numeric,
    Int nrows,
    Int ncols,
    Int **Rows,
    Int **Cols,
    Entry **C,
    Int *size,
    Element **epout
)
{

    Element *ep ;
    Unit *p ;
    Int i ;

    ASSERT (Numeric) ;
    ASSERT (Numeric->Memory) ;

#ifndef NDEBUG
    UMF_allocfail = FALSE ;
    if (UMF_gprob > 0)
    {
	double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
	DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
	UMF_allocfail = rrr < UMF_gprob ;   /* a double relop, but ignore NaN case */
	if (UMF_allocfail)
	{
	    DEBUG0 (("Random garbage collection (alloc_element)\n"));
	}
    }
#endif

    *size = GET_ELEMENT_SIZE (nrows, ncols) ;
    if (INT_OVERFLOW (DGET_ELEMENT_SIZE (nrows, ncols) + 1))
    {
	DEBUG0 (("alloc element failed - problem too large\n")) ;
	return (0) ;	/* problem is too large */
    }

    i = UMF_mem_alloc_tail_block (Numeric, *size) ;
    (*size)++ ;
    if (!i)
    {
	DEBUG0 (("alloc element failed - out of memory\n")) ;
	return (0) ;	/* out of memory */
    }
    p = Numeric->Memory + i ;

    ep = (Element *) p ;

    DEBUG2 (("alloc_element done ("ID" x "ID"): p: "ID" i "ID"\n",
	nrows, ncols, p-Numeric->Memory, i)) ;

    /* Element data structure, in order: */
    p += UNITS (Element, 1) ;		/* (1) Element header */
    *Cols = (Int *) p ;			/* (2) col [0..ncols-1] indices */
    *Rows = *Cols + ncols ;		/* (3) row [0..nrows-1] indices */
    p += UNITS (Int, ncols + nrows) ;
    *C = (Entry *) p ;			/* (4) C [0..nrows-1, 0..ncols-1] */

    ep->nrows = nrows ;		/* initialize the header information */
    ep->ncols = ncols ;
    ep->nrowsleft = nrows ;
    ep->ncolsleft = ncols ;
    ep->cdeg = 0 ;
    ep->rdeg = 0 ;
    ep->next = EMPTY ;

    DEBUG2 (("new block size: "ID" ", GET_BLOCK_SIZE (Numeric->Memory + i))) ;
    DEBUG2 (("Element size needed "ID"\n", GET_ELEMENT_SIZE (nrows, ncols))) ;

    *epout = ep ;

    /* return the offset into Numeric->Memory */
    return (i) ;
}


```

sparse-matrix/umfpack/umf_mem_alloc_tail_block.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL Int UMF_mem_alloc_tail_block
(
    NumericType *Numeric,
    Int nunits
) ;


```

sparse-matrix/umfpack/umf_mem_free_tail_block.c:
```
/* ========================================================================== */
/* === UMF_mem_free_tail_block ============================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/* The UMF_mem_* routines manage the Numeric->Memory memory space. */

/* free a block from the tail of Numeric->memory */

#include "umf_internal.h"

GLOBAL void UMF_mem_free_tail_block
(
    NumericType *Numeric,
    Int i
)
{
    Unit *pprev, *pnext, *p, *pbig ;
    Int sprev ;

    ASSERT (Numeric) ;
    ASSERT (Numeric->Memory) ;
    if (i == EMPTY || i == 0) return ;	/* already deallocated */

    /* ---------------------------------------------------------------------- */
    /* get the block */
    /* ---------------------------------------------------------------------- */

    p = Numeric->Memory + i ;

    p-- ;	/* get the corresponding header */
    DEBUG2 (("free block: p: "ID, p-Numeric->Memory)) ;
    ASSERT (p >= Numeric->Memory + Numeric->itail) ;
    ASSERT (p < Numeric->Memory + Numeric->size) ;
    ASSERT (p->header.size > 0) ;		/* block not already free */
    ASSERT (p->header.prevsize >= 0) ;

    Numeric->tail_usage -= p->header.size + 1 ;

    /* ---------------------------------------------------------------------- */
    /* merge with next free block, if any */
    /* ---------------------------------------------------------------------- */

    pnext = p + 1 + p->header.size ;
    DEBUG2 (("size: "ID" next: "ID" ", p->header.size, pnext-Numeric->Memory)) ;
    ASSERT (pnext < Numeric->Memory + Numeric->size) ;
    ASSERT (pnext->header.prevsize == p->header.size) ;
    ASSERT (pnext->header.size != 0) ;

    if (pnext->header.size < 0)
    {
	/* next block is also free - merge with current block */
	p->header.size += (-pnext->header.size) + 1 ;
	DEBUG2 ((" NEXT FREE ")) ;
    }

    /* ---------------------------------------------------------------------- */
    /* merge with previous free block, if any */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    if (p == Numeric->Memory + Numeric->itail)
    {
	DEBUG2 ((" at top of tail ")) ;
	ASSERT (p->header.prevsize == 0) ;
    }
#endif

    if (p > Numeric->Memory + Numeric->itail)
    {
	ASSERT (p->header.prevsize > 0) ;
	pprev = p - 1 - p->header.prevsize ;
	DEBUG2 ((" prev: "ID" ", pprev-Numeric->Memory)) ;
	ASSERT (pprev >= Numeric->Memory + Numeric->itail) ;
	sprev = pprev->header.size ;
	if (sprev < 0)
	{
	    /* previous block is also free - merge it with current block */
	    ASSERT (p->header.prevsize == -sprev) ;
	    pprev->header.size = p->header.size + (-sprev) + 1 ;
	    p = pprev ;
	    DEBUG2 ((" PREV FREE ")) ;
	    /* note that p may now point to Numeric->itail */
	}
#ifndef NDEBUG
	else
	{
	    ASSERT (p->header.prevsize == sprev) ;
	}
#endif
    }

    /* ---------------------------------------------------------------------- */
    /* free the block, p */
    /* ---------------------------------------------------------------------- */

    pnext = p + 1 + p->header.size ;
    ASSERT (pnext < Numeric->Memory + Numeric->size) ;

    if (p == Numeric->Memory + Numeric->itail)
    {
	/* top block in list is freed */
	Numeric->itail = pnext - Numeric->Memory ;
	pnext->header.prevsize = 0 ;
	DEBUG2 ((" NEW TAIL : "ID" ", Numeric->itail)) ;
	ASSERT (pnext->header.size > 0) ;
	if (Numeric->ibig != EMPTY && Numeric->ibig <= Numeric->itail)
	{
	    /* the big free block is now above the tail */
	    Numeric->ibig = EMPTY ;
	}
    }
    else
    {
	/* keep track of the biggest free block seen */
	if (Numeric->ibig == EMPTY)
	{
	    Numeric->ibig = p - Numeric->Memory ;
	}
	else
	{
	    pbig = Numeric->Memory + Numeric->ibig ;
	    if (-(pbig->header.size) < p->header.size)
	    {
		Numeric->ibig = p - Numeric->Memory ;
	    }
	}
	/* flag the block as free, somewhere in the middle of the tail */
	pnext->header.prevsize = p->header.size ;
	p->header.size = -p->header.size ;
    }

    DEBUG2 (("new p: "ID" freesize: "ID"\n", p-Numeric->Memory,
	-p->header.size)) ;

#ifndef NDEBUG
    UMF_debug -= 10 ;
    UMF_dump_memory (Numeric) ;
    UMF_debug += 10 ;
#endif

}


```

sparse-matrix/umfpack/umf_triplet.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL Int UMF_triplet_map_x
(
    Int n_row,
    Int n_col,
    Int nz,
    const Int Ti [ ],
    const Int Tj [ ],
    Int Ap [ ],
    Int Ai [ ],
    Int Rp [ ],
    Int Rj [ ],
    Int W [ ],
    Int RowCount [ ]
    , const double Tx [ ]
    , double Ax [ ]
    , double Rx [ ]
#ifdef COMPLEX
    , const double Tz [ ]
    , double Az [ ]
    , double Rz [ ]
#endif
    , Int Map [ ]
    , Int Map2 [ ]
) ;

GLOBAL Int UMF_triplet_map_nox
(
    Int n_row,
    Int n_col,
    Int nz,
    const Int Ti [ ],
    const Int Tj [ ],
    Int Ap [ ],
    Int Ai [ ],
    Int Rp [ ],
    Int Rj [ ],
    Int W [ ],
    Int RowCount [ ]
    , Int Map [ ]
    , Int Map2 [ ]
) ;

GLOBAL Int UMF_triplet_nomap_x
(
    Int n_row,
    Int n_col,
    Int nz,
    const Int Ti [ ],
    const Int Tj [ ],
    Int Ap [ ],
    Int Ai [ ],
    Int Rp [ ],
    Int Rj [ ],
    Int W [ ],
    Int RowCount [ ]
    , const double Tx [ ]
    , double Ax [ ]
    , double Rx [ ]
#ifdef COMPLEX
    , const double Tz [ ]
    , double Az [ ]
    , double Rz [ ]
#endif
) ;

GLOBAL Int UMF_triplet_nomap_nox
(
    Int n_row,
    Int n_col,
    Int nz,
    const Int Ti [ ],
    const Int Tj [ ],
    Int Ap [ ],
    Int Ai [ ],
    Int Rp [ ],
    Int Rj [ ],
    Int W [ ],
    Int RowCount [ ]
) ;


```

sparse-matrix/umfpack/umfpack_report_vector.h:
```
/* ========================================================================== */
/* === umfpack_report_vector ================================================ */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

int umfpack_di_report_vector
(
    int n,
    const double X [ ],
    const double Control [UMFPACK_CONTROL]
) ;

long umfpack_dl_report_vector
(
    long n,
    const double X [ ],
    const double Control [UMFPACK_CONTROL]
) ;

int umfpack_zi_report_vector
(
    int n,
    const double Xx [ ], const double Xz [ ],
    const double Control [UMFPACK_CONTROL]
) ;

long umfpack_zl_report_vector
(
    long n,
    const double Xx [ ], const double Xz [ ],
    const double Control [UMFPACK_CONTROL]
) ;

/*
double int Syntax:

    #include "umfpack.h"
    int n, status ;
    double *X, Control [UMFPACK_CONTROL] ;
    status = umfpack_di_report_vector (n, X, Control) ;

double long Syntax:

    #include "umfpack.h"
    long n, status ;
    double *X, Control [UMFPACK_CONTROL] ;
    status = umfpack_dl_report_vector (n, X, Control) ;

complex int Syntax:

    #include "umfpack.h"
    int n, status ;
    double *Xx, *Xz, Control [UMFPACK_CONTROL] ;
    status = umfpack_zi_report_vector (n, Xx, Xz, Control) ;

complex long Syntax:

    #include "umfpack.h"
    long n, status ;
    double *Xx, *Xz, Control [UMFPACK_CONTROL] ;
    status = umfpack_zl_report_vector (n, Xx, Xz, Control) ;

Purpose:

    Verifies and prints a dense vector.

Returns:

    UMFPACK_OK if Control [UMFPACK_PRL] <= 2 (the input is not checked).

    Otherwise:
    
    UMFPACK_OK if the vector is valid.
    UMFPACK_ERROR_argument_missing if X or Xx is missing.
    UMFPACK_ERROR_n_nonpositive if n <= 0.

Arguments:

    Int n ;		Input argument, not modified.

	X is a real or complex vector of size n.  Restriction: n > 0.

    double X [n] ;	Input argument, not modified.  For real versions.

	A real vector of size n.  X must not be (double *) NULL.

    double Xx [n or 2*n] ; Input argument, not modified.  For complex versions.
    double Xz [n or 0] ;   Input argument, not modified.  For complex versions.

	A complex vector of size n, in one of two storage formats.
	Xx must not be (double *) NULL.

	If Xz is not (double *) NULL, then Xx [i] is the real part of X (i) and
	Xz [i] is the imaginary part of X (i).  Both vectors are of length n.
	This is the "split" form of the complex vector X.

	If Xz is (double *) NULL, then Xx holds both real and imaginary parts,
	where Xx [2*i] is the real part of X (i) and Xx [2*i+1] is the imaginary
	part of X (i).  Xx is of length 2*n doubles.  If you have an ANSI C99
	compiler with the intrinsic double _Complex type, then Xx can be of
	type double _Complex in the calling routine and typecast to (double *)
	when passed to umfpack_*_report_vector (this is untested, however).
	This is the "merged" form of the complex vector X.

	Future work:  all complex routines in UMFPACK could use this same
	strategy for their complex arguments.  The split format is useful for
	MATLAB, which holds its real and imaginary parts in seperate arrays.
	The merged format is compatible with the intrinsic double _Complex
	type in ANSI C99, and is also compatible with SuperLU's method of
	storing complex matrices.  In the current version, only 
	umfpack_*_report_vector supports both formats.

    double Control [UMFPACK_CONTROL] ;	Input argument, not modified.

	If a (double *) NULL pointer is passed, then the default control
	settings are used.  Otherwise, the settings are determined from the
	Control array.  See umfpack_*_defaults on how to fill the Control
	array with the default settings.  If Control contains NaN's, the
	defaults are used.  The following Control parameters are used:

	Control [UMFPACK_PRL]:  printing level.

	    2 or less: no output.  returns silently without checking anything.
	    3: fully check input, and print a short summary of its status
	    4: as 3, but print first few entries of the input
	    5: as 3, but print all of the input
	    Default: 1
*/

```

sparse-matrix/umfpack/umfpack_report_triplet.h:
```
/* ========================================================================== */
/* === umfpack_report_triplet =============================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

int umfpack_di_report_triplet
(
    int n_row,
    int n_col,
    int nz,
    const int Ti [ ],
    const int Tj [ ],
    const double Tx [ ],
    const double Control [UMFPACK_CONTROL]
) ;

long umfpack_dl_report_triplet
(
    long n_row,
    long n_col,
    long nz,
    const long Ti [ ],
    const long Tj [ ],
    const double Tx [ ],
    const double Control [UMFPACK_CONTROL]
) ;

int umfpack_zi_report_triplet
(
    int n_row,
    int n_col,
    int nz,
    const int Ti [ ],
    const int Tj [ ],
    const double Tx [ ], const double Tz [ ],
    const double Control [UMFPACK_CONTROL]
) ;

long umfpack_zl_report_triplet
(
    long n_row,
    long n_col,
    long nz,
    const long Ti [ ],
    const long Tj [ ],
    const double Tx [ ], const double Tz [ ],
    const double Control [UMFPACK_CONTROL]
) ;

/*
double int Syntax:

    #include "umfpack.h"
    int n_row, n_col, nz, *Ti, *Tj, status ;
    double *Tx, Control [UMFPACK_CONTROL] ;
    status = umfpack_di_report_triplet (n_row, n_col, nz, Ti, Tj, Tx, Control) ;

double long Syntax:

    #include "umfpack.h"
    long n_row, n_col, nz, *Ti, *Tj, status ;
    double *Tx, Control [UMFPACK_CONTROL] ;
    status = umfpack_dl_report_triplet (n_row, n_col, nz, Ti, Tj, Tx, Control) ;

complex int Syntax:

    #include "umfpack.h"
    int n_row, n_col, nz, *Ti, *Tj, status ;
    double *Tx, *Tz, Control [UMFPACK_CONTROL] ;
    status = umfpack_zi_report_triplet (n_row, n_col, nz, Ti, Tj, Tx, Tz,
	Control) ;

complex long Syntax:

    #include "umfpack.h"
    long n_row, n_col, nz, *Ti, *Tj, status ;
    double *Tx, *Tz, Control [UMFPACK_CONTROL] ;
    status = umfpack_zl_report_triplet (n_row, n_col, nz, Ti, Tj, Tx, Tz,
	Control) ;

Purpose:

    Verifies and prints a matrix in triplet form.

Returns:

    UMFPACK_OK if Control [UMFPACK_PRL] <= 2 (the input is not checked).

    Otherwise:

    UMFPACK_OK if the Triplet matrix is OK.
    UMFPACK_ERROR_argument_missing if Ti and/or Tj are missing.
    UMFPACK_ERROR_n_nonpositive if n_row <= 0 or n_col <= 0.
    UMFPACK_ERROR_nz_negative if nz < 0.
    UMFPACK_ERROR_invalid_triplet if any row or column index in Ti and/or Tj
	is not in the range 0 to n_row-1 or 0 to n_col-1, respectively.

Arguments:

    Int n_row ;		Input argument, not modified.
    Int n_col ;		Input argument, not modified.

	A is an n_row-by-n_col matrix.

    Int nz ;		Input argument, not modified.

	The number of entries in the triplet form of the matrix.

    Int Ti [nz] ;	Input argument, not modified.
    Int Tj [nz] ;	Input argument, not modified.
    double Tx [nz] ;	Input argument, not modified.
    double Tz [nz] ;	Input argument, not modified, for complex versions.

	Ti, Tj, Tx (and Tz for complex versions) hold the "triplet" form of a
	sparse matrix.  The kth nonzero entry is in row i = Ti [k], column
	j = Tj [k], the real numerical value of a_ij is Tx [k], and the
	imaginary part of a_ij is Tz [k] (for complex versions).  The row and
	column indices i and j must be in the range 0 to n_row-1 or 0 to
	n_col-1, respectively.  Duplicate entries may be present.  The
	"triplets" may be in any order.  Tx and Tz are optional; if Tx or Tz are
	not present ((double *) NULL pointers), then the numerical values are
	not printed.

	Future complex version:  if Tx is present and Tz is NULL, then both real
	and imaginary parts will be contained in Tx[0..2*nz-1], with Tx[2*k]
	and Tx[2*k+1] being the real and imaginary part of the kth entry.

    double Control [UMFPACK_CONTROL] ;	Input argument, not modified.

	If a (double *) NULL pointer is passed, then the default control
	settings are used.  Otherwise, the settings are determined from the
	Control array.  See umfpack_*_defaults on how to fill the Control
	array with the default settings.  If Control contains NaN's, the
	defaults are used.  The following Control parameters are used:

	Control [UMFPACK_PRL]:  printing level.

	    2 or less: no output.  returns silently without checking anything.
	    3: fully check input, and print a short summary of its status
	    4: as 3, but print first few entries of the input
	    5: as 3, but print all of the input
	    Default: 1
*/

```

sparse-matrix/umfpack/umf_analyze.c:
```
/* ========================================================================== */
/* === UMF_analyze ========================================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*
    Symbolic LL' factorization of A'*A, to get upper bounds on the size of
    L and U for LU = PAQ, and to determine the frontal matrices and
    (supernodal) column elimination tree.  No fill-reducing column pre-ordering
    is used.

    Returns TRUE if successful, FALSE if out of memory.  UMF_analyze can only
    run out of memory if anzmax (which is Ap [n_row]) is too small.

    Uses workspace of size O(nonzeros in A).  On input, the matrix A is
    stored in row-form at the tail end of Ai.  It is destroyed on output.
    The rows of A must be sorted by increasing first column index.
    The matrix is assumed to be valid.

    Empty rows and columns have already been removed.

*/

#include "umf_internal.h"
#include "umf_order_front_tree.h"
#include "umf_apply_order.h"

/* ========================================================================== */

GLOBAL Int UMF_analyze
(
    Int n_row,		/* A is n_row-by-n_col */
    Int n_col,
    Int Ai [ ],		/* Ai [Ap [0]..Ap[n_row]-1]: column indices */
			/* destroyed on output.  Note that this is NOT the */
			/* user's Ai that was passed to UMFPACK_*symbolic */
			/* size of Ai, Ap [n_row] = anzmax >= anz + n_col */
			/* Ap [0] must be => n_col.  The space to the */
			/* front of Ai is used as workspace. */

    Int Ap [ ],		/* of size MAX (n_row, n_col) + 1 */
			/* Ap [0..n_row]: row pointers */
			/* Row i is in Ai [Ap [i] ... Ap [i+1]-1] */

			/* rows must have smallest col index first, or be */
			/* in sorted form.  Used as workspace of size n_col */
			/* and destroyed. */

			/* Note that this is NOT the */
			/* user's Ap that was passed to UMFPACK_*symbolic */

    Int Up [ ],		/* workspace of size n_col, and output column perm. */

    /* temporary workspaces: */
    Int W [ ],		/* W [0..n_col-1] */
    Int Link [ ],	/* Link [0..n_col-1] */

    /* output: information about each frontal matrix: */
    Int Front_ncols [ ],	/* size n_col */
    Int Front_nrows [ ],	/* of size n_col */
    Int Front_npivcol [ ],	/* of size n_col */
    Int Front_parent [ ],	/* of size n_col */
    Int *nfr_out,

    Int *p_ncompactions		/* number of compactions in UMF_analyze */
)
{
    /* ====================================================================== */
    /* ==== local variables ================================================= */
    /* ====================================================================== */

    Int j, j3, col, k, row, parent, j2, pdest, p, p2, thickness, npivots, nfr,
	frsize, i, *Winv, kk, npiv, jnext, krow, knext, pfirst,
	jlast, ncompactions, *Stack, *Front_maxfr, *Front_order, *Front_child,
	*Front_sibling, fprev, maxfrsize, bigf, fnext, bigfprev, f, Wflag,
	npivcol, fallrows, fallcols, fpiv, frows, fcols ;

#ifndef NDEBUG
    Int nfr2, nchild ;
#endif

    nfr = 0 ;
    DEBUG0 (("UMF_analyze: anzmax "ID" anrow "ID" ancol "ID"\n",
	Ap [n_row], n_row, n_col)) ;

    /* ====================================================================== */
    /* ==== initializations ================================================= */
    /* ====================================================================== */

    for (j = 0 ; j < n_col ; j++)
    {
	Link [j] = EMPTY ;
	W [j] = EMPTY ;
	Up [j] = EMPTY ;

	/* Frontal matrix data structure: */
	Front_npivcol [j] = 0 ;		/* number of pivot columns */
	Front_nrows [j] = 0 ;		/* number of rows, incl. pivot rows */
	Front_ncols [j] = 0 ;		/* number of cols, incl. pivot cols */
	Front_parent [j] = EMPTY ;	/* parent front */
	/* Note that only non-pivotal columns are stored in a front (a "row" */
	/* of U) during elimination. */
    }

    /* the rows must be sorted by increasing min col */
    krow = 0 ;
    pfirst = Ap [0] ;
    jlast = EMPTY ;
    jnext = EMPTY ;
    Wflag = 0 ;

    ASSERT (pfirst >= n_col) ;	/* Ai must be large enough */

    /* pdest points to the first free space in Ai */
    pdest = 0 ;
    ncompactions = 0 ;

    /* ====================================================================== */
    /* === compute symbolic LL' factorization (unsorted) ==================== */
    /* ====================================================================== */

    for (j = 0 ; j < n_col ; j = jnext)
    {
	DEBUG1 (("\n\n============Front "ID" starting. nfr = "ID"\n", j, nfr)) ;

	/* ================================================================== */
	/* === garbage collection =========================================== */
	/* ================================================================== */

	if (pdest + (n_col-j) > pfirst)
	{
	    /* we might run out ... compact the rows of U */

#ifndef NDEBUG
	    DEBUG0 (("UMF_analyze COMPACTION, j="ID" pfirst="ID"\n",
		j, pfirst)) ;
	    for (row = 0 ; row < j ; row++)
	    {
		if (Up [row] != EMPTY)
		{
		    /* this is a live row of U */
		    DEBUG1 (("Live row: "ID" cols: ", row)) ;
		    p = Up [row] ;
		    ASSERT (Front_ncols [row] > Front_npivcol [row]) ;
		    p2 = p + (Front_ncols [row] - Front_npivcol [row]) ;
		    for ( ; p < p2 ; p++)
		    {
			DEBUG1 ((ID, Ai [p])) ;
			ASSERT (p < pfirst) ;
			ASSERT (Ai [p] > row && Ai [p] < n_col) ;
		    }
		    DEBUG1 (("\n")) ;
		}
	    }
	    DEBUG1 (("\nStarting to compact:\n")) ;
#endif

	    pdest = 0 ;
	    ncompactions++ ;
	    for (row = 0 ; row < j ; row++)
	    {
		if (Up [row] != EMPTY)
		{
		    /* this is a live row of U */
		    DEBUG1 (("Live row: "ID" cols: ", row)) ;
		    ASSERT (row < n_col) ;
		    p = Up [row] ;
		    ASSERT (Front_ncols [row] > Front_npivcol [row]) ;
		    p2 = p + (Front_ncols [row] - Front_npivcol [row]) ;
		    Up [row] = pdest ;
		    for ( ; p < p2 ; p++)
		    {
			DEBUG1 ((ID, Ai [p])) ;
			ASSERT (p < pfirst) ;
			ASSERT (Ai [p] > row && Ai [p] < n_col) ;
			Ai [pdest++] = Ai [p] ;
			ASSERT (pdest <= pfirst) ;
		    }
		    DEBUG1 (("\n")) ;
		}
	    }

#ifndef NDEBUG
	    DEBUG1 (("\nAFTER COMPACTION, j="ID" pfirst="ID"\n", j, pfirst)) ;
	    for (row = 0 ; row < j ; row++)
	    {
		if (Up [row] != EMPTY)
		{
		    /* this is a live row of U */
		    DEBUG1 (("Live row: "ID" cols: ", row)) ;
		    p = Up [row] ;
		    ASSERT (Front_ncols [row] > Front_npivcol [row]) ;
		    p2 = p + (Front_ncols [row] - Front_npivcol [row]) ;
		    for ( ; p < p2 ; p++)
		    {
			DEBUG1 ((ID, Ai [p])) ;
			ASSERT (p < pfirst) ;
			ASSERT (Ai [p] > row && Ai [p] < n_col) ;
		    }
		    DEBUG1 (("\n")) ;
		}
	    }
#endif

	}

	if (pdest + (n_col-j) > pfirst)
	{
	   /* Out of memory!  This is not supposed to happen ... */
	   /* it can't, if pfirst >= n_col */
	   return (FALSE) ;	/* internal error! */
	}

	/* ------------------------------------------------------------------ */
	/* is the last front a child of this one? */
	/* ------------------------------------------------------------------ */

	if (jlast != EMPTY && Link [j] == jlast)
	{
	    /* yes - create row j by appending to jlast */
	    DEBUG1 (("GOT:last front is child of this one: j "ID" jlast "ID"\n",
		j, jlast)) ;
	    ASSERT (jlast >= 0 && jlast < j) ;

	    Up [j] = Up [jlast] ;
	    Up [jlast] = EMPTY ;

	    /* find the parent, delete column j, and update W */
	    parent = n_col ;
	    for (p = Up [j] ; p < pdest ; )
	    {
		j3 = Ai [p] ;
		DEBUG1 (("Initial row of U: col "ID" ", j3)) ;
		ASSERT (j3 >= 0 && j3 < n_col) ;
		DEBUG1 (("W: "ID" \n", W [j3])) ;
		ASSERT (W [j3] == Wflag) ;
		if (j == j3)
		{
		    DEBUG1 (("Found column j at p = "ID"\n", p)) ;
		    Ai [p] = Ai [--pdest] ;
		}
		else
		{
		    if (j3 < parent)
		    {
			parent = j3 ;
		    }
		    p++ ;
	    	}
	    }

	    /* delete jlast from the link list of j */
	    Link [j] = Link [jlast] ;

	    ASSERT (Front_nrows [jlast] > Front_npivcol [jlast]) ;
	    thickness = (Front_nrows [jlast] - Front_npivcol [jlast]) ;

	}
	else
	{
	    Up [j] = pdest ;
	    parent = n_col ;
	    /* thickness: number of (nonpivotal) rows in frontal matrix j */
	    thickness = 0 ;
	    Wflag = j ;
	}

	/* ================================================================== */
	/* === compute row j of A*A' ======================================== */
	/* ================================================================== */

	/* ------------------------------------------------------------------ */
	/* flag the diagonal entry in row U, but do not add to pattern */
	/* ------------------------------------------------------------------ */

	ASSERT (pdest <= pfirst) ;
	W [j] = Wflag ;

	DEBUG1 (("\nComputing row "ID" of A'*A\n", j)) ;
	DEBUG2 (("	col: "ID" (diagonal)\n", j)) ;

	/* ------------------------------------------------------------------ */
	/* find the rows the contribute to this column j */
	/* ------------------------------------------------------------------ */

	jnext = n_col ;
	for (knext = krow ; knext < n_row ; knext++)
	{
	    ASSERT (Ap [knext] < Ap [knext+1]) ;

		ASSERT (Ap [knext] >= pfirst && Ap [knext] <= Ap [n_row]) ;
		jnext = Ai [Ap [knext]] ;
		ASSERT (jnext >= j) ;
		if (jnext != j)
		{
		    break ;
		}
	}

	/* rows krow ... knext-1 all have first column index of j */
	/* (or are empty) */

	/* row knext has first column index of jnext */
	/* if knext = n_row, then jnext is n_col */
	if (knext == n_row)
	{
	    jnext = n_col ;
	}

	ASSERT (jnext > j) ;
	ASSERT (jnext <= n_col) ;

	/* ------------------------------------------------------------------ */
	/* for each nonzero A (k,j) in column j of A do: */
	/* ------------------------------------------------------------------ */

	for (k = krow ; k < knext ; k++)
	{
	    p = Ap [k] ;
	    p2 = Ap [k+1] ;
	    ASSERT (p < p2) ;

		/* merge row k of A into W */
		DEBUG2 (("	---- A row "ID" ", k)) ;
		ASSERT (k >= 0 && k < n_row) ;
		ASSERT (Ai [p] == j) ;
		DEBUG2 (("  p "ID" p2 "ID"\n        cols:", p, p2)) ;
		ASSERT (p  >= pfirst && p  < Ap [n_row]) ;
		ASSERT (p2 >  pfirst && p2 <= Ap [n_row]) ;
		for ( ; p < p2 ; p++)
		{
		    /* add to pattern if seen for the first time */
		    col = Ai [p] ;
		    ASSERT (col >= j && col < n_col) ;
		    DEBUG3 ((" "ID, col)) ;
		    if (W [col] != Wflag)
		    {
			Ai [pdest++] = col ;
			ASSERT (pdest <= pfirst) ;
			/* flag this column has having been seen for row j */
			W [col] = Wflag ;
			if (col < parent)
			{
			    parent = col ;
			}
		    }
		}
		DEBUG2 (("\n")) ;
		thickness++ ;

	}

#ifndef NDEBUG
	DEBUG3 (("\nRow "ID" of A'A:\n", j)) ;
	for (p = Up [j] ; p < pdest ; p++)
	{
	    DEBUG3 ((" "ID, Ai [p])) ;
	}
	DEBUG3 (("\n")) ;
#endif

	/* ------------------------------------------------------------------ */
	/* delete rows up to but not including knext */
	/* ------------------------------------------------------------------ */

	krow = knext ;
	pfirst = Ap [knext] ;

	/* we can now use Ai [0..pfirst-1] as workspace for rows of U */

	/* ================================================================== */
	/* === compute jth row of U ========================================= */
	/* ================================================================== */

	/* for each nonzero U (k,j) in column j of U (1:j-1,:) do */
	for (k = Link [j] ; k != EMPTY ; k = Link [k])
	{
	    /* merge row k of U into W */
	    DEBUG2 (("	---- U row "ID, k)) ;
	    ASSERT (k >= 0 && k < n_col) ;
	    ASSERT (Up [k] != EMPTY) ;
	    p = Up [k] ;
	    ASSERT (Front_ncols [k] > Front_npivcol [k]) ;
	    p2 = p + (Front_ncols [k] - Front_npivcol [k]) ;
	    DEBUG2 (("  p "ID" p2 "ID"\n        cols:", p, p2)) ;
	    ASSERT (p <= pfirst) ;
	    ASSERT (p2 <= pfirst) ;
	    for ( ; p < p2 ; p++)
	    {
		/* add to pattern if seen for the first time */
		col = Ai [p] ;
		ASSERT (col >= j && col < n_col) ;
		DEBUG3 ((ID, col)) ;
		if (W [col] != Wflag)
		{
		    Ai [pdest++] = col ;
		    ASSERT (pdest <= pfirst) ;
		    /* flag this col has having been seen for row j */
		    W [col] = Wflag ;
		    if (col < parent)
		    {
			parent = col ;
		    }
		}
	    }
	    DEBUG2 (("\n")) ;

	    /* mark the row k as deleted */
	    Up [k] = EMPTY ;

	    ASSERT (Front_nrows [k] > Front_npivcol [k]) ;
	    thickness += (Front_nrows [k] - Front_npivcol [k]) ;
	    ASSERT (Front_parent [k] == j) ;
	}

#ifndef NDEBUG
	DEBUG3 (("\nRow "ID" of U prior to supercolumn detection:\n", j));
	for (p = Up [j] ; p < pdest ; p++)
	{
	    DEBUG3 ((" "ID, Ai [p])) ;
	}
	DEBUG3 (("\n")) ;
#endif

	/* ================================================================== */
	/* === quicky mass elimination ====================================== */
	/* ================================================================== */

	/* this code detects some supernodes, but it might miss */
	/* some because the elimination tree (created on the fly) */
	/* is not yet post-ordered, and because the pattern of A'*A */
	/* is also computed on the fly. */

	/* j2 is incremented because the pivot columns are not stored */

	for (j2 = j+1 ; j2 < jnext ; j2++)
	{
	    ASSERT (j2 >= 0 && j2 < n_col) ;
	    if (W [j2] != Wflag || Link [j2] != EMPTY)
	    {
		break ;
	    }
	}

	/* the loop above terminated with j2 at the first non-supernode */
	DEBUG1 (("jnext = "ID"\n", jnext)) ;
	ASSERT (j2 <= jnext) ;
	jnext = j2 ;
	j2-- ;
	DEBUG1 (("j2 = "ID"\n", j2)) ;
	ASSERT (j2 < n_col) ;

	npivots = j2-j+1 ;

	/* rows j:j2 have the same nonzero pattern, except for columns j:j2-1 */

	if (j2 > j)
	{
	    /* supernode detected, prune the pattern of new row j */
	    ASSERT (parent == j+1) ;
	    ASSERT (j2 < n_col) ;
	    DEBUG1 (("Supernode detected, j "ID" to j2 "ID"\n", j, j2)) ;

	    parent = n_col ;
	    p2 = pdest ;
	    pdest = Up [j] ;
	    for (p = Up [j] ; p < p2 ; p++)
	    {
		col = Ai [p] ;
		ASSERT (col >= 0 && col < n_col) ;
		ASSERT (W [col] == Wflag) ;
		if (col > j2)
		{
		    /* keep this col in the pattern of the new row j */
		    Ai [pdest++] = col ;
		    if (col < parent)
		    {
			parent = col ;
		    }
		}
	    }
	}

	DEBUG1 (("Parent ["ID"] = "ID"\n", j, parent)) ;
	ASSERT (parent > j2) ;

	if (parent == n_col)
	{
	    /* this front has no parent - it is the root of a subtree */
	    parent = EMPTY ;
	}

#ifndef NDEBUG
	DEBUG3 (("\nFinal row "ID" of U after supercolumn detection:\n", j)) ;
	for (p = Up [j] ; p < pdest ; p++)
	{
	    ASSERT (Ai [p] >= 0 && Ai [p] < n_col) ;
	    DEBUG3 ((" "ID" ("ID")", Ai [p], W [Ai [p]])) ;
	    ASSERT (W [Ai [p]] == Wflag) ;
	}
	DEBUG3 (("\n")) ;
#endif

	/* ================================================================== */
	/* === frontal matrix =============================================== */
	/* ================================================================== */

	/* front has Front_npivcol [j] pivot columns */
	/* entire front is Front_nrows [j] -by- Front_ncols [j] */
	/* j is first column in the front */

	npivcol = npivots ;
	fallrows = thickness ;
	fallcols = npivots + pdest - Up [j] ;

	/* number of pivots in the front (rows and columns) */
	fpiv = MIN (npivcol, fallrows) ;

	/* size of contribution block */
	frows = fallrows - fpiv ;
	fcols = fallcols - fpiv ;

	if (frows == 0 || fcols == 0)
	{
	    /* front has no contribution block and thus needs no parent */
	    Up [j] = EMPTY ;
	    parent = EMPTY ;
	}

	Front_npivcol [j] = npivots ;
	Front_nrows [j] = fallrows ;
	Front_ncols [j] = fallcols ;
	Front_parent [j] = parent ;
	ASSERT (npivots > 0) ;

	/* Front_parent [j] is the first column of the parent frontal matrix */

	DEBUG1 (("\n\n==== Front "ID", pivot columns "ID":"ID" all front: "ID
	    "-by-"ID"\n", j, j,j+npivots-1, Front_nrows [j], Front_ncols [j])) ;
	nfr++ ;

	/* ================================================================== */
	/* === prepare this row for its parent ============================== */
	/* ================================================================== */

	if (parent != EMPTY)
	{
	    Link [j] = Link [parent] ;
	    Link [parent] = j ;
	}

	ASSERT (jnext > j) ;

	jlast = j ;
    }

    /* ====================================================================== */
    /* === scan the fronts ================================================== */
    /* ====================================================================== */

    *nfr_out = nfr ;

    /* use Ap for Front_child and use Link for Front_sibling [ */
    Front_child = Ap ;
    Front_sibling = Link ;

    /* use W for Front_maxfr [ */
    Front_maxfr = W ;

    for (j = 0 ; j < n_col ; j++)
    {
	Front_child [j] = EMPTY ;
	Front_sibling [j] = EMPTY ;
	Front_maxfr [j] = EMPTY ;
    }

    DEBUG1 (("\n\n========================================FRONTS:\n")) ;

    /* ---------------------------------------------------------------------- */
    /* find max front size for tree rooted at node j, for each front j */
    /* ---------------------------------------------------------------------- */

    for (j = 0 ; j < n_col ; j++)
    {
	DEBUG1 ((""ID" : npiv "ID" nrows "ID" ncols "ID" parent "ID" ",
		j, Front_npivcol [j], Front_nrows [j], Front_ncols [j],
		Front_parent [j])) ;
	if (Front_npivcol [j] > 0)
	{
	    /* this is a frontal matrix */
	    parent = Front_parent [j] ;
	    frsize = Front_nrows [j] * Front_ncols [j] ;

	    DEBUG1 ((" a front, frsize "ID", true parent: "ID"\n", frsize,
		parent)) ;

	    Front_maxfr [j] = MAX (Front_maxfr [j], frsize) ;
	    DEBUG1 (("Front_maxfr [j = "ID"] = "ID"\n", j, Front_maxfr [j])) ;

	    if (parent != EMPTY)
	    {
		ASSERT (Front_npivcol [parent] > 0) ;
		ASSERT (parent > j) ;

		/* find the maximum frontsize of self and children */
		Front_maxfr [parent] = MAX (Front_maxfr [parent],
			Front_maxfr [j]) ;
		DEBUG1 (("Front_maxfr [parent = "ID"] = "ID"\n",
		    parent, Front_maxfr [parent]));
	    }
	}
	DEBUG1 (("\n")) ;
    }

    /* ---------------------------------------------------------------------- */
    /* place the children in link lists - bigger fronts will tend to be last */
    /* ---------------------------------------------------------------------- */

    for (j = n_col-1 ; j >= 0 ; j--)
    {
	if (Front_npivcol [j] > 0)
	{
	    /* this is a frontal matrix */
	    parent = Front_parent [j] ;
	    if (parent != EMPTY)
	    {
		/* place the front in link list of the children its parent */
		Front_sibling [j] = Front_child [parent] ;
		Front_child [parent] = j ;
	    }
	}
    }

#ifndef NDEBUG
    DEBUG1 (("\n\n========================================FRONTS (again):\n")) ;
    nfr2 = 0 ;
    for (j = 0 ; j < n_col ; j++)
    {
	if (Front_npivcol [j] > 0)
	{
	    DEBUG1 (( ""ID" :  nfr "ID" npiv "ID" nrows "ID" ncols "ID
		" parent "ID" maxfr "ID"\n", j, nfr2,
		Front_npivcol [j], Front_nrows [j], Front_ncols [j],
		Front_parent [j], Front_maxfr [j])) ;

	    /* this is a frontal matrix */

	    /* dump the link list of children */
	    DEBUG1 (("    Children: ")) ;
	    for (f = Front_child [j] ; f != EMPTY ; f = Front_sibling [f])
	    {
		DEBUG1 ((ID, f)) ;
		ASSERT (Front_parent [f] == j) ;
	    }
	    DEBUG1 (("\n")) ;

	    parent = Front_parent [j] ;
	    if (parent != EMPTY)
	    {
		/* Assert that the parent front can absorb the child element */
		ASSERT (Front_npivcol [parent] > 0) ;
		ASSERT ((Front_nrows [j] - Front_npivcol [j])
		<= Front_nrows [parent]) ;
		ASSERT ((Front_ncols [j] - Front_npivcol [j])
		<= Front_ncols [parent]) ;
	    }
	    nfr2++ ;
	}
    }
    ASSERT (nfr == nfr2) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* Order the front tree via depth-first-search */
    /* ---------------------------------------------------------------------- */

    for (i = 0 ; i < n_col ; i++)
    {
	if (Front_npivcol [i] > 0 && Front_child [i] != EMPTY)
	{

#ifndef NDEBUG
	    DEBUG1 (("Before partial sort, front "ID"\n", i)) ;
	    nchild = 0 ;
	    for (f = Front_child [i] ; f != EMPTY ; f = Front_sibling [f])
	    {
		DEBUG1 (("        "ID"  "ID"\n", f, Front_maxfr [f])) ;
		nchild++ ;
	    }
#endif

	    /* find the biggest front in the child list */
	    fprev = EMPTY ;
	    maxfrsize = EMPTY ;
	    bigfprev = EMPTY ;
	    bigf = EMPTY ;
	    for (f = Front_child [i] ; f != EMPTY ; f = Front_sibling [f])
	    {
		frsize = Front_maxfr [f] ;
		if (frsize >= maxfrsize)
		{
		    /* this is the biggest seen so far */
		    maxfrsize = frsize ;
		    bigfprev = fprev ;
		    bigf = f ;
		}
		fprev = f ;
	    }
	    ASSERT (bigf != EMPTY) ;

	    fnext = Front_sibling [bigf] ;

	    DEBUG1 (("bigf "ID" maxfrsize "ID" bigfprev "ID" fnext "ID" fprev "
		ID"\n", bigf, maxfrsize, bigfprev, fnext, fprev)) ;

	    if (fnext != EMPTY)
	    {
		/* if fnext is EMPTY, then bigf is already at the end of list */

		if (bigfprev == EMPTY)
		{
		    /* delete bigf from the front of the list */
		    Front_child [i] = fnext ;
		}
		else
		{
		    /* delete bigf from the middle of the list */
		    Front_sibling [bigfprev] = fnext ;
		}

		/* put bigf at the end of the list */
		Front_sibling [bigf] = EMPTY ;
		ASSERT (Front_child [i] != EMPTY) ;
		ASSERT (fprev != bigf) ;
		ASSERT (fprev != EMPTY) ;
		Front_sibling [fprev] = bigf ;
	    }

#ifndef NDEBUG
	    DEBUG1 (("After partial sort, front "ID"\n", i)) ;
	    for (f = Front_child [i] ; f != EMPTY ; f = Front_sibling [f])
	    {
		DEBUG1 (("        "ID"  "ID"\n", f, Front_maxfr [f])) ;
		ASSERT (Front_npivcol [f] > 0) ;
		nchild-- ;
	    }
	    ASSERT (nchild == 0) ;
#endif

	}
    }

    /* Front_maxfr no longer needed ] */

    /* ---------------------------------------------------------------------- */
    /* postorder the supernodal column elimination tree */
    /* ---------------------------------------------------------------------- */

    /* use W for Front_order ( */
    Front_order = W ;

    /* use Ai as Stack for UMF_order_front_tree [ */
    Stack = Ai ;

    for (i = 0 ; i < n_col ; i++)
    {
	Front_order [i] = EMPTY ;
    }

#ifndef NDEBUG
    UMF_nbug = n_col ;	/* frontal id's are in the range 0..n_col-1 */
    UMF_fbug = nfr ;	/* total number of frontal matrices */
#endif

    k = 0 ;
    for (i = 0 ; i < n_col ; i++)
    {
	if (Front_parent [i] == EMPTY && Front_npivcol [i] != 0)
	{
	    DEBUG1 (("Root of front tree "ID"\n", i)) ;
	    k = UMF_order_front_tree (i, k, Front_child, Front_sibling,
		Front_order, Stack) ;
	}
    }

    /* Stack no longer needed ] */
    /* Front_child, Front_sibling no longer needed ] */

    /* ---------------------------------------------------------------------- */
    /* construct the column permutation (return in Up) */
    /* ---------------------------------------------------------------------- */

    /* Front_order [i] = k means that front i is kth front in the new order. */
    /* i is in the range 0 to n_col-1, and k is in the range 0 to nfr-1 */

    /* Use Ai as workspace for Winv [ */
    Winv = Ai ;
    for (k = 0 ; k < nfr ; k++)
    {
	Winv [k] = EMPTY ;
    }

    /* compute the inverse of Front_order, so that Winv [k] = i */
    /* if Front_order [i] = k */

    DEBUG1 (("\n\nComputing output column permutation:\n")) ;
    for (i = 0 ; i < n_col ; i++)
    {
	k = Front_order [i] ;
	if (k != EMPTY)
	{
	    DEBUG1 (("Front "ID" new order: "ID"\n", i, k)) ;
	    ASSERT (k >= 0 && k < nfr) ;
	    ASSERT (Winv [k] == EMPTY) ;
	    Winv [k] = i ;
	}
    }

    /* Use Up as output permutation */
    kk = 0 ;
    for (k = 0 ; k < nfr ; k++)
    {
	i = Winv [k] ;
	DEBUG1 (("Old Front "ID" New Front "ID" npivots "ID" nrows "ID" ncols "ID"\n",
	    i, k, Front_npivcol [i], Front_nrows [i], Front_ncols [i])) ;
	ASSERT (i >= 0 && i < n_col) ;
	ASSERT (Front_npivcol [i] > 0) ;
	for (npiv = 0 ; npiv < Front_npivcol [i] ; npiv++)
	{
	    Up [kk] = i + npiv ;
	    DEBUG1 (("    Cperm ["ID"] = "ID"\n", kk, Up [kk])) ;
	    kk++ ;
	}
    }
    ASSERT (kk == n_col) ;

    /* Winv no longer needed ] */

    /* ---------------------------------------------------------------------- */
    /* apply the postorder traversal to renumber the frontal matrices */
    /* ---------------------------------------------------------------------- */

    /* use Ai as workspace */

    UMF_apply_order (Front_npivcol, Front_order, Ai, n_col, nfr) ;
    UMF_apply_order (Front_nrows,   Front_order, Ai, n_col, nfr) ;
    UMF_apply_order (Front_ncols,   Front_order, Ai, n_col, nfr) ;
    UMF_apply_order (Front_parent,  Front_order, Ai, n_col, nfr) ;

    /* fix the parent to refer to the new numbering */
    for (i = 0 ; i < nfr ; i++)
    {
	parent = Front_parent [i] ;
	if (parent != EMPTY)
	{
	    ASSERT (parent >= 0 && parent < n_col) ;
	    ASSERT (Front_order [parent] >= 0 && Front_order [parent] < nfr) ;
	    Front_parent [i] = Front_order [parent] ;
	}
    }

    /* Front_order longer needed ) */

#ifndef NDEBUG
    DEBUG1 (("\nFinal frontal matrices:\n")) ;
    for (i = 0 ; i < nfr ; i++)
    {
	DEBUG1 (("Final front "ID": npiv "ID" nrows "ID" ncols "ID" parent "
	    ID"\n", i, Front_npivcol [i], Front_nrows [i],
	    Front_ncols [i], Front_parent [i])) ;
    }
#endif

    *p_ncompactions = ncompactions ;
    return (TRUE) ;
}


```

sparse-matrix/umfpack/umf_valid_symbolic.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL Int UMF_valid_symbolic
(
    SymbolicType *Symbolic
) ;


```

sparse-matrix/umfpack/wrap_umf_ltsolve.c:
```
#define	CONJUGATE_SOLVE
#include "umf_ltsolve.c"

```

sparse-matrix/umfpack/umfpack_get_symbolic.c:
```
/* ========================================================================== */
/* === UMFPACK_get_symbolic ================================================= */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*
    User-callable.  Gets the symbolic information held in the Symbolic object.
    See umfpack_get_symbolic.h for a more detailed description.
*/

#include "umf_internal.h"
#include "umf_valid_symbolic.h"

/* ========================================================================== */

GLOBAL Int UMFPACK_get_symbolic
(
    Int *p_n_row,
    Int *p_n_col,
    Int *p_nz,
    Int *p_nfr,
    Int *p_nchains,
    Int Ptree [ ],
    Int Qtree [ ],
    Int Front_npivcol [ ],
    Int Front_parent [ ],
    Int Front_1strow [ ],
    Int Front_leftmostdesc [ ],
    Int Chain_start [ ],
    Int Chain_maxrows [ ],
    Int Chain_maxcols [ ],
    void *SymbolicHandle
)
{
    SymbolicType *Symbolic ;
    Int k, n_row, n_col, nfr, nchains, *p ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    Symbolic = (SymbolicType *) SymbolicHandle ;
    if (!UMF_valid_symbolic (Symbolic))
    {
	return (UMFPACK_ERROR_invalid_Symbolic_object) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get contents of Symbolic */
    /* ---------------------------------------------------------------------- */

    n_row = Symbolic->n_row ;
    n_col = Symbolic->n_col ;
    nfr = Symbolic->nfr ;
    nchains = Symbolic->nchains ;

    if (p_n_row)
    {
	*p_n_row = n_row ;
    }

    if (p_n_col)
    {
	*p_n_col = n_col ;
    }

    if (p_nz)
    {
	*p_nz = Symbolic->nz ;
    }

    if (p_nfr)
    {
	*p_nfr = nfr ;
    }

    if (p_nchains)
    {
	*p_nchains = nchains ;
    }

    if (Ptree)
    {
	p = Symbolic->Rperm_init ;
	for (k = 0 ; k < n_row ; k++)
	{
	    Ptree [k] = p [k] ;
	}
    }

    if (Qtree)
    {
	p = Symbolic->Cperm_init ;
	for (k = 0 ; k < n_col ; k++)
	{
	    Qtree [k] = p [k] ;
	}
    }

    if (Front_npivcol)
    {
	p = Symbolic->Front_npivcol ;
	for (k = 0 ; k <= nfr ; k++)
	{
	    Front_npivcol [k] = p [k] ;
	}
    }

    if (Front_parent)
    {
	p = Symbolic->Front_parent ;
	for (k = 0 ; k <= nfr ; k++)
	{
	    Front_parent [k] = p [k] ;
	}
    }

    if (Front_1strow)
    {
	p = Symbolic->Front_1strow ;
	for (k = 0 ; k <= nfr ; k++)
	{
	    Front_1strow [k] = p [k] ;
	}
    }

    if (Front_leftmostdesc)
    {
	p = Symbolic->Front_leftmostdesc ;
	for (k = 0 ; k <= nfr ; k++)
	{
	    Front_leftmostdesc [k] = p [k] ;
	}
    }

    if (Chain_start)
    {
	p = Symbolic->Chain_start ;
	for (k = 0 ; k <= nchains ; k++)
	{
	    Chain_start [k] = p [k] ;
	}
    }

    if (Chain_maxrows)
    {
	p = Symbolic->Chain_maxrows ;
	for (k = 0 ; k < nchains ; k++)
	{
	    Chain_maxrows [k] = p [k] ;
	}
	Chain_maxrows [nchains] = 0 ;
    }

    if (Chain_maxcols)
    {
	p = Symbolic->Chain_maxcols ;
	for (k = 0 ; k < nchains ; k++)
	{
	    Chain_maxcols [k] = p [k] ;
	}
	Chain_maxcols [nchains] = 0 ;
    }

    return (UMFPACK_OK) ;
}

```

sparse-matrix/umfpack/umf_free.c:
```
/* ========================================================================== */
/* === UMF_free ============================================================= */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*
    Free a block previously allocated by UMF_malloc and return NULL.
    Usage is p = UMF_free (p), to ensure that we don't free it twice.
    Also maintains the UMFPACK malloc count.
*/

#include "umf_internal.h"

#if defined (UMF_MALLOC_COUNT) || !defined (NDEBUG)
#include "umf_malloc.h"
#endif

GLOBAL void *UMF_free
(
    void *p
)
{
    if (p)
    {

	/* see umf_config.h for the memory allocator selection */
	FREE (p) ;

#if defined (UMF_MALLOC_COUNT) || !defined (NDEBUG)
	/* One more object has been free'd.  Keep track of the count. */
	/* (purely for sanity checks). */
	UMF_malloc_count-- ;
#endif

    }

    return ((void *) NULL) ;
}


```

sparse-matrix/umfpack/umf_ltsolve.c:
```
/* ========================================================================== */
/* === UMF_ltsolve ========================================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*  Solves L'x = b or L.'x=b, where L is the lower triangular factor of a */
/*  matrix.  B is overwritten with the solution X. */
/*  Returns the floating point operation count */

#include "umf_internal.h"

GLOBAL double
#ifdef CONJUGATE_SOLVE
UMF_lhsolve			/* solve L'x=b  (complex conjugate transpose) */
#else
UMF_ltsolve			/* solve L.'x=b (array transpose) */
#endif
(
    NumericType *Numeric,
    Entry X [ ],		/* b on input, solution x on output */
    Int Pattern [ ]		/* a work array of size n */
)
{
    Int k, deg, *ip, j, row, *Lpos, *Lilen, kstart, kend, *Lip, llen,
	lp, pos, npiv ;
    Entry *xp, xk ;

    /* ---------------------------------------------------------------------- */

    if (Numeric->n_row != Numeric->n_col) return (0.) ;
    npiv = Numeric->npiv ;
    Lpos = Numeric->Lpos ;
    Lilen = Numeric->Lilen ;
    Lip = Numeric->Lip ;
    kstart = npiv ;

#ifndef NDEBUG
    DEBUG4 (("Ltsolve start:\n")) ;
    for (j = 0 ; j < Numeric->n_row ; j++)
    {
	DEBUG4 (("Ltsolve start "ID": ", j)) ;
	EDEBUG4 (X [j]) ;
	DEBUG4 (("\n")) ;
    }
#endif

    for (kend = npiv-1 ; kend >= 0 ; kend = kstart-1)
    {

	/* ------------------------------------------------------------------ */
	/* find the start of this Lchain */
	/* ------------------------------------------------------------------ */

	/* for (kstart = kend ; kstart >= 0 && Lip [kstart] > 0 ; kstart--) ; */
	kstart = kend ;
	while (kstart >= 0 && Lip [kstart] > 0)
	{
	    kstart-- ;
	}

	/* the Lchain goes from kstart to kend */

	/* ------------------------------------------------------------------ */
	/* scan the whole chain to find the pattern of the last column of L */
	/* ------------------------------------------------------------------ */

	deg = 0 ;
	DEBUG4 (("start of chain for column of L\n")) ;
	for (k = kstart ; k <= kend ; k++)
	{
	    ASSERT (k >= 0 && k < npiv) ;

	    /* -------------------------------------------------------------- */
	    /* make column k of L in Pattern [0..deg-1] */
	    /* -------------------------------------------------------------- */

	    /* remove pivot row */
	    pos = Lpos [k] ;
	    if (pos != EMPTY)
	    {
		DEBUG4 (("  k "ID" removing row "ID" at position "ID"\n",
		k, Pattern [pos], pos)) ;
		ASSERT (k != kstart) ;
		ASSERT (deg > 0) ;
		ASSERT (pos >= 0 && pos < deg) ;
		ASSERT (Pattern [pos] == k) ;
		Pattern [pos] = Pattern [--deg] ;
	    }

	    /* concatenate the pattern */
	    lp = Lip [k] ;
	    if (k == kstart)
	    {
		lp = -lp ;
	    }
	    ASSERT (lp > 0) ;
	    ip = (Int *) (Numeric->Memory + lp) ;
	    llen = Lilen [k] ;
	    for (j = 0 ; j < llen ; j++)
	    {
		row = *ip++ ;
		DEBUG4 (("  row "ID"  k "ID"\n", row, k)) ;
		ASSERT (row > k) ;
		Pattern [deg++] = row ;
	    }

	}
	/* Pattern [0..deg-1] is now the pattern of column kend */

	/* ------------------------------------------------------------------ */
	/* solve using this chain, in reverse order */
	/* ------------------------------------------------------------------ */

	DEBUG4 (("Unwinding Lchain\n")) ;
	for (k = kend ; k >= kstart ; k--)
	{

	    /* -------------------------------------------------------------- */
	    /* use column k of L */
	    /* -------------------------------------------------------------- */

	    ASSERT (k >= 0 && k < npiv) ;
	    lp = Lip [k] ;
	    if (k == kstart)
	    {
		lp = -lp ;
	    }
	    ASSERT (lp > 0) ;
	    llen = Lilen [k] ;
	    xp = (Entry *) (Numeric->Memory + lp + UNITS (Int, llen)) ;
	    xk = X [k] ;
	    for (j = 0 ; j < deg ; j++)
	    {
		DEBUG4 (("  row "ID"  k "ID" value", Pattern [j], k)) ;
		EDEBUG4 (*xp) ;
		DEBUG4 (("\n")) ;
#ifdef CONJUGATE_SOLVE
		/* xk -= X [Pattern [j]] * conjugate (*xp) ; */
		MULT_SUB_CONJ (xk, X [Pattern [j]], *xp) ;
#else
		/* xk -= X [Pattern [j]] * (*xp) ; */
		MULT_SUB (xk, X [Pattern [j]], *xp) ;
#endif
		xp++ ;
	    }
	    X [k] = xk ;

	    /* -------------------------------------------------------------- */
	    /* construct column k-1 of L */
	    /* -------------------------------------------------------------- */

	    /* un-concatenate the pattern */
	    deg -= llen ;

	    /* add pivot row */
	    pos = Lpos [k] ;
	    if (pos != EMPTY)
	    {
		DEBUG4 (("  k "ID" adding row "ID" at position "ID"\n",
		k, k, pos)) ;
		ASSERT (k != kstart) ;
		ASSERT (pos >= 0 && pos <= deg) ;
		Pattern [deg++] = Pattern [pos] ;
		Pattern [pos] = k ;
	    }
	}
    }

#ifndef NDEBUG
    for (j = 0 ; j < Numeric->n_row ; j++)
    {
	DEBUG4 (("Ltsolve done "ID": ", j)) ;
	EDEBUG4 (X [j]) ;
	DEBUG4 (("\n")) ;
    }
    DEBUG4 (("Ltsolve done.\n")) ;
#endif

    return (MULTSUB_FLOPS * ((double) Numeric->lnz)) ;
}


```

sparse-matrix/umfpack/umf_get_memory.c:
```
/* ========================================================================== */
/* === UMF_get_memory ======================================================= */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*
    Reallocate the workspace (Numeric->Memory) and shift elements downwards.
    needunits: increase in size so that the free space is at least this many
    Units (to which the tuple lengths is added).

    Return TRUE if successful, FALSE if out of memory.
*/

#include "umf_internal.h"
#include "umf_garbage_collection.h"
#include "umf_tuple_lengths.h"
#include "umf_build_tuples.h"
#include "umf_mem_free_tail_block.h"
#include "umf_realloc.h"

GLOBAL Int UMF_get_memory
(
    NumericType *Numeric,
    WorkType *Work,
    Int needunits
)
{
    Int i, minsize, newsize, newmem, costly, row, col, *Row_tlen, *Col_tlen,
	n_row, n_col, *Row_degree, *Col_degree ;
    Unit *mnew, *p ;
    double nsize, bsize ;

    /* ---------------------------------------------------------------------- */
    /* get and check parameters */
    /* ---------------------------------------------------------------------- */

    ASSERT (Numeric) ;
    ASSERT (Work) ;
    ASSERT (Numeric->Memory) ;

#ifndef NDEBUG
    DEBUG1 (("::::GET MEMORY::::\n")) ;
    UMF_dump_memory (Numeric) ;
#endif

    n_row = Work->n_row ;
    n_col = Work->n_col ;
    Row_degree = Numeric->Rperm ;	/* for NON_PIVOTAL_ROW macro */
    Col_degree = Numeric->Cperm ;	/* for NON_PIVOTAL_COL macro */
    Row_tlen   = Numeric->Uilen ;
    Col_tlen   = Numeric->Lilen ;

    /* ---------------------------------------------------------------------- */
    /* initialize the tuple list lengths */
    /* ---------------------------------------------------------------------- */

    for (row = 0 ; row < n_row ; row++)
    {
	if (NON_PIVOTAL_ROW (row))
	{
	    Row_tlen [row] = 0 ;
	}
    }
    for (col = 0 ; col < n_col ; col++)
    {
	if (NON_PIVOTAL_COL (col))
	{
	    Col_tlen [col] = 0 ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* determine how much memory is needed for the tuples */
    /* ---------------------------------------------------------------------- */

    nsize = (double) needunits + 2 ;
    needunits += UMF_tuple_lengths (Numeric, Work, &nsize) ;
    needunits += 2 ;	/* add 2, so that newmem >= 2 is true if realloc'd */

    /* note: Col_tlen and Row_tlen are updated, but the tuple lists */
    /* themselves are not.  Do not attempt to scan the tuple lists. */
    /* They are now stale, and are about to be destroyed and recreated. */

    /* ---------------------------------------------------------------------- */
    /* determine the desired new size of memory */
    /* ---------------------------------------------------------------------- */

    DEBUG0 (("UMF_get_memory: needunits: "ID"\n", needunits)) ;

    minsize = Numeric->size + needunits ;
    nsize += (double) Numeric->size ;

    bsize = ((double) Int_MAX) / sizeof (Unit) - 1 ;

    if (nsize > bsize)	    /* a double relop, but ignore NaN case */
    {
	return (FALSE) ;	/* the minimum size is larger than Int_MAX */
    }

    newsize = (Int) (UMF_REALLOC_INCREASE * ((double) minsize)) ;
    nsize *= UMF_REALLOC_INCREASE * (1.0 + MAX_EPSILON) ;

    if (newsize < 0 || nsize > bsize)
    {
	newsize = (Int) bsize ;	/* we cannot increase the size beyond bsize */
    }
    else
    {
	newsize = MAX (newsize, minsize) ;
    }

    DEBUG0 ((
    "REALLOC MEMORY: needunits "ID" old size: "ID" new size: "ID" Units \n",
	needunits, Numeric->size, newsize)) ;

    /* Forget where the biggest free block is (we no longer need it) */
    /* since garbage collection will occur shortly. */
    Numeric->ibig = EMPTY ;

    /* ---------------------------------------------------------------------- */
    /* reallocate the memory, if possible, and make it bigger */
    /* ---------------------------------------------------------------------- */

    mnew = (Unit *) NULL ;
    while (!mnew)
    {
	mnew = (Unit *) UMF_realloc (Numeric->Memory, newsize, sizeof (Unit)) ;
	if (!mnew)
	{
	    if (newsize == minsize)	/* last realloc attempt failed */
	    {
		/* We failed to get the minimum.  Just stick with the */
		/* current allocation and hope that garbage collection */
		/* can recover enough space. */
		mnew = Numeric->Memory ;	/* no new memory available */
		newsize = Numeric->size ;
	    }
	    else
	    {
		/* otherwise, reduce the request and keep trying */
		newsize = (Int) (UMF_REALLOC_REDUCTION * ((double) newsize)) ;
		newsize = MAX (minsize, newsize) ;
	    }
	}
    }
    ASSERT (mnew) ;

    /* see if realloc had to copy, rather than just extend memory */
    costly = (mnew != Numeric->Memory) ;

    /* ---------------------------------------------------------------------- */
    /* extend the tail portion of memory downwards */
    /* ---------------------------------------------------------------------- */

    Numeric->Memory = mnew ;

    newmem = newsize - Numeric->size ;
    ASSERT (newmem == 0 || newmem >= 2) ;

    if (newmem >= 2)
    {
	/* reallocation succeeded */

	/* point to the old tail marker block of size 1 + header */
	p = Numeric->Memory + Numeric->size - 2 ;

	/* create a new block out of the newly extended memory */
	p->header.size = newmem - 1 ;
	i = Numeric->size - 1 ;
	p += newmem ;

	/* create a new tail marker block */
	p->header.prevsize = newmem - 1 ;
	p->header.size = 1 ;

	Numeric->size = newsize ;

	/* free the new block */
	UMF_mem_free_tail_block (Numeric, i) ;

	Numeric->nrealloc++ ;

	if (costly)
	{
	    Numeric->ncostly++ ;
	}

    }
    DEBUG1 (("Done with realloc memory\n")) ;

    /* ---------------------------------------------------------------------- */
    /* garbage collection on the tail of Numeric->memory (destroys tuples) */
    /* ---------------------------------------------------------------------- */

    UMF_garbage_collection (Numeric, Work) ;

    /* ---------------------------------------------------------------------- */
    /* rebuild the tuples */
    /* ---------------------------------------------------------------------- */

    return (UMF_build_tuples (Numeric, Work)) ;

}


```

sparse-matrix/umfpack/umf_solve.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL Int UMF_solve
(
    Int sys,
    const Int Ap [ ],
    const Int Ai [ ],
    const double Ax [ ],
    double Xx [ ],
    const double Bx [ ],
#ifdef COMPLEX
    const double Az [ ],
    double Xz [ ],
    const double Bz [ ],
#endif
    NumericType *Numeric,
    Int irstep,
    double Info [UMFPACK_INFO],
    Int Pattern [ ],
    double SolveWork [ ]
) ;


```

sparse-matrix/umfpack/umf_apply_order.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL void UMF_apply_order
(
    Int Front [ ],
    const Int Order [ ],
    Int Temp [ ],
    Int n_col,
    Int nfr
) ;


```

sparse-matrix/umfpack/umf_dump.c:
```
/* ========================================================================== */
/* === UMF_dump ============================================================= */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/* These routines, and external variables, are used only when debugging. */
/* If debugging is disabled (for normal operation) then this entire file */
/* becomes empty */

#include "umf_internal.h"

#ifndef NDEBUG

/* These global debugging variables and arrays do not exist if debugging */
/* is disabled at compile time (which is the default). */
GLOBAL Int UMF_debug = -1 ;
GLOBAL Int UMF_nbug = -999 ;
GLOBAL Int UMF_fbug = -999 ;
GLOBAL Int UMF_allocfail = FALSE ;
GLOBAL double UMF_gprob = -1.0 ;

/* static debugging arrays used only in UMF_dump_rowcol */
PRIVATE Int UMF_DBflag = 0 ;
PRIVATE Int UMF_DBpacked [UMF_DBMAX+1] ;
PRIVATE Int UMF_DBscatter [UMF_DBMAX+1] ;

/* ========================================================================== */
/* === UMF_DBinit =========================================================== */
/* ========================================================================== */

/* clear the debugging arrays */

PRIVATE void UMF_DBinit
(
    void
)
{
    Int i ;

    /* Int_MAX is defined in umfpack.h */
    if (UMF_DBflag < 1 || UMF_DBflag == Int_MAX)
    {
	/* clear the debugging arrays */
	UMF_DBflag = 0 ;
	for (i = 0 ; i <= UMF_DBMAX ; i++)
	{
	    UMF_DBscatter [i] = 0 ;
	    UMF_DBpacked  [i] = 0 ;
	}
    }

    UMF_DBflag++ ;

    /* UMF_DBflag > UMF_DBscatter [0...UMF_DBmax] is now true */
}

/* ========================================================================== */
/* === UMF_dump_dense ======================================================= */
/* ========================================================================== */

GLOBAL void UMF_dump_dense
(
    Entry *Fx,
    Int dim,
    Int m,
    Int n
)
{

    /* dump Fx [1..m,1..n], with column dimenstion dim */
    Int i, j;

    if (UMF_debug < 7) return ;
    if (!Fx)
    {
	DEBUG7 (("No dense matrix allocated\n")) ;
	return ;
    }
    DEBUG8 ((" dimension= "ID" rows= "ID" cols= "ID"\n", dim, m, n)) ;

    for (i = 0 ; i < m ; i++)
    {
	DEBUG9 ((ID": ", i)) ;
	for (j = 0 ; j < n ; j++)
	{
	    EDEBUG9 (Fx [i+j*dim]) ;
	    if (j % 6 == 5) DEBUG9 (("\n     ")) ;
	}
	DEBUG9 (("\n")) ;
    }

    for (i = 0 ; i < m ; i++)
    {
	for (j = 0 ; j < n ; j++)
	{
	    if (IS_ZERO (Fx [i+j*dim]))
	    {
		DEBUG8 ((".")) ;
	    }
	    else
	    {
		DEBUG8 (("X")) ;
	    }
	}
	DEBUG8 (("\n")) ;
    }
}

/* ========================================================================== */
/* === UMF_dump_element ===================================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_element
(
    NumericType *Numeric,
    WorkType *Work,
    Int e,
    Int clean
)
{

    Int i, j, k, *Rows, *Cols, nrows, ncols, *E, row, col,
	*Row_degree, *Col_degree ;
    Entry *C ;
    Element *ep ;
    Unit *p ;

    if (UMF_debug < 7) return ;
    DEBUG7 (("\n====================ELEMENT: "ID" ", e)) ;
    if (!Numeric || !Work || !Numeric->Memory)
    {
	DEBUG7 ((" No Numeric, Work\n")) ;
	return ;
    }
    DEBUG7 ((" nel: "ID" of "ID, e, Work->nel)) ;
    if (e <= Work->nelorig) DEBUG7 ((" Original ")) ;
    E = Work->E ;
    if (!E)
    {
	DEBUG7 ((" No elements\n")) ;
	return ;
    }
    if (e < 0 || e > Work->nel)
    {
	DEBUG7 (("e out of range!\n")) ;
	return ;
    }
    if (!E [e])
    {
	DEBUG7 ((" deallocated\n")) ;
	return ;
    }
    DEBUG7 (("\n")) ;
    Col_degree = Numeric->Cperm ;
    Row_degree = Numeric->Rperm ;

    p = Numeric->Memory + E [e] ;
    DEBUG7 (("ep "ID"\n", p-Numeric->Memory)) ;
    GET_ELEMENT (ep, p, Cols, Rows, ncols, nrows, C) ;
    DEBUG7 (("nrows "ID" nrowsleft "ID"\n", nrows, ep->nrowsleft)) ;
    DEBUG7 (("ncols "ID" ncolsleft "ID"\n", ncols, ep->ncolsleft)) ;
    DEBUG7 (("cdeg-cdeg0 "ID" rdeg-rdeg0 "ID" next "ID"\n",
    ep->cdeg - Work->cdeg0, ep->rdeg - Work->rdeg0, ep->next)) ;

    DEBUG8 (("rows: ")) ;
    k = 0 ;
    for (i = 0 ; i < ep->nrows ; i++)
    {
	row = Rows [i] ;
	if (row >= 0)
	{
	    DEBUG8 ((" "ID, row)) ;
	    ASSERT (row < Work->n_row) ;
	    if ((k++ % 10) == 9) DEBUG8 (("\n")) ;
	    ASSERT (IMPLIES (clean, NON_PIVOTAL_ROW (row))) ;
	}
    }

    DEBUG8 (("\ncols: ")) ;
    k = 0 ;
    for (j = 0 ; j < ep->ncols ; j++)
    {
	col = Cols [j] ;
	if (col >= 0)
	{
	    DEBUG8 ((" "ID, col)) ;
	    ASSERT (col < Work->n_col) ;
	    if ((k++ % 10) == 9) DEBUG8 (("\n")) ;
	    ASSERT (IMPLIES (clean, NON_PIVOTAL_COL (col))) ;
	}
    }

    DEBUG8 (("\nvalues:\n")) ;
    if (UMF_debug >= 9)
    {
	for (i = 0 ; i < ep->nrows ; i++)
	{
	    row = Rows [i] ;
	    if (row >= 0)
	    {
		DEBUG9 ((ID": ", row)) ;
		k = 0 ;
		for (j = 0 ; j < ep->ncols ; j++)
		{
		    col = Cols [j] ;
		    if (col >= 0)
		    {
			EDEBUG9 (C [i+j*ep->nrows]) ;
			if (k++ % 6 == 5) DEBUG9 (("\n     ")) ;
		    }
		}
		DEBUG9 (("\n")) ;
	    }
	}
    }

    DEBUG7 (("====================\n")) ;
}


/* ========================================================================== */
/* === UMF_dump_rowcol ====================================================== */
/* ========================================================================== */

/* dump a row or a column, from one or more memory spaces */
/* return exact degree */

GLOBAL void UMF_dump_rowcol
(
    Int dumpwhich,		/* 0 for row, 1 for column */
    NumericType *Numeric,
    WorkType *Work,
    Int dumpindex,		/* row or column index to dump */
    Int check_degree	/* true if degree is to be checked */
)
{
    Int f, nrows, j, jj, len, e, deg, index, n_row, n_col, *Cols, *Rows, nn,
	dumpdeg, ncols, preve, *E, tpi, *Pattern, approx_deg, not_in_use ;
    Tuple *tp, *tend ;
    Element *ep ;
    Int *Row_tuples, *Row_degree, *Row_tlen ;
    Int *Col_tuples, *Col_degree, *Col_tlen ;
    Entry value, *C ;
    Unit *p ;
    Int is_there ;

    /* clear the debugging arrays */
    UMF_DBinit () ;

    if (dumpwhich == 0)
    {
	DEBUG7 (("\n====================ROW: "ID, dumpindex)) ;
    }
    else
    {
	DEBUG7 (("\n====================COL: "ID, dumpindex)) ;
    }

    if (dumpindex == EMPTY)
    {
	DEBUG7 ((" (EMPTY)\n")) ;
	return ;
    }

    deg = 0 ;
    approx_deg = 0 ;

    if (!Numeric || !Work)
    {
	DEBUG7 ((" No Numeric, Work\n")) ;
	return ;
    }

    n_row = Work->n_row ;
    n_col = Work->n_col ;
    nn = MAX (n_row, n_col) ;
    E = Work->E ;

    Col_degree = Numeric->Cperm ;
    Row_degree = Numeric->Rperm ;

    Row_tuples = Numeric->Uip ;
    Row_tlen   = Numeric->Uilen ;
    Col_tuples = Numeric->Lip ;
    Col_tlen   = Numeric->Lilen ;

	if (!E
	|| !Row_tuples || !Row_degree || !Row_tlen
	|| !Col_tuples || !Col_degree || !Col_tlen)
	{
	    DEBUG7 ((" No E, Rows, Cols\n")) ;
	    return ;
	}

	if (dumpwhich == 0)
	{
	    /* dump a row */
	    ASSERT (dumpindex >= 0 && dumpindex < n_row) ;
	    if (!NON_PIVOTAL_ROW (dumpindex))
	    {
		DEBUG7 ((" Pivotal\n")) ;
		return ;
	    }
	    len = Row_tlen [dumpindex] ;
	    dumpdeg = Row_degree [dumpindex] ;
	    tpi = Row_tuples [dumpindex] ;
	}
	else
	{
	    /* dump a column */
	    ASSERT (dumpindex >= 0 && dumpindex < n_col) ;
	    if (!NON_PIVOTAL_COL (dumpindex))
	    {
		DEBUG7 ((" Pivotal\n")) ;
		return ;
	    }
	    len = Col_tlen [dumpindex] ;
	    dumpdeg = Col_degree [dumpindex] ;
	    tpi = Col_tuples [dumpindex] ;
	}

	p = Numeric->Memory + tpi ;
	tp = (Tuple *) p ;
	if (!tpi)
	{
	    DEBUG7 ((" Nonpivotal, No tuple list tuples "ID" tlen "ID"\n",
		tpi, len)) ;
	    return ;
	}
	ASSERT (p >= Numeric->Memory + Numeric->itail) ;
	ASSERT (p <  Numeric->Memory + Numeric->size) ;

	DEBUG7 ((" degree: "ID" len: "ID"\n", dumpdeg, len)) ;
	not_in_use = (p-1)->header.size - UNITS (Tuple, len) ;
	DEBUG7 ((" Tuple list: p+1: "ID" size: "ID" units, "ID" not in use\n",
		p-Numeric->Memory, (p-1)->header.size, not_in_use)) ;
	ASSERT (not_in_use >= 0) ;
	tend = tp + len ;
	preve = 0 ;
	for ( ; tp < tend ; tp++)
	{
	    /* row/col of element e, offset is f: */
	    /* DEBUG8 (("    (tp="ID")\n", tp)) ; */
	    e = tp->e ;
	    f = tp->f ;
	    DEBUG8 (("    (e="ID", f="ID")\n", e, f)) ;
	    ASSERT (e > 0 && e <= Work->nel) ;
	    /* dump the pattern and values */
	    if (E [e])
	    {
		p = Numeric->Memory + E [e] ;
		GET_ELEMENT (ep, p, Cols, Rows, ncols, nrows, C) ;
		if (dumpwhich == 0)
		{
		    Pattern = Cols ;
		    jj = ep->ncols ;
		    is_there = Rows [f] >= 0 ;
		    if (is_there) approx_deg += ep->ncolsleft ;
		}
		else
		{
		    Pattern = Rows ;
		    jj = ep->nrows ;
		    is_there = Cols [f] >= 0 ;
		    if (is_there) approx_deg += ep->nrowsleft ;
		}
		if (!is_there)
		{
			DEBUG8 (("\t\tnot present\n")) ;
		}
		else
		{
		    for (j = 0 ; j < jj ; j++)
		    {
			index = Pattern [j] ;
			value =
			    C [ (dumpwhich == 0) ? (f+nrows*j) : (j+nrows*f) ] ;
			if (index >= 0)
			{
			    DEBUG8 (("\t\t"ID":", index)) ;
			    EDEBUG8 (value) ;
			    DEBUG8 (("\n")) ;
			    if (dumpwhich == 0)
			    {
				/* col must be in the range 0..n_col-1 */
				ASSERT (index < n_col) ;
			    }
			    else
			    {
				/* row must be in the range 0..n_row-1 */
				ASSERT (index < n_row) ;
			    }

			    if (nn <= UMF_DBMAX)
			    {
				if (UMF_DBscatter [index] != UMF_DBflag)
				{
				    UMF_DBpacked [deg++] = index ;
				    UMF_DBscatter [index] = UMF_DBflag ;
				}
			    }
			}
		    }
		}
		/* the (e,f) tuples should be in order of their creation */
		/* this means that garbage collection will not jumble them */
		ASSERT (preve < e) ;
		preve = e ;
	    }
	    else
	    {
		DEBUG8 (("\t\tdeallocated\n")) ;
	    }
	}

    if (nn <= UMF_DBMAX)
    {
	if (deg > 0)
	{
	    DEBUG7 ((" Assembled, actual deg: "ID" : ", deg)) ;
	    for (j = 0 ; j < deg ; j++)
	    {
		index = UMF_DBpacked [j] ;
		DEBUG8 ((ID" ", index)) ;
		if (j % 20 == 19) DEBUG8 (("\n ")) ;
		ASSERT (UMF_DBscatter [index] == UMF_DBflag) ;
	    }
	    DEBUG7 (("\n")) ;
	}
    }

    if (check_degree)
    {
	DEBUG8 (("  approx_deg "ID"  dumpdeg "ID"\n", approx_deg, dumpdeg)) ;
	ASSERT (approx_deg == dumpdeg) ;
    }

    DEBUG7 (("====================\n")) ;

    /* deg is now the exact degree */
    /* if nn <= UMF_DBMAX, then UMF_DBscatter [i] == UMF_DBflag for every i */
    /* in the row or col, and != UMF_DBflag if not */

    return ;
}


/* ========================================================================== */
/* === UMF_dump_matrix ====================================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_matrix
(
    NumericType *Numeric,
    WorkType *Work,
    Int check_degree
)
{

    Int e, row, col, intfrag, frag, n_row, n_col, *E, fullsize, actualsize ;
    Element *ep ;
    Unit *p ;

    DEBUG6 (("=================================================== MATRIX:\n")) ;
    if (!Numeric || !Work)
    {
	DEBUG6 (("No Numeric or Work allocated\n")) ;
	return ;
    }
    if (!Numeric->Memory)
    {
	DEBUG6 (("No Numeric->Memory\n")) ;
	return ;
    }

	n_row = Work->n_row ;
	n_col = Work->n_col ;
	DEBUG6 (("n_row "ID" n_col "ID" nz "ID"\n", n_row, n_col, Work->nz)) ;
	DEBUG6 (("============================ ELEMENTS: "ID" \n", Work->nel)) ;
	intfrag = 0 ;
	E = Work->E ;
	if (!E)
	{
	    DEBUG6 (("No elements allocated\n")) ;
	}
	else
	{
	    for (e = 0 ; e <= Work->nel ; e++)
	    {
		UMF_dump_element (Numeric, Work, e, FALSE) ;
		if (e > 0 && E [e])
		{
		    p = Numeric->Memory + E [e] ;
		    ep = (Element *) p ;
		    ASSERT (ep->nrowsleft > 0 || ep->ncolsleft > 0) ;
		    fullsize = GET_BLOCK_SIZE (p) ;
		    actualsize = GET_ELEMENT_SIZE (ep->nrowsleft,ep->ncolsleft);
		    frag =  fullsize - actualsize ;
		    intfrag += frag ;
		    DEBUG7 (("dump el: "ID", full "ID" actual "ID" frag: "ID
			" intfrag: "ID"\n", e, fullsize, actualsize, frag,
			intfrag)) ;
		}
	    }
	}

	DEBUG6 (("CURRENT INTERNAL FRAG in elements: "ID" \n", intfrag)) ;



    DEBUG6 (("======================================== ROWS: "ID"\n", n_row)) ;
    UMF_debug -= 2 ;
    for (row = 0 ; row < n_row ; row++)
    {
	UMF_dump_rowcol (0, Numeric, Work, row, check_degree) ;
    }
    UMF_debug += 2 ;
    DEBUG6 (("======================================== COLS: "ID"\n", n_col)) ;
    UMF_debug -= 2 ;
    for (col = 0 ; col < n_col ; col++)
    {
	UMF_dump_rowcol (1, Numeric, Work, col, check_degree) ;
    }
    UMF_debug += 2 ;
    DEBUG6 (("============================================= END OF MATRIX:\n"));
}


/* ========================================================================== */
/* === UMF_dump_current_front =============================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_current_front
(
    NumericType *Numeric,
    WorkType *Work,
    Int check
)
{
    Entry *Fx ;
    Int fnrows_max, fncols_max, fnrows, fncols, fnpiv, *Frows, *Fcols,
	i, j, *Fcpos, *Frpos ;
    if (!Work) return ;
    DEBUG7 (("\n\n========CURRENT FRONTAL MATRIX:\n")) ;

    Fx = Work->Fx ;
    Frows = Work->Frows ;
    Fcols = Work->Fcols ;
    Frpos = Work->Frpos ;
    Fcpos = Work->Fcpos ;
    fnrows_max = Work->fnrows_max ;
    fncols_max = Work->fncols_max ;
    fnrows = Work->fnrows ;
    fncols = Work->fncols ;
    fnpiv = Work->fnpiv ;

    DEBUG6 (("=== fnpiv= "ID"\n", fnpiv)) ;
    DEBUG6 (("fncols_max      fnrows_max "ID" "ID"\n", fncols_max,fnrows_max)) ;
    DEBUG6 (("fncols          fnrows     "ID" "ID"\n", fncols, fnrows)) ;
    DEBUG6 (("Pivot row pattern:\n")) ;
    for (j = 0 ; j < fncols ; j++)
    {
	DEBUG7 ((ID" "ID" "ID" "ID"\n", j, Fcols [j], Fcpos [Fcols [j]],
	    j < fncols)) ;
	if (check)
	{
	    ASSERT (Fcols [j] >= 0 && Fcols [j] < Work->n_col) ;
	}
	ASSERT (Fcpos [Fcols [j]] == j * fnrows_max) ;
    }
    DEBUG6 (("Pivot col pattern:\n")) ;
    for (i = 0 ; i < fnrows ; i++)
    {
	DEBUG7 ((ID" "ID" "ID" "ID"\n", i, Frows [i], Frpos [Frows [i]],
	    i < fnrows)) ;
	if (check)
	{
	    ASSERT (Frows [i] >= 0 && Frows [i] < Work->n_row) ;
	}
	ASSERT (Frpos [Frows [i]] == i) ;
    }
    if (UMF_debug < 7) return ;

    DEBUG7 (("C  block: ")) ;
    UMF_dump_dense (Fx, fnrows_max, fnrows, fncols) ;
    DEBUG7 (("L  block: ")) ;
    UMF_dump_dense (Fx+(fncols_max-fnpiv)*fnrows_max, fnrows_max, fnrows,fnpiv);
    DEBUG7 (("U  block: ")) ;
    UMF_dump_dense (Fx+(fnrows_max-fnpiv), fnrows_max, fnpiv, fncols) ;
    if (fnpiv > 0)
    {
	DEBUG7 (("Pivot entry: ")) ;
	EDEBUG7 (Fx [(fnrows_max-fnpiv)+(fncols_max-fnpiv)*fnrows_max]) ;
	DEBUG7 (("\n")) ;
    }
}

/* ========================================================================== */
/* === UMF_dump_lu ========================================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_lu
(
    NumericType *Numeric
)
{
    Int i, n_row, n_col, *Cperm, *Rperm ;

    DEBUG6 (("=============================================== LU factors:\n")) ;
    if (!Numeric)
    {
	DEBUG6 (("No LU factors allocated\n")) ;
	return ;
    }
    n_row = Numeric->n_row ;
    n_col = Numeric->n_col ;
    DEBUG6 (("n_row: "ID" n_col: "ID"\n", n_row, n_col)) ;
    DEBUG6 (("nLentries: "ID" nUentries: "ID"\n",
	Numeric->nLentries, Numeric->nUentries)) ;

    if (Numeric->Cperm)
    {
	Cperm = Numeric->Cperm ;
	DEBUG7 (("Column permutations: (new: old)\n")) ;
	for (i = 0 ; i < n_col ; i++)
	{
	    if (Cperm [i] != EMPTY)
	    {
		DEBUG7 ((ID": "ID"\n", i, Cperm [i])) ;
	    }
	}
    }
    else
    {
	DEBUG7 (("No Numeric->Cperm allocatated\n")) ;
    }

    if (Numeric->Rperm)
    {
	Rperm = Numeric->Rperm ;
	DEBUG7 (("row permutations: (new: old)\n")) ;
	for (i = 0 ; i < n_row ; i++)
	{
	    if (Rperm [i] != EMPTY)
	    {
		DEBUG7 ((ID": "ID"\n", i, Rperm [i])) ;
	    }
	}
    }
    else
    {
	DEBUG7 (("No Numeric->Rperm allocatated\n")) ;
    }

    DEBUG6 (("========================================= END OF LU factors:\n"));
}


/* ========================================================================== */
/* === UMF_dump_memory ====================================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_memory
(
    NumericType *Numeric
)
{

    Unit *p ;
    Int prevsize, s ;
    Int found ;

    if (!Numeric)
    {
	DEBUG6 (("No memory space S allocated\n")) ;
	return ;
    }

    DEBUG6 (("\n ============================================== MEMORY:\n")) ;
    if (!Numeric || !Numeric->Memory)
    {
	DEBUG6 (("No memory space Numeric allocated\n")) ;
	return ;
    }

    DEBUG6 (("S: "ID"\n", (Int) Numeric)) ;
    DEBUG6 (("S->ihead           : "ID"\n", Numeric->ihead)) ;
    DEBUG6 (("S->itail           : "ID"\n", Numeric->itail)) ;
    DEBUG6 (("S->size            : "ID"\n", Numeric->size)) ;
    DEBUG6 (("S->ngarbage        : "ID"\n", Numeric->ngarbage)) ;
    DEBUG6 (("S->nrealloc        : "ID"\n", Numeric->nrealloc)) ;
    DEBUG6 (("   in use at head           : "ID"\n", Numeric->ihead)) ;
    DEBUG6 (("   free space               : "ID"\n",
	Numeric->itail - Numeric->ihead)) ;
    DEBUG6 (("   blocks in use at tail    : "ID"\n",
	Numeric->size - Numeric->itail)) ;
    DEBUG6 (("   total in use             : "ID"\n",
	Numeric->size - (Numeric->itail - Numeric->ihead))) ;

    prevsize = 0 ;
    found = FALSE ;

    ASSERT (0 <= Numeric->ihead) ;
    ASSERT (Numeric->ihead <= Numeric->itail) ;
    ASSERT (Numeric->itail <= Numeric->size) ;

    p = Numeric->Memory + Numeric->itail ;

    while (p < Numeric->Memory + Numeric->size)
    {
	DEBUG8 (("p: "ID" p+1: "ID" prevsize: "ID" size: "ID,
	    p-Numeric->Memory, p+1-Numeric->Memory,
	    p->header.prevsize, p->header.size)) ;
	if (p->header.size < 0)
	{
	    DEBUG8 ((" free")) ;
	}

	if (p == Numeric->Memory + Numeric->itail)
	{
	    ASSERT (p->header.prevsize == 0) ;
	}
	else
	{
	    ASSERT (p->header.prevsize > 0) ;
	}

	ASSERT (p->header.size != 0) ;
	s = prevsize >= 0 ? prevsize : -prevsize ;
	ASSERT (p->header.prevsize == s) ;
	/* no adjacent free blocks */
	ASSERT (p->header.size > 0 || prevsize > 0) ;
	if (Numeric->ibig != EMPTY)
	{
	    if (p == Numeric->Memory + Numeric->ibig)
	    {
		ASSERT (p->header.size < 0) ;
		DEBUG8 ((" <===== Numeric->ibig")) ;
		found = TRUE ;
	    }
	}
	s = p->header.size ;
	prevsize = s ;
	s = s >= 0 ? s : -s ;
	p = p + 1 + s ;
	DEBUG8 (("\n")) ;
    }

    ASSERT (p == Numeric->Memory + Numeric->size) ;
    ASSERT (IMPLIES (Numeric->ibig != EMPTY, found)) ;
    DEBUG6 (("============================================= END OF MEMORY:\n"));

}


/* ========================================================================== */
/* === UMF_dump_packed_memory =============================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_packed_memory
(
    NumericType *Numeric,
    WorkType *Work
)
{
    Unit *p, *p3 ;
    Int prevsize, col, row, *Rows, *Cols, ncols, nrows, k, esize,
	*Row_tuples, *Row_degree, *Col_tuples, *Col_degree ;
    Entry *C ;
    Element *ep ;

    Col_degree = Numeric->Cperm ;
    Row_degree = Numeric->Rperm ;
    Row_tuples = Numeric->Uip ;
    Col_tuples = Numeric->Lip ;

    DEBUG6 (("============================================ PACKED MEMORY:\n")) ;
    if (!Numeric || !Numeric->Memory)
    {
	DEBUG6 (("No memory space S allocated\n")) ;
	return ;
    }
    DEBUG6 (("S: "ID"\n", (Int) Numeric)) ;
    DEBUG6 (("S->ihead           : "ID"\n", Numeric->ihead)) ;
    DEBUG6 (("S->itail           : "ID"\n", Numeric->itail)) ;
    DEBUG6 (("S->size            : "ID"\n", Numeric->size)) ;
    DEBUG6 (("S->ngarbage        : "ID"\n", Numeric->ngarbage)) ;
    DEBUG6 (("S->nrealloc        : "ID"\n", Numeric->nrealloc)) ;
    DEBUG6 (("   in use at head           : "ID"\n", Numeric->ihead)) ;
    DEBUG6 (("   free space               : "ID"\n",
	Numeric->itail - Numeric->ihead)) ;
    DEBUG6 (("   blocks in use at tail    : "ID"\n",
	Numeric->size - Numeric->itail)) ;
    DEBUG6 (("   total in use             : "ID"\n",
	Numeric->size - (Numeric->itail - Numeric->ihead))) ;

    ASSERT (0 <= Numeric->ihead) ;
    ASSERT (Numeric->ihead <= Numeric->itail) ;
    ASSERT (Numeric->itail <= Numeric->size) ;

    for (row = 0 ; row < Work->n_row ; row++)
    {
	ASSERT (IMPLIES (NON_PIVOTAL_ROW (row), !Row_tuples [row])) ;
    }
    for (col = 0 ; col < Work->n_col ; col++)
    {
	ASSERT (IMPLIES (NON_PIVOTAL_COL (col), !Col_tuples [col])) ;
    }

    prevsize = 0 ;
    p = Numeric->Memory + Numeric->itail ;
    while (p < Numeric->Memory + Numeric->size)
    {
	DEBUG9 (("====================\n")) ;
	DEBUG7 (("p: "ID" p+1: "ID" prevsize: "ID" size: "ID"\n",
	    p-Numeric->Memory, p+1-Numeric->Memory,
	    p->header.prevsize, p->header.size)) ;
	ASSERT (p->header.size > 0) ;

	if (p == Numeric->Memory + Numeric->itail)
	{
	    ASSERT (p->header.prevsize == 0) ;
	}
	else
	{
	    ASSERT (p->header.prevsize > 0) ;
	}

	ASSERT (p->header.prevsize == prevsize) ;
	prevsize = p->header.size ;

	if (p != Numeric->Memory + Numeric->size - 2)
	{

	    p3 = p + 1 ;

	    /* this is a packed element */
	    GET_ELEMENT (ep, p3, Cols, Rows, ncols, nrows, C) ;
	    DEBUG9 (("ep "ID"\n nrows "ID" ncols "ID"\n",
		(p+1)-Numeric->Memory, ep->nrows, ep->ncols)) ;
	    DEBUG9 (("rows:")) ;
	    for (k = 0 ; k < ep->nrows; k++)
	    {
		row = Rows [k] ;
		DEBUG9 ((" "ID, row)) ;
		ASSERT (row >= 0 && row <= Work->n_row) ;
		if ((k % 10) == 9) DEBUG9 (("\n")) ;
	    }
	    DEBUG9 (("\ncols:")) ;
	    for (k = 0 ; k < ep->ncols; k++)
	    {
		col = Cols [k] ;
		DEBUG9 ((" "ID, col)) ;
		ASSERT (col >= 0 && col <= Work->n_col) ;
		if ((k % 10) == 9) DEBUG9 (("\n")) ;
	    }
	    DEBUG9 (("\nvalues: ")) ;
	    if (UMF_debug >= 9)
	    {
		UMF_dump_dense (C, ep->nrows, ep->nrows, ep->ncols) ;
	    }
	    esize = GET_ELEMENT_SIZE (ep->nrows, ep->ncols) ;
	    DEBUG9 (("esize: "ID"\n", esize)) ;
	    ASSERT (esize <= p->header.size) ;

	}
	else
	{
	    /* this is the final marker block */
	    ASSERT (p->header.size == 1) ;
	}
	p = p + 1 + p->header.size ;
    }

    ASSERT (Numeric->ibig == EMPTY) ;
    ASSERT (p == Numeric->Memory + Numeric->size) ;
    DEBUG6 (("======================================END OF PACKED MEMORY:\n")) ;

}

/* ========================================================================== */
/* === UMF_dump_col_matrix ================================================== */
/* ========================================================================== */

/* This code is the same for real or complex matrices. */

GLOBAL void UMF_dump_col_matrix
(
    const double Ax [ ],	/* Ax [0..nz-1]: real values, in column order */
#ifdef COMPLEX
    const double Az [ ],	/* Az [0..nz-1]: imag values, in column order */
#endif
    const Int Ai [ ],		/* Ai [0..nz-1]: row indices, in column order */
    const Int Ap [ ],		/* Ap [0..n_col]: column pointers */
    Int n_row,			/* number of rows of A */
    Int n_col,			/* number of columns of A */
    Int nz			/* number of entries */
)
{
    Int col, p, p1, p2, row ;
    if (!Ai || !Ap) return ;
    DEBUG6 (("============================================ COLUMN FORM:\n")) ;


    ASSERT (n_col >= 0) ;
    nz = Ap [n_col] ;
    DEBUG2 (("UMF_dump_col:  nz "ID"\n", nz)) ;
    DEBUG2 (("n_row "ID"  & "ID"\n", n_row, &n_row)) ;
    DEBUG2 (("n_col "ID"  & "ID"\n", n_col, &n_col)) ;
    DEBUG2 (("Ap   & "ID" to & "ID"\n", Ap, Ap + (n_col+1) - 1)) ;
    DEBUG2 (("Ai   & "ID" to & "ID"\n", Ai, Ai + (nz) - 1)) ;
    if (Ax) DEBUG2 (("Ax   & "ID" to & "ID"\n", Ax, Ax + (nz) - 1)) ;

#ifdef COMPLEX
    if (Az) DEBUG2 (("Az   & "ID" to & "ID"\n", Az, Az + (nz) - 1)) ;
#endif

    DEBUG6 ((" n_row = "ID", n_col ="ID" nz = "ID" Ap [0] "ID", Ap [n] "ID"\n",
	n_row, n_col, nz, Ap [0], Ap [n_col])) ;
    ASSERT (Ap [0] == 0) ;
    ASSERT (Ap [n_col] == nz) ;
    for (col = 0 ; col < n_col ; col++)
    {
	p1 = Ap [col] ;
	p2 = Ap [col+1] ;
	DEBUG6 (("col: "ID", length "ID"\n", col, p2 - p1)) ;
	ASSERT (p2 >= p1) ;
	for (p = p1 ; p < p2 ; p++)
	{
	    row = Ai [p] ;
	    ASSERT (row >= 0 && row < n_row) ;
	    DEBUG6 (("\t"ID" ", row)) ;
	    if (Ax)
	    {
#ifdef COMPLEX
		if (Az)
		{
		    DEBUG6 ((" (%e+%ei) ", Ax [p], Az [p])) ;
		}
		else
		{
		    DEBUG6 ((" %e", Ax [p])) ;
		}
#else
		DEBUG6 ((" %e", Ax [p])) ;
#endif
	    }
	    DEBUG6 (("\n")) ;
	}
    }
    DEBUG6 (("========================================== COLUMN FORM done\n")) ;
}


/* ========================================================================== */
/* === UMF_dump_chain ======================================================= */
/* ========================================================================== */

GLOBAL void UMF_dump_chain
(
    Int frontid,
    Int Front_parent [ ],
    Int Front_npivcol [ ],
    Int Front_nrows [ ],
    Int Front_ncols [ ],
    Int nfr
)
{
    Int i, len = 0 ;

    /* print a list of contiguous parents */
    i = frontid ;
    ASSERT (Front_parent [i] == EMPTY ||
	(Front_parent [i] > i && Front_parent [i] < nfr)) ;

    len++ ;
    DEBUG3 (("Chain:\n	"ID" ["ID","ID"]("ID"-by-"ID")\n", i,
		Front_npivcol [i],
		MIN (Front_npivcol [i], Front_nrows [i]),
		Front_nrows [i],
		Front_ncols [i])) ;

    for (i = frontid ; i < nfr ; i++)
    {
	ASSERT (Front_parent [i] == EMPTY ||
	(Front_parent [i] > i && Front_parent [i] < nfr)) ;
	if (Front_parent [i] == i+1)
	{
	    len++ ;
	    DEBUG3 (("\t"ID" ["ID","ID"]("ID"-by-"ID")\n", i+1,
		Front_npivcol [i+1],
		MIN (Front_npivcol [i+1], Front_nrows [i+1]),
		Front_nrows [i+1],
		Front_ncols [i+1])) ;
	}
	else
	{
	    DEBUG2 (("Length of chain: "ID"\n", len)) ;
	    return ;
	}
    }
}


/* ========================================================================== */
/* === UMF_dump_start ======================================================= */
/* ========================================================================== */

GLOBAL void UMF_dump_start
(
    void
)
{
    FILE *ff ;

    /* get the debug print level from the "debug.umf" file, if it exists */
    UMF_debug = 0 ;
    ff = fopen ("debug.umf", "r") ;
    if (ff)
    {
	(void) fscanf (ff, ID, &UMF_debug) ;
	(void) fclose (ff) ;
    }

    DEBUG0 (("umfpack: debug version (SLOW!) ")) ;

    DEBUG0 ((" BLAS: ")) ;

#if defined (USE_NO_BLAS)
    DEBUG0 (("none.")) ;
#elif defined (USE_C_BLAS)
    DEBUG0 (("C-BLAS.")) ;
#elif defined (USE_MATLAB_BLAS)
    DEBUG0 (("built-in MATLAB BLAS.")) ;
#elif defined (USE_SUNPERF_BLAS)
    DEBUG0 (("Sun Performance Library BLAS.")) ;
#elif defined (USE_SCSL_BLAS)
    DEBUG0 (("SGI SCSL BLAS.")) ;
#elif defined (USE_FORTRAN_BLAS)
    DEBUG0 (("Fortran BLAS.")) ;
#endif

    DEBUG0 ((" MATLAB: ")) ;
#ifdef MATLAB_MEX_FILE
    DEBUG0 (("mexFunction.\n")) ;
#else
#ifdef MATHWORKS
    DEBUG0 (("yes (uses MathWorks internal ut* routines).\n")) ;
#else
    DEBUG0 (("no.\n")) ;
#endif
#endif

    UMF_gprob = -1.0 ;
    ff = fopen ("gprob.umf", "r") ;
    if (ff)
    {
	(void) fscanf (ff, "%lg", &UMF_gprob) ;
	(void) fclose (ff) ;
    }

    if (UMF_gprob > 1.0) UMF_gprob = 1.0 ;
    DEBUG1 (("factor: UMF_gprob: %e UMF_debug "ID"\n", UMF_gprob, UMF_debug)) ;

    DEBUG2 (("sizeof: (bytes / int / Units) \n")) ;
    DEBUG2 (("sizeof (Int)           %u %u %u\n",
    sizeof (Int), sizeof (Int) / sizeof (int), UNITS (Int, 1) )) ;
    DEBUG2 (("sizeof (int)           %u %u %u\n",
    sizeof (int), sizeof (int) / sizeof (int), UNITS (int, 1) )) ;
    DEBUG2 (("sizeof (size_t)        %u %u %u\n",
    sizeof (size_t), sizeof (size_t) / sizeof (size_t), UNITS (size_t, 1) )) ;
    DEBUG2 (("sizeof (long)          %u %u %u\n",
    sizeof (long), sizeof (long) / sizeof (long), UNITS (long, 1) )) ;
    DEBUG2 (("sizeof (double)        %u %u %u\n",
    sizeof (double), sizeof (double) / sizeof (int), UNITS (double, 1) )) ;
    DEBUG2 (("sizeof (Unit)          %u %u %u\n",
    sizeof (Unit), sizeof (Unit) / sizeof (int), UNITS (Unit, 1) )) ;
    DEBUG2 (("sizeof (Entry)         %u %u %u\n",
    sizeof (Entry), sizeof (Entry) / sizeof (int), UNITS (Entry, 1) )) ;
    DEBUG2 (("sizeof (Tuple)         %u %u %u\n",
    sizeof (Tuple), sizeof (Tuple) / sizeof (int), UNITS (Tuple, 1) )) ;
    DEBUG2 (("sizeof (Tuple *)       %u %u %u\n",
    sizeof (Tuple *), sizeof (Tuple *) / sizeof (int), UNITS (Tuple *, 1) )) ;
    DEBUG2 (("sizeof (Element)       %u %u %u\n",
    sizeof (Element), sizeof (Element) / sizeof (int), UNITS (Element, 1) )) ;
    DEBUG2 (("sizeof (Element *)     %u %u %u\n",
    sizeof (Element *), sizeof (Element *) / sizeof (int),
    UNITS (Element *, 1) )) ;
    DEBUG2 (("sizeof (WorkType)      %u %u %u\n",
    sizeof (WorkType), sizeof (WorkType) / sizeof (int),
    UNITS (WorkType, 1) )) ;
    DEBUG2 (("sizeof (NumericType)   %u %u %u\n",
    sizeof (NumericType), sizeof (NumericType) / sizeof (int),
    UNITS (NumericType, 1) )) ;
    DEBUG2 (("sizeof (SymbolicType)  %u %u %u\n",
    sizeof (SymbolicType), sizeof (SymbolicType) / sizeof (int),
    UNITS (SymbolicType, 1) )) ;

}


/* ========================================================================== */
/* === UMF_dump_rowmerge ==================================================== */
/* ========================================================================== */

GLOBAL void UMF_dump_rowmerge
(
    NumericType *Numeric,
    SymbolicType *Symbolic,
    WorkType *Work
)
{
    Int *Front_leftmostdesc, *Front_1strow, *Front_new1strow, row1, row2,
	fleftmost, nfr, n_row, *Row_degree, i, frontid, row ;

    nfr = Symbolic->nfr ;
    DEBUG3 (("\n================== Row merge sets: nfr "ID"\n", nfr)) ;
    Front_leftmostdesc = Symbolic->Front_leftmostdesc ;
    Front_1strow = Symbolic->Front_1strow ;
    Front_new1strow = Work->Front_new1strow ;
    n_row = Symbolic->n_row ;
    Row_degree = Numeric->Rperm ;
    frontid = Work->frontid ;

    for (i = frontid ; i <= nfr ; i++)
    {
	DEBUG3 (("----------------------\n")) ;
	if (i == nfr) DEBUG3 (("Dummy: ")) ;
	DEBUG3 (("Front "ID" 1strow "ID" new1strow "ID" leftmostdesc "ID,
	    i, Front_1strow [i], Front_new1strow [i], Front_leftmostdesc [i])) ;
	DEBUG3 ((" parent "ID" pivcol\n", Symbolic->Front_parent [i],
	    Symbolic->Front_npivcol [i])) ;

	if (i == nfr)
	{
	    fleftmost = -1 ;
	    row1 = Front_new1strow [i] ;
	    row2 = n_row-1 ;
	}
	else
	{
	    fleftmost = Front_leftmostdesc [i] ;
	    row1 = Front_new1strow [fleftmost] ;
	    row2 = Front_1strow [i+1] - 1 ;
	}
	DEBUG3 (("Leftmost: "ID"  Rows ["ID" to "ID"], search ["ID" to "ID"]\n",
	    fleftmost, Front_1strow [i], row2, row1, row2)) ;

	for (row = row1 ; row <= row2 ; row++)
	{
	    ASSERT (row >= 0 && row < n_row) ;
	    DEBUG3 (("   Row "ID"  live: "ID"\n", row, NON_PIVOTAL_ROW (row))) ;
	}
    }
}

#endif /* NDEBUG */

```

sparse-matrix/umfpack/umf_local_search.h:
```
/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

GLOBAL Int UMF_local_search
(
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic
) ;


```

sparse-matrix/umfpack/umfpack_transpose.c:
```
/* ========================================================================== */
/* === UMFPACK_transpose ==================================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 4.0 (Apr 11, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis.  All Rights Reserved.  See README for License.                      */
/* email: davis@cise.ufl.edu    CISE Department, Univ. of Florida.            */
/* web: http://www.cise.ufl.edu/research/sparse/umfpack                       */
/* -------------------------------------------------------------------------- */

/*

    User callable.  Computes a permuted transpose, R = (A (P,Q))' in MATLAB
    notation.  See umfpack_transpose.h for details.  A and R can be rectangular.
    The matrix A may be singular.
    The complex version can do transpose (') or array transpose (.').

    Dynamic memory usage:

	A single call to UMF_malloc is made, for a workspace of size
	max (n_row,n_col,1) * sizeof(Int).  This is then free'd on return,
	via UMF_free.

*/

#include "umf_internal.h"
#include "umf_transpose.h"
#include "umf_malloc.h"
#include "umf_free.h"

#ifndef NDEBUG
PRIVATE Int init_count ;
#endif

/* ========================================================================== */

GLOBAL Int UMFPACK_transpose
(
    Int n_row,
    Int n_col,
    const Int Ap [ ],	/* size n_col+1 */
    const Int Ai [ ],	/* size nz = Ap [n_col] */
    const double Ax [ ], /* size nz, if present */
#ifdef COMPLEX
    const double Az [ ], /* size nz, if present */
#endif

    const Int P [ ],	/* P [k] = i means original row i is kth row in A(P,Q)*/
			/* P is identity if not present */
			/* size n_row, if present */

    const Int Q [ ],	/* Q [k] = j means original col j is kth col in A(P,Q)*/
			/* Q is identity if not present */
			/* size n_col, if present */

    Int Rp [ ],		/* size n_row+1 */
    Int Ri [ ],		/* size nz */
    double Rx [ ]	/* size nz, if present */
#ifdef COMPLEX
    , double Rz [ ]	/* size nz, if present */
    , Int do_conjugate	/* if true, then to conjugate transpose */
			/* otherwise, do array transpose */
#endif
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int status, *W, nn ;

#ifndef NDEBUG
    init_count = UMF_malloc_count ;
    UMF_dump_start ( ) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    nn = MAX (n_row, n_col) ;
    nn = MAX (nn, 1) ;
    W = (Int *) UMF_malloc (nn, sizeof (Int)) ;
    if (!W)
    {
	ASSERT (UMF_malloc_count == init_count) ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }
    ASSERT (UMF_malloc_count == init_count + 1) ;

    /* ---------------------------------------------------------------------- */
    /* C = (A (P,Q))' or (A (P,Q)).' */
    /* ---------------------------------------------------------------------- */

    status = UMF_transpose (n_row, n_col, Ap, Ai, Ax, P, Q, n_col, Rp, Ri, Rx,
	W, TRUE
#ifdef COMPLEX
	, Az, Rz, do_conjugate
#endif
	) ;

    /* ---------------------------------------------------------------------- */
    /* free the workspace */
    /* ---------------------------------------------------------------------- */

    (void) UMF_free ((void *) W) ;
    ASSERT (UMF_malloc_count == init_count) ;

    return (status) ;
}


```

sparse-matrix/y12m/index.html:
```
<!-- X-URL: http://www.netlib.org/y12m/index.html -->
<!-- Date: Sun, 15 Sep 2002 16:59:37 GMT -->
<!-- Last-Modified: Fri, 21 Jun 2002 14:14:39 GMT -->
<BASE HREF="http://www.netlib.org/y12m/index.html">
<head>
<title>y12m</title>
<meta name="waisindex" value="nse">
</head>
<h1>y12m</h1>
<p>
Click <A HREF="http://www.netlib.org/master_counts2.html#y12m">here</A> to see the number of accesses to this library.
<p><hr>
<pre>
file    <a href="doc">doc</a>
for     documentation for the package
size    125 kilobytes

file    <a href="y12m.f">y12m.f</a>  <a href="/cgi-bin/netlibfiles.pl?filename=/y12m/y12m.f">y12m.f plus dependencies</a>
for     solution of linear systems, matrices are large and sparse

file    <a href="y12mae.f">y12mae.f</a>  <a href="/cgi-bin/netlibfiles.pl?filename=/y12m/y12mae.f">y12mae.f plus dependencies</a>
for     sparse matrix, solve one system, single right hand side
prec    single

file    <a href="y12maf.f">y12maf.f</a>  <a href="/cgi-bin/netlibfiles.pl?filename=/y12m/y12maf.f">y12maf.f plus dependencies</a>
for     sparse matrix, solve one system, single right hand side
prec    double

file    <a href="y12mfe.f">y12mfe.f</a>  <a href="/cgi-bin/netlibfiles.pl?filename=/y12m/y12mfe.f">y12mfe.f plus dependencies</a>
for     Solves a large sparse system of linear algebraic equations
,       using Gaussian elimination and sparse matrix techniques.
,       Iterative refinement is applied in order to improve accuracy.
gams    d2a4

lib     <a href="ex/">ex</a>
for     test programs
</pre>
</body>
</html>


```

sparse-matrix/y12m/README:
```
This directory contains the Harwell Y12M sparse LU decompositon routines,
as obtained from netlib (url given in ./www) in September 2002.

Y12MAE		single precision driver
Y12MAF		double precision driver

Y12MF		iterative improvement

Y12MB[EF]	analyse
Y12MC[EF]	factor (LU decompose)
Y12MD[EF]	solve given LU decomposition

```

sparse-matrix/y12m/www:
```
http://www.netlib.org/y12m/index.html

```

sparse-matrix/y12m/doc:
```

The Y12M documentation:

C                =================================
C                Documentation of subroutine Y12MA
C                =================================
C
C     1.  Purpose
C
C
C     Y12MA   solves   sparse  systems  of  linear  algebraic
C     equations by Gaussian elimination.  The subroutine is a
C     "black  box  subroutine"  designed to solve efficiently
C     problems which contain only one system  with  a  single
C     right  hand side. The number of the input parameters is
C     minimized. The user must assign values only to NN, NN1,
C     N,  Z,  A,  SNR,  RNR, IHA and B according to the rules
C     described in Section 2.4 (see below).  It is  extremely
C     easy  to  modify  the  subroutine  to  the cases: (a) a
C     sequence of systems with  the  same  matrix  is  to  be
C     solved (note that one system with many right hand sides
C     can be rewritten as a sequence of systems with the same
C     matrix),  (b)  a sequence of systems whose matrices are
C     different but of the same structure is to be solved and
C     (c)  a  sequence  of  systems whose matrices are of the
C     same structure and some of them are the same is  to  be
C     solved.   These  cases  are  defined as case (ii), case
C     (iii) and case (iv)  in  Section  1.1.  "Scope  of  the
C     Y12M".   The recommendations in Section 1.3.6 should be
C     followed in order to modify the  subroutine  Y12MA  for
C     the  above  cases.  If  a  sequence  of  systems  whose
C     matrices are of different structure (this case  appears
C     as  case  (v)  in  Section  1.1)  is  to be solved then
C     subroutine Y12MA should be called in  the  solution  of
C     each system in the sequence.
C
C     2.  Calling sequence and declaration of the parameters
C
C     The  subroutine  is  written in FORTRAN and it has been
C     extensively tested with the FOR and FTN compilers on  a
C     UNIVAC  1100/82  computer,  at  the  Regional Computing
C     Centre at the University of  Copenhagen  (RECKU).  Many
C     examples  have  been run on an IBM 3033 computer at the
C     Northern Europe University Computing Centre (NEUCC) and
C     on  a  CDC Cyber 173 computer at the Regional Computing
C     Centre  at  the  University  of  Aarhus  (RECAU).   Two
C     different  versions  are  available: a single precision
C     version named Y12MAE and  a  double  precision  version
C     named  Y12MAF.  The calls of these two versions and the
C     declarations of the parameters are as follows.
C
C     A). Single precision version: Y12MAE
C
C           SUBROUTINE Y12MAE(N, Z, A, SNR, NN, RNR, NN1,
C          1  PIVOT, HA, IHA, AFLAG, IFLAG, B, IFAIL)
C
C           REAL A(NN), PIVOT(N), B(N), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(IHA,11), IFLAG(10)
C           INTEGER N, Z, NN, NN1, IHA, IFAIL
C
C     B). Double precision version: Y12MAF
C
C           SUBROUTINE Y12MAF(N, Z, A, SNR, NN, RNR, NN1,
C          1  PIVOT, HA, IHA, AFLAG, IFLAG, B, IFAIL)
C
C           DOUBLE PRECISION A(NN), PIVOT(N), B(N), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(IHA,11), IFLAG(10)
C           INTEGER N, Z, NN, NN1, IHA, IFAIL
C
C     These two versions can be used on many other  computers
C     also. However some alterations may be needed and/or may
C     ensure greater efficiency of  the  performance  of  the
C     subroutine. For example, it will be much more efficient
C     to declare arrays SNR, RNR  and  (if  possible)  HA  as
C     INTEGER*2 arrays on some IBM installations.
C
C
C     3.  Method
C
C     The system Ax = b is solved  by  Gaussian  elimination.
C     Pivotal interchanges are used in an attempt to preserve
C     both the stability of the computations and the sparsity
C     of  the original matrix. In this way a decomposition LU
C     = PAQ is normally calculated. P and Q  are  permutation
C     matrices, L is a lower triangular matrix, U is an upper
C     triangular matrix. The right hand side vector b is also
C     modified  during  the  decomposition so that the vector
C     c=L**(-1)*P*b  is  available  after  the  decomposition
C     stage.  In  this  way  there  is  no  need to store the
C     non-zero elements of matrix L. Therefore these elements
C     are  not  stored.  This  leads  to  a  reduction of the
C     storage requirements (the length of arrays  A  and  SNR
C     can  be  decreased).  An  approximation to the solution
C     vector is found by solving U*tr(T)*x=c, where tr(T)  is
C     the  transpose.  The  subroutine calculates the rate at
C     which the  elements  of  the  matrix  grow  during  the
C     decomposition  (see  parameter  AFLAG(5) below) and the
C     minimal  in  absolute  value   pivotal   element   (see
C     parameter  AFLAG(8)  below).  These  two numbers can be
C     used to decide whether the  computed  approximation  is
C     acceptable   or  not.  Positive  values  of  a  special
C     parameter IFAIL indicate that the subroutine is  unable
C     to  solve  the problem. The error diagnostics, given in
C     Section 7, describe the probable cause.
C
C     4.  Parameters of the subroutine
C
C
C     N     - INTEGER On entry N must contain the  number  of
C             equations  in  the  system   Ax=b. Unchanged on
C             exit.
C
C     Z     - INTEGER. On entry Z must contain the number  of
C             non-zero  elements  in the coefficient matrix A
C             of the system Ax = b. Unchanged on exit.
C
C     A     - REAL (in the single precision  version  Y12MAE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MAF) array of length NN (see below).
C             On  entry the first Z locations of array A must
C             contain   the   non-zero   elements   of    the
C             coefficient  matrix A of the system Ax = b. The
C             order  of  the   non-zero   elements   may   be
C             completely arbitrary. The content of array A is
C             modified by  subroutine  Y12MA.  On  successful
C             exit array A will contain the non-zero elements
C             of the upper triangular matrix U  (without  the
C             diagonal  elements  of  matrix  U  which can be
C             found in array PIVOT, see below).
C
C     SNR   - INTEGER array of  length  NN  (see  below).  On
C             entry  SNR(j),  j  =  1(1)Z,  must  contain the
C             column number of the non-zero element stored in
C             A(j).   The content of array SNR is modified by
C             subroutine Y12MA.  On successful exit array SNR
C             will contain the column numbers of the non-zero
C             elements  of  the  upper  triangular  matrix  U
C             (without  the  column  numbers  of the diagonal
C             elements of matrix U).
C
C     NN    - INTEGER. On entry NN must contain the length of
C             arrays   A  and  SNR.  Restriction:  NN.GE.2*Z.
C             Recommended value: 2*Z.LE.NN.LE.3*Z.  Unchanged
C             on exit.
C
C     RNR   - INTEGER  array  of  length  NN1 (see below). On
C             entry RNR(i), i = 1(1)Z, must contain  the  row
C             number  of the non-zero element stored in A(i).
C             The  content  of  array  RNR  is  modified   by
C             subroutine   Y12MA.   On  successful  exit  all
C             components of array RNR will normally be  zero.
C
C     NN1   - INTEGER. On entry NN1 must contain  the  length
C             of   the  array  RNR.   Restriction:  NN1.ge.Z.
C             Recommended      value:      2*Z.LE.NN1.LE.3*Z.
C             Unchanged on exit.
C
C     PIVOT - REAL  (in  the single precision version Y12MAE)
C             or DOUBLE PRECISION (in  the  double  precision
C             version  Y12MAF) array of length N. The content
C             of array PIVOT is modified by subroutine Y12MA.
C             On successful exit array PIVOT will contain the
C             pivotal  elements  (the  diagonal  elements  of
C             matrix  U). This means that a small element (or
C             small elements) in  array  PIVOT  on  exit  may
C             indicate    numerical    singularity   of   the
C             coefficient matrix A. Note that the smallest in
C             absolute  value  element in array PIVOT is also
C             stored in AFLAG(8), see below.
C
C     HA    - INTEGER two-dimensional array.  The  length  of
C             the  first  dimension  is  IHA (see below). The
C             length of the  second  dimension  is  11.  This
C             array  is  used  as  a work space by subroutine
C             Y12MA.
C
C     IHA   - INTEGER. On entry IHA must contain  the  length
C             of   the   first   dimension   of   array   HA.
C             Restriction:  IHA.GE.N. Unchanged on exit.
C
C     AFLAG - REAL (in the single precision  version  Y12MAE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MAF) array of length 8. The  content
C             of array AFLAG is modified by subroutine Y12MA.
C             The content of the components of this array can
C             be described as follows.
C
C             AFLAG(1) - Stability factor. An element can  be
C                        chosen  as  pivotal  element only if
C                        this element is larger (in  absolute
C                        value)  than  the  absolute value of
C                        the  largest  element  in  its   row
C                        divided   by  AFLAG(1).   Subroutine
C                        Y12MA  sets  AFLAG(1)  =  16.   This
C                        value  has  been  found satisfactory
C                        for a wide range of test-examples.
C
C             AFLAG(2) - Drop-tolerance. An element, which in
C                        the   process  of  the  computations
C                        becomes smaller (in absolute  value)
C                        than  the drop-tolerance, is removed
C                        from array A (and its column and row
C                        numbers  are removed from arrays SNR
C                        and  RNR).   Subroutine  Y12MA  sets
C                        AFLAG(2)  =  1.0E-12. This value has
C                        been found satisfactory for  a  wide
C                        range   of  test-matrices.  By  this
C                        choice it is assumed that the matrix
C                        is not too badly scaled and that the
C                        magnitude of the elements is 1.
C
C             AFLAG(3) - The   subroutine   will   stop   the
C                        computations  when the growth factor
C                        (parameter  AFLAG(5),   see   below)
C                        becomes  larger  than  AFLAG(3). Our
C                        experiments show that if AFLAG(3)  >
C                        1.0E6  then the solution is normally
C                        quite wrong.   Therefore  subroutine
C                        Y12MA sets AFLAG(3) = 1.0E6.
C
C             AFLAG(4) - The   subroutine   will   stop   the
C                        computations when the absolute value
C                        of  a  current  pivotal  element  is
C                        smaller    than    AFLAG(4)*AFLAG(6)
C                        (where  the  absolute  value  of the
C                        largest (in absolute value)  element
C                        of  the original matrix is stored in
C                        AFLAG(6),    see     below).     Our
C                        experiments show that
C                        AFLAG(4)=1.0E-12  will normally be a
C                        good  choice.  Therefore  subroutine
C                        Y12MA sets  AFLAG(4)=1.0E-12.
C
C             AFLAG(5) - Growth factor. After each  stage  of
C                        the   elimination  subroutine  Y12MA
C                        sets  AFLAG(5)  =  AFLAG(7)/AFLAG(6)
C                        (the   description   of   parameters
C                        AFLAG(6)  and  AFLAG(7)   is   given
C                        below).  Large  values  of  AFLAG(5)
C                        indicate that an  appreciable  error
C                        in    the   computed   solution   is
C                        possible. In an  extreme  case  when
C                        AFLAG(5)  becomes larger than 1.0E6,
C                        see parameter  AFLAG(3),  subroutine
C                        Y12MA  will stop the computations in
C                        an attempt to prevent overflows.
C
C             AFLAG(6) - Subroutine Y12MA sets AFLAG(6) equal
C                        to  max(abs(a(i,j))), i = 1(1)N, j =
C                        1(1)N.
C
C             AFLAG(7) - Subroutine Y12MA sets AFLAG(7) equal
C                        to max(abs(a(i,j;s))),  1.lt.s.lt.k,
C                        after each step  k,   k=1(1)N-1,  of
C                        the elimination.
C
C             AFLAG(8) - Subroutine Y12MA sets AFLAG(8) equal
C                        to min(abs(a(i,i))), i= 1(1)N.  This
C                        means   that   the  minimal  pivotal
C                        element (in absolute value) will  be
C                        stored  in  AFLAG(8)  on  successful
C                        exit.   Small  values  of   AFLAG(8)
C                        indicate  numerical  singularity  of
C                        the original matrix.  We advise  the
C                        user to check this parameter on exit
C                        very carefully.
C
C     IFLAG - INTEGER array of length 10. The content of this
C             array is  modified  by  subroutine  Y12MA.  The
C             content  of the components of this array can be
C             described as follows.
C
C             IFLAG(1) - Subroutine  Y12MA uses IFLAG(1) as a
C                        work space.
C
C             IFLAG(2) - Subroutine Y12MA sets IFLAG(2) =  3.
C                        This means that at each stage of the
C                        Gaussian  elimination  (except   the
C                        last  one)  the  pivotal  search  is
C                        carried out in the 3 rows which have
C                        least  numbers of non-zero elements.
C
C             IFLAG(3) - Subroutine  Y12MA sets IFLAG(3) = 1.
C                        This means that the pivotal strategy
C                        for  general  matrices will be used.
C                        For  some  special   matrices   (for
C                        example positive definite) this will
C                        be  inefficient.   Subroutine  Y12MA
C                        can  easily  be  modified  for  such
C                        matrices;   only    the    statement
C                        IFLAG(3)  = 1 should be changed (for
C                        positive  definite   matrices   e.g.
C                        IFLAG(3)  =  2  can  be  used). More
C                        details  about  the  use   of   this
C                        parameter  with special matrices are
C                        given in Section 1.3.1
C
C             IFLAG(4) - Subroutine Y12MA sets IFLAG(4) =  0.
C                        This  is the best choice in the case
C                        where only one system Ax = b  is  to
C                        be   solved,  see  more  details  in
C                        Section 1.3.
C
C             IFLAG(5) - Subroutine Y12MA sets IFLAG(5) =  1.
C                        This   means   that   the   non-zero
C                        elements  of  the  lower  triangular
C                        matrix  L will be removed during the
C                        decomposition   stage,   see    more
C                        details in Section 1.3.3.
C
C             IFLAG(6) - On  successful exit IFLAG(6) will be
C                        equal to  the  number  of  "garbage"
C                        collections in the row ordered list.
C                        If IFLAG(6)  is  large  then  it  is
C                        better  to  choose a larger value of
C                        NN in the next calls  of  subroutine
C                        Y12MA  with  the  same  or a similar
C                        matrix  A.  This  will  lead  to   a
C                        reduction in the computing time.
C
C             IFLAG(7) - On  successful exit IFLAG(7) will be
C                        equal to  the  number  of  "garbage"
C                        collections  in  the  column ordered
C                        list.  If IFLAG(7) is large then  it
C                        is  better  to choose a larger value
C                        of  NN1  in  the   next   calls   of
C                        subroutine  Y12MA with the same or a
C                        similar matrix A. This will lead  to
C                        a reduction in the computing time.
C
C             IFLAG(8) - On  successful exit IFLAG(8) will be
C                        equal  to  the  maximal  number   of
C                        non-zero elements kept in array A at
C                        any   stage    of    the    Gaussian
C                        elimination.  If  IFLAG(8)  is  much
C                        smaller then NN (or  NN1)  then  the
C                        length  NN  (or  NN1)  can be chosen
C                        smaller  in  the   next   calls   of
C                        subroutine  Y12MA with the same or a
C                        similar matrix A. This will lead  to
C                        a reduction of the storage needed.
C
C             IFLAG(9) - This   parameter   is   ignored   by
C                        subroutine Y12MA.  It will  be  used
C                        in  some  of  the  other subroutines
C                        when IFLAG(4) = 1  is  specified  on
C                        entry.
C
C             IFLAG(10)- This   parameter   is   ignored   by
C                        subroutine Y12MA.  It will  be  used
C                        in  some  of  the  other subroutines
C                        when IFLAG(4) = 1  is  specified  on
C                        entry.
C
C     B     - REAL (in the single precision  version  Y12MAE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MAF) array of length N. On entry the
C             right  hand  side vector b of the system Ax = b
C             must be stored in array B. The content of array
C             B   is   modified   by  subroutine  Y12MA.   On
C             successful exit the  computed  solution  vector
C             will be stored in array B.
C
C     IFAIL - Error  diagnostic  parameter.  The  content  of
C             parameter  IFAIL  is  modified  by   subroutine
C             Y12MA.  On exit IFAIL = 0 if the subroutine has
C             not detected  any  error.  Positive  values  of
C             IFAIL  on  exit  show  that some error has been
C             detected by the subroutine. Many of  the  error
C             diagnostics  are  common for all subroutines in
C             the package.  Therefore the  error  diagnostics
C             are listed in a separate section, Section 7, of
C             this book. We advise  the  user  to  check  the
C             value of this parameter on exit.
C
C     5.  Error diagnostics
C
C     Error diagnostics are given by positive values  of  the
C     parameter  IFAIL  (see  above).   We advise the user to
C     check carefully the value of this  parameter  on  exit.
C     The error messages are listed in Section 7.
C
C     6.  Auxiliary subroutines
C
C     Y12MA  calls  three other subroutines: Y12MB, Y12MC and
C     Y12MD.
C
C     7.  Timing
C
C     The time taken depends  on  the  order  of  the  matrix
C     (parameter  N),  the number of the non-zero elements in
C     the matrix (parameter Z), the magnitude of the non-zero
C     elements and their distribution in the matrix.
C
C     8.  Storage
C
C     There are no internally declared arrays.
C
C     9.  Accuracy
C
C     It  is  difficult  to  evaluate  the  accuracy  of  the
C     computed solution. Large values of parameter  AFLAG(5),
C     the   growth  factor,  indicate  unstable  computations
C     during  the  decomposition  stage.  Small   values   of
C     parameter  AFLAG(8)  can  be considered as a signal for
C     numerical singularity.  We  must  emphasize  here  that
C     normally much more reliable evaluations of the accuracy
C     achieved  can  be  found  by  the  use   of   iterative
C     refinement, i.e. by the use of subroutine Y12MF. By the
C     use of the latter subroutine the  computing  time  will
C     often be reduced too. However, the storage requirements
C     may be increased sometimes.
C
C     10.  Some remarks
C
C     Remark 1   Subroutine  Y12MA  may also be considered as
C                an example of how to initialize the first  4
C                components  of  array  AFLAG and the first 5
C                components of  array  IFLAG  when  only  one
C                system  with  a single right hand side is to
C                be  solved.  An   efficient   use   of   the
C                subroutines  Y12MB,  Y12MC and Y12MD for the
C                other cases discussed in Section 1.1 may  be
C                achieved  by  a single modification of Y12MA
C                according to  the  rules  given  in  Section
C                1.3.6   (a   change   of  only  one  or  two
C                statements in Y12MA is needed to obtain such
C                a modification).
C
C     Remark 2   The last 4 components of array AFLAG and the
C                last 5 components of array IFLAG can be used
C                as  output  parameters.   The  user  is  not
C                obliged to do this.  However,  we  recommend
C                the check of these parameters on exit.
C                =================================
C                Documentation of subroutine Y12MB
C                =================================
C
C     1.  Purpose
C
C     Y12MB prepares a system of linear  algebraic  equations
C     to  be  factorized (by subroutine Y12MC) and solved (by
C     subroutine Y12MD).  Each call of subroutine Y12MC  must
C     be  preceded  by a call of Y12MB. It is very convenient
C     to perform some operations on the non-zero elements  of
C     the  coefficient  matrix  between  calls  of  Y12MB and
C     Y12MC.  For  example,  when  iterative  refinement   is
C     carried  out  the information needed in the calculation
C     of the residual vector is copied in some  extra  arrays
C     between  the  calls of Y12MB and Y12MC. It is also very
C     easy to perform any kind of scaling after the  call  of
C     Y12MB.
C
C     2.  Calling sequence and declaration of the parameters
C
C     The  subroutine  is  written  in  FORTRAN  and has been
C     extensively tested with the FOR and FTN compilers on  a
C     UNIVAC  1100/82  computer  at  the  Regional  Computing
C     Centre at the University of  Copenhagen  (RECKU).  Many
C     examples  have  been run on an IBM 3033 computer at the
C     Northern Europe University Computing Centre (NEUCC) and
C     on  a  CDC Cyber 173 computer at the Regional Computing
C     Centre  at  the  University  of  Aarhus  (RECAU).   Two
C     different  versions  are available:  a single precision
C     version Y12MBE and a double precision  version  Y12MBF.
C     The  calls of these two versions and the declaration of
C     the parameters are as follows:
C
C     A) Single precision version Y12MBE
C
C           SUBROUTINE Y12MBE(N, Z, A, SNR, NN, RNR, NN1,
C          1  HA, IHA, AFLAG, IFLAG, IFAIL)
C
C           REAL A(NN), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(N,11), IFLAG(10)
C           INTEGER N, Z, IHA, IFAIL
C
C     B) Double precision version Y12MBF
C
C           SUBROUTINE Y12MBF(N, Z, A, SNR, NN, RNR, NN1,
C          1  HA, IHA, AFLAG, IFLAG, IFAIL)
C
C           DOUBLE PRECISION A(NN), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(N,11), IFLAG(10)
C           INTEGER N, Z, IHA, IFAIL
C
C     These  two versions can be used on many other computers
C     also. However some alterations may be needed and/or may
C     ensure  greater  efficiency  of  the performance of the
C     subroutine. For example, it will be much more efficient
C     to  declare  arrays  SNR,  RNR  and (if possible) HA as
C     INTEGER*2 arrays on some IBM installations.
C
C
C     3.  Method
C
C     The  non-zero  elements of matrix A are ordered by rows
C     and stored in the first Z positions  of  array  A.  The
C     order   of  the  non-zero  elements  within  a  row  is
C     arbitrary. The column numbers of the non-zero  elements
C     are  stored  in  the  first Z positions of array SNR so
C     that if  A(J)=a(i,j),  J=1(1)Z, then  SNR(J)=j. The row
C     numbers  of  the  non-zero  elements  are stored in the
C     first Z positions of array RNR so that the row  numbers
C     of  the non-zero elements in the first column of matrix
C     A are located before the row numbers  of  the  non-zero
C     elements  in  the  second  column  of matrix A, the row
C     numbers of the non-zero elements in the  second  column
C     of  matrix  A are located before the row numbers of the
C     non-zero elements in the third column of matrix  A  and
C     so  on. Some additional information, e.g. about the row
C     starts, row ends, column starts  and  column  ends,  is
C     stored  in  the  work array HA. This storage scheme has
C     been proposed by Gustavson.
C
C     4.  Parameters of the subroutine
C
C
C     N     - INTEGER. On entry N must contain the number  of
C             equations  in  the  system   Ax=b. Unchanged on
C             exit.
C
C     Z     - INTEGER. On entry Z must contain the number  of
C             non-zero  elements  in the coefficient matrix A
C             of the system Ax = b. Unchanged on exit.
C
C     A     - REAL (in the single precision  version  Y12MBE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MBF) array of length NN (see below).
C             On  entry the first Z locations of array A must
C             contain   the   non-zero   elements   of    the
C             coefficient  matrix A of the system Ax = b. The
C             order  of  the   non-zero   elements   may   be
C             completely arbitrary. The content of array A is
C             modified by  subroutine  Y12MB.  On  successful
C             exit  the  first  Z  positions  of array A will
C             contain the non-zero elements of the  matrix  A
C             ordered by rows.
C
C     SNR   - INTEGER  array  of  length  NN  (see below). On
C             entry SNR(j),  j  =  1(1)Z,  must  contain  the
C             column number of the non-zero element stored in
C             A(j).  The content of array SNR is modified  by
C             subroutine  Y12MB.   On successful exit SNR(j),
C             j=1(1)Z, will contain the column number of  the
C             non-zero element stored in A(j).
C
C     NN    - INTEGER. On entry NN must contain the length of
C             arrays  A  and  SNR.  Restriction:   NN.ge.2*Z.
C             Recommended  value: 2*Z.le.NN.le.3*Z.  See also
C             the description of NN in Y12MC.   Unchanged  on
C             exit.
C
C     RNR   - INTEGER  array  of  length  NN1 (see below). On
C             entry RNR(i), i = 1(1)Z, must contain  the  row
C             number  of the non-zero element stored in A(i).
C             The  content  of  array  RNR  is  modified   by
C             subroutine  Y12MB.  On  successful exit the row
C             numbers of the non-zero elements  of  matrix  A
C             are  stored  in  the first Z positions of array
C             RNR, so that the row numbers  of  the  non-zero
C             elements  in  the  first column of matrix A are
C             before the row numbers of the non-zero elements
C             in  the  second  column  of  matrix  A, the row
C             numbers of the non-zero elements in the  second
C             column  of  matrix A are before the row numbers
C             of the non-zero elements in the third column of
C             matrix A and so on. This means that on exit the
C             row number of the non-zero  element  stored  in
C             A(i),  i  =  1(1)Z, is not stored in RNR(i), in
C             general.
C
C     NN1   - INTEGER. On entry NN1 must contain  the  length
C             of   the  array  RNR.   Restriction:  NN1.ge.Z.
C             Recommended value: 2*Z.le.NN1.le.3*Z.  See also
C             the  desription  of NN1 in Y12MC.  Unchanged on
C             exit.
C
C     HA    - INTEGER two-dimensional array.  The  length  of
C             the  first  dimension of HA is IHA (see below).
C             The length of the second dimension of HA is 11.
C             The contents of some elements of this array are
C             modified by subroutine Y12MB, the  contents  of
C             the others are ignored. On successful exit:
C
C             (1) HA(i,1) contains the position  in  array  A
C                         where the first element of row i, i
C                         = 1(1)N, is stored.
C             (2) HA(i,3) contains  the  position  in array A
C                         where the last element of row i,  i
C                         =  1(1)N,  is  stored (all non-zero
C                         elements of  row   i   are  located
C                         between    HA(i,1)    and   HA(i,3)
C                         compactly; the number  of  non-zero
C                         elements  in  row  i  is  HA(i,3) -
C                         HA(i,1) + 1).
C             (3) HA(i,4) contains  the position in array RNR
C                         where the row number of  the  first
C                         non-zero  element  of  column  j is
C                         stored (j = 1(1)N).
C             (4) HA(j,6) contains  the position in array RNR
C                         where the row number  of  the  last
C                         element  in column j, j = 1(1)N, is
C                         stored  (all  row  numbers  of  the
C                         non-zero  elements  of column j are
C                         located between HA(j,4) and HA(j,6)
C                         compactly,  the  number of non-zero
C                         elements    in    column    j    is
C                         HA(j,6)-HA(j,4)+1).
C
C             (5)         Some   information  needed  in  the
C                         pivotal    search    during     the
C                         decomposition  is stored in columns
C                         7,8 and 11 of array HA.
C
C             (6)         The other columns of HA are  either
C                         ignored  by Y12MB or used as a work
C                         space.
C
C     IHA   - INTEGER.  On  entry IHA must contain the length
C             of   the   first   dimension   of   array   HA.
C             Restriction:  IHA.ge.N. Unchanged on exit.
C
C     AFLAG - REAL  (in  the single precision version Y12MBE)
C             or DOUBLE PRECISION (in  the  double  precision
C             version Y12MBF) array of length 8. The contents
C             of  all  locations  of  array   AFLAG,   except
C             AFLAG(6), are ignored by subroutine Y12MB.  The
C             content of AFLAG(6) is modified  by  Y12MB.  On
C             successful exit AFLAG(6) contains
C             max(abs(i,j)).
C
C     IFLAG - INTEGER array of length 10. The user should set
C             IFLAG(1).ge.0  before  the call of package Y12M
C             (i.e. before the first call of a subroutine  of
C             this  package).  IFLAG(1)  is used in the error
C             checks by the subroutines  and  should  not  be
C             altered  by the user between any two successive
C             calls of subroutines of the  package.  IFLAG(1)
C             will  be  equal to  -1  on successful exit from
C             subroutine Y12MB. Thus, the content of IFLAG(1)
C             is  modified  by  subroutine  Y12MB.  On  entry
C             IFLAG(4) must contain 0, 1 or 2. IFLAG(4)  =  0
C             is  the  best choice when only one system is to
C             be solved, when the first system of a  sequence
C             of systems with the same matrix is to be solved
C             and when any system of a  sequence  of  systems
C             whose matrices are of different structure is to
C             be solved. IFLAG(4) = 1 is the best choice when
C             the  first system in a sequence of systems with
C             the same structure is to be solved. IFLAG(4)  =
C             2  is the best choice when any system after the
C             first  one  in  a  sequence  of  systems  whose
C             matrices  are  of  the  same structure is to be
C             solved. The content of IFLAG(4) is unchanged by
C             subroutine  Y12MB. The other locations of IFLAG
C             are either ignored by Y12MB or used as  a  work
C             space.
C
C     IFAIL - Error  diagnostic  parameter.  The  content  of
C             parameter  IFAIL  is  modified  by   subroutine
C             Y12MB.  On exit IFAIL = 0 if the subroutine has
C             not detected  any  error.  Positive  values  of
C             IFAIL  on  exit  show  that some error has been
C             detected by the subroutine. Many of  the  error
C             diagnostics  are  common for all subroutines in
C             the package.  Therefore the  error  diagnostics
C             are listed in a separate section, Section 7, of
C             this book. We advise  the  user  to  check  the
C             value of this parameter on exit.
C
C     5.  Error diagnostics
C
C     Error diagnostics are given by positive values  of  the
C     parameter  IFAIL  (see  above).  We  advise the user to
C     check carefully the value of this  parameter  on  exit.
C     The error messages are listed in Section 7.
C
C     6.  Auxiliary subroutines
C
C     None.
C
C     7.  Timing
C
C     The  time  taken  depends  on  the  number  of non-zero
C     elements (parameter Z) in matrix A.
C
C     8.  Storage
C
C     There are no internally declared arrays.
C
C     9.  Some remarks
C
C     Remark 1 The use of subroutine Y12MB is followed by the
C              use of Y12MC and Y12MD. Subroutines Y12MA  and
C              Y12MF  can be considered as examples of how to
C              use Y12MB, Y12MC and Y12MD.
C
C     Remark 2 The contents of N, Z, A, SNR,  NN,  RNR,  NN1,
C              columns  1,  3,  4, 6, 7, 8 and 11 of HA, IHA,
C              AFLAG(6), IFLAG(1), IFLAG(4) and IFAIL  should
C              not  be  altered  between  calls  of Y12MB and
C              Y12MC.
C
C     Remark 3 If IFAIL > 0 on exit  of  Y12MB  there  is  no
C              sense  in  calling  Y12MC and Y12MD. Therefore
C              the computations should  be  stopped  in  this
C              case  and  one  should  investigate (using the
C              error diagnostics  given  in  Section  7)  why
C              Y12MB  has assigned a positive value to IFAIL.
C                =================================
C                Documentation of subroutine Y12MC
C                =================================
C
C     1.  Purpose
C
C     Y12MC   decomposes  a  matrix  A  into  two  triangular
C     matrices L and U. Each call of subroutine Y12MC  should
C     be  preceded  by  a  call of Y12MB. Subroutine Y12MD is
C     normally called one or several times after the call  of
C     Y12MC.
C
C     2.  Calling sequence and declaration of the parameters
C
C     The  subroutine  is  written  in  FORTRAN  and has been
C     extensively tested with the FOR and  FTN  compilers  on
C     the  UNIVAC  1100/82 computer at the Regional Computing
C     Centre at the University of  Copenhagen  (RECKU).  Many
C     examples  have  been run on an IBM 3033 computer at the
C     Northern Europe University Computing Centre (NEUCC) and
C     on  a  CDC Cyber 173 computer at the Regional Computing
C     Centre  at  the  University  of  Aarhus  (RECAU).   Two
C     different  versions  are  available: a single precision
C     version named Y12MCE and  a  double  precision  version
C     named  Y12MCF.  The calls of these two versions and the
C     declaration of the parameters are as follows.
C
C     A). Single precision version: Y12MCE
C
C           SUBROUTINE Y12MCE(N, Z, A, SNR, NN, RNR, NN1,
C          1  PIVOT, B, HA, IHA, AFLAG, IFLAG, IFAIL)
C
C           REAL A(NN), PIVOT(N), B(N), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(IHA,11), IFLAG(10)
C           INTEGER N, Z, NN, NN1, IHA, IFAIL
C
C     B). Double precision version: Y12MCF
C
C           SUBROUTINE Y12MCF(N, Z, A, SNR, NN, RNR, NN1,
C          1  PIVOT, B, HA, IHA, AFLAG, IFLAG, IFAIL)
C
C           DOUBLE PRECISION A(NN), PIVOT(N), B(N), AFLAG(8)
C           INTEGER SNR(NN), RNR(NN1), HA(IHA,11), IFLAG(10)
C           INTEGER N, Z, NN, NN1, IHA, IFAIL
C
C     These  two versions can be used on many other computers
C     also. However some alterations may be needed and/or may
C     ensure  greater  efficiency  of  the performance of the
C     subroutine. For example, it will be much more efficient
C     to  declare  arrays  SNR,  RNR  and (if possible) HA as
C     INTEGER*2 arrays on some IBM installations.
C
C
C     3.  Method
C
C     Gaussian  elimination  is  used in the decomposition of
C     matrix A. Pivotal interchanges are  implemented  as  an
C     attempt   to   preserve   both  the  stability  of  the
C     computations  and  the  sparsity  of  the   coefficient
C     matrix. Two triangular matrices L and U are computed so
C     that  LU=PAQ  (where P and Q are permutation matrices).
C     The  right  hand side vector b is also modified so that
C     vector c = L**(-1)*P*b is computed on successful  exit.
C     In  this  way  matrix  L is sometimes not needed in the
C     further computations and may be removed if this is  so.
C
C     4.  Parameters of the subroutine
C
C
C     N     - INTEGER. On entry N must contain the number  of
C             equations  in  the  system   Ax=b. Unchanged on
C             exit.
C
C     Z     - INTEGER. On entry Z must contain the number  of
C             non-zero  elements  in the coefficient matrix A
C             of the system  Ax=b. Unchanged on exit.
C
C     A     - REAL (in the single precision  version  Y12MCE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MCF) array of length NN (see below).
C             On  entry the first Z locations of array A must
C             contain   the   non-zero   elements   of    the
C             coefficient  matrix  A  of  the  system  Ax = b
C             ordered by  rows  (in  the  preceding  call  of
C             Y12MB).  The  content of array A is modified by
C             subroutine Y12MC.  On successful exit  array  A
C             will contain the non-zero elements of the upper
C             triangular  matrix  U  (without  the   diagonal
C             elements  of  matrix  U  which  can be found in
C             array PIVOT, see below) and sometimes also  the
C             non-zero   elements  of  the  lower  triangular
C             matrix  L (without the diagonal elements  which
C             are not stored).
C
C     SNR   - INTEGER  array  of  length  NN  (see below). On
C             entry SNR(j),  j  =  1(1)Z,  must  contain  the
C             column number of the non-zero element stored in
C             A(j).   This  is  accomplished  by   subroutine
C             Y12MB.  The content of array SNR is modified by
C             subroutine Y12MC.  On successful exit array SNR
C             will contain the column numbers of the non-zero
C             elements  of  the  upper  triangular  matrix  U
C             (without  the  column  numbers  of the diagonal
C             elements of matrix U) and  sometimes  also  the
C             column  numbers of the non-zero elements of the
C             lower triangular matrix L (without  the  column
C             numbers of the diagonal elements of L).
C
C     NN    - INTEGER. On entry NN must contain the length of
C             array  A  and  SNR.   Restriction:   NN.ge.2*Z.
C             Recommended  value:  2*Z .le.NN.le.  3*Z if the
C             non-zero elements of matrix L will  be  removed
C             by  subroutine  Y12MC  (i.e. if Y12MC is called
C             with IFLAG(5) = 1) or 3*Z.le.  NN.le.5*Z if the
C             non-zero  elements  of matrix L will be kept by
C             subroutine Y12MC (i.e. if Y12MC is called  with
C             IFLAG(5) = 2).  Unchanged on exit.
C
C     RNR   - INTEGER  array  of  length  NN1 (see below). On
C             entry the first Z locations of array  RNR  must
C             contain   the   row  numbers  of  the  non-zero
C             elements of the coefficient  matrix  A  of  the
C             system  Ax  =  b so that the row numbers of the
C             non-zero elements in the first column of matrix
C             A  are  located  before  the row numbers of the
C             non-zero  elements  in  the  second  column  of
C             matrix  A,  the  row  numbers  of  the non-zero
C             elements in the second column of matrix  A  are
C             located  before the row numbers of the non-zero
C             elements in the third column of matrix A and so
C             on  (this  ordereing  is prepared by subroutine
C             Y12MB). The content of array RNR is modified by
C             subroutine   Y12MC.   On  successful  exit  all
C             components of array RNR will normally be  zero.
C
C     NN1   - INTEGER. On entry NN1 must contain  the  length
C             of   the  array  RNR.   Restriction:  NN1.ge.Z.
C             Recommended     value:       2*Z.le.NN1.le.3*Z.
C             Unchanged on exit.
C
C     PIVOT - REAL  (in  the single precision version Y12MCE)
C             or DOUBLE PRECISION (in  the  double  precision
C             version  Y12MCF) array of length N. The content
C             of array PIVOT is modified by subroutine Y12MC.
C             On successful exit array PIVOT will contain the
C             pivotal elements (  the  diagonal  elements  of
C             matrix  U). This means that a small element (or
C             small elements) in  array  PIVOT  on  exit  may
C             indicate    numerical    singularity   of   the
C             coefficient matrix A. Note that the smallest in
C             absolute value element in array PIVOT is stored
C             in AFLAG(8), see below.
C
C     B -     REAL (in the single precision  version  Y12MCE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MCF) array of length  N.  The  right
C             hand side vector b of the system Ax = b must be
C             stored in B on entry. The content of array B is
C             modified  by  subroutine  Y12MC.  On successful
C             exit array B will  contain  the  components  of
C             vector c = L**(-1)*P*b.
C
C     HA    - INTEGER  two-dimensional  array.  The length of
C             the first dimension of HA is IHA  (see  below).
C             The length of the second dimension of HA is 11.
C             The content of columns 1, 3, 4, 6, 7, 8 and  11
C             is  prepared by Y12MB (and thus they should not
C             be altered between calls of Y12MB  and  Y12MC).
C             The   content   of  array  HA  is  modified  by
C             subroutine   Y12MC.   The   non-zero   elements
C             (without  the  diagonal  elements)  of row i in
C             matrix L  (when  this  matrix  is  stored)  are
C             between HA(i,1) and HA(i,2) -1. If the non-zero
C             elements  of  matrix  L  are  not  stored  then
C             HA(i,1)=HA(i,2), i=1(1)N. The non-zero elements
C             of row i in  matrix  U  (without  the  diagonal
C             elements)   are   stored  between  HA(i,2)  and
C             HA(i,3).  Information concerning  the  row  and
C             column  interchanges  is  stored in HA(i,7) and
C             HA(i,8),   i=1(1)N-1.   Information  about  the
C             largest  number  of  non-zero elements found in
C             row i /  column  j  during  any  stage  of  the
C             elimination  is  stored (when IFLAG(4)=1  only)
C             in  HA(i,9)/HA(j,10).  The  other   information
C             stored  in  array HA is not used in the further
C             computations.
C
C     IHA   - INTEGER. On entry IHA must contain  the  length
C             of   the   first   dimension   of   array   HA.
C             Restriction: IHA
C            .ge.N. Unchanged on exit.
C
C     AFLAG - REAL  (in  the single precision version Y12MCE)
C             or DOUBLE PRECISION (in  the  double  precision
C             version  Y12MCF) array of length 8. The content
C             of the array can be described as follows:
C
C             AFLAG(1) -  Stability factor. An element can be
C                         chosen as pivotal element  only  if
C                         this element is larger (in absolute
C                         value) than the absolute  value  of
C                         the  largest  element  in  its  row
C                         divided  by  AFLAG(1).   On   entry
C                         AFLAG(1)   should  contain  a  real
C                         number larger than 1.0. If this  is
C                         not  so  then  the  subroutine sets
C                         AFLAG(1)  =   1.0005.   Recommended
C                         values:   AFLAG(1) ranging from 4.0
C                         to 16.0.  Unchanged on  exit  (when
C                         correctly initialized).
C
C             AFLAG(2)  - Drop-tolerance. An element which in
C                         the  process  of  the  computations
C                         becomes smaller (in absolute value)
C                         than the drop-tolerance is  removed
C                         from  array  A  (and  its  row  and
C                         column  numbers  are  removed  from
C                         arrays   RNR  and  SNR).  On  entry
C                         AFLAG(2)   should   contain    some
C                         positive   small  number  or  zero.
C                         Recommended   value   AFLAG(2)    =
C                         1.0E-12  when  matrix  A is not too
C                         badly scaled and the  magnitude  of
C                         the   elements   is   1,  otherwise
C                         smaller values of  AFLAG(2)  should
C                         be used.  Unchanged on exit.
C
C              AFLAG(3) - The   subroutine   will   stop  the
C                         computation when the growth  factor
C                         (parameter   AFLAG(5),  see  below)
C                         becomes larger  than  AFLAG(3).  On
C                         entry  AFLAG(3)  should  contain  a
C                         large    positive    number.     If
C                         AFLAG(3)<1.0e5  then the subroutine
C                         sets  AFLAG(3)=1.0e5.   Recommended
C                         value   AFLAG(3)=1.0E6.   Unchanged
C                         on     exit     (when     correctly
C                         initialized).
C
C              AFLAG(4) - The   subroutine   will   stop  the
C                         computation when the absolute value
C                         of  a  current  pivotal  element is
C                         smaller   than    AFLAG(4)*AFLAG(6)
C                         (parameter  AFLAG(6)  is  described
C                         below).  On  entry  AFLAG(4)   must
C                         contain    a   small   non-negative
C                         number.  If  AFLAG(4)<0   on  entry
C                         then     the     subroutine    sets
C                         AFLAG(4)=-AFLAG(4).     Recommended
C                         value  AFLAG(4)=1.0E-12.  Unchanged
C                         on     exit     (when     correctly
C                         initialized).
C
C             AFLAG(5)  - Growth   factor.   The  content  of
C                         parameter AFLAG(5) is  modified  by
C                         subroutine  Y12MC. After each stage
C                         of   the    Gaussian    elimination
C                         subroutine  Y12MC  sets  AFLAG(5) =
C                         AFLAG(7)/AFLAG(6)       (parameters
C                         AFLAG(6) and AFLAG(7) are described
C                         below). On  exit  large  values  of
C                         parameters  AFLAG(5)  indicate that
C                         an   appreciable   error   in   the
C                         computed  solution  is possible. In
C                         an    extreme    case    ,    where
C                         AFLAG(5)>AFLAG(3)   the  subroutine
C                         will terminate the computations  in
C                         an attempt to prevent overflow (and
C                         IFAIL will be set equal to 4).
C
C             AFLAG(6)  - On entry AFLAG(6) is equal  to  the
C                         largest  element in the coefficient
C                         matrix A of the system Ax = b  (set
C                         by subroutine Y12MB).  Unchanged on
C                         exit.
C
C             AFLAG(7)  - On exit the  largest  (in  absolute
C                         value)  element  found  during  any
C                         stage of the  elimination  will  be
C                         stored  in AFLAG(7). The content of
C                         parameter AFLAG(7) is  modified  by
C                         subroutine Y12MC.
C
C             AFLAG(8)  - On  entry  the minimal (in absolute
C                         value)  pivotal  element  will   be
C                         stored in AFLAG(8). Small values of
C                         AFLAG(8)     indicate     numerical
C                         singularity   of   the  coefficient
C                         matrix A. We  advise  the  user  to
C                         check  this  parameter on exit from
C                         the calculation very carefully. The
C                         content  of  parameter  AFLAG(8) is
C                         modified by the subroutine Y12MC.
C
C     IFLAG - INTEGER array of length 10. The content of this
C             array is  modified  by  subroutine  Y12MC.  The
C             contents of the components of this array can be
C             described as follows.
C
C             IFLAG(1) - This parameter is used in connection
C                        with the error diagnostics. The user
C                        should  set IFLAG(1).ge.0 before the
C                        call of package  Y12M  (i.e.  before
C                        the  first  call  of a subroutine of
C                        this package). IFLAG(1) is  used  in
C                        the  error checks by the subroutines
C                        and should not  be  altered  by  the
C                        user   between  any  two  successive
C                        calls of subroutines of the package.
C                        IFLAG(1)  will  be  equal  to  -2 on
C                        successful  exit   from   subroutine
C                        Y12MC. Thus, the content of IFLAG(1)
C                        is modified by subroutine Y12MC.
C
C             IFLAG(2) - On entry IFLAG(2) must contain  some
C                        positive  integer smaller than N. We
C                        recommend IFLAG(2).le.3. If IFLAG(3)
C                        =  0  then this parameter is ignored
C                        by     subroutine     Y12MC.      If
C                        IFLAG((3).ge.0   then   the  pivotal
C                        search   at   any   stage   of   the
C                        elimination (except possibly some of
C                        the last stages) is carried  out  in
C                        the  IFLAG(2)  rows which have least
C                        numbers   of   non-zero    elements.
C                        Unchanged on exit.
C
C             IFLAG(3) - On  entry IFLAG(3) must contain 0, 1
C                        or 2.  For  general  pivotal  search
C                        IFLAG(3)  should  be set equal to 1.
C                        If IFLAG(3) = 2 then  only  diagonal
C                        elements of the coefficient matrix A
C                        will   be   selected   as    pivotal
C                        elements.  If  IFLAG(3) = 0 then the
C                        Gaussian elimination will be carried
C                        out     without     any    pivoting.
C                        IFLAG(3)=0 or IFLAG(3)=2  (i.e.  one
C                        of the special pivotal strategies is
C                        to be applied) should be  used  very
C                        carefully    because    the    error
C                        diagnostics algorithm may not  trace
C                        all   errors   in  this  case.   For
C                        example, if the user attempts to use
C                        IFLAG(3)=0   for   matrix   A  which
C                        contains zero elements on  the  main
C                        diagonal, then the run will often be
C                        stopped because a division  by  zero
C                        occurs.  Unchanged on exit.
C
C             IFLAG(4) - On  entry IFLAG(4) must contain 0, 1
C                        or 2.  IFLAG(4)  =  0  is  the  best
C                        choice  when  (i) only one system is
C                        to be solved, (ii) the first  system
C                        of  a  sequence  of systems with the
C                        same matrix (Ax = b1, Ax = b2,  ...,
C                        Ax = bp) is to be solved, (iii) when
C                        any system in a sequence of  systems
C                        whose   matrices  are  of  different
C                        structure is to be solved.  IFLAG(4)
C                        =  1  is  the  best  choice when the
C                        first  system  of  a   sequence   of
C                        systems  whose  matrices  are of the
C                        same structure is to be  solved.  In
C                        this case IFLAG(4) = 2 is to be used
C                        in the solution of any system  after
C                        the first one.  Unchanged on exit.
C
C             IFLAG(5) - On  entry IFLAG(5) must contain 1 or
C                        2.   If  IFLAG(5)  =  1   then   the
C                        non-zero  elements  of matrix L will
C                        be removed. If IFLAG(5) = 2 then the
C                        non-zero  elements  of matrix L will
C                        be stored.  Unchanged on exit.
C
C             IFLAG(6) - On successful exit IFLAG(6) will  be
C                        equal  to  the  number  of "garbage"
C                        collections in the row ordered list.
C                        If  IFLAG(6)  is  large  then  it is
C                        better to choose a larger  value  of
C                        NN  with  next  calls  of subroutine
C                        Y12MC with the  same  or  a  similar
C                        matrix   A.  This  will  lead  to  a
C                        reduction  in  the  computing  time.
C                        The  content of IFLAG(6) is modified
C                        by the subroutine Y12MC.
C
C             IFLAG(7) - On successful exit IFLAG(7) will  be
C                        equal  to  the  number  of "garbage"
C                        collections in  the  column  ordered
C                        list.   If IFLAG(7) is large then it
C                        is better to choose a  larger  value
C                        of   NN1   in   the  next  calls  of
C                        subroutine Y12MC with the same or  a
C                        similar  matrix A. This will lead to
C                        a reduction in the  computing  time.
C                        The  content of IFLAG(7) is modified
C                        by subroutine Y12MC.
C
C             IFLAG(8) - On successful exit IFLAG(8) will  be
C                        equal   to  the  maximal  number  of
C                        non-zero elements kept in array A at
C                        any    stage    of    the   Gaussian
C                        elimination.  If  IFLAG(8)  is  much
C                        smaller  then  NN  (or NN1) then the
C                        length NN (or  NN1)  can  be  chosen
C                        smaller  in next calls of subroutine
C                        Y12MC with the  same  or  a  similar
C                        matrix   A.  This  will  lead  to  a
C                        reduction of the storage needed. The
C                        content  of  IFLAG(8) is modified by
C                        subroutine Y12MC.
C
C             IFLAG(9) - The content of IFLAG(3) is  modified
C                        by  subroutine Y12MC when IFLAG(4) =
C                        1  and   ignored   otherwise.    The
C                        minimal  length  NN1 such that Y12MC
C                        can solve systems whose matrices are
C                        of   the   same   structure  without
C                        "garbage" collections in the  column
C                        ordered   list   and   "movings"  of
C                        columns at the  end  of  the  column
C                        ordered  list  is stored in IFLAG(9)
C                        after  the  solution  of  the  first
C                        system   in   the   sequence   (with
C                        IFLAG(4) = 1).
C
C             IFLAG(10)- The content of IFLAG(10) is modified
C                        by   the   subroutine   Y12MC   when
C                        IFLAG(4) = 1 and ignored  otherwise.
C                        The  minimal  length  NN  such  that
C                        subroutine Y12MC can  solve  systems
C                        whose   matrices  are  of  the  same
C                        structure     without      "garbage"
C                        collections  in the row ordered list
C                        and "movings" of rows to the end  of
C                        the  row  ordered  list is stored in
C                        IFLAG(10) after the solution of  the
C                        first  system  in the sequence (with
C                        IFLAG(4) = 1).
C
C     IFAIL - Error  diagnostics  parameter.  The  content of
C             parameter  IFAIL  is  modified  by   subroutine
C             Y12MC.  On exit IFAIL = 0 if the subroutine has
C             not detected  any  error.  Positive  values  of
C             IFAIL  on  exit  show  that some error has been
C             detected by the subroutine. Many of  the  error
C             diagnostics  are  common for all subroutines in
C             the package.  Therefore the  error  diagnostics
C             are listed in a separate section, Section 7, of
C             this book. We advise  the  user  to  check  the
C             value of this parameter on exit.
C
C     5.  Error diagnostics
C
C     Error diagnostics are given by positive values  of  the
C     parameter  IFAIL  (see  above).   We advise the user to
C     check carefully the value of this  parameter  on  exit.
C     The error messages are listed in Section 7.
C
C     6.  Auxiliary subroutines
C
C     None.
C
C     7.  Timing
C
C     The  time  taken  depends  on  the  order of the matrix
C     (parameter N), the number of the non-zero  elements  in
C     the matrix (parameter Z), the magnitude of the non-zero
C     elements and their distribution in the matrix.
C
C     8.  Storage
C
C     There are no internally declared arrays.
C
C     9.  Accuracy
C
C     It  is  difficult  to  evaluate  the  accuracy  of  the
C     computed  solution. Large values of parameter AFLAG(5),
C     the  growth  factor,  indicate  unstable   computations
C     during   the   decomposition  stage.  Small  values  of
C     parameter AFLAG(8) can be considered as  a  signal  for
C     numerical  singularity.  We  must  emphasize  here that
C     normally much more reliable evaluations of the accuracy
C     achieved   can   be  found  by  the  use  of  iterative
C     refinement, i.e. by the use of subroutine Y12MF. By the
C     use  of  the  latter subroutine the computing time will
C     often be reduced too.
C
C     10.  Some remarks
C
C     Remark 1   The values on entry of Y12MC are the same as
C                the  values  on  exit  of  Y12MB  for   many
C                parameters.  Therefore  the content of N, Z,
C                A, SNR, NN, RNR, NN1, columns 1, 3, 4, 6, 7,
C                8 and 11 of HA, AFLAG(6), IFLAG(1), IFLAG(4)
C                and IFAIL  should  not  be  changed  between
C                calls of Y12MB and Y12MC.
C
C     Remark 2   The  call  of  Y12MC is normally followed by
C                one or several calls of Y12MD.  The  content
C                of N, A, SNR, NN, B, PIVOT, columns 1, 2, 3,
C                7  and  8  of  HA,  IHA,  AFLAG,   IFLAG(1),
C                IFLAG(3),  IFLAG(4)  and IFAIL should not be
C                altered between calls of Y12MC and Y12MD.
C
C     Remark 3   If IFAIL > 0 on exit from Y12MC there is  no
C                justification  for  calling Y12MD. Therefore
C                the computations should  be  terminated  and
C                the user should investigate (using the error
C                diagnostics given in Section  7)  why  Y12MC
C                has assigned a positive value to IFAIL.
C                =================================
C                Documentation of subroutine Y12MD
C                =================================
C
C     1.  Purpose
C
C     Y12MD   solves   sparse  systems  of  linear  algebraic
C     equations.
C
C     2.  Calling sequence and declaration of the parameters
C
C     The subroutine is written in FORTRAN and  it  has  been
C     extensively  tested  with  the FOR and FTN compilers on
C     the UNIVAC 1100/82 computer at the  Regional  Computing
C     Centre  at  the  University of Copenhagen (RECKU). Many
C     examples have been run on an IBM 3033 computer  at  the
C     Northern Europe University Computing Centre (NEUCC) and
C     on a CDC Cyber 173 computer at the  Regional  Computing
C     Centre  at  the  University  of  Aarhus  (RECAU).   Two
C     different versions are available:  a  single  precision
C     version  named  Y12MDE  and  a double precision version
C     named Y12MDF. The calls of these two versions  and  the
C     declarations of the parameters are as follows.
C
C     A). Single precision version: Y12MDE
C
C           SUBROUTINE Y12MDE(N, A, NN, B, PIVOT, SNR,
C          1                  HA, IHA,, IFLAG, IFAIL)
C           REAL A(NN), PIVOT(N), B(N)
C           INTEGER SNR(NN), HA(IHA,11), IFLAG(10)
C           INTEGER N, NN, IHA, IFAIL
C
C     B). Double precision version: Y12MDF
C
C           SUBROUTINE Y12MDF(N, A, NN, B, PIVOT, SNR,
C          1                  HA, IHA,, IFLAG, IFAIL)
C           DOUBLE PRECISION A(NN), PIVOT(N), B(N)
C           INTEGER SNR(NN), HA(IHA,11), IFLAG(10)
C           INTEGER N, NN, IHA, IFAIL
C
C     These two versions can be used on many others computers
C     also. However some alterations may be needed and/or may
C     ensure  greater  efficiency  of  the performance of the
C     subroutine. For example, it will be much more efficient
C     to declare arrays SNR and (if possible) HA as INTEGER*2
C     arrays on some IBM installations.
C
C
C     3.  Method
C
C     The  LU  decomposition  (or  only  the upper triangular
C     matrix U if the  vector  c  =  L**(-1)*P*b  is  already
C     computed)  is  used  to  obtain an approximation to the
C     solution vector  x  of  the  system  Ax  =  b.  The  LU
C     decomposition  (or only matrix U ) must be available on
C     entry. This means that if a system with a new matrix is
C     solved  then  the  call  of  subroutine  Y12MD  must be
C     preceded by a call of Y12MC and the  contents  of  some
C     parameters and arrays should not be altered between the
C     calls of Y12MC and Y12MD. If a  system  with  the  same
C     matrix  has already been solved, then Y12MD only should
C     be called (but the  contents  of  some  parameters  and
C     arrays  used  in the preceding call of Y12MD should not
C     be altered).
C
C     4.  Parameters of the subroutine
C
C     N     - INTEGER.  On entry N must contain the number of
C             equations in the  system   Ax=b.  Unchanged  on
C             exit.
C
C     A     - REAL  (in  the single precision version Y12MDE)
C             or DOUBLE PRECISION (in  the  double  precision
C             version Y12MDF) array of length NN (see below).
C             On entry array  A  must  contain  the  non-zero
C             elements  of  the  upper  triangular  matrix  U
C             (without the diagonal elements)  and  sometimes
C             also   the   non-zero  elements  of  the  lower
C             triangular matrix L under the  diagonal  (these
C             elements   are  calculated  by  the  subroutine
C             Y12MC, the non-zero elements of L are stored by
C             Y12MC  only when this subroutine is called with
C             IFLAG(5) = 2). The content of the  array  A  is
C             not modified by subroutine Y12MD.
C
C     NN   -  INTEGER. On entry NN must contain the length of
C             the arrays A and SNR.   Restriction:  NN  >  Z.
C             Recommended  value:  2*Z  <  NN  <  3*Z  if the
C             non-zero elements of matrix L will  be  removed
C             during  the  decomposition  (i.e. if subroutine
C             Y12MC is called with IFLAG(5) = 1) and 3*Z < NN
C             < 5*Z if the non-zero elements of matrix L will
C             be stored during the decomposition (i.e. if the
C             subroutine  Y12MC is called with IFLAG(5) = 2).
C             Unchanged on exit.
C
C     B -     REAL (in the single precision  version  Y12MDE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version  Y12MDF)  array   of   length   N.   If
C             subroutine   Y12MC   has  been  called  in  the
C             solution  of  system   Ax   =   b   (i.e.    if
C             IFLAG(5)<3), then on entry array B must contain
C             vector c = L**(-1)*P*b (computed by Y12MC).  If
C             subroutine  Y12MC  has  not  been called in the
C             solution of system Ax = b (i.e  a  system  with
C             the  same matrix has been solved before solving
C             Ax = b and the old LU decomposition is used  by
C             setting  IFLAG(5)  =  3, see below) the array B
C             must contain the right hand side  vector  b  on
C             entry.   The content of the array B is modified
C             by the subroutine Y12MD. On successful exit  an
C             approximation  to  the  true solution x will be
C             found in B.
C
C     PIVOT - REAL (in the single precision  version  Y12MDE)
C             or  DOUBLE  PRECISION  (in the double precision
C             version Y12MDF) array of length N. On entry the
C             diagonal   elements  of  the  upper  triangular
C             matrix U must be stored in array  PIVOT  (these
C             elements  are calculated and stored in PIVOT by
C             subroutine Y12MC).  Unchanged on exit.
C
C     SNR   - INTEGER array of  length  NN  (see  below).  On
C             entry   the  column  numbers  of  the  non-zero
C             elements  of  the  upper  triangular  matrix  U
C             (without  the  column  numbers  of the non-zero
C             elements on the diagonal)  and  sometimes  also
C             the  column numbers of the non-zero elements of
C             the lower  triangular  matrix  L  (without  the
C             column  numbers of the non-zero elements on the
C             diagonal) must be stored in  array  SNR.   This
C             structure  is prepared by Y12MC. The content of
C             array SNR is not  modified  by  the  subroutine
C             Y12MD.
C
C     HA    - INTEGER  two-dimesional  array.   The length of
C             the first dimension of HA is IHA  (see  below).
C             The length of the second dimension of HA is 11.
C             The content of columns 4, 5, 6, 9, 10 and 11 is
C             ignored  by  subroutine  Y12MD.  The content of
C             columns  1,  2,  3,  7  and  8  is  stored   by
C             subroutine  Y12MC  and  should  not  be altered
C             between calls of Y12MC and Y12MD. Unchanged  on
C             exit.
C
C     IHA   - INTEGER.  On  entry IHA must contain the length
C             of   the   first   dimension   of   array   HA.
C             Restriction: IHA .ge. N. Unchanged on exit.
C
C     IFLAG - INTEGER array of length 10. The contents of all
C             locations   in   this  array  except  IFLAG(1),
C             IFLAG(3), IFLAG(4) and IFLAG(5) are ignored  by
C             subroutine  Y12MD. The user should set IFLAG(1)
C             .ge. 0 before the call of  package  Y12M  (i.e.
C             before  the  first call of a subroutine of this
C             package). IFLAG(1) is used in the error  checks
C             by the subroutines and should not be altered by
C             the user between any two  successive  calls  of
C             subroutines  of  the package. IFLAG(1) is equal
C             to  -2  both on entry and  on  successful  exit
C             from  subroutine  Y12MD.  Thus,  the content of
C             IFLAG(1) is not modified by  subroutine  Y12MD.
C             The  same  values  of  IFLAG(3) and IFLAG(4) as
C             those in the preceding call of Y12MC should  be
C             used.  If  subroutine  Y12MC has been called in
C             the solution of the system  Ax  =  b,  then  on
C             entry  IFLAG(5)  must have the same value as on
C             entry of Y12MC. If  subroutine  Y12MC  has  not
C             been  called in the solution of the system Ax =
C             b (i.e. a system with the same matrix has  been
C             solved  before  solving  Ax  =  b  and  the  LU
C             decomposition of matrix A  is  thus  available)
C             then  on entry IFLAG(5) must contain the number
C             3. The content of array IFLAG is  unchanged  on
C             exit.
C
C     IFAIL - Error  diagnostics  parameter.  The  content of
C             parameter  IFAIL  is  modified  by   subroutine
C             Y12MA.  On exit IFAIL = 0 if the subroutine has
C             not detected  any  error.  Positive  values  of
C             IFAIL  on  exit  show  that some error has been
C             detected by the subroutine. Many of  the  error
C             diagnostics  are  common for all subroutines in
C             the package.  Therefore the  error  diagnostics
C             are listed in a separate section, Section 7, of
C             this book. We advise  the  user  to  check  the
C             value of this parameter on exit.
C
C     5.  Error diagnostics
C
C     Error diagnostics are given by positive values  of  the
C     parameter  IFAIL  (see  above).   We advise the user to
C     check carefully the value of this  parameter  on  exit.
C     The error messages are listed in Section 7.
C
C     6.  Auxiliary subroutines
C
C     None.
C
C     7.  Timing
C
C     The  time  taken  depends  on  the  order of the matrix
C     (parameter N) and the number of the  non-zero  elements
C     in the LU-decomposition of matrix A.
C
C     8.  Storage
C
C     There are no internally declared arrays.
C
C     9.  Accuracy
C
C     It  is  difficult  to  evaluate  the  accuracy  of  the
C     computed solution. Large values of parameter  AFLAG(5),
C     the   growth  factor,  indicate  unstable  computations
C     during  the  decomposition  stage.  Small   values   of
C     parameter AFLAG(8), the minimal pivotal element, can be
C     considered as a signal for  numerical  singularity.  We
C     must  emphasize  here  that normally much more reliable
C     evaluations of the accuracy achieved can  be  found  by
C     the  use  of  iterative  refinement, i.e. by the use of
C     subroutine Y12MF. By the use of the  latter  subroutine
C     the  computing time will often be reduced too. However,
C     the storage requirements may sometimes be increased.
C
C     10.  Some remarks
C
C     Remark 1 The content of N, A, SNR, NN, columns 1, 2, 3,
C              7 and 8 of HA,  IHA,  IFLAG(3),  IFLAG(4)  and
C              IFAIL  should  not be altered between calls of
C              Y12MC and Y12MD.
C
C     Remark 2 If   the  LU  decomposition  of  matrix  A  is
C              available (i.e. a system  with  matrix  A  has
C              already  been  solved)  then  Y12MB  and Y12MC
C              should not be called.  The  user  should  only
C              assign the new right hand side vector to array
C              B, set IFLAG(5) = 3 and call Y12MD.
C                =================================
C                Documentation of subroutine Y12MF
C                =================================
C
C     1.  Purpose
C
C     Large  and sparse systems of linear algebraic equations
C     with  real  coefficients  are  solved  by  the  use  of
C     Gaussian   elimination  and  sparse  matrix  technique.
C     Iterative refinement is applied in order to improve the
C     accuracy.
C
C     2.  Calling sequence and declaration of the parameters
C
C     The  subroutine  is  written  in  FORTRAN  and has been
C     extensively tested with the FOR and  FTN  compilers  on
C     the  UNIVAC  1100/82 computer at the Regional Computing
C     Centre at the University of  Copenhagen  (RECKU).  Many
C     examples  have  been run on an IBM 3033 computer at the
C     Northern Europe University Computing Centre (NEUCC) and
C     on  a  CDC Cyber 173 computer at the Regional Computing
C     Centre at the University of  Aarhus  (RECAU).   Only  a
C     single precision version, Y12MFE, of this subroutine is
C     available.  The  call  of  the   subroutine   and   the
C     declarations of the parameters are as follows.
C
C           SUBROUTINE Y12MFE(N, A, SNR, NN, RNR, NN1, A1,
C     SN, NZ,
C          1                  HA, IHA, B, B1, X, Y, AFLAG,
C     IFLAG, IFAIL)
C           REAL A(NN), B(N), B1(N), X(N), Y(N), A1(NZ),
C     AFLAG(11)
C           INTEGER SNR(NN), RNR(NN1), HA(IHA,13), SN(NZ),
C     IFLAG(12)
C           INTEGER N, NN, NN1, NZ, IHA, IFAIL
C
C     This  subroutine  can  be  used on many other computers
C     also. However, some alterations may  be  needed  and/or
C     may ensure greater efficiency of the performance of the
C     subroutine.   For  example,  it  will  be   much   more
C     efficient  to  declare  arrays  SNR,  RNR,  SN  and (if
C     possible)  HA  as  INTEGER*2   arrays   on   some   IBM
C     instalations.  Note too that the subroutine accumulates
C     some inner products in double precision and then rounds
C     them  to  single  precision.  Therefore  if  the use of
C     double precision is very expensive (in comparison  with
C     the  use  of  single  precision) on the computer at the
C     user's disposal then it will not be  efficient  to  use
C     subroutine  Y12MF. The single precision versions of the
C     other subroutines should be used in this situation.
C
C     3.  Method
C
C     Consider the system Ax = b, where matrix A  is  sparse.
C     The  non-zero  elements of matrix A are ordered by rows
C     (subroutine Y12MB is called to perform this  operation)
C     and  then  factorized  into two triangular matrices, an
C     upper triangular matrix U and a unit  lower  triangular
C     matrix  L  (subroutine Y12MC is called to calculate the
C     non-zero elements of U amd L). The factorized system is
C     solved  (subroutine  Y12MD  is  called  to calculate an
C     approximation x1 to  the  solution  vector  x)  and  an
C     attempt  to  improve  the  first  solution by iterative
C     refinement is carried out in the following way:
C
C                      r(k-1) = b - A*x(k-1)
C
C                d(k-1) = Q*U**(-1)*L(-1)*P*r(k-1)
C
C                    x(k)    = X(k-1) + d(k-1)
C
C                     where k = 2, 3, ..., p.
C
C     Normally, this process will improve the accuracy of the
C     first solution x1. If the process is not convergent  or
C     the convegence is very slow, then information about the
C     trouble can be  obtained  by  checking  the  parameters
C     AFLAG(10)  (the  max-norm  of  the last residual vector
C     r(p-1) computed by Y12MF) and AFLAG(9) (the max-norm of
C     the last correction vector, d(p-1), computed by Y12MF).
C     We advise the user to check carefully these  parameters
C     on exit. Large values of these parameters show that the
C     computed solution is not very accurate.
C
C     4.  Parameters of the subroutine
C
C     N     - INTEGER.  On entry N must contain the number of
C             equations in the  system   Ax=b.  Unchanged  on
C             exit.
C
C     A     - REAL  array  of  length  NN (see below). If the
C             coefficient matrix must be factorized (in  this
C             case  IFLAG(5) = 2), then on entry the first NZ
C             locations of array A must contain the  non-zero
C             elements of matrix A, the order of the elements
C             can  be  arbitrary.  If  the  factorization  of
C             matrix  A  is available (i.e. a system with the
C             same matrix has been solved in a previous  call
C             of  Y12MF)  then  on entry array A must contain
C             the non-zero elements of U and L (IFLAG(5) =  3
C             should  also  be  assigned  in  this case). The
C             content of array A is modified  by  Y12MF  when
C             the  coefficient  matrix  has to be factorized.
C             Unchanged on exit when an old LU  factorization
C             is  used.  The content of array A should not be
C             altered between successive calls of  Y12MF  for
C             the solution of systems with the same matrices.
C
C     SNR   - INTEGER  array of the length NN (see below). If
C             the coefficient matrix  A  must  be  factorized
C             then on entry the first NZ positions of array A
C             must contain the column numbers of the non-zero
C             elements  of  matrix A (ordered as the non-zero
C             elements in array A). The content of array  SNR
C             is  modified  by  the  subroutine Y12MF in this
C             case. If the LU factorization of  matrix  A  is
C             available  then on entry array SNR must contain
C             the column numbers of the non-zero elements  of
C             U  and L. The content of array SNR is unchanged
C             on exit in this case. The content of array  SNR
C             should  not be altered between successive calls
C             of Y12MF for the solution of systems  with  the
C             same matrices.
C
C     NN    - INTEGER. On entry NN must contain the length of
C             array A and  SNR.  Restriction:  NN  .ge.  2*Z.
C             Recommended  value:  2*Z   .le.  NN  .le.   3*Z
C             Unchanged on exit.
C
C     RNR   - INTEGER array of length NN1 (see below). If the
C             coefficient  matrix  A must be factorized, then
C             on entry the first NZ positions  of  array  RNR
C             must  contain  the  row numbers of the non-zero
C             elements of matrix A (ordered as  the  non-zero
C             elements  in array A). The content of array RNR
C             is modified by the subroutine in this case.  If
C             the  LU  factorization of matrix A is available
C             then the content of array RNR is ignored by the
C             subroutine Y12MF.
C
C     NN1   - INTEGER.  On  entry NN1 must contain the length
C             of the array RNR.   Restriction:  NN1  .ge.  Z.
C             Recommended  value:  1.5*Z  .le.  NN1 .le. 2*Z.
C             Unchanged on exit.
C
C     A1    - REAL array  of  length  NZ  (see  below).   The
C             content  of  array A1 is modified by subroutine
C             Y12MF  when  the  LU   factorization   of   the
C             coefficient   matrix   A   is   not  available.
C             Subroutine Y12MF copies the first NZ  locations
C             of  array  A  into array A1 in this case (after
C             the internal call of  Y12MB;  this  means  that
C             array  A1 contains the non-zero elements of the
C             coefficient matrix A ordered by rows on  exit).
C             If  the  LU  factorization  of  the coefficient
C             matrix A is available then the content of array
C             A1  is unchanged on exit.  The content of array
C             A1 should  not  be  altered  between  successve
C             calls  of Y12MF in the solution of systems with
C             the same matrices.
C
C     SN    - INTEGER array of length  NZ  (see  below).  The
C             content  of  array SN is modified by subroutine
C             Y12MF  when  the  LU   factorization   of   the
C             coefficient   matrix   A   is   not  available.
C             Subroutine Y12MF copies the first NZ  locations
C             of  array SNR into array SN in this case (after
C             the internal call of  Y12MB;  this  means  that
C             array  SN  contains  the  column numbers of the
C             non-zero elements ordered by rows on exit).  If
C             the  LU  factorization  is  available  then the
C             content of array SN is unchanged on  exit.  The
C             content  of  array  SN  should  not  be altered
C             between  successive  calls  of  Y12MF  in   the
C             solution of systems with the same matrices.
C
C     NZ    - INTEGER. On entry NZ must contain the number of
C             non-zero elements in the coefficient  matrix  A
C             of the system Ax = b. Unchanged on exit.
C
C     HA    - INTEGER  two-dimensional  array.  The length of
C             the first dimension of HA is IHA  (see  below).
C             The length of the second dimension of HA is 13.
C             If a new decomposition  should  be  calculated,
C             then  subroutine Y12MF modifies the contents of
C             HA. The contents on exit of some of the columns
C             of  array HA are described in the documentation
C             of  subroutine  Y12MC.  The  last  two  columns
C             (12'th  and  13'th) contain on exit information
C             about the row starts and the row  ends  in  the
C             original matrix (after the non-zero elements of
C             this matrix have been ordered  by  rows);  this
C             means  that  the  non-zero elements in row i of
C             the coefficient matrix A  are  located  between
C             positions  HA(i,12)  and  HA(i,13)  in array A1
C             (the column numbers of the non-zero elements in
C             row   i  are  also  located  between  positions
C             HA(i,12) and HA(i,13)  in  array  SN).  If  the
C             matrix  of the system has the same structure as
C             the matrix of a system which is already solved,
C             then  subroutine Y12MF will use the information
C             stored in columns 7, 8, 9 and 10 of  HA  during
C             the  previous  call (therefore this information
C             should not be altered). If the LU decomposition
C             of  the  coefficient  matrix is available, then
C             the contents of array HA are unchanged on exit.
C             The  contents  of columns 1, 2, 3, 7, 8, 12 and
C             13 of array HA should not  be  altered  between
C             successive  calls  of  Y12MF in the solution of
C             systems with the same matrix.
C
C     IHA   - INTEGER. On entry IHA must contain  the  length
C             of   the   first   dimension   of   array   HA.
C             Restriction: IHA .ge. N. Unchanged on exit.
C
C     B     - REAL array of length N. On entry the right-hand
C             side vector b of  the  system   Ax=b   must  be
C             stored  in  array  B. The content of array B is
C             modified by subroutine  Y12MF.   On  successful
C             exit  the  components  of  the  last correction
C             vector d(p-1) are stored in array B.
C
C     B1 -    REAL array of length N. The content of array B1
C             is modified by subroutine Y12MF. The right hand
C             side vector of the system Ax = b is  stored  in
C             array B1 on successful exit.
C
C     X -     REAL  array of length N. The content of array X
C             is  modified  by  the  subroutine   Y12MF.   On
C             successful  exit  the corrected solution vector
C             is stored in array X.
C
C     Y -     REAL array of length N. The content of array  Y
C             is  modified by subroutine Y12MF. On successful
C             exit array Y will contain the pivotal  elements
C             (the diagonal elements of matrix U). This means
C             that a small element  (or  small  elements)  in
C             array   Y   on   exit  may  indicate  numerical
C             singularity of the coefficient matrix  A.  Note
C             that  the smallest in absolute value element in
C             array Y is also stored in AFLAG(8), see  below.
C
C     AFLAG - REAL array of length 11.  The  content  of  the
C             array can be described as follows:
C
C             AFLAG(1) -  Stability factor. An element can be
C                         chosen  as  pivotal element only if
C                         this element is larger (in absolute
C                         value)  than  the absolute value of
C                         the  largest  element  in  its  row
C                         divided   by   AFLAG(1).  On  entry
C                         AFLAG(1)  should  contain  a   real
C                         number  larger than 1.0. If this is
C                         not so  then  the  subroutine  sets
C                         AFLAG(1)   =   1.0005.  Recommended
C                         values of AFLAG(1) ranging from 4.0
C                         to  16.0.   Unchanged on exit (when
C                         correctly initialized).
C
C             AFLAG(2) -  Drop-tolerance. An element which in
C                         the  process  of  the  computations
C                         becomes smaller(in absolute  value)
C                         than  the drop-tolerance is removed
C                         from  array  A  (and  its  row  and
C                         column  numbers  are  removed  from
C                         arrays RNR  and  SNR).  Recommended
C                         value:   on entry  AFLAG(2)  should
C                         be in the interval
C                         (a*1.0E-4,a*1.0E-1)  where a is the
C                         magnitude of the elements.  If  the
C                         magnitude    a    of  the  non-zero
C                         elements is  not  known,  then  the
C                         user  should intialize the required
C                         drop-tolerance multiplied  by   -1.
C                         Let a(i) be the maximal element (in
C                         absolute value) in row i (  i=1(1)N
C                         ).   Let  a  be  the minimal number
C                         among all a(i). If a negative value
C                         of   AFLAG(2)   is   assigned,  the
C                         subroutine computes  a  and uses  a
C                         drop-tolerance       equal       to
C                         -AFLAG(2)*a.     In    the    above
C                         considerations  it  is assumed that
C                         the coefficient matrix A is not too
C                         badly  scaled.  If  this  is not so
C                         then perform  row  scaling  of  the
C                         coefficient   matrix  so  that  the
C                         largest elements in the rows are of
C                         magnitude  1 and choose AFLAG(2) in
C                         the    interval    (1.0E-5,1.0E-3).
C                         Unchanged on exit.
C
C             AFLAG(3) -  The   subroutine   will   stop  the
C                         computation when the growth  factor
C                         (parameter   AFLAG(5),  see  below)
C                         becomes larger  than  AFLAG(3).  On
C                         entry  AFLAG(3)  should  contain  a
C                         large    positive    number.     If
C                         AFLAG(3)<1.0E5  then the subroutine
C                         sets  AFLAG(3)=1.0E5.   Recommended
C                         value   AFLAG(3)=1.0E16.  Unchanged
C                         on     exit     (when     correctly
C                         initialized).
C
C             AFLAG(4) -  The   subroutine   will   stop  the
C                         computation when the absolute value
C                         of  a  current  pivotal  element is
C                         smaller   than    AFLAG(4)*AFLAG(6)
C                         (parameter  AFLAG(6)  is  described
C                         below).  On  entry  AFLAG(4)   must
C                         contain    a   small   non-negative
C                         number.  If  AFLAG(4)<0   then  the
C                         subroutine sets
C                         AFLAG(4)=-AFLAG(4).     Recommended
C                         value   AFLAG(4)=1.0E-12. Unchanged
C                         on     exit     (when     correctly
C                         intialized).
C
C             AFLAG(5) -  Growth   factor.   The  content  of
C                         parameter AFLAG(5) is  modified  by
C                         subroutine  Y12MF. After each stage
C                         of   the    Gaussian    elimination
C                         subroutine  Y12MF  sets  AFLAG(5) =
C                         AFLAG(7)/AFLAG(6)       (parameters
C                         AFLAG(6) and AFLAG(7) are described
C                         below). On  exit  large  values  of
C                         parameters  AFLAG(5)  indicate that
C                         an   appreciable   error   in   the
C                         computed  solution  is possible. In
C                         an extreme case, where
C                         AFLAG(5)>AFLAG(3),  the  subroutine
C                         will terminate the computations  in
C                         an attempt to prevent overflow.
C
C             AFLAG(6) -  On  exit  AFLAG(6)  is equal to the
C                         largest element in the  coefficient
C                         matrix  A of the system  Ax=b  (set
C                         by subroutine Y12MB). Unchanged  on
C                         exit.
C
C             AFLAG(7) -  On  exit  the  largest (in absolute
C                         value)  element  found  during  any
C                         stage  of  the  elimination will be
C                         stored in AFLAG(7). The content  of
C                         parameter  AFLAG(7)  is modified by
C                         subroutine Y12MF.
C
C             AFLAG(8) -  On exit the  minimal  (in  absolute
C                         value)   pivotal  element  will  be
C                         stored in AFLAG(8). Small values of
C                         AFLAG(8)     indicate     numerical
C                         singularity  of   the   coefficient
C                         matrix  A.  We  advise  the user to
C                         check this parameter on  exit  from
C                         the calculation very carefully. The
C                         content of  parameter  AFLAG(8)  is
C                         modified by the subroutine Y12MF.
C
C             AFLAG(9) -  The content of AFLAG(9) is modified
C                         by  the   subroutine   Y12MF.   The
C                         max-norm  of  the  last  correction
C                         vector d(p-1)  will  be  stored  in
C                         AFLAG(9)  on  successful  exit.  We
C                         advise the user to check  carefully
C                         this parameter.
C
C             AFLAG(10) - The   content   of   AFLAG(10)   is
C                         modified by the  subroutine  Y12MF.
C                         The  max-norm  of the last residual
C                         vector r(p-1)  will  be  stored  in
C                         AFLAG(10)  on  successful  exit. We
C                         advise the user to check  carefully
C                         this parameter.
C
C             AFLAG(11) - The   content   of   AFLAG(11)   is
C                         modified by the  subroutine  Y12MF.
C                         On  exit AFLAG(11) will contain the
C                         max-norm of the corrected  solution
C                         vector.  If  the value of AFLAG(11)
C                         is  not  to  close  to  zero   then
C                         AFLAG(9)/AFLAG(11)   will  normally
C                         give an excellent evaluation of the
C                         relative   error  in  the  solution
C                         vector.
C
C     IFLAG - INTEGER array of length 12. The content of this
C             array can be described as follows:
C
C             IFLAG(1) - This  parameter  is  used  as a work
C                        space by subroutine Y12MF.
C
C             IFLAG(2) - On entry IFLAG(2) must contain  some
C                        positive  integer smaller than N. We
C                        recommend  IFLAG(2)   .le.   3.   If
C                        IFLAG(3)  = 0 then this parameter is
C                        ignored  by  subroutine  Y12MF.   If
C                        IFLAG((2)  .ge.  0  then the pivotal
C                        search   at   any   stage   of   the
C                        elimination (except possibly some of
C                        the last stages) is carried  out  in
C                        the  IFLAG(2)  rows which have least
C                        number   of    non-zero    elements.
C                        Unchanged on exit.
C
C             IFLAG(3) - On  entry IFLAG(3) must contain 0, 1
C                        or 2.  For  general  pivotal  search
C                        IFLAG(3)  should  be set equal to 1.
C                        If IFLAG(3) = 2 then  only  diagonal
C                        elements of the coefficient matrix A
C                        can be selected as pivotal elements.
C                        If  IFLAG(3)  =  0 then the Gaussian
C                        elimination  will  be  carried   out
C                        without any pivoting.  IFLAG(3)=0 or
C                        IFLAG(3)=2 (i.e. one of the  special
C                        pivotal strategies is to be applied)
C                        should  be   used   very   carefully
C                        because    the   error   diagnostics
C                        algorithm may not trace  all  errors
C                        in this case.  Unchanged on exit.
C
C             IFLAG(4) - On  entry IFLAG(4) must contain 0, 1
C                        or 2.  IFLAG(4)  =  0  is  the  best
C                        choice  when  (i) only one system is
C                        to be solved, (ii) the first  system
C                        of  a  sequence  of systems with the
C                        same  matrix  (Ax   =   b1,   Ax   =
C                        b2,......Ax  =  bp) is to be solved,
C                        (iii) when any system in a  sequence
C                        of  systems  whose  matrices  are of
C                        different structure is to be solved.
C                        IFLAG(4) = 1 is the best choice when
C                        the first system of  a  sequence  of
C                        systems  whose  matrices  are of the
C                        same structure is to be  solved.  In
C                        this  case  IFLAG(4) = 2 can be used
C                        in the solution of any system  after
C                        the first one.  Unchanged on exit.
C
C             IFLAG(5) - If   the  LU  factorization  of  the
C                        coefficient matrix is not available,
C                        then  IFLAG(5)  must  be set to 2 on
C                        entry. If the  LU  factorization  of
C                        the coefficient matrix is available,
C                        then IFLAG(5) must be set  to  3  on
C                        entry.  Unchanged on exit.
C
C             IFLAG(6) - On  successful exit IFLAG(6) will be
C                        equal to  the  number  of  "garbage"
C                        collections in the row ordered list.
C                        If IFLAG(6)  is  large  then  it  is
C                        better  to  choose a larger value of
C                        NN with  next  calls  of  subroutine
C                        Y12MF   with  the  same  or  similar
C                        matrix  A.  This  will  lead  to   a
C                        reduction  in  the  computing  time.
C                        The content of IFLAG(6) is  modified
C                        by the subroutine Y12MF.
C
C             IFLAG(7) - On  successful exit IFLAG(7) will be
C                        equal to  the  number  of  "garbage"
C                        collections  in  the  column ordered
C                        list.  If IFLAG(7) is large then  it
C                        is  better  to choose a larger value
C                        of  NN1  in  the   next   calls   of
C                        subroutine  Y12MF  with  the same or
C                        similar matrix A. This will lead  to
C                        a  reduction  of the computing time.
C                        The content of IFLAG(7) is  modified
C                        by subroutine Y12MF.
C
C             IFLAG(8) - On  successful exit IFLAG(8) will be
C                        equal  to  the  maximal  number   of
C                        non-zero elements kept in array A at
C                        any   stage    of    the    Gaussian
C                        elimination.  If  IFLAG(8)  is  much
C                        smaller than NN (or  NN1)  then  the
C                        length  NN  (or  NN1)  can be chosen
C                        smaller in next calls of  subroutine
C                        Y12MF   with  the  same  or  similar
C                        matrix  A.  This  will  lead  to   a
C                        reduction of the storage needed. The
C                        content of IFLAG(8) is  modified  by
C                        subroutine Y12MF.
C
C             IFLAG(9) - The  minimal  length  NN1  such that
C                        Y12MF  can   solve   systems   whose
C                        matrices  are  of the same structure
C                        without "garbage" collections in the
C                        column ordered list and "movings" of
C                        columns at the  end  of  the  column
C                        ordered  list  is stored in IFLAG(9)
C                        after  the  solution  of  the  first
C                        system   in   the   sequence   (with
C                        IFLAG(4)=1).    The    content    of
C                        IFLAG(9)  is  modified by subroutine
C                        Y12MF when IFLAG(4) = 1 and  ignored
C                        otherwise.
C
C             IFLAG(10)  The  minimal  length  NN  such  that
C                        subroutine Y12MF can  solve  systems
C                        whose   matrices  are  of  the  same
C                        structure     without      "garbage"
C                        collections  in the row ordered list
C                        and "movings" of rows to the end  of
C                        the  row  ordered  list is stored in
C                        IFLAG(10) after the solution of  the
C                        first  system  in the sequence (with
C                        IFLAG(4)  =  1).  The   content   of
C                        IFLAG(10)   is   modified   by   the
C                        subroutine Y12MF when IFLAG(4)  =  1
C                        and ignored otherwise.
C
C             IFLAG(11)  The   maximum   allowed   number  of
C                        iterations  must  be  contained   in
C                        IFLAG(11)  on  entry.   Restriction:
C                        IFLAG(11)>1.   Recommended  value  :
C                        IFLAG(11)< 33.  Unchanged on exit.
C
C             IFLAG(12)  The content of IFLAG(12) is modified
C                        by the subroutine  Y12MF.   On  exit
C                        the  number  of  iterations actually
C                        performed   will   be   stored    in
C                        IFLAG(12).
C
C     IFAIL - Error  diagnostic  parameter.  The  content  of
C             parameter   IFAIL  is  modified  by  subroutine
C             Y12MF.  On exit IFAIL = 0 if the subroutine has
C             not  detected  any  error.  Positive  values of
C             IFAIL on exit show that  some  error  has  been
C             detected  by  the subroutine. Many of the error
C             diagnostics are common for all  subroutines  in
C             the  package.   Therefore the error diagnostics
C             are listed in a separate section, Section 7, of
C             this  book.  We  advise  the  user to check the
C             value of this parameter on exit.
C
C     5.  Error diagnostics
C
C     Error  diagnostics  are  given  by  positive  values of
C     parameter IFAIL (see above).  We  advise  the  user  to
C     check  carefully  the  value of this parameter on exit.
C     The error messages are listed in Section 7.
C
C     6.  Auxiliary subroutines
C
C     Y12MF calls three other subroutines: Y12MB,  Y12MC  and
C     Y12MD.
C
C     7.  Timing
C
C     The  time  taken  depends  on  the  order of the matrix
C     (parameter N), the number of the non-zero  elements  in
C     the matrix (parameter Z), the magnitude of the non-zero
C     elements and their distribution in the matrix.
C
C     8.  Storage
C
C     There are no internally declared arrays.
C
C     9.  Accuracy
C
C     Normally the accuracy achieved can  be  estimated  very
C     well  by  means  of  AFLAG(9)  and  AFLAG(10).  Further
C     information  about  the  accuracy  can   sometimes   be
C     obtained  by  inspection of the growth factor AFLAG(5),
C     and the smallest pivotal element  (in  absolute  value)
C     stored in AFLAG(8).
C
C     10.  Some remarks
C
C     Remark 1 Following the recommendations given in Section
C              1.3.6 the user can write a subroutine (similar
C              to the subroutine Y12MA) where the recommended
C              values of the parameters AFLAG(1) to AFLAG(4),
C              IFLAG(2)  to  IFLAG(5)   and   IFLAG(11)   are
C              initialized.  If this is done then only N, NN,
C              NN1, IHA, A, SNR, RNR and B should be assigned
C              before the call of this new subroutine.
C
C     Remark 2 The  information  stored in some of the arrays
C              should not be altered between successive calls
C              of  subroutine  Y12MF  (see  more  details  in
C              Section 1.3.6).
C                        =================
C                        Error diagnostics
C                        =================
C
C     IFAIL is the error diagnostics parameter.  On exit from
C     each  subroutine  IFAIL  =  0  if  no  error  has  been
C     detected. IFAIL > 0 indicates that some error has  been
C     detected  and  the  computations  have  been terminated
C     immediately after  the  detection  of  the  error.  The
C     errors  corresponding  to the different positive values
C     of IFAIL are listed below.
C
C     IFAIL = 1    The    coefficient   matrix   A   is   not
C                  factorized, i.e. the  call  of  subroutine
C                  Y12MD  was not preceded by a call of Y12MC
C                  during the solution of   Ax=b   or  during
C                  the  solution  of  the  first  system in a
C                  sequence ( Ax1 = b1 , Ax2 = b2,.....,Axp =
C                  bp)  of  systems with the same coefficient
C                  matrix. This will work in all  cases  only
C                  if  the  user  sets IFLAG(1) .ge. 0 before
C                  the call of package Y12M (i.e. before  the
C                  first   call   of  a  subroutine  of  this
C                  package).
C
C     IFAIL = 2    The coefficient matrix A is  not  ordered,
C                  i.e.  the call of subroutine Y12MC was not
C                  preceded by a call  of  Y12MB.  This  will
C                  work  in  all  cases only if the user sets
C                  IFLAG(1) .ge. 0 before the call of package
C                  Y12M  (i.e.  before  the  first  call of a
C                  subroutine of this package).
C
C     IFAIL = 3    A pivotal element abs(a(i,i;j)) < AFLAG(4)
C                  *  AFLAG(6) is selected.  When AFLAG(4) is
C                  sufficiently small this is  an  indication
C                  that the coefficient matrix is numerically
C                  singular.
C
C     IFAIL = 4    AFLAG(5), the  growth  factor,  is  larger
C                  than    AFLAG(3).    When    AFLAG(3)   is
C                  sufficiently large this indicates that the
C                  elements  of the coefficient matrix A grow
C                  so quickly during the  factorization  that
C                  the continuation of the computation is not
C                  justified.  The  choice   of   a   smaller
C                  stability   factor,   AFLAG(1),  may  give
C                  better results in this case.
C
C     IFAIL = 5    The length NN of arrays A and SNR  is  not
C                  sufficient.   Larger  values  of  NN  (and
C                  possibly of NN1) should be used.
C
C     IFAIL = 6    The  length  NN1  of  array  RNR  is   not
C                  sufficient.   Larger  values  of  NN1 (and
C                  possibly of NN) should be used.
C
C     IFAIL = 7    A row without  non-zero  elements  in  its
C                  active    part   is   found   during   the
C                  decomposition.  If   the   drop-tolerance,
C                  AFLAG(2),   is  sufficiently  small,  then
C                  IFAIL = 7 indicates  that  the  matrix  is
C                  numerically  singular. If a large value of
C                  the drop-tolerance AFLAG(2) is used and if
C                  IFAIL = 7  on exit, this is not certain. A
C                  run  with  a  smaller  value  of  AFLAG(2)
C                  and/or  a  careful check of the parameters
C                  AFLAG(8) and AFLAG(5)  is  recommended  in
C                  the latter case.
C
C     IFAIL = 8    A  column without non-zero elements in its
C                  active   part   is   found   during    the
C                  decomposition.   If   the  drop-tolerance,
C                  AFLAG(2),  is  sufficiently  small,   then
C                  IFAIL  =  8  indicates  that the matrix is
C                  numerically singular. If a large value  of
C                  the drop-tolerance AFLAG(2) is used and if
C                  IFAIL = 8  on exit, this is not certain. A
C                  run  with  a  smaller  value  of  AFLAG(2)
C                  and/or a careful check of  the  parameters
C                  AFLAG(8)  and  AFLAG(5)  is recommended in
C                  the latter case.
C
C     IFAIL = 9    A pivotal element  is  missing.  This  may
C                  occur  if  AFLAG(2)  >  0 and IFLAG(4) = 2
C                  (i.e. some system after the first one in a
C                  sequence   of   systems   with   the  same
C                  structure is solved using a positive value
C                  for  the drop-tolerance). The value of the
C                  drop-tolerance   AFLAG(2),    should    be
C                  decreased  and  the  coefficient matrix of
C                  the system refactorized.  This  error  may
C                  also occur when one of the special pivotal
C                  strategies (IFLAG(3)=0 or  IFLAG(3)=2)  is
C                  used  and  the  matrix is not suitable for
C                  such a strategy.
C
C     IFAIL = 10   Subroutine Y12MF is called with IFLAG(5) =
C                  1  (i.e.  with  a  request  to  remove the
C                  non-zero elements of the lower  triangular
C                  matrix    L).     IFLAG(5)=2     must   be
C                  initialized instead of IFLAG(5)=1.
C
C     IFAIL = 11   The coefficient matrix A contains at least
C                  two  elements  in the same position (i,j).
C                  The  input   data   should   be   examined
C                  carefully in this case.
C
C     IFAIL = 12   The number of equations in the system Ax=b
C                  is smaller than 2 (i.e.  N<2).  The  value
C                  of N should be checked.
C
C     IFAIL = 13   The  number  of  non-zero  elements of the
C                  coefficient matrix is  non-positive  (i.e.
C                  Z.le.0  ).   The  value of the parameter Z
C                  (renamed NZ in Y12MF) should be checked.
C
C     IFAIL = 14   The number of  non-zero  elements  in  the
C                  coefficient  matrix  is  smaller  than the
C                  number of equations (i.e. Z  <  N  ).   If
C                  there  is no mistake (i.e. if parameter Z,
C                  renamed NZ in Y12MF, is correctly assigned
C                  on  entry)  then the coefficient matrix is
C                  structurally singular in this case.
C
C     IFAIL = 15   The length IHA of the first  dimension  of
C                  array  HA  is  smaller  than  N.  IHA.ge.N
C                  should be assigned.
C
C     IFAIL = 16   The value of  parameter  IFLAG(4)  is  not
C                  assigned  correctly.  IFLAG(4)  should  be
C                  equal to 0, 1 or 2. See  more  details  in
C                  the description of this parameter.
C
C     IFAIL = 17   A  row  without non-zero elements has been
C                  found in the coefficient matrix A  of  the
C                  system  before the Gaussian elimination is
C                  initiated.  Matrix   A   is   structurally
C                  singular.
C
C     IFAIL = 18   A  column  without  non-zero  elements has
C                  been found in the coefficient matrix A  of
C                  the system before the Gaussian elimination
C                  is initiated.  Matrix  A  is  structurally
C                  singular.
C
C     IFAIL = 19   Parameter  IFLAG(2) is smaller than 1. The
C                  value of IFLAG(2)  should  be  a  positive
C                  integer (IFLAG(2) = 3 is recommended).
C
C     IFAIL = 20   Parameter   IFLAG(3)   is  out  of  range.
C                  IFLAG(3) should be equal to 0, 1 or 2.
C
C     IFAIL = 21   Parameter  IFLAG(5)  is  out   of   range.
C                  IFLAG(5) should be equal to 1, 2 or 3 (but
C                  when IFLAG(5) = 3 Y12MB and  Y12MC  should
C                  not  be  called;  see also the message for
C                  IFAIL = 22 below).
C
C     IFAIL = 22   Either  subroutine  Y12MB  or   subroutine
C                  Y12MC is called with IFLAG(5) = 3. Each of
C                  these subroutines should  be  called  with
C                  IFLAG(5) equal to 1 or 2.
C
C     IFAIL = 23   The    number    of   allowed   iterations
C                  (parameter IFLAG(11) when Y12MF  is  used)
C                  is  smaller  than  2.   IFLAG(11)  .ge.  2
C                  should be assigned.
C
C     IFAIL = 24   At least one element whose  column  number
C                  is  either larger than N or smaller than 1
C                  is found.
C
C     IFAIL = 25   At least one element whose row  number  is
C                  either  larger than N or smaller than 1 is
C                  found.
C                           ==========
C                           References
C                           ==========
C        1.  Bjorck, A. -
C                  "Methods for Sparse  Linear  Least-Squares
C                  Problems".
C                  In: "Sparse Matrix Computations"
C                  (J.Bunch and D.Rose, eds.), pp.177-199.
C                  Academic Press, New York, 1976.
C
C        2.  Clasen, R.J. -
C                  "Techniques  for  Automatic  Tolerance  in
C                  Linear Programming",
C                  Comm. ACM 9, pp. 802-803, 1966.
C
C        3.  Cline, A.K.,  Moler,  C.B.,  Stewart,  G.W.  and
C            Wilkinson, J.H. -
C                  "An estimate for the condition number of a
C                  matrix",
C                  SIAM J. Numer. Anal. 16, 368-375, 1979.
C
C        4.  Dongarra,  J.J.,  Bunch,  J.R.,  Moler, C.B. and
C            Stewart, G.W. -
C                  "LINPACK User's Guide",
C                  SIAM, Philadelphia, 1979.
C
C        5.  Duff, I.S. -
C                  "MA28 - a Set of FORTRAN Subroutines
C                  for Sparse Unsymmetric Matrices",
C                  Report    No.   R8730,   A.E.R.E.,Harwell,
C                  England, 1977.
C
C        6.  Duff, I.S. and Reid, J.K. -
C                  "Some  Design  Features of a Sparse Matrix
C                  Code",
C                  ACM Trans. Math. Software  5,  pp.  18-35,
C                  1979.
C
C        7.  Forsythe, G.E., Malcolm, M.A., and Moler, C.B. -
C                  "Computer   Methods    for    Mathematical
C                  Computations",
C                  Prentice-Hall,   Englewood  Cliffs,  N.J.,
C                  1977.
C
C        8.  Forsythe, G.E. and Moler, C.B. -
C                  "Computer  Solution  of  Linear  Algebraic
C                  Equations",
C                  Prentice-Hall,  Englewood  Cliffs,   N.J.,
C                  1967.
C
C        9.  Gustavson, F.G. -
C                  "Some Basic Techniques for Solving Sparse
C                  Systems of Linear Equations".
C                  In:    "Sparse    Matrices    and    Their
C                  Applications",
C                  (D.J.  Rose and R.A. Willoughby, eds.), pp
C                  41-52,
C                  Plenum Press, New York, 1972.
C
C       10.  Gustavson, F.G. -
C                  "Two  Fast Algorithms for Sparse Matrices:
C                  Multiplication and Permuted
C                  Transposition",
C                  ACM Trans. Math. Software, 4, pp. 250-269,
C                  1978.
C
C       11.  Houbak, N. and Thomsen, P.G. -
C                  "SPARKS  -  a   FORTRAN   Subroutine   for
C                  Solution
C                  of  Large  Systems  of  Stiff  ODE's  with
C                  Sparse Jacobians",
C                  Report  79-02,  Institute  for   Numerical
C                  Analysis,
C                  Technical  University  of Denmark, Lyngby,
C                  Denmark, 1979.
C
C       12.  Moler, C.B. -
C                  "Three  Research  Problems  in   Numerical
C                  Linear Algebra".
C                  In:   "Proceedings   of  the  Symposia  in
C                  Applied Mathematics"
C                  (G.H. Golub and J. Oliger, eds.), Vol. 22,
C                  pp. 1-18,
C                  American Mathematical Society,
C                  Providence, Rhode Island, 1978.
C
C       13.  NAG Library -
C                  Fortran Manual, Mark 7, Vol. 3, 4,
C                  Numerical Algorithms Group,
C                  7 Banbury Road,  Oxford  OX2  6NN,  United
C                  Kingdom.
C
C       14.  Reid, J.K. -
C                  "A  Note  on  the  Stability  of  Gaussian
C                  Elimination",
C                  J.  Inst.  Math.  Appl.,  8,  pp. 374-375,
C                  1971.
C
C       15.  Reid, J.K. -
C                  "Fortran  Subroutines  for Handling Sparse
C                  Linear Programming Bases",
C                  Report R8269, A.E.R.E., Harwell,  England,
C                  1976.
C
C       16.  Schaumburg, K. and Wasniewski, J. -
C                  "Use   of   a   Semiexplicit   Runge-Kutta
C                  Integration  Algorithm  in a Spectroscopic
C                  Problem"
C                  Computers  and  Chemistry  2,  pp.  19-25,
C                  1978.
C
C       17.  Schaumburg, K., Wasniewski, J. and Zlatev, Z. -
C                  "Solution   of    Ordinary    Differential
C                  Equations.   Development of a Semiexplicit
C                  Runge-Kutta Algorithm and Application to a
C                  Spectroscopic Problem",
C                  Computers  and  Chemistry,  3,  pp. 57-63,
C                  1979.
C
C       18.  Schaumburg, K., Wasniewski, J. and Zlatev, Z. -
C                  "The Use of Sparse Matrix Technique in the
C                  Numerical Integration of Stiff Systems  of
C                  Linear Ordinary Differential Equations",
C                  Computers  and  Chemistry,  4,  pp.  1-12,
C                  1980.
C
C       19.  Stewart, G.W. -
C                  "Introduction to Matrix Computations",
C                  Academic Press, New York, 1973.
C
C       20.  Tewarson, R.P. -
C                  "Sparse Matrices",
C                  Academic Press, New York, 1973.
C
C       21.  Thomsen, P.G. -
C                  "Numerical  Solution of Large Systems with
C                  Sparse Jacobians".
C                  In: "Working Papers for  the  1979  SIGNUM
C                  Meeting on Numerical Ordinary Differential
C                  Equations" (R.D. Skeel, ed.),
C                  Computer Science Department,
C                  University  of  Illinois   at   Urbana   -
C                  Champaign, Urbana, Illinois, 1979.
C
C       22.  Wasniewski, J., Zlatev, Z. and Schaumburg, K. -
C                  "A Multibanking  Option  of  an  Iterative
C                  Refinement Subroutine".
C                  In:  "Conference Proceedings and Technical
C                  Papers",
C                  Spring   Conference   of   Univac    Users
C                  Assotiation/Europe, Geneva, 1981.
C
C       23.  Wilkinson, J.H. -
C                  "Rounding Errors in Algebraic Processes",
C                  Prentice-Hall,  Englewood  Cliffs,   N.J.,
C                  1963.
C
C       24.  Wilkinson, J.H. -
C                  "The Algebraic Eigenvalue Problem",
C                  Oxford University Press, London, 1965.
C
C       25.  Wilkinson, J.H and Reinsch, C. -
C                  "Handbook for Automatic Computation",
C                  Vol II, Linear Algebra, pp. 50-56,
C                  Springer, Heidelberg, 1971.
C
C       26.  Wolfe, P. -
C                  "Error   in   the   Solution   of   Linear
C                  Programming Problems",
C                  In:   "Error   in   Digital   Computation"
C                  (L.B.Rall, ed.), Vol 2, pp. 271-284,
C                  Wiley, New York, 1965.
C
C       27.  Zlatev, Z. -
C                  "Use   of   Iterative  Refinement  in  the
C                  Solution of Sparse Linear Systems",
C                  Report 1/79, Institute of Mathematics  and
C                  Statistics,   The   Royal  Veterinary  and
C                  Agricultural University,
C                  Copenhagen, Denmark, 1979
C                  (to appear in SIAM J. Numer. Anal.).
C
C       28.  Zlatev, Z. -
C                  "On  Some  Pivotal  Strategies in Gaussian
C                  Elimination by Sparse Technique",
C                  SIAM J. Numer. Anal. 17, pp. 18-30,  1980.
C
C       29.  Zlatev, Z. -
C                  "On Solving Some Large Linear Problems  by
C                  Direct Methods",
C                  Report   111,   Department   of   Computer
C                  Science,  University  of  Aarhus,  Aarhus,
C                  Denmark, 1980.
C
C       30.  Zlatev, Z. -
C                  "Modified  Diagonally Implicit Runge-Kutta
C                  Methods",
C                  Report No.  112,  Department  of  Computer
C                  Science,  University  of  Aarhus,  Aarhus,
C                  Denmark, 1980
C                  (to appear in SIAM Journal  on  Scientific
C                  and Statistical Computing).
C
C       31.  Zlatev, Z. -
C                  "Comparison  of  Two Pivotal Strategies in
C                  Sparse Plane Rotations",
C                  Report   122,   Department   of   Computer
C                  Science,  University  of  Aarhus,  Aarhus,
C                  Denmark, 1980.
C                  (to appear in  Computers  and  Mathematics
C                  with Applications).
C
C       32.  Zlatev, Z., Barker, V.A. and Thomsen, P.G. -
C                  "SSLEST -  a  FORTRAN  IV  Subroutine  for
C                  Solving Sparse Systems of Linear Equations
C                  (USER's GUIDE)",
C                  Report  78-01,  Institute  for   Numerical
C                  Analysis,
C                  Technical  University  of Denmark, Lyngby,
C                  Denmark, 1978.
C
C       33.  Zlatev, Z. and Nielsen, H.B. -
C                  "Least  - Squares Solution of Large Linear
C                  Problems".
C                  In:  "Symposium i Anvendt Statistik 1980"
C                  (A. Hoskuldsson, K.  Conradsen,  B.  Sloth
C                  Jensen and K.Esbensen, eds.), pp. 17-52.
C                  NEUCC, Technical University of Denmark,
C                  Lyngby, Denmark, 1980.
C
C       34.  Zlatev, Z., Schaumburg, K. and Wasniewski, J. -
C                  "Implementation of an Iterative Refinement
C                  Option in a  Code  for  Large  and  Sparse
C                  Systems".
C                  Computers  and  Chemistry,  4,  pp. 87-99,
C                  1980.
C
C       35.  Zlatev, Z. and Thomsen., P.G. -
C                  "ST  -  a  FORTRAN  IV  Subroutine for the
C                  Solution  of  Large  Systems   of   Linear
C                  Algebraic Equations with Real Coefficients
C                  by Use of Sparse Technique",
C                  Report  76-05,  Institute  for   Numerical
C                  Analysis,
C                  Technical  University  of Denmark, Lyngby,
C                  Denmark, 1976.
C
C       36.  Zlatev, Z. and Thomsen, P.G. -
C                  "An   Algorithm   for   the   Solution  of
C                  Parabolic Partial  Differential  Equations
C                  Based on Finite Element Discretization",
C                  Report   77-09,  Institute  for  Numerical
C                  Analysis,
C                  Technical University of  Denmark,  Lyngby,
C                  Denmark, 1977.
C
C       37.  Zlatev, Z. and Thomsen, P.G. -
C                  "Application of  Backward  Differentiation
C                  Methods  to the Finite Element Solution of
C                  Time Dependent Problems",
C                  International   Journal   for    Numerical
C                  Methods  in  Engineering,  14,  pp. 1051 -
C                  1061, 1979.
C
C       38.  Zlatev, Z., Wasniewski, J. and Schaumburg, K. -
C                  "Comparison  of Two Algorithms for Solving
C                  Large Linear Systems".
C                  Report No 80/9,
C                  Regional   Computing   Centre    at    the
C                  University  of Copenhagen, Vermundsgade 5,
C                  DK-2100 Copenhagen, Denmark, 1980.
C
C       39.  Zlatev, Z., Wasniewski, J. and Schaumburg, K. -
C                  "Classification of the Systems of Ordinary
C                  Differential   Equations   and   Practical
C                  Aspects in the  Numerical  Integration  of
C                  Large Systems",
C                  Computers  and  Chemistry,  4,  pp. 13-18,
C                  1980.
C
C       40.  Zlatev, Z., Wasniewski, J., Schaumburg, K. -
C                  "A Testing Scheme For Subroutines  Solving
C                  Large Linear Problems",
C                  Report No 81/1,
C                  Regional    Computing    Centre   at   the
C                  University of Copenhagen, Vermundsgade  5,
C                  DK-2100 Copenhagen, Denmark, 1981
C                  (to  appear in Computers and Chemistry, 5,
C                  1981).
Acknowledge-To: <NEUJW@vm.uni-c.dk>


```

sparse-matrix/y12m/ex/matrd1.f:
```
      subroutine matrd1(n,z,c,nn,nn1,a,snr,rnr)                                 
c                                                                               
c                                                                               
c  a matrix which depends on two parameters(n-the dimension of the mat-         
c  rix and c-a structure parameter)is generated by the subroutine matrd1        
c  the non-zero elements of the matrix (in any order) are stored                
c  in the first  z  positions (z  is the number of the non-zero                 
c  elements) of the one-dimensional array  a ,  their column and                
c  row numbers in the corresponding positions of array  snr  and                
c  array  rnr.                                                                  
c                                                                               
c                                                                               
      implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)                         
      dimension a(nn)                                                           
c     integer*2 snr(nn),rnr(nn1)                                                
      integer snr(nn),rnr(nn1)                                                  
      do 20 i=1,n                                                               
      a(i)=1.0                                                                  
      snr(i)=i                                                                  
   20 rnr(i)=i                                                                  
      do 21 i=1,n                                                               
      r=n+i                                                                     
      s=c+i                                                                     
      a(r)=i+1                                                                  
      if(s.le.n)snr(r)=s                                                        
      if(s.gt.n)snr(r)=s-n                                                      
   21 rnr(r)=i                                                                  
      l=2*n                                                                     
      do 22 i=1,n                                                               
      r=l+i                                                                     
      s=c+i+1                                                                   
      a(r)=-i                                                                   
      if(s.le.n)snr(r)=s                                                        
      if(s.gt.n)snr(r)=s-n                                                      
   22 rnr(r)=i                                                                  
      k=3*n                                                                     
      do 23 i=1,n                                                               
      r=k+i                                                                     
      s=c+i+2                                                                   
      a(r)=16.0                                                                 
      if(s.le.n)snr(r)=s                                                        
      if(s.gt.n)snr(r)=s-n                                                      
   23 rnr(r)=i                                                                  
      rr1=10                                                                    
      rr2=4*n                                                                   
      rr3=1                                                                     
   25 continue                                                                  
      do 26 i=1,rr1                                                             
      a(rr2+i)=100.0*i                                                          
      snr(rr2+i)=n-rr1+i                                                        
      rnr(rr2+i)=rr3                                                            
26    continue                                                                  
      if(rr1.eq.1)    go to 27                                                  
      rr2=rr2+rr1                                                               
      rr1=rr1-1                                                                 
      rr3=rr3+1                                                                 
      go to 25                                                                  
   27 z=4*n+55                                                                  
      return                                                                    
      end                                                                       

```

sparse-matrix/y12m/ex/index.html:
```
<!-- X-URL: http://www.netlib.org/y12m/ex/ -->
<!-- Date: Sun, 15 Sep 2002 17:01:04 GMT -->
<!-- Last-Modified: Fri, 21 Jun 2002 14:14:40 GMT -->
<BASE HREF="http://www.netlib.org/y12m/ex/">
<head>
<title>y12m/ex</title>
<meta name="waisindex" value="nse">
</head>
<h1>y12m/ex</h1>
<p>
Click <A HREF="http://www.netlib.org/master_counts2.html#y12m/ex">here</A> to see the number of accesses to this library.
<p><hr>
<pre>
file    <a href="maind.d">maind.d</a>
for     output from (y12m/ex/maind.f)

file    <a href="maind.f">maind.f</a>
for     test program for (y12m/y12mae)

file    <a href="maine.f">maine.f</a>
for     test program for the (y12m/y12m) package

file    <a href="mainf.f">mainf.f</a>
for     test program for (y12m/y12mhe)

file    <a href="mainf2.f">mainf2.f</a>
for     test program for the (y12m/y12m) package

file    <a href="matrd1.f">matrd1.f</a>
for     auxillary routine needed by (y12m/ex/maind.f)

file    <a href="matre1.f">matre1.f</a>
for     auxillary routine needed by (y12m/ex/maind.f)

file    <a href="matrf2.f">matrf2.f</a>
for     auxillary routine needed by (y12m/ex/mainf.f)

file    <a href="test1.f">test1.f</a>
for     template for (y12m/y12mae) use, user must supply data

file    <a href="test2.f">test2.f</a>
for     template for (y12m/y12mfe) use, user must supply data

</pre>
</body>
</html>


```

sparse-matrix/y12m/ex/test1.f:
```
      parameter (iha = 10,nn = 200,nn1 = 100)
      implicit real (a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
      real a(nn),pivot(iha),b(iha),aflag(8)
      integer snr(nn),rnr(nn1),ha(iha,11),iflag(10)
      data nin/5/, nout/6/
c
c     initialization of the parameters.
c
      read (nin,101)n,z
101   format(2i4)
c
c     initialize the non-zero elements of matrix
c     a  in arbitrary order.
c
      do 120 k = 1,z
      read(nin,110) rnr(k), snr(k), a(k)
110   format(2i4,f12.6)
120   continue
c
c
c     initialize the components of the right-hand side vector  b.
c
      read(nin,130) (b(k),k = 1,n)
130   format(6f12.6)
c
c     call the subroutine  y12mae.
c
      call y12mae(n,z,a,snr,nn,rnr,nn1,pivot,ha,iha,aflag,
     1 iflag,b,ifail)
c
c     print the results.
c
      write(nout,1)ifail
1     format('1the error diagnostic parameter  ifail',
     1 '  is equal to',i4)
      if(ifail.gt.0)go to 5
      write(nout,2)
    2 format('0the solution vector is given below.')
      do 4 i = 1,6
      write(nout,3)i,b(i)
    3 format(' ',i10,f20.5)
    4 continue
c
c     print the auxiliary information about the solution.
c     this is optionally.
c
      write(nout,11)aflag(6)
11    format('0the largest element in the original',
     1 ' matrix is:'f12.5)
      write(nout,12)aflag(7)
   12 format('0the largest element found in the elimination',
     1f12.5)
      write(nout,13)aflag(8)
   13 format('0the minimal(in absolute value)pivotal element',
     1 f12.5)
      write(nout,14)aflag(5)
   14 format('0the growth factor is:',1pd12.2)
      write(nout,15)iflag(6)
   15 format('0the number of collections in the row list',i5)
      write(nout,16)iflag(7)
   16 format('0the number of collections in the column list',i5)
      write(nout,17)iflag(8)
   17 format('0the largest number of elements found in array a',
     1 i9)
    5 continue
      stop
      end

```

sparse-matrix/y12m/ex/matre1.f:
```
      subroutine matre1(n,z,c,nn,nn1,a,snr,rnr)                                 
      implicit real(a-b,g,t-v),integer(c,f,h-n,r-s,z)                           
      real a(nn)                                                                
c     integer*2 snr(nn),rnr(nn1)                                                
      integer snr(nn),rnr(nn1)                                                  
      do 1 i=1,n                                                                
      a(i)=4.                                                                   
      snr(i)=i                                                                  
    1 rnr(i)=i                                                                  
      r=n-1                                                                     
      do 2 i=1,r                                                                
      r1=n+i                                                                    
      a(r1)=-1.                                                                 
      snr(r1)=i+1                                                               
    2 rnr(r1)=i                                                                 
      r2=2*n-1                                                                  
      do 3 i=1,r                                                                
      r1=r2+i                                                                   
      a(r1)=-1.                                                                 
      snr(r1)=i                                                                 
    3 rnr(r1)=i+1                                                               
      r=n-c                                                                     
      r2=3*n-2                                                                  
      do 4 i=1,r                                                                
      r1=r2+i                                                                   
      a(r1)=-1.                                                                 
      snr(r1)=i+c                                                               
    4 rnr(r1)=i                                                                 
      r2=4*n-2-c                                                                
      do 5 i=1,r                                                                
      r1=r2+i                                                                   
      a(r1)=-1.                                                                 
      snr(r1)=i                                                                 
    5 rnr(r1)=i+c                                                               
      z=5*n-2*c-2                                                               
      return                                                                    
      end                                                                       

```

sparse-matrix/y12m/ex/test2.f:
```
      parameter (iha=10,nn=200,nn1=100,iha1=60)
      implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
      real a(nn),y(iha),b(iha),aflag(11),b1(iha),x(iha),a1(iha1)
      integer snr(nn),rnr(nn1),ha(iha,13),iflag(12),sn(iha1)
      data nin/5/, nout/6/
c
c     initialization of the parameters.
c
      aflag(1)=128.0
      aflag(2)=1.e-3
      aflag(3)=1.e+16
      aflag(4)=1.e-12
      iflag(2)=2
      iflag(3)=1
      iflag(4)=1
      iflag(5)=2
      iflag(11)=25
      read (nin,101)n,z
101   format(2i4)
c
c     initialize the non-zero elements of matrix  a  in arbitrary order.
c
      do 120 k=1,z
      read(nin,110) rnr(k), snr(k), a(k)
110   format(2i4,f12.6)
120   continue
c
c
c     initialize the components of the right-hand side vector  b.
c
      read(nin,130) (b(k),k=1,n)
130   format(6f12.6)
c
c     call the subroutine  y12mfe.
c
      call y12mfe(n,a,snr,nn,rnr,nn1,a1,sn,z,ha,iha,b,b1,x,y,
     1 aflag,iflag,ifail)
c
c     print the results.
c
      write(nout,1)ifail
    1 format('1the error diagnostic parameter  ifail  is equal to',i4)
      if(ifail.gt.0)go to 5
      write(nout,2)
    2 format('0the solution vector is given below.')
      do 4 i=1,6
      write(nout,3)i,x(i)
    3 format(' ',i10,f20.5)
    4 continue
c
c     print the auxiliary information about the solution.
c     this is optionally.
c
      write(nout,11)aflag(6)
   11 format('0the largest element in the original matrix is:'f12.5)
      write(nout,12)aflag(7)
   12 format('0the largest element found in the elimination',f12.5)
      write(nout,13)aflag(8)
   13 format('0the minimal(in absolute value)pivotal element',f12.5)
      write(nout,14)aflag(5)
   14 format('0the growth factor is:',1pe12.2)
      write(nout,15)iflag(6)
   15 format('0the number of collections in the row list',i5)
      write(nout,16)iflag(7)
   16 format('0the number of collections in the column list',i5)
      write(nout,17)iflag(8)
   17 format('0the largest number of elements found in array a',i9)
      write(nout,18) iflag(12)
   18 format('0the number of iterations is:,'i5)
      write(nout,19) aflag(9)
   19 format('0estimation of the absolute error is:',1pe10.2)
    5 continue
      stop
      end

```

sparse-matrix/y12m/ex/maind.f:
```
      parameter (ibdim=1000, iadim=25*ibdim, icdim=20*ibdim)
c     parameter (ibdim=600, iadim=25*ibdim, icdim=20*ibdim)
c     implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
c     real a(15000),pivot(600),b(600)
c     integer*2 snr(15000),rnr(12000),ha(600,11)
c     integer snr(15000),rnr(12000),ha(600,11)
c     ibdim=600
c     iadim=25*ibdim
c     icdim=20*ibdim
c     call main0(ibdim,iadim,icdim,a,pivot,b,snr,rnr,ha)
c     stop
c     end
c     subroutine main0(ibdim,iadim,icdim,a,pivot,b,snr,rnr,ha)
c
c     this program tests the subroutine of package y12m by
c     means of matrices of class d(n,c) and/or class e(n,c).
c     the program uses data consisting of 7 integers.
c     the first of these integers (in the program it is de-
c     noted by indexp) should be equal to:
c         1     if the matrices of class d(n,c) has to be used.
c         2     if the matrices of class e(n,c) has to be used.
c         3     if the matrices of both classes has to be used.
c     the next three integers (called nstart,nincr and nend
c     in the program) are used to determine the range of the
c     parameter n. nstart should be larger than 22. nincr
c     should be larger than zero. nend should be larger than
c     or equal to nstart. if these conditions are satisfied
c     then the range of n for the systems solved is:
c            n = nstart(nincr)nend
c     the last three integers (called cstart,cincr and cend
c     in the program) are used in the program to determine
c     the range of parameter c (the sparsity of the matrix
c     is changed by c). cstart should be chosen between 2 and
c     n-13. cincr should be larger than 1. cend should be
c     smaller than n-13. if these conditions are satisfied,
c     then the range of c for the systems solved is given as:
c            c = cstart(cincr)cend
c     in the version which is distributed with the package
c     the data read in line 12 are:
c         3   250  50  600  4  40  204
c     if these data are changed,then the parameter ibdim
c     skould be set equal to or larger than the value for
c     nend.
c     parameter ibdim=600, iadim=25*ibdim, icdim=20*ibdim
      implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
      real a(iadim),pivot(ibdim),b(ibdim),aflag(8)
      real time, y12cck
c     integer*2 snr(iadim),rnr(icdim),ha(ibdim,11),iflag(10)
      integer snr(iadim),rnr(icdim),ha(ibdim,11),iflag(10)
      data nin/5/, nout /6/
c
c     call y12cqe('y12mae      ')
      iha=ibdim
      write(nout,50)
50    format(' indexp,nstart,nincr,nend,cstart,cincr,cend:')
      read(nin,*)indexp,nstart,nincr,nend,cstart,cincr,cend
      write(nout,*)indexp,nstart,nincr,nend,cstart,cincr,cend
52    format()
c52    format(10(1x,i5))
      if(indexp.gt.0.and.indexp.lt.4)go to 301
      write(nout,302)
302   format(' indexp is out of range')
      go to 54
301   continue
      if(nstart.gt.21)go to 303
      write(nout,304)
304   format(' nstart is out of range')
      go to 54
303   continue
      if(nincr.ge.1)go to 305
      write(nout,306)
306   format(' nincr is out of range')
      go to 54
305   continue
      if(nend.ge.nstart)go to 307
      write(nout,308)
308   format(' nend is out of range')
      go to 54
307   continue
      if(cstart.gt.1.and.cstart.lt.nend-13)go to 309
      write(nout,310)
310   format(' cstart is out of range')
      go to 54
309   continue
      if(cend.ge.cstart.and.cend.lt.nend-13)go to 311
      write(nout,312)
312   format(' cend is out of range')
      go to 54
311   continue
      if(cincr.gt.0)go to 313
      write(nout,314)
314   format(' cincr is out of range')
      go to 54
313   continue
      n=nstart
      c=cstart
      if(indexp.eq.2)index=2
      if(indexp.eq.1)index=1
      if(indexp.eq.3)index=1
      nn=iadim
      nn1=icdim
   51 continue
      if(n.gt.ibdim) go to 410
      if(index.eq.1)print 41,n,c
   41 format('1','matrix of class d,with parameters n=',i4,'  c=',i4)
      if(index.eq.2)print 33,n,c
   33 format('1matrix of class e: n=',i4,' c='i4)
      if(index.eq.1) call matrd1(n,z,c,nn,nn1,a,snr,rnr)
       if(index.eq.2) call matre1(n,z,c,nn,nn1,a,snr,rnr)
      write(nout,53)z
53    format('0the number of non-zero elements in the original',
     1 ' matrix is equal to:',10x,i8)
      do 1 i=1,n
      b(i)=0.0
1     continue
      do 2 i=1,z
      lrow=rnr(i)
      lcol=snr(i)
2     b(lrow)=b(lrow)+a(i)
      ifail1=0
      time=y12cck(1,ifail1)
      call y12mae(n,z,a,snr,nn,rnr,nn1,pivot,ha,iha,aflag,iflag,b,ifail)
      ifail1=0
      time=-time+y12cck(1,ifail1)
      if(ifail.ne.0)go to 3
      write(nout,110)time
110   format(' subs after y12mae: ',f12.2)
      t=0.0
      do 4 i=1,n
      tt=abs(b(i)-1.)
      if(tt.gt.t)t=tt
4     continue
      write(nout,102) t
102   format('0the largest error is: ',1pe10.2)
3     continue
      write(nout,104)iflag(8)
  104 format('0the largest number of elements in a:',i8)
      write(nout,105)iflag(6)
  105 format('0the number of collections in row list',i4)
      write(nout,106)iflag(7)
  106 format('0the number of collections in column list',i4)
      write(nout,107)aflag(6)
  107 format('0the largest element in original matrix',1pe10.2)
      write(nout,108)aflag(7)
  108 format('0the largest element in lu-matrix',1pe10.2)
      write(nout,109)aflag(5)
  109 format('0the growth factor is:',1pe10.2)
      write(nout,100)aflag(8)
  100 format('0the minimal pivotal element',1pe10.2)
      write(nout,204) aflag(2),aflag(1)
204   format('0the drop tolerance: ',1pe10.2,
     1 ',     the stability factor: ',1pe10.2)
      write(nout,103) ifail
103   format('0the error diagnostic parameter = ',i4)
      c=c+cincr
      if(c.le.cend)go to 51
      c=cstart
      n=n+nincr
      if(n.le.nend)go to 51
      if(indexp.ne.3)go to 54
      c=cstart
      n=nstart
      index=index+1
      if(index.eq.2)go to 51
54    continue
c     call y12cqe('term.       ')
      stop
410   continue
      write(nout,420) ibdim,n
420   format(' maxn = ',i4,' is greater than n = ',i4)
      stop
      end

```

sparse-matrix/y12m/ex/matrf2.f:
```
      subroutine matrf2(m,n,c,index,alpha,nn,nn1,nz,a,snr,rnr,ifejlm)           
c                                                                               
c                                                                               
c   purpose.                                                                    
c   - - - - -                                                                   
c                                                                               
c                                                                               
c   the subroutine generates sparse  (rectangular or square)  matrices.         
c   the dimensions of the matrix and the average number of non-zero             
c   elements per row can be specified by the user.     moreover,                
c   the user can also change the sparsity pattern and the condition num-        
c   ber of the matrix.   the non-zero elements of the desired matrix            
c   will be accumulated  (in an arbitrary order)  in the first   nz             
c   positions of array   a.   the column and the row numbers of the non-        
c   zero element stored in   a(i),   i=1(1)nz,   will be found in               
c   snr(i)   and   rnr(i),   respectively.                                      
c                                                                               
c                                                                               
c                                                                               
c                                                                               
c   input parameters.                                                           
c                                                                               
c                                                                               
c   m       - integer.  the number of the rows in the desired matrix.           
c             n < m+1 < maxint+1    must be specified.                          
c                                                                               
c   n       - integer.  the number of the columns in the desired matrix.        
c             21 < n < maxint+1   must be specified.                            
c                                                                               
c   c       - integer.  the sparsity pattern can be changed by means of         
c             this parameter.   10 < c < n-10   must be specified.              
c                                                                               
c   index   - integer.   the average number of non-zero elements per row        
c             in the matrix will be equal to   index.                           
c             1 < index < n-c-8    must be specified.                           
c                                                                               
c   alpha   - real.   the condition number of the matrix can be changed         
c             by this parameter.   alpha > 0.0   must be specified.             
c             if   alpha   is approximately equal to   1.0   then the           
c             generated matrix is well-conditioned.   large values of           
c             alpha   will usually produce ill-conditioned matrices.            
c             note that no round-off errors during the computations in          
c             this subroutine are made if   alpha = 2**i   (where   i           
c             is an arbitrary integer which produces numbers in the             
c             machine range).                                                   
c                                                                               
c   nn      - integer.   the length of arrays   a   and   snr   (see            
c             below). index*m+109 < nn < maxint+1    must be specified.         
c                                                                               
c   nn1     - integer.   the length of array   rnr   (see below).               
c             index*m+109 < nn1 < maxint+1   must be specified.                 
c                                                                               
c                                                                               
c                                                                               
c                                                                               
c                                                                               
c   output parameters.                                                          
c                                                                               
c                                                                               
c   nz      - integer.   the number of non-zero elements in the matrix.         
c                                                                               
c   a(nn)   - real array. the non-zero elements of the matrix generated         
c             are accumulated in the first   nz   locations of array  a.        
c                                                                               
c   snr(nn) - integer*2 array.   the column number of the non-zero ele-         
c             ment kept in   a(i),   i=1(1)nz,   is stored in   snr(i).         
c                                                                               
c   rnr(nn1)- integer*2 array.   the row number of the non-zero element         
c             kept in   a(i),   i=1(1)nz,   is stored in   rnr(i).              
c                                                                               
c   ifejlm   - integer.   ifejlm=0  indicates that the call is successful.      
c             error diagnostics are given by means of positive values of        
c             this parameter as follows:                                        
c                  ifejlm=1   -   n       is out of range.                      
c                  ifejlm=2   -   m       is out of range.                      
c                  ifejlm=3   -   c       is out of range.                      
c                  ifejlm=4   -   index   is out of range.                      
c                  ifejlm=5   -   nn      is out of range.                      
c                  ifejlm=6   -   nn1     is out of range.                      
c                  ifejlm=7   -   alpha   is out of range.                      
c                                                                               
c                                                                               
c                                                                               
c                                                                               
      real a,alpha,alpha1                                                       
      integer m,n,nz,c,nn,nn1,ifejlm,m1,nz1,rr1,rr2,rr3,k,m2,n1,n2              
c     integer*2 snr,rnr                                                         
      integer snr,rnr                                                           
      dimension a(nn),snr(nn),rnr(nn1)                                          
c     maxint -- the larget integer such that          maxint                    
c     and      -maxint     are representable on the computer                    
c     maxint=32768                                                              
      maxint=int(2.0**31-1.0)                                                   
      m1=m                                                                      
      ifejlm=0                                                                  
      nz1=index*m+110                                                           
      k=1                                                                       
      alpha1=alpha                                                              
      index1=index-1                                                            
c                                                                               
c  check the parameters.                                                        
c                                                                               
      if(n.ge.22)go to 1                                                        
    2 ifejlm=1                                                                  
      return                                                                    
    1 if(n.gt.maxint)go to 2                                                    
      if(m.ge.n)go to 3                                                         
    4 ifejlm=2                                                                  
      return                                                                    
    3 if(m.gt.maxint)go to 4                                                    
      if(c.lt.11)go to 6                                                        
      if(n-c.ge.11)go to 5                                                      
    6 ifejlm=3                                                                  
      return                                                                    
    5 if(index.lt.2)go to 12                                                    
      if(n-c-index.ge.9)go to 13                                                
   12 ifejlm=4                                                                  
   13 if(nn.ge.nz1)go to 7                                                      
    8 ifejlm=5                                                                  
      return                                                                    
    7 if(nn.gt.maxint)go to 8                                                   
      if(nn1.ge.nz1)go to 9                                                     
   10 ifejlm=6                                                                  
      return                                                                    
    9 if(nn1.gt.maxint)go to 10                                                 
      if(alpha.gt.0.)go to 11                                                   
      ifejlm=7                                                                  
      return                                                                    
   11 continue                                                                  
c                                                                               
c  end of the error check.   begin to generate the non-zero elements of         
c  the required matrix.                                                         
c                                                                               
      do 20 i=1,n                                                               
      a(i)=1.                                                                   
      snr(i)=i                                                                  
   20 rnr(i)=i                                                                  
      nz=n                                                                      
      j1=1                                                                      
      do 21 j=1,index1                                                          
      j1=-j1                                                                    
      do 22 i=1,n                                                               
      a(nz+i)=j1*j*i                                                            
      if(i+c+j-1.le.n)snr(nz+i)=i+c+j-1                                         
      if(i+c+j-1.gt.n)snr(nz+i)=c+i+j-1-n                                       
   22 rnr(nz+i)=i                                                               
   21 nz=nz+n                                                                   
      rr1=10                                                                    
      rr2=nz                                                                    
      rr3=1                                                                     
   25 continue                                                                  
      do 26 i=1,rr1                                                             
      a(rr2+i)=alpha*i                                                          
      snr(rr2+i)=n-rr1+i                                                        
      rnr(rr2+i)=rr3                                                            
   26 continue                                                                  
      if(rr1.eq.1)go to 27                                                      
      rr2=rr2+rr1                                                               
      rr1=rr1-1                                                                 
      rr3=rr3+1                                                                 
      go to 25                                                                  
   27 nz=nz+55                                                                  
   29 m1=m1-n                                                                   
      alpha=1./alpha                                                            
      if(m1.le.0)go to 28                                                       
      n2=k*n                                                                    
      if(m1.ge.n)m2=n                                                           
      if(m1.lt.n)m2=m1                                                          
      l=0                                                                       
      if(m2.le.10)l=11-m2                                                       
      do 30 i=1,m2                                                              
      a(nz+i)=alpha*(k+1)                                                       
      snr(nz+i)=i+l                                                             
   30 rnr(nz+i)=n2+i                                                            
      nz=nz+m2                                                                  
      j1=1                                                                      
      do 41 j=1,index1                                                          
      j1=-j1                                                                    
      do 42 i=1,m2                                                              
      a(nz+i)=alpha*j*j1*((k+1)*i+1.)                                           
      if(i+c+j-1.le.n)snr(nz+i)=i+c+j-1                                         
      if(i+c+j-1.gt.n)snr(nz+i)=c+i+j-1-n                                       
   42 rnr(nz+i)=n2+i                                                            
   41 nz=nz+m2                                                                  
      k=k+1                                                                     
      go to 29                                                                  
   28 continue                                                                  
      alpha=1./alpha1                                                           
      rr1=1                                                                     
      rr2=nz                                                                    
   35 continue                                                                  
      do 36 i=1,rr1                                                             
      a(rr2+i)=alpha*(rr1+1-i)                                                  
      snr(rr2+i)=i                                                              
      rnr(rr2+i)=m-10+rr1                                                       
   36 continue                                                                  
      if(rr1.eq.10)go to 34                                                     
      rr2=rr2+rr1                                                               
      rr1=rr1+1                                                                 
      go to 35                                                                  
   34 nz=nz+55                                                                  
      alpha=alpha1                                                              
      return                                                                    
      end                                                                       

```

sparse-matrix/y12m/ex/maine.f:
```
      parameter (ibdim=2000, iadim=25*ibdim, icdim=20*ibdim,
     1 iddim=5*ibdim)
c     parameter (ibdim=600, iadim=25*ibdim, icdim=20*ibdim,
c    1 iddim=5*ibdim)
c     implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
c     real a(15000),pivot(600),b(600)
c     real a1(3000),x(600),b1(600)
c     integer*2 snr(15000),rnr(12000),ha(600,13),sn(3000)
c     integer snr(15000),rnr(12000),ha(600,13),sn(3000)
c     ibdim=600
c     iadim=25*ibdim
c     icdim=20*ibdim
c     iddim=5*ibdim
c     call main0(ibdim,iadim,icdim,a,pivot,b,snr,rnr,ha,
c    1 iddim,b1,x,a1,sn)
c     stop
c     end
c     subroutine main0(ibdim,iadim,icdim,a,pivot,b,snr,rnr,ha,
c    1 iddim,b1,x,a1,sn)
c
c     this program tests the subroutine of package y12m by
c     means of matrices of class d(n,c) and/or class e(n,c).
c     the program uses data consisting of 7 integers.
c     the first of these integers (in the program it is de-
c     noted by indexp) should be equal to:
c         1     if the matrices of class d(n,c) has to be used.
c         2     if the matrices of class e(n,c) has to be used.
c         3     if the matrices of both classes has to be used.
c     the next three integers (called nstart,nincr and nend
c     in the program) are used to determine the range of the
c     parameter n. nstart should be larger than 22. nincr
c     should be larger than zero. nend should be larger than
c     or equal to nstart. if these conditions are satisfied
c     then the range of n for the systems solved is:
c            n = nstart(nincr)nend
c     the last three integers (called cstart,cincr and cend
c     in the program) are used in the program to determine
c     the range of parameter c (the sparsity of the matrix
c     is changed by c). cstart should be chosen between 2 and
c     n-13. cincr should be larger than 1. cend should be
c     smaller than n-13. if these conditions are satisfied,
c     then the range of c for the systems solved is given as:
c            c = cstart(cincr)cend
c     in the version which is distributed with the package
c     the data read in line 12 are:
c         3   250  50  600  4  40  204
c     if these data are changed,then the parameter ibdim
c     should be set equal to or larger than the value for
c     nend.
c     the values of aflag(1)-aflag(4),iflag(2)-iflag(5) and iflag(11)
c     are read; see the description of these parameters
c
c     parameter (ibdim=600, iadim=25*ibdim, icdim=20*ibdim,
c    1 iddim=5*ibdim)
      implicit real(a-b,g,p,t-v),integer(c,f,h-n,r-s,z)
      real a(iadim),pivot(ibdim),b(ibdim),aflag(11),
     1 b1(ibdim),x(ibdim),a1(iddim)
      real time, y12cck
c     integer*2 snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12),
      integer snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12),
     1 sn(iddim)
      data nin/5/, nout /6/
c
c     call y12cqe('y12mfe      ')
      iha=ibdim
      write(nout,50)
50    format(' indexp,nstart,nincr,nend,cstart,cincr,cend:')
      read(nin,*)indexp,nstart,nincr,nend,cstart,cincr,cend
      write(nout,*)indexp,nstart,nincr,nend,cstart,cincr,cend
52    format()
c52    format(10(1x,i5))
      write(nout,60)
60    format(' (aflag(j),j=1,4),(iflag(j),j=2,5),iflag(11):')
      read(nin,*)(aflag(j),j=1,4),(iflag(j),j=2,5),iflag(11)
520   format(4(1x,f8.2),5i5)
521   format(4(1x,e8.2),5i5)
      write(nout,521)(aflag(j),j=1,4),(iflag(j),j=2,5),iflag(11)
      if(indexp.gt.0.and.indexp.lt.4)go to 301
      write(nout,302)
302   format(' indexp is out of range')
      go to 54
301   continue
      if(nstart.gt.21)go to 303
      write(nout,304)
304   format(' nstart is out of range')
      go to 54
303   continue
      if(nincr.ge.1)go to 305
      write(nout,306)
306   format(' nincr is out of range')
      go to 54
305   continue
      if(nend.ge.nstart)go to 307
      write(nout,308)
308   format(' nend is out of range')
      go to 54
307   continue
      if(cstart.gt.1.and.cstart.lt.nend-13)go to 309
      write(nout,310)
310   format(' cstart is out of range')
      go to 54
309   continue
      if(cend.ge.cstart.and.cend.lt.nend-13)go to 311
      write(nout,312)
312   format(' cend is out of range')
      go to 54
311   continue
      if(cincr.gt.0)go to 313
      write(nout,314)
314   format(' cincr is out of range')
      go to 54
313   continue
      n=nstart
      c=cstart
      if(indexp.eq.2)index=2
      if(indexp.eq.1)index=1
      if(indexp.eq.3)index=1
      nn=iadim
      nn1=icdim
   51 continue
      if(n.gt.ibdim) go to 410
      if(index.eq.1)print 41,n,c
   41 format('1','matrix of class d,with parameters n=',i4,'  c=',i4)
      if(index.eq.2)print 33,n,c
   33 format('1matrix of class e: n=',i4,' c='i4)
      if(index.eq.1) call matrd1(n,z,c,nn,nn1,a,snr,rnr)
       if(index.eq.2) call matre1(n,z,c,nn,nn1,a,snr,rnr)
      write(nout,53)z
53    format('0the number of non-zero elements in the original',
     1 ' matrix is equal to:',10x,i8)
      do 1 i=1,n
      b(i)=0.0
1     continue
      do 2 i=1,z
      lrow=rnr(i)
      lcol=snr(i)
2     b(lrow)=b(lrow)+a(i)
      ifail1=0
      time=y12cck(1,ifail1)
      call y12mfe(n,a,snr,nn,rnr,nn1,a1,sn,z,ha,iha,b,b1,x,
     1 pivot,aflag,iflag,ifail)
      ifail1=0
      time=-time+y12cck(1,ifail1)
      if(ifail.ne.0)go to 3
      write(nout,110)time
110   format(' subs after y12mfe: ',f12.2)
      t=0.0
      do 4 i=1,n
      tt=abs(x(i)-1.0)
      if(tt.gt.t)t=tt
4     continue
      write(nout,102) t
102   format('0the largest error is: ',1pe10.2)
3     continue
      write(nout,104)iflag(8)
  104 format('0the largest number of elements in a:',i8)
      write(nout,105)iflag(6)
  105 format('0the number of collections in row list',i4)
      write(nout,106)iflag(7)
  106 format('0the number of collections in column list',i4)
      write(nout,107)aflag(6)
  107 format('0the largest element in original matrix',1pe10.2)
      write(nout,108)aflag(7)
  108 format('0the largest element in lu-matrix',1pe10.2)
      write(nout,109)aflag(5)
  109 format('0the growth factor is:',1pe10.2)
      write(nout,100)aflag(8)
  100 format('0the minimal pivotal element',1pe10.2)
      write(nout,204) aflag(2),aflag(1)
204   format('0the drop tolerance: ',1pe10.2,
     1 ',     the stability factor: ',1pe10.2)
      write(nout,103) ifail
103   format('0the error diagnostic parameter = ',i4)
      c=c+cincr
      if(c.le.cend)go to 51
      c=cstart
      n=n+nincr
      if(n.le.nend)go to 51
      if(indexp.ne.3)go to 54
      c=cstart
      n=nstart
      index=index+1
      if(index.eq.2)go to 51
54    continue
c     call y12cqe('term.       ')
      stop
410   continue
      write(nout,420) ibdim,n
420   format(' maxn = ',i4,' is greater than n = ',i4)
      stop
      end

```

sparse-matrix/y12m/ex/mainf2.f:
```
      parameter (ibdim=500,iadim=100*ibdim,icdim=100*ibdim,
     * iddim=10*ibdim,maxsto=1)
      implicit real(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      real a(iadim),y(ibdim),b(ibdim),aflag(11),b1(ibdim),w(ibdim)
      real a1(iddim),x(ibdim),tm,anorm,rcond,cond
c     integer*2 snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12)
      integer snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12)
c     integer*2 sn(iddim)
      integer sn(iddim)
      data nin/5/,nout/6/
      lstop=0
      iter=0
      m=200
      n=200
      c=20
      index=16
      nn=iadim
      nn1=icdim
      alpha=1.0
      aflag(1)=4.0
      aflag(2)=1.0
      aflag(3)=1.e+16
      aflag(4)=1.e-12
      iflag(2)=3
      iflag(3)=1
      iflag(4)=1
      write(nout,50)
50    format(' m, n, c, index, alpha:')
      read(nin,*) m, n, c, index, alpha
      write(nout,*) m, n, c, index, alpha
52    format()
c52    format(10(1x,i5))
      write(nout,60)
60    format(' (aflag(j),j=1,4),(iflag(j),j=2,4):')
      read(nin,*)(aflag(j),j=1,4),(iflag(j),j=2,4)
520   format(4(1x,f8.2),5i5)
521   format(4(1x,e8.2),5i5)
      write(nout,521)(aflag(j),j=1,4),(iflag(j),j=2,4)
   51 continue
      iflag(5)=2
      write(6,*)'      call matrf2'
      call matrf2(m,n,c,index,alpha,nn,nn1,nz,a,snr,rnr,ifejlm)
      if(ifejlm.gt.0)go to 531
      do 1 i=1,m
      b(i)=0.0
1     continue
      do 2 i=1,nz
      lrow=rnr(i)
      lcol=snr(i)
2     b(lrow)=b(lrow)+a(i)
      iflag(11)=64
      if(nz.le.32000)go to 33
      ifejlm=8
      go to 53
33    continue
      nstart=1
      if(m.eq.n) go to 300
      do 301 i=1,nz
      a(nz+i)=a(i)
      snr(nz+i)=rnr(i)
      snr(i)=snr(i)+m
  301 rnr(nz+i)=snr(i)
      nz=2*nz
      do 302 i=1,m
      a(nz+i)=1.0
      snr(nz+i)=i
  302 rnr(nz+i)=i
      nz=nz+m
      n=n+m
      nstart=m+1
      do 303 i=nstart,n
  303 b(i)=0.0
      write(6,*)'  300 call y12mhe'
  300 call y12mhe(n,nz,a,snr,w,anorm)
      iha=ibdim
      print 37,m,n,c,index,alpha
   37 format('1','matrix of class     f2     with parameters   m=',i6,'
     1      n=',i6,'       c=',i6,'    index=',i6,'    alpha=',f16.1)
      if(iter.eq.0) print 38
   38 format('0','the system is solved directly')
      if(iter.eq.1) print 39
   39 format('0','the system is solved by iterative refinement')
      print 55,nz
   55 format('0','the number of non-zeros before the elimination:',i12)
      print 56,anorm
   56 format('0','the 1-norm of matrix    a   is equal to:',1pe12.2)
      write(6,*)'      call time'
      call time(itime1)
      if(iter.eq.1) go to 31
      write(6,*)'      call y12mbe'
      call y12mbe(n,nz,a,snr,nn,rnr,nn1,ha,iha,aflag,iflag,ifail)
      write(6,*)'      call y12mce'
      call y12mce(n,nz,a,snr,nn,rnr,nn1,y,b,ha,iha,
     *            aflag,iflag,ifail)
      write(6,*)'      call y12mde'
      call y12mde(n,a,nn,b,y,snr,ha,iha,iflag,ifail)
      go to 32
      write(6,*)'   31 call y12mfe'
   31 call y12mfe(n,a,snr,nn,rnr,nn1,a1,sn,nz,ha,iha,b,b1,x,y,
     1 aflag,iflag,ifail)
      write(6,*)'   32 call time'
   32 call time(itime2)
      if(ifail.ne.0)go to 3
      write(6,*)'      call y12mge'
      rcond = 1.0
c      call y12mge(n,nn,a,snr,w,y,anorm,rcond,iha,ha,iflag,ifail)
      tm=float(itime2-itime1)/1.e+6
      write(6,210)tm
  210 format('0','the computing time is equal to:',5x,f9.2)
      cond=1.0/rcond
      write(6,57) cond
   57 format('0','the eestimate of the condition number of matrix    a
     1  is       cond =',1pe12.2)
      t=0.0
      do 4 i=nstart,n
      if(iter.eq.1) tt=abs(x(i)-1.)
      if(iter.eq.0) tt=abs(b(i)-1.)
      if(tt.gt.t)t=tt
4     continue
      write(6,102) t
102   format('0the largest error is: ',1pe10.2)
3     continue
      write(6,104)iflag(8)
  104 format('0the largest number of elements in a:',i8)
      write(6,105)iflag(6)
  105 format('0the number of collections in row list',i4)
      write(6,106)iflag(7)
  106 format('0the number of collections in column list',i4)
      write(6,107)aflag(6)
  107 format('0the largest element in original matrix',1pe10.2)
      write(6,108)aflag(7)
  108 format('0the largest element in lu-matrix',1pe10.2)
      write(6,109)aflag(5)
  109 format('0the growth factor is:',1pe10.2)
      write(6,100)aflag(8)
  100 format('0the minimal pivotal element',1pe10.2)
      if(iter.eq.0) go to 401
      write(6,202)iflag(12)
  202 format('0the number of iterations is:',i4)
      write(6,902)iflag(11)
  902 format('0the number of allowed iterations is:',i4)
      write(6,203)aflag(9),aflag(10),aflag(11)
  203 format('0the norms of the last correction , the residual  and
     1the solution vector:',3(4x,1pe14.6))
  401 write(6,204) aflag(2),aflag(1)
204   format('0the drop tolerance: ',1pe10.2,
     1 ',     the stability factor: ',1pe10.2)
      write(6,103) ifail
103   format('0the error diagnostic parameter = ',i4)
 531  continue
      write(6,903) ifejlm
  903 format('0the error diagnostic parameter for,the matrix generator
     1is          ifejlm =',i3)
53    continue
      if(n.gt.m) n=n-m
      iter=iter+1
      if(iter.lt.2) go to 51
c      iter=0
c      aflag(2)=aflag(2)/10.0
c      lstop=lstop+1
c      if(lstop.eq.maxsto) aflag(2)=0.0
c      if(lstop.le.maxsto) go to 51
      stop
      end

```

sparse-matrix/y12m/ex/mainf.f:
```
      parameter (ibdim=2000,iadim=50*ibdim,icdim=50*ibdim,
     * iddim=10*ibdim,maxsto=1)
      implicit real(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      real a(iadim),y(ibdim),b(ibdim),aflag(11),b1(ibdim),w(ibdim)
      real a1(iddim),x(ibdim),tm,anorm,rcond,cond
c     integer*2 snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12)
      integer snr(iadim),rnr(icdim),ha(ibdim,13),iflag(12)
c     integer*2 sn(iddim)
      integer sn(iddim)
      data nin/5/,nout/6/
      lstop=0
      iter=0
      m=200
      n=200
      c=20
      index=16
      nn=iadim
      nn1=icdim
      alpha=1.0
      aflag(1)=4.0
      aflag(2)=1.0
      aflag(3)=1.e+16
      aflag(4)=1.e-12
      iflag(2)=3
      iflag(3)=1
      iflag(4)=1
      write(nout,50)
50    format(' m, n, c, index, alpha:')
      read(nin,*) m, n, c, index, alpha
      write(nout,*) m, n, c, index, alpha
52    format()
c52    format(10(1x,i5))
      write(nout,60)
60    format(' (aflag(j),j=1,4),(iflag(j),j=2,4):')
      read(nin,*)(aflag(j),j=1,4),(iflag(j),j=2,4)
520   format(4(1x,f8.2),5i5)
521   format(4(1x,e8.2),5i5)
      write(nout,521)(aflag(j),j=1,4),(iflag(j),j=2,4)
   51 continue
      iflag(5)=2
      call matrf2(m,n,c,index,alpha,nn,nn1,nz,a,snr,rnr,ifejlm)
      if(ifejlm.gt.0)go to 531
      do 1 i=1,m
      b(i)=0.0
1     continue
      do 2 i=1,nz
      lrow=rnr(i)
      lcol=snr(i)
2     b(lrow)=b(lrow)+a(i)
      iflag(11)=64
      if(nz.le.32000)go to 33
      ifejlm=8
      go to 53
33    continue
      nstart=1
      if(m.eq.n) go to 300
      do 301 i=1,nz
      a(nz+i)=a(i)
      snr(nz+i)=rnr(i)
      snr(i)=snr(i)+m
  301 rnr(nz+i)=snr(i)
      nz=2*nz
      do 302 i=1,m
      a(nz+i)=1.0
      snr(nz+i)=i
  302 rnr(nz+i)=i
      nz=nz+m
      n=n+m
      nstart=m+1
      do 303 i=nstart,n
  303 b(i)=0.0
  300 call y12mhe(n,nz,a,snr,w,anorm)
      iha=ibdim
      print 37,m,n,c,index,alpha
   37 format('1','matrix of class     f2     with parameters   m=',i6,'
     1      n=',i6,'       c=',i6,'    index=',i6,'    alpha=',f16.1)
      if(iter.eq.0) print 38
   38 format('0','the system is solved directly')
      if(iter.eq.1) print 39
   39 format('0','the system is solved by iterative refinement')
      print 55,nz
   55 format('0','the number of non-zeros before the elimination:',i12)
      print 56,anorm
   56 format('0','the 1-norm of matrix    a   is equal to:',1pe12.2)
      call time(itime1)
      if(iter.eq.1) go to 31
      call y12mbe(n,nz,a,snr,nn,rnr,nn1,ha,iha,aflag,iflag,ifail)
      call y12mce(n,nz,a,snr,nn,rnr,nn1,y,b,ha,iha,
     *            aflag,iflag,ifail)
      call y12mde(n,a,nn,b,y,snr,ha,iha,iflag,ifail)
      go to 32
   31 call y12mfe(n,a,snr,nn,rnr,nn1,a1,sn,nz,ha,iha,b,b1,x,y,
     1 aflag,iflag,ifail)
   32 call time(itime2)
      if(ifail.ne.0)go to 3
      call y12mge(n,nn,a,snr,w,y,anorm,rcond,iha,ha,iflag,ifail)
      tm=float(itime2-itime1)/1.e+6
      write(6,210)tm
  210 format('0','the computing time is equal to:',5x,f9.2)
      cond=1.0/rcond
      write(6,57) cond
   57 format('0','the eestimate of the condition number of matrix    a
     1  is       cond =',1pe12.2)
      t=0.0
      do 4 i=nstart,n
      if(iter.eq.1) tt=abs(x(i)-1.)
      if(iter.eq.0) tt=abs(b(i)-1.)
      if(tt.gt.t)t=tt
4     continue
      write(6,102) t
102   format('0the largest error is: ',1pe10.2)
3     continue
      write(6,104)iflag(8)
  104 format('0the largest number of elements in a:',i8)
      write(6,105)iflag(6)
  105 format('0the number of collections in row list',i4)
      write(6,106)iflag(7)
  106 format('0the number of collections in column list',i4)
      write(6,107)aflag(6)
  107 format('0the largest element in original matrix',1pe10.2)
      write(6,108)aflag(7)
  108 format('0the largest element in lu-matrix',1pe10.2)
      write(6,109)aflag(5)
  109 format('0the growth factor is:',1pe10.2)
      write(6,100)aflag(8)
  100 format('0the minimal pivotal element',1pe10.2)
      if(iter.eq.0) go to 401
      write(6,202)iflag(12)
  202 format('0the number of iterations is:',i4)
      write(6,902)iflag(11)
  902 format('0the number of allowed iterations is:',i4)
      write(6,203)aflag(9),aflag(10),aflag(11)
  203 format('0the norms of the last correction , the residual  and
     1the solution vector:',3(4x,1pe14.6))
  401 write(6,204) aflag(2),aflag(1)
204   format('0the drop tolerance: ',1pe10.2,
     1 ',     the stability factor: ',1pe10.2)
      write(6,103) ifail
103   format('0the error diagnostic parameter = ',i4)
531   continue
      write(6,903) ifejlm
  903 format('0the error diagnostic parameter for,the matrix generator
     1is          ifejlm =',i3)
53    continue
      if(n.gt.m) n=n-m
      iter=iter+1
      if(iter.lt.2) go to 51
c      iter=0
c      aflag(2)=aflag(2)/10.0
c      lstop=lstop+1
c      if(lstop.eq.maxsto) aflag(2)=0.0
c      if(lstop.le.maxsto) go to 51
      stop
      end

```

sparse-matrix/y12m/ex/maind.d:
```
 indexp,nstart,nincr,nend,cstart,cincr,cend:
 1 600 600 600 4 44 204
1matrix of class d,with parameters n= 600  c=   4
0the number of non-zero elements in the original matrix is equal to:              2455
 subs after y12mae:         5.95
0the largest error is:   1.12e-03
0the largest number of elements in a:    3334
0the number of collections in row list   0
0the number of collections in column list   0
0the largest element in original matrix  1.00e+03
0the largest element in lu-matrix  5.02e+03
0the growth factor is:  5.02e+00
0the minimal pivotal element  1.00e+00
0the drop tolerance:   1.00e-12,     the stability factor:   1.60e+01
0the error diagnostic parameter =    0
1matrix of class d,with parameters n= 600  c=  48
0the number of non-zero elements in the original matrix is equal to:              2455
 subs after y12mae:        18.72
0the largest error is:   2.08e-03
0the largest number of elements in a:    6381
0the number of collections in row list   0
0the number of collections in column list   0
0the largest element in original matrix  1.00e+03
0the largest element in lu-matrix  1.01e+05
0the growth factor is:  1.01e+02
0the minimal pivotal element  1.00e+00
0the drop tolerance:   1.00e-12,     the stability factor:   1.60e+01
0the error diagnostic parameter =    0
1matrix of class d,with parameters n= 600  c=  92
0the number of non-zero elements in the original matrix is equal to:              2455
 subs after y12mae:        17.07
0the largest error is:   3.53e-04
0the largest number of elements in a:    6071
0the number of collections in row list   0
0the number of collections in column list   0
0the largest element in original matrix  1.00e+03
0the largest element in lu-matrix  9.36e+03
0the growth factor is:  9.36e+00
0the minimal pivotal element  3.78e-01
0the drop tolerance:   1.00e-12,     the stability factor:   1.60e+01
0the error diagnostic parameter =    0
1matrix of class d,with parameters n= 600  c= 136
0the number of non-zero elements in the original matrix is equal to:              2455
 subs after y12mae:        19.02
0the largest error is:   6.70e-04
0the largest number of elements in a:    6261
0the number of collections in row list   0
0the number of collections in column list   0
0the largest element in original matrix  1.00e+03
0the largest element in lu-matrix  5.74e+03
0the growth factor is:  5.74e+00
0the minimal pivotal element  6.29e-01
0the drop tolerance:   1.00e-12,     the stability factor:   1.60e+01
0the error diagnostic parameter =    0
1matrix of class d,with parameters n= 600  c= 180
0the number of non-zero elements in the original matrix is equal to:              2455
 subs after y12mae:        17.23
0the largest error is:   8.59e-04
0the largest number of elements in a:    5843
0the number of collections in row list   0
0the number of collections in column list   0
0the largest element in original matrix  1.00e+03
0the largest element in lu-matrix  1.06e+05
0the growth factor is:  1.06e+02
0the minimal pivotal element  6.29e-01
0the drop tolerance:   1.00e-12,     the stability factor:   1.60e+01
0the error diagnostic parameter =    0

```

sparse-matrix/y12m/y12m/y12mfe.f:
```
      subroutine y12mfe(n,a,snr,nn,rnr,nn1,a1,sn,nz,ha,iha,b,b1,x,y,
     1 aflag,iflag,ifail)
      implicit real(a-b,d,g,p,t-y),integer(c,f,h-n,r-s,z)
      double precision ext,er,er1,er2,err,e
      real a(nn),b(n),b1(n),x(n),y(n),a1(nz),aflag(11)
      integer snr(nn),rnr(nn1),ha(iha,13),sn(nz),iflag(12)
c
c  store the non-zero elements,their column numbers,information about
c  row starts,information about row ends and the right-hand side.
c
      ifail=0
      nres=0
      dres=0.0
      state=iflag(5)
      kit=1
      it=iflag(11)
      if(state.eq.1)ifail=10
      if(it.lt.2)ifail=23
      if(ifail.ne.0)go to 160
      do 10 i=1,n
   10 b1(i)=b(i)
      if(state.eq.3)go to 70
      call y12mbe(n,nz,a,snr,nn,rnr,nn1,ha,iha,aflag,iflag,ifail)
      if(ifail.ne.0)go to 160
      do 20 i=1,nz
      sn(i)=snr(i)
   20 a1(i)=a(i)
      do 30 i=1,n
      ha(i,12)=ha(i,1)
   30 ha(i,13)=ha(i,3)
      if(aflag(2).ge.0.0)go to 60
      gt1=aflag(6)
      do 50 i=1,n
      l1=ha(i,1)
      l2=ha(i,3)
      gt2=0.0
      do 40 j=l1,l2
      d=abs(a(j))
   40 if(gt2.lt.d)gt2=d
   50 if(gt2.lt.gt1)gt1=gt2
      aflag(2)=-gt1*aflag(2)
c
c  find the first solution.
c
   60 call y12mce(n,nz,a,snr,nn,rnr,nn1,y,b,ha,iha,aflag,iflag,ifail)
      if(ifail.ne.0)go to 160
   70 call y12mde(n,a,nn,b,y,snr,ha,iha,iflag,ifail)
      if(ifail.ne.0)go to 160
c
c  prepare the data in order to begin the iterations.
c
      dd=0.0
      do 80 i=1,n
      x(i)=b(i)
      xx=abs(b(i))
   80 if(dd.lt.xx)dd=xx
      xm=dd
      if(dd.eq.0.)go to 160
c
c  begin to iterate.
c
   90 d=dd
      dres=0.
      do 110 i=1,n
      er=b1(i)
      l1=ha(i,12)
      l2=ha(i,13)
      do 100 j=l1,l2
      er1=a1(j)
      l3=sn(j)
      er2=x(l3)
  100 er=er-er1*er2
c
c  store residuals rounded to single precision.
c
      b(i)=er
      xx=dabs(er)
  110 if(dres.lt.xx)dres=xx
      if(dres.eq.0.)go to 160
      if(nres.eq.1) go to 150
      if(dres.gt.1.0e+4*xm)go to 150
      kit=kit+1
      iflag(5)=3
      call y12mde(n,a,nn,b,y,snr,ha,iha,iflag,ifail)
      if(ifail.ne.0)go to 160
c
c  compute the uniform norm of the current solution vector.
c
      dd=0.
      do 120 i=1,n
      xx=abs(b(i))
  120 if(dd.lt.xx)dd=xx
      if(dd.eq.0.0)go to 160
c
c  check the convergence criterion.
c
      if(dd.gt.d.and.kit.gt.2)go to 160
c
c  calculate an improved solution.
c
      dcor=dd
      xm=0.0
      do 130 i=1,n
      x(i)=x(i)+b(i)
      xx=abs(x(i))
  130 if(xx.gt.xm) xm=xx
c
c  check the stopping criteria.
c
      if(10.0+dd/xm.eq.10.0) go to 140
      if(kit.lt.it) go to 90
c
c  end of the iterations.
c
  140 nres=1
      go to 90
  150 dd=abs(dd)
  160 iflag(5)=state
      iflag(12)=kit
      aflag(9)=dd
      aflag(10)=dres
      aflag(11)=xm
      return
      end

```

sparse-matrix/y12m/y12m/y12mbe.f:
```
      subroutine y12mbe(n, z, a, snr, nn, rnr, nn1, ha, iha, aflag,
     1 iflag,ifail)
c
c
c  the non-zero elements of a sparse matrix a are prepared  in order to
c  solve the system ax=b by use of sparse matrix technique/
c
c
      implicit real(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      real a(nn), aflag(8)
      integer snr(nn), rnr(nn1), ha(iha,11), iflag(10)
      mode=iflag(4)
      ifail=0
      if(n.lt.2)ifail=12
      if(z.le.0)ifail=13
      if(nn.lt.2*z)ifail=5
      if(nn1.lt.z)ifail=6
      if(ifail.eq.0.and.n.gt.z)ifail=14
      if(iha.lt.n)ifail=15
      if(mode.lt.0)ifail=16
      if(mode.gt.2)ifail=16
      if(ifail.ne.0) go to 22
      gt1=0.0
      do 10 i=1,n
      ha(i,2)=0
      ha(i,3)=0
   10 ha(i,6)=0
c
c  find the number of the non-zero elements in each row and column;move
c  the non-zero elements in the end of the arrays a and snr;find the
c  largest non-zero element in a(in absolute value).
c
      do 20 i=1,z
      t=abs(a(i))
      l3=rnr(i)
      l4=snr(i)
      if(l4.gt.n.or.l4.lt.1)ifail=24
      if(l3.gt.n.or.l3.lt.1)ifail=25
      ha(l3,3)=ha(l3,3)+1
      ha(l4,6)=ha(l4,6)+1
      if(t.gt.gt1)gt1=t
      a(z+i)=a(i)
   20 snr(z+i)=snr(i)
      if(ifail.gt.0)go to 22
c
c  store the information of the row starts(in ha(i,1))and of the column
c  starts(in ha(i,4)).
c
      l1=1
      l2=1
      do 40 i=1,n
      l3=ha(i,3)
      l4=ha(i,6)
      if(l3.gt.0)go to 21
      ifail=17
      go to 22
   21 if(l4.gt.0)go to 23
      ifail=18
      go to 22
   23 if(mode.eq.2)go to 30
      ha(i,9)=l3
      ha(i,10)=l4
      ha(i,11)=0
      ha(l3,2)=ha(l3,2)+1
      ha(i,5)=l3
   30 ha(i,1)=l1
      ha(i,4)=l2
      l1=l1+l3
      l2=l2+l4
      ha(i,3)=0
   40 ha(i,6)=0
c
c  store the non-zero elements of matrix a(ordered in rows) in the
c  first z locations of the array a.do the same for their column numbers
c
      do 50 i=1,z
      l1=z+i
      l3=rnr(i)
      l2=ha(l3,1)+ha(l3,3)
      a(l2)=a(l1)
      snr(l2)=snr(l1)
   50 ha(l3,3)=ha(l3,3)+1
c
c  store the row numbers of the non-zero elements ordered by columns in
c  the first z locations of the array rnr. store information about row
c  ends(in ha(i,3)).
c
      l4=1
      do 70 i=1,n
      if(mode.eq.2)go to 60
      if(ha(i,2).eq.0)go to 60
      ha(i,11)=l4
      l4=l4+ha(i,2)
      ha(i,2)=ha(i,11)
   60 ha(i,3)=ha(i,1)+ha(i,3)-1
      l1=ha(i,1)
      l2=ha(i,3)
      do 70 j=l1,l2
      l3=snr(j)
      r=ha(l3,6)
      index=ha(l3,4)+r
      rnr(index)=i
      if(r.eq.0)go to 70
      if(j.eq.l1)go to 70
      if(rnr(index-1).ne.i)go to 70
      ifail=11
      go to 22
   70 ha(l3,6)=r+1
      do 90 i=1,n
      if(mode.eq.2)go to 80
      l3=ha(i,5)
      l5=ha(l3,2)
      ha(l5,8)=i
      ha(i,7)=l5
      ha(l3,2)=ha(l3,2)+1
   80 continue
   90 ha(i,6)=ha(i,4)+ha(i,6)-1
      aflag(6)=gt1
      iflag(6)=0
      iflag(7)=0
      iflag(8)=z
      iflag(1) = -1
22    return
      end

```

sparse-matrix/y12m/y12m/y12mce.f:
```
      subroutine y12mce(n,z,a,snr,nn,rnr,nn1,pivot,b,ha,iha,
     1 aflag,iflag,ifail)
c
c  systens of linear equations are solved by use of sparse matrix tech-
c  nique and by gaussian elimination.
c
      implicit real(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      real a(nn),b(n),pivot(n),aflag(8)
      integer snr(nn),rnr(nn1),ha(iha,11), iflag(10)
c
c  information which is necessary to begin the elimination is stored.
c
      ifail=0
      if(iflag(1).ne.-1)ifail=2
      if(aflag(1).lt.1.0)aflag(1)=1.0005
      if(aflag(3).lt.1.0e+5)aflag(3)=1.0e+5
      if(aflag(4).lt.0.0)aflag(4)=-aflag(4)
      if(iflag(2).lt.1)ifail=19
      if(iflag(3).lt.0.or.iflag(3).gt.2)ifail=20
      if(iflag(5).lt.1.or.iflag(5).gt.3)ifail=21
      if(iflag(5).eq.3)ifail=22
      if(ifail.gt.0)go to 1110
      snr(z+1)=0
      rnr(z+1)=0
      n8=n+1
      n7=n-1
      u=aflag(1)
      grmin=aflag(4)*aflag(6)
      zz=z
c
c  use the information about fill-ins if it is possible.
c
      nr=n*n
      if(iflag(4).ne.2)go to 100
      if(iflag(10).gt.nn)go to 50
      l1=iflag(10)
      l5=l1+1
      if(l5.le.nn)snr(l5)=0
      do 40 i=1,n
      l=n8-i
      l2=ha(l,3)+1
      l3=l2-ha(l,1)
      do 10 j=1,l3
      snr(l5-j)=snr(l2-j)
   10 a(l5-j)=a(l2-j)
      ha(l,3)=l1
      ha(l,1)=l5-l3
      l6=l1-l3
      l5=l5-ha(l,9)
      if(l5.gt.l6)go to 30
      do 20 j=l5,l6
   20 snr(j)=0
   30 continue
   40 l1=l5-1
   50 if(iflag(9).gt.nn1)go to 100
      l2=iflag(9)
      l5=l2+1
      if(l5.le.nn1)rnr(l5)=0
      do 90 i=1,n
      l=n8-i
      l1=ha(l,6)+1
      l4=l1-ha(l,4)
      do 60 j=1,l4
   60 rnr(l5-j)=rnr(l1-j)
      ha(l,4)=l5-l4
      ha(l,6)=l2
      l6=l2-l4
      l5=l5-ha(l,10)
      if(l5.gt.l6)go to 80
      do 70 j=l5,l6
   70 rnr(j)=0
   80 continue
   90 l2=l5-1
  100 r4=ha(n,3)
      r5=ha(n,6)
      aflag(7)=aflag(6)
      aflag(8)=aflag(6)
      do 110 i=1,n
      pivot(i)=0.0
      ha(i,2)=ha(i,1)
  110 ha(i,5)=ha(i,4)
      index=ha(n,8)
      slut=ha(index,3)-ha(index,2)+1
c
c  start of gaussian elimination.
c
      do 950 i=1,n7
      rr3=ha(i,2)
      rr4=ha(i,3)
      c1=ha(i,4)
      cr4=ha(i,6)
      if(iflag(3).eq.0)go to 350
      if(iflag(4).ne.2)go to 120
      rrow=ha(i,7)
      rcoll=ha(i,8)
      go to 220
  120 l4=ha(i,8)
      if(iflag(3).eq.1)go to 130
      rrow=l4
      rcoll=rrow
      rpivot=i
      go to 170
  130 r=nr
      v=0.0
      index=iflag(2)
      do 160 kk=1,index
      l1=i-1+kk
      if(l1.gt.n)go to 170
      j=ha(l1,8)
      r7=ha(j,2)
      r8=ha(j,3)
      r9=r8-r7
      t=0.0
      do 140 k=r7,r8
      td=abs(a(k))
  140 if(t.lt.td)t=td
      t=t/u
      do 160 k=r7,r8
      td=abs(a(k))
      if(td.lt.t)go to 150
      r6=snr(k)
      r3=r9*(ha(r6,6)-ha(r6,5))
      if(r3.gt.r)go to 150
      if(r3.lt.r)go to 151
      if(v.ge.td)go to 150
  151 v=td
      rrow=j
      rcoll=r6
      r=r3
      rpivot=l1
  150 continue
  160 continue
  170 r3=ha(rcoll,10)
      ha(rcoll,10)=ha(i,10)
      ha(i,10)=r3
      r3=ha(rrow,9)
      ha(rrow,9)=ha(i,9)
      ha(i,9)=r3
c
c  remove the pivot row of the list where the rows are ordered by
c  increasing numbers of non-zero elements.
c
      l1=0
      l=i
      l2=ha(l4,3)-ha(l4,2)+1
  180 l=l+1
      if(l2.gt.l1)ha(l2,11)=l
      if(l.gt.n)go to 190
      l5=ha(l,8)
      l3=ha(l5,3)-ha(l5,2)+1
      if(rpivot.lt.l)go to 190
      ha(l4,7)=l
      ha(l,8)=l4
      l4=l5
      l1=l2
      l2=l3
      l3=n8
      go to 180
  190 if(l2.eq.l1)go to 200
      if(l3.eq.l2)go to 200
      ha(l2,11)=0
  200 l5=ha(i,7)
      if(rrow.eq.i)go to 210
      ha(l5,8)=rrow
      ha(rrow,7)=l5
  210 ha(i,7)=rrow
      ha(i,8)=rcoll
c
c  row interchanges.
c
  220 if(rrow.eq.i)go to 290
      t=b(rrow)
      b(rrow)=b(i)
      b(i)=t
      do 250 j=rr3,rr4
      l1=snr(j)
      r=ha(l1,5)-1
      r10=ha(l1,6)
  240 r=r+1
      if(rnr(r).ne.i)go to 240
      rnr(r)=rnr(r10)
  250 rnr(r10)=rrow
      rr3=ha(rrow,2)
      rr4=ha(rrow,3)
      do 270 j=rr3,rr4
      l1=snr(j)
      r=ha(l1,5)-1
  260 r=r+1
      if(rnr(r).ne.rrow)go to 260
  270 rnr(r)=i
      do 280 j=1,3
      r3=ha(rrow,j)
      ha(rrow,j)=ha(i,j)
  280 ha(i,j)=r3
c
c  column interchanges.
c
  290 if(rcoll.eq.i)go to 350
      do 310 j=c1,cr4
      l1=rnr(j)
      r=ha(l1,2)-1
      r10=ha(l1,3)
  300 r=r+1
      if(snr(r).ne.i)go to 300
      t=a(r10)
      a(r10)=a(r)
      a(r)=t
      snr(r)=snr(r10)
  310 snr(r10)=rcoll
      c1=ha(rcoll,4)
      cr4=ha(rcoll,6)
      do 330 j=c1,cr4
      l1=rnr(j)
      r=ha(l1,2)-1
  320 r=r+1
      if(snr(r).ne.rcoll)go to 320
  330 snr(r)=i
      do 340 j=4,6
      r3=ha(rcoll,j)
      ha(rcoll,j)=ha(i,j)
  340 ha(i,j)=r3
c
c end of the interchanges.
c the row ordered list and the column ordered list are prepared to
c begin step i of the elimination.
c
  350 r9=rr4-rr3
      do 360 rr=rr3,rr4
      if(snr(rr).eq.i)go to 370
  360 continue
      ifail=9
      go to 1110
  370 v=a(rr)
      pivot(i)=v
      td=abs(v)
      if(td.lt.aflag(8))aflag(8)=td
      if(td.ge.grmin)go to 380
      ifail=3
      go to 1110
  380 r2=ha(i,1)
      a(rr)=a(rr3)
      snr(rr)=snr(rr3)
      a(rr3)=a(r2)
      snr(rr3)=snr(r2)
      snr(r2)=0
      z=z-1
      rr3=rr3+1
      ha(i,2)=rr3
      ha(i,1)=r2+1
      cr3=ha(i,5)
      if(r9.le.0)go to 431
      do 430 j=rr3,rr4
      index=snr(j)
  430 pivot(index)=a(j)
  431 r7=cr4-cr3+1
      do 880 k=1,r7
      r1=rnr(cr3-1+k)
      if(r1.eq.i)go to 870
      i1=ha(r1,1)
      rr1=ha(r1,2)
      rr2=ha(r1,3)
      l2=rr2-rr1+1
      l=rr1-1
  390 l=l+1
      if(snr(l).ne.i)go to 390
      t=a(l)/v
      if(iflag(5).eq.2)go to 400
      a(l)=a(i1)
      snr(l)=snr(i1)
      snr(i1)=0
      i1=i1+1
      ha(r1,1)=i1
      z=z-1
      go to 410
  400 a(l)=a(rr1)
      a(rr1)=t
      r3=snr(rr1)
      snr(rr1)=snr(l)
      snr(l)=r3
  410 rr1=rr1+1
      ha(r1,2)=rr1
      b(r1)=b(r1)-b(i)*t
      if(r9.le.0)go to 669
      r=rr1
      if(r.gt.rr2)go to 470
      do 460 l=r,rr2
      l1=snr(l)
      td=pivot(l1)
      if(td.eq.0.0)go to 450
      pivot(l1)=0.0
      td=a(l)-td*t
      a(l)=td
      td1=abs(td)
      if(td1.gt.aflag(7))aflag(7)=td1
      if(td1.gt.aflag(2))go to 450
c
c  too small element is created.remove it from the lists.
c
      z=z-1
      a(l)=a(rr1)
      snr(l)=snr(rr1)
      a(rr1)=a(i1)
      snr(rr1)=snr(i1)
      snr(i1)=0
      rr1=rr1+1
      i1=i1+1
      ha(r1,2)=rr1
      ha(r1,1)=i1
      r3=ha(l1,5)
      r2=r3-1
      l4=ha(l1,4)
      l5=rnr(l4)
      l6=rnr(r3)
  440 r2=r2+1
      if(rnr(r2).ne.r1)go to 440
      rnr(r2)=l6
      rnr(r3)=l5
      rnr(l4)=0
      ha(l1,5)=r3+1
      ha(l1,4)=l4+1
  450 continue
  460 continue
  470 continue
      do 750 j=1,r9
      r=rr3-1+j
      r2=snr(r)
      tol2=pivot(r2)
      pivot(r2)=a(r)
      if(tol2.eq.0.0)go to 740
      tol3=-tol2*t
      tol1=abs(tol3)
      if(tol1.lt.aflag(2))go to 740
      c2=ha(r2,4)
      cr2=ha(r2,6)
      cr1=ha(r2,5)
      lfr=rr2-i1+2
      lfc=cr2-c2+2
      if(iflag(4).ne.1)go to 480
      if(lfr.gt.ha(r1,9))ha(r1,9)=lfr
      if(lfc.gt.ha(r2,10))ha(r2,10)=lfc
  480 if(i1.eq.1)go to 490
      if(snr(i1-1).eq.0)go to 600
  490 if(rr2.eq.nn)go to 500
      if(snr(rr2+1).eq.0)go to 580
  500 r10=nn-lfr
c
c  collection in row ordered list.
c
      if(r10.ge.r4)go to 560
      iflag(6)=iflag(6)+1
      do 520  jj=1,n
      l1=ha(jj,3)
      if(l1.lt.ha(jj,1))go to 510
      ha(jj,3)=snr(l1)
      snr(l1)=-jj
  510 continue
  520 continue
      l3=0
      l4=1
      do 550  jj=1,r4
      if(snr(jj).eq.0)go to 540
      l3=l3+1
      if(snr(jj).gt.0)go to 530
      l5=-snr(jj)
      snr(jj)=ha(l5,3)
      ha(l5,3)=l3
      l6=l4+ha(l5,2)-ha(l5,1)
      ha(l5,2)=l6
      ha(l5,1)=l4
      l4=l3+1
  530 a(l3)=a(jj)
      snr(l3)=snr(jj)
  540 continue
  550 continue
      r4=l3
      snr(l3+1)=0
      rr3=ha(i,2)
      rr4=ha(i,3)
      i1=ha(r1,1)
      rr1=ha(r1,2)
      r=rr3-1+j
      if(r10.ge.r4)go to 560
      ifail=5
      go to 1110
c
c fill-in takes place in the row ordered list.
c
  560 r8=lfr-1
      rr2=r4+lfr
      if(r8.le.0)go to 579
      l3=i1-1
      do 570 ll=1,r8
      l4=r4+ll
      l5=l3+ll
      a(l4)=a(l5)
      snr(l4)=snr(l5)
  570 snr(l5)=0
  579 rr1=r4+rr1-i1+1
      ha(r1,3)=rr2
      ha(r1,2)=rr1
      i1=r4+1
      ha(r1,1)=i1
      l1=rr2
      go to 590
  580 rr2=rr2+1
      ha(r1,3)=rr2
      l1=rr2
      if(rr2.le.r4)go to 610
  590 r4=rr2
      if(r4.lt.nn)snr(r4+1)=0
      go to 610
  600 rr1=rr1-1
      i1=i1-1
      ha(r1,1)=i1
      ha(r1,2)=rr1
      l1=rr1
      snr(i1)=snr(l1)
      a(i1)=a(l1)
  610 a(l1)=tol3
      snr(l1)=snr(r)
      td=abs(a(l1))
      if(td.gt.aflag(7))aflag(7)=td
      z=z+1
      if(iflag(8).lt.z)      iflag(8)=z
      if(c2.eq.1)go to 620
      if(rnr(c2-1).eq.0)go to 720
  620 if(cr2.eq.nn1)go to 630
      if(rnr(cr2+1).eq.0)go to 700
  630 r10=nn1-lfc
c
c  collection in column ordered list.
c
      if(r10.ge.r5)go to 680
      iflag(7)=iflag(7)+1
      do 640  jj=i,n
      l1=ha(jj,6)
      ha(jj,6)=rnr(l1)
  640 rnr(l1)=-jj
      l3=0
      l4=1
      do 670  jj=1,r5
      if(rnr(jj).eq.0)go to 660
      l3=l3+1
      if(rnr(jj).gt.0)go to 650
      l5=-rnr(jj)
      rnr(jj)=ha(l5,6)
      ha(l5,6)=l3
      l6=l4+ha(l5,5)-ha(l5,4)
      ha(l5,5)=l6
      ha(l5,4)=l4
      l4=l3+1
  650 rnr(l3)=rnr(jj)
  660 continue
  670 continue
      r5=l3
      rnr(r5+1)=0
      c2=ha(r2,4)
      cr3=ha(i,5)
      cr4=ha(i,6)
      cr1=ha(r2,5)
      if(r10.ge.r5)go to 680
      ifail=6
      go to 1110
c
c fill-in takes place in the column ordered list.
c
  680 r8=lfc-1
      cr2=r5+lfc
      if(r8.le.0)go to 699
      l3=c2-1
      do 690 l=1,r8
      l4=r5+l
      l5=l3+l
      rnr(l4)=rnr(l5)
  690 rnr(l5)=0
  699 cr1=r5+cr1-c2+1
      c2=r5+1
      ha(r2,6)=cr2
      ha(r2,4)=c2
      ha(r2,5)=cr1
      r=cr2
      go to 710
  700 cr2=cr2+1
      ha(r2,6)=cr2
      r=cr2
      if(cr2.le.r5)go to 730
  710 r5=cr2
      if(r5.lt.nn1)rnr(r5+1)=0
      go to 730
  720 cr1=cr1-1
      c2=c2-1
      ha(r2,4)=c2
      ha(r2,5)=cr1
      r=cr1
      rnr(c2)=rnr(r)
  730 rnr(r)=r1
  740 continue
  750 continue
  669 if(rr1.le.rr2)go to 760
      ifail=7
      go to 1110
c
c  update the information in the list where the rows are ordered by
c  increasing numbers of the non-zero elements.
c
  760 if(iflag(4).eq.2)go to 870
      if(iflag(3).eq.0)go to 870
      l1=rr2-rr1+1
      if(l1.eq.l2)go to 870
      l6=ha(r1,7)
      l4=ha(l2,11)
      if(l1.gt.l2)go to 820
      if(l6.gt.l4)go to 780
      if(l4.eq.n)go to 770
      l=ha(l4+1,8)
      l5=ha(l,3)-ha(l,2)+1
      if(l5.eq.l2)go to 790
  770 ha(l2,11)=0
      go to 800
  780 l5=ha(l4,8)
      l3=ha(l6,8)
      ha(l4,8)=l3
      ha(l6,8)=l5
      ha(l5,7)=l6
      ha(l3,7)=l4
      l6=l4
  790 ha(l2,11)=l4+1
  800 if(l4.eq.i+1)go to 810
      l=ha(l6-1,8)
      l2=ha(l,3)-ha(l,2)+1
      l4=ha(l2,11)
      if(l1.lt.l2)go to 780
  810 if(l1.ne.l2)ha(l1,11)=l6
      go to 870
  820 if(l6.gt.l4)go to 840
      if(l4.eq.n)go to 830
      l=ha(l4+1,8)
      l5=ha(l,3)-ha(l,2)+1
      if(l5.eq.l2)go to 840
  830 ha(l2,11)=0
  840 l2=l2+1
      if(l2.le.slut)go to 850
      l3=n
      slut=l1
      l2=l1
      go to 860
  850 l3=ha(l2,11)-1
      if(l3.eq.-1)go to 840
      if(l2.gt.l1)l2=l1
  860 ha(l2,11)=l3
      l4=ha(l3,8)
      l7=ha(l6,8)
      ha(l3,8)=l7
      ha(l6,8)=l4
      ha(l7,7)=l3
      ha(l4,7)=l6
      l6=l3
      if(l2.lt.l1)go to 840
  870 continue
  880 continue
      if(r9.le.0)go to 882
      do 881 j=rr3,rr4
      index=snr(j)
  881 pivot(index)=0.0
  882 continue
      cr3=ha(i,4)
      do 890 j=cr3,cr4
  890 rnr(j)=0
      if(r9.le.0)go to 930
      l2=ha(i,2)-1
      do 920 ll=1,r9
      r=snr(l2+ll)
      r1=ha(r,5)
      r2=ha(r,6)
      if(r2.gt.r1)go to 900
      ifail=8
      go to 1110
  900 ha(r,5)=r1+1
      r3=r1-1
  910 r3=r3+1
      if(rnr(r3).ne.i)go to 910
      rnr(r3)=rnr(r1)
  920 rnr(r1)=i
  930 aflag(5)=aflag(7)/aflag(6)
      if(aflag(5).lt.aflag(3))go to 940
      ifail=4
      go to 1110
  940 continue
  950 continue
c
c  preparation to begin the back substitution.
c
      index=ha(n,2)
      pivot(n)=a(index)
      a(index)=0.0
      td=abs(pivot(n))
      if(td.gt.aflag(7))aflag(7)=td
      if(td.lt.aflag(8))aflag(8)=td
      if(td.gt.grmin)go to 960
      ifail=3
      go to 1110
  960 if(iflag(4).ne.1)go to 1060
      iflag(10)=ha(n,9)
      iflag(9)=ha(n,10)
      do 990 i=1,n7
      r1=n-i
      iflag(10)=iflag(10)+ha(r1,9)
      iflag(9)=iflag(9)+ha(r1,10)
      if(iflag(3).eq.0)go to 980
      do 970 j=9,10
      r2=ha(r1,j-2)
      r6=ha(r2,j)
      ha(r2,j)=ha(r1,j)
  970 ha(r1,j)=r6
  980 continue
  990 continue
1060  continue
      aflag(5)=aflag(7)/aflag(6)
      iflag(1)=-2
 1110 z=zz
      return
      end

```

sparse-matrix/y12m/y12m/y12mge.f:
```
      subroutine y12mge(n,nn,a,snr,w,pivot,anorm,rcond,iha,ha
     *                 ,iflag,ifail)
c
c
c   purpose.
c   --------
c
c   this subroutine computes the number called    rcond    by
c   dongarra et al.(1979). this number is the reciprocal of the
c   condition number of matrix   a .   the subroutine can be
c   called immediately after the call of   y12mce.   the parameters
c   (except   rcond   and   anorm ) have the same meaning as the
c   corresponding parameters in the subroutines of package   y12m  (the
c   subroutine can be  call only if the   lu   decomposition of matrix
c   a   computed by   y12mce   is not destroyed). subroutine  y12mhe
c   should be called before the call of subroutine   y12mce (this
c   subroutine calculates the   one-norm   of matrix   a   and
c   stores  it  in   anorm.   on successful exit   rcond   will
c   contain an approximation to the reciprocal of the condition
c   number of matrix   a.   more details, concerning the use
c   of similar subroutines for  dense matrices, can be found
c   in   j.dongarra, j.r.bunch, c.b.moler and g.w.stewart (1979):
c        "linpack - user's guide", siam, philadelphia.
c
c
c
c
c  declaration of the global variables and arrays.
c
c
      integer n, nn, iha, iflag, ifail
      integer   snr, ha
      real      a, w,    pivot, rcond, anorm
      dimension a(nn),snr(nn),ha(iha,3),pivot(n),w(n),iflag(5)
c
c
c  declaration of the internal variables.
c
c
      real  aa, ynorm, znorm, t
      integer  l1, l2, l3, l, n7, n8
c
c
c   check whether the entry is correct or not.
c
c
      if(ifail.ne.0) go to 180
      if(iflag(5).ne.1) go to 10
      ifail=26
      go to 180
c
c
c   no error detected.  the computations will be continued.
c
c
   10 n8=n+1
      n7=n-1
c
c
c   solve a system of the form    u1*w=e   where   u1   is the
c   transpose of matrix   u   in the   lu-factorization of matrix
c   a   and    e    is a vector whose components are equal to   +1
c   or   -1.
c
c
      w(1)=1.0/pivot(1)
      do   20   i=2,n
   20 w(i)=0.0
      do   50   i=2,n
      l1=ha(i,2)
      l2=ha(i,3)
      if(l1.gt.l2) go to 40
      t=w(i-1)
      do   30   j=l1,l2
      l=snr(j)
   30 w(l)=w(l)+t*a(j)
   40 if(w(i).gt.0.0) w(i)=w(i)+1.0
      if(w(i).le.0.0) w(i)=w(i)-1.0
   50 w(i)=-w(i)/pivot(i)
c
c
c   solve a system of the form   l1*y=w   where   l1   is the
c   transpose of matrix   l   in the   lu-factorization of
c   matrix   a .   the components of vector   y   are stored
c   array   w  (thus, the contents of array   w   are overwritten
c   by the components of vector   y ).
c
c
      do   80   i=1,n7
      l=n-i
      l1=ha(l,1)
      l2=ha(l,2)-1
      if(l1.gt.l2) go to 70
      t=w(l+1)
      do   60   j=l1,l2
      l3=snr(j)
   60 w(l3)=w(l3)-t*a(j)
   70 continue
   80 continue
c
c
c   calculate the one-norm of vector   y .
c
c
      ynorm=0.0
      do   90   i=1,n
   90 ynorm=ynorm+abs(w(i))
c
c
c   compute the solution of    (lu)z=y .  this means that
c   two systems with triangular matrices are solved using the
c   same ideas as above. the components of the calculated solution
c   are stored in array   w .
c
c
      do 130 i=1,n
      l1=ha(i,1)
      l2=ha(i,2)-1
      if(l1.gt.l2) go to 120
      do 110 j=l1,l2
      l=snr(j)
  110 w(i)=w(i)-a(j)*w(l)
  120 continue
  130 continue
      do 160 i=1,n
      l3=n8-i
      l1=ha(l3,2)
      l2=ha(l3,3)
      if(l1.gt.l2) go to 150
      do 140 j=l1,l2
      l=snr(j)
  140 w(l3)=w(l3)-a(j)*w(l)
  150 continue
  160 w(l3)=w(l3)/pivot(l3)
c
c
c   compute the one-norm of vector   z   (vector   z   is
c   the vector calculated above and stored in array   w .
c
c
      znorm=0.0
      do   170   i=1,n
  170 znorm=znorm+abs(w(i))
c
c
c   find the value of the required estimate for the reciprocal
c   of the condition number of matrix   a .
c
c
      rcond=(ynorm/anorm)/znorm
c
c
c   end of the computations.
c
c
  180 if(ifail.ne.0) rcond=-1.0
      return
      end

```

sparse-matrix/y12m/y12m/y12mhe.f:
```
      subroutine y12mhe(n,nz,a,snr,work,anorm)
c
c
c   purpose.
c   -------
c
c
c   this subroutine computes the    one-norm   of a sparse
c   matrix   a.   all parameters  (except    anorm )   have  the
c   same meaning as in the other subroutines in  package   y12m.
c   on exit the   one-norm   of matrix   a   will be stored in
c   anorm.
c
c
c
c
c  declaration of the global variables and arrays.
c
c
      integer n, nz
      integer   snr
      real a, work, anorm
      dimension a(nz), snr(nz), work(n)
c
c
c  declaration of the internal variables.
c
c
      integer l
c
c
c  set all locations of array     work     equal to zero.
c
c
      do 10 i=1,n
   10 work(i)=0.0
c
c
c  calculate the sums of the absolute values of the non-zero
c  elements in each row of matrix     a .     store these sums
c  in array     work .
c
c
      do 20 i=1,nz
      l=snr(i)
   20 work(l)=work(l)+abs(a(i))
c
c
c  calculate the one-norm of matrix     a .
c
c
      anorm=0.0
      do 30 i=1,n
   30 if(work(i).gt.anorm) anorm=work(i)
c
c
c  stop the computations.
c
c
      return
      end

```

sparse-matrix/y12m/y12m/y12mbf.f:
```
      subroutine y12mbf(n, z, a, snr, nn, rnr, nn1, ha, iha, aflag,
     1 iflag,ifail)
c
c
c  the non-zero elements of a sparse matrix a are prepared  in order to
c  solve the system ax=b by use of sparse matrix technique/
c
c
      implicit double precision(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      double precision a(nn), aflag(8)
      integer snr(nn), rnr(nn1), ha(iha,11), iflag(10)
      mode=iflag(4)
      ifail=0
      if(n.lt.2)ifail=12
      if(z.le.0)ifail=13
      if(nn.lt.2*z)ifail=5
      if(nn1.lt.z)ifail=6
      if(ifail.eq.0.and.n.gt.z)ifail=14
      if(iha.lt.n)ifail=15
      if(mode.lt.0)ifail=16
      if(mode.gt.2)ifail=16
      if(ifail.ne.0) go to 22
      gt1=0.0d0
      do 10 i=1,n
      ha(i,2)=0
      ha(i,3)=0
   10 ha(i,6)=0
c
c  find the number of the non-zero elements in each row and column;move
c  the non-zero elements in the end of the arrays a and snr;find the
c  largest non-zero element in a(in absolute value).
c
      do 20 i=1,z
      t=dabs(a(i))
      l3=rnr(i)
      l4=snr(i)
      if(l4.gt.n.or.l4.lt.1)ifail=24
      if(l3.gt.n.or.l3.lt.1)ifail=25
      ha(l3,3)=ha(l3,3)+1
      ha(l4,6)=ha(l4,6)+1
      if(t.gt.gt1)gt1=t
      a(z+i)=a(i)
   20 snr(z+i)=snr(i)
      if(ifail.gt.0)go to 22
c
c  store the information of the row starts(in ha(i,1))and of the column
c  starts(in ha(i,4)).
c
      l1=1
      l2=1
      do 40 i=1,n
      l3=ha(i,3)
      l4=ha(i,6)
      if(l3.gt.0)go to 21
      ifail=17
      go to 22
   21 if(l4.gt.0)go to 23
      ifail=18
      go to 22
   23 if(mode.eq.2)go to 30
      ha(i,9)=l3
      ha(i,10)=l4
      ha(i,11)=0
      ha(l3,2)=ha(l3,2)+1
      ha(i,5)=l3
   30 ha(i,1)=l1
      ha(i,4)=l2
      l1=l1+l3
      l2=l2+l4
      ha(i,3)=0
   40 ha(i,6)=0
c
c  store the non-zero elements of matrix a(ordered in rows) in the
c  first z locations of the array a.do the same for their column numbers
c
      do 50 i=1,z
      l1=z+i
      l3=rnr(i)
      l2=ha(l3,1)+ha(l3,3)
      a(l2)=a(l1)
      snr(l2)=snr(l1)
   50 ha(l3,3)=ha(l3,3)+1
c
c  store the row numbers of the non-zero elements ordered by columns in
c  the first z locations of the array rnr. store information about row
c  ends(in ha(i,3)).
c
      l4=1
      do 70 i=1,n
      if(mode.eq.2)go to 60
      if(ha(i,2).eq.0)go to 60
      ha(i,11)=l4
      l4=l4+ha(i,2)
      ha(i,2)=ha(i,11)
   60 ha(i,3)=ha(i,1)+ha(i,3)-1
      l1=ha(i,1)
      l2=ha(i,3)
      do 70 j=l1,l2
      l3=snr(j)
      r=ha(l3,6)
      index=ha(l3,4)+r
      rnr(index)=i
      if(r.eq.0)go to 70
      if(j.eq.l1)go to 70
      if(rnr(index-1).ne.i)go to 70
      ifail=11
      go to 22
   70 ha(l3,6)=r+1
      do 90 i=1,n
      if(mode.eq.2)go to 80
      l3=ha(i,5)
      l5=ha(l3,2)
      ha(l5,8)=i
      ha(i,7)=l5
      ha(l3,2)=ha(l3,2)+1
   80 continue
   90 ha(i,6)=ha(i,4)+ha(i,6)-1
      aflag(6)=gt1
      iflag(6)=0
      iflag(7)=0
      iflag(8)=z
      iflag(1)=-1
22    return
      end

```

sparse-matrix/y12m/y12m/y12mdf.f:
```
      subroutine y12mdf(n,a,nn,b,pivot,snr,ha,iha,iflag,ifail)
      implicit double precision(a-b,g,p,t-y),integer (c,f,h-n,r-s,z)
      double precision a(nn), pivot(n), b(n)
      integer snr(nn), ha(iha,11), iflag(10)
      ifail=0
      if(iflag(1).eq.-2)go to 1000
      ifail=1
      go to 1110
1000  mode=iflag(4)
      ipiv=iflag(3)
      n8=n+1
      n7=n-1
      state=iflag(5)
c
c  solve the system with lower triangular matrix  l  (if the
c  lu-factorization is available).
c
      if(state.ne.3)go to 1051
      if(ipiv.eq.0)go to 1020
      do 1010 i=1,n7
      l1=ha(i,7)
      t=b(l1)
      b(l1)=b(i)
      b(i)=t
1010  continue
1020  continue
      do 1050 i=1,n
      rr1=ha(i,1)
      rr2=ha(i,2)-1
      if(rr1.gt.rr2)go to 1040
      do 1030 j=rr1,rr2
      l1=snr(j)
 1030 b(i)=b(i)-a(j)*b(l1)
 1040 continue
 1050 continue
c
c  solve the system with upper triagular matrix.
c
 1051 continue
      do 1090 i=1,n
      r1=n8-i
      rr1=ha(r1,2)
      rr2=ha(r1,3)
      if(rr2.lt.rr1)   go to 1080
      do 1070 j=rr1,rr2
      r2=snr(j)
 1070 b(r1)=b(r1)-a(j)*b(r2)
 1080 continue
 1090 b(r1)=b(r1)/pivot(r1)
c
c if interchanges were used during the  elimination then a reordering in
c lution vector is made.
c
      if(ipiv.eq.0)go to 1110
      do 1100 i=1,n7
      r1=n-i
      r2=ha(r1,8)
      t=b(r2)
      b(r2)=b(r1)
 1100 b(r1)=t
 1110 return
      end

```

sparse-matrix/y12m/y12m/y12maf.f:
```
      subroutine y12maf(n, z, a, snr, nn, rnr, nn1, pivot, ha,
     1iha,aflag,iflag,b,ifail)
      implicit double precision (a-b,g,p,t-y), integer (c,f,h-n,r-s,z)
      double precision a(nn), pivot(n), aflag(8),b(n)
      integer snr(nn), rnr(nn1), ha(iha,11), iflag(10)
      aflag(1)=16.0d0
      aflag(2)=1.d-12
      aflag(3)=1.d+16
      aflag(4)=1.d-12
      iflag(2)=2
      iflag(3)=1
      iflag(4)=0
      iflag(5)=1
      call y12mbf(n,z,a,snr,nn,rnr,nn1,ha,iha,aflag,iflag,ifail)
      if(ifail.ne.0)go to 1
      call y12mcf(n,z,a,snr,nn,rnr,nn1,pivot,b,ha,iha,aflag,iflag,
     1 ifail)
      if(ifail.ne.0)go to 1
      call y12mdf(n,a,nn,b,pivot,snr,ha,iha,iflag,ifail)
1     return
      end

```

sparse-matrix/y12m/y12m/y12mde.f:
```
      subroutine y12mde(n,a,nn,b,pivot,snr,ha,iha,iflag,ifail)
      implicit real(a-b,g,p,t-y),integer (c,f,h-n,r-s,z)
      real a(nn), pivot(n), b(n)
      integer snr(nn), ha(iha,11), iflag(10)
      if(iflag(1).eq.-2)go to 1000
      ifail=1
      go to 1110
1000  mode=iflag(4)
      ipiv=iflag(3)
      n7=n-1
      state=iflag(5)
c
c  solve the system with lower triangular matrix  l  (if the
c  lu-factorization is available).
c
      if(state.ne.3)go to 1051
      if(ipiv.eq.0)go to 1020
      do 1010 i=1,n7
      l1=ha(i,7)
      t=b(l1)
      b(l1)=b(i)
      b(i)=t
1010  continue
1020  continue
      do 1050 i=1,n
      rr1=ha(i,1)
      rr2=ha(i,2)-1
      if(rr1.gt.rr2)go to 1040
      do 1030 j=rr1,rr2
      l1=snr(j)
 1030 b(i)=b(i)-a(j)*b(l1)
 1040 continue
 1050 continue
c
c  solve the system with upper triagular matrix.
c
 1051 n8=n+1
      do 1090 i=1,n
      r1=n8-i
      rr1=ha(r1,2)
      rr2=ha(r1,3)
      if(rr2.lt.rr1)   go to 1080
      do 1070 j=rr1,rr2
      r2=snr(j)
 1070 b(r1)=b(r1)-a(j)*b(r2)
 1080 continue
 1090 b(r1)=b(r1)/pivot(r1)
c
c if interchanges were used during the  elimination then a reordering in
c the solution vector is made.
c
      if(ipiv.eq.0)go to 1110
      do 1100 i=1,n7
      r1=n-i
      r2=ha(r1,8)
      t=b(r2)
      b(r2)=b(r1)
 1100 b(r1)=t
 1110 return
      end

```

sparse-matrix/y12m/y12m/y12m.f:
```
      subroutine y12m
c     dummy routine to trick netlib into sending entire y12m package
      call y12cck
      call y12mae
      call y12maf
      call y12mbe
      call y12mbf
      call y12mce
      call y12mcf
      call y12mde
      call y12mdf
      call y12mfe
      call y12mge
      call y12mhe
      end

```

sparse-matrix/y12m/y12m/y12cck.f:
```
      real function y12cck(i,j)
      y12cck = float(itime(k))/60.
      return
      end

```

sparse-matrix/y12m/y12m/y12mae.f:
```
      subroutine y12mae(n, z, a, snr, nn, rnr, nn1, pivot, ha,
     1iha,aflag,iflag,b,ifail)
      implicit real (a-b,g,p,t-y), integer (c,f,h-n,r-s,z)
      real a(nn), pivot(n), aflag(8),b(n)
      integer snr(nn), rnr(nn1), ha(iha,11), iflag(10)
      aflag(1)=16.
      aflag(2)=1.e-12
      aflag(3)=1.e+16
      aflag(4)=1.e-12
      iflag(2)=2
      iflag(3)=1
      iflag(4)=0
      iflag(5)=1
      call y12mbe(n,z,a,snr,nn,rnr,nn1,ha,iha,aflag,iflag,ifail)
      if(ifail.ne.0)go to 1
      call y12mce(n,z,a,snr,nn,rnr,nn1,pivot,b,ha,iha,aflag,iflag,
     1 ifail)
      if(ifail.ne.0)go to 1
      call y12mde(n,a,nn,b,pivot,snr,ha,iha,iflag,ifail)
1     return
      end

```

gr.cg/inverse_metric_gradient.c:
```
/*
 * inputs = {g_uu, partial_d_g_dd}
 * outputs = {partial_d_g_uu}
 * cost = 63*assignments+183*multiplications+117*additions
 */
fp t1, t2, t3, t5, t6, t7, t10, t11, t12, t15;
fp t16, t18, t19, t22, t23, t28, t29, t31, t33, t35;
fp t36, t38, t40, t48, t49, t51, t53, t60, t62, t65;
fp t74, t76, t86, t88, t90, t93, t96, t98, t101, t148;
fp t150, t153, t156, t158, t161;
      t1 = g_uu_11;
      t2 = t1*t1;
      t3 = partial_d_g_dd_111;
      t5 = g_uu_12;
      t6 = t5*t1;
      t7 = partial_d_g_dd_112;
      t10 = g_uu_13;
      t11 = t10*t1;
      t12 = partial_d_g_dd_113;
      t15 = t5*t5;
      t16 = partial_d_g_dd_122;
      t18 = t10*t5;
      t19 = partial_d_g_dd_123;
      t22 = t10*t10;
      t23 = partial_d_g_dd_133;
      partial_d_g_uu_111 = -t2*t3-2.0*t6*t7-2.0*t11*t12-t15*t16-2.0*t18*t19-t22
*t23;
      t28 = g_uu_22;
      t29 = t1*t28;
      t31 = t5*t28;
      t33 = t10*t28;
      t35 = g_uu_23;
      t36 = t1*t35;
      t38 = t5*t35;
      t40 = t10*t35;
      partial_d_g_uu_112 = -t6*t3-t15*t7-t18*t12-t29*t7-t31*t16-t33*t19-t36*t12
-t38*t19-t40*t23;
      t48 = g_uu_33;
      t49 = t1*t48;
      t51 = t48*t5;
      t53 = t10*t48;
      partial_d_g_uu_113 = -t11*t3-t18*t7-t22*t12-t36*t7-t38*t16-t40*t19-t49*
t12-t51*t19-t53*t23;
      t60 = t28*t28;
      t62 = t35*t28;
      t65 = t35*t35;
      partial_d_g_uu_122 = -t15*t3-2.0*t31*t7-2.0*t38*t12-t60*t16-2.0*t62*t19-
t65*t23;
      t74 = t28*t48;
      t76 = t35*t48;
      partial_d_g_uu_123 = -t18*t3-t33*t7-t40*t12-t38*t7-t62*t16-t65*t19-t51*
t12-t74*t19-t76*t23;
      t86 = t48*t48;
      partial_d_g_uu_133 = -t22*t3-2.0*t40*t7-2.0*t53*t12-t65*t16-2.0*t76*t19-
t86*t23;
      t88 = partial_d_g_dd_211;
      t90 = partial_d_g_dd_212;
      t93 = partial_d_g_dd_213;
      t96 = partial_d_g_dd_222;
      t98 = partial_d_g_dd_223;
      t101 = partial_d_g_dd_233;
      partial_d_g_uu_211 = -t2*t88-2.0*t6*t90-2.0*t11*t93-t15*t96-2.0*t18*t98-
t22*t101;
      partial_d_g_uu_212 = -t6*t88-t15*t90-t18*t93-t29*t90-t31*t96-t33*t98-t36*
t93-t38*t98-t40*t101;
      partial_d_g_uu_213 = -t11*t88-t18*t90-t22*t93-t36*t90-t38*t96-t40*t98-t49
*t93-t51*t98-t53*t101;
      partial_d_g_uu_222 = -t15*t88-2.0*t31*t90-2.0*t38*t93-t60*t96-2.0*t62*t98
-t65*t101;
      partial_d_g_uu_223 = -t18*t88-t33*t90-t40*t93-t38*t90-t62*t96-t65*t98-t51
*t93-t74*t98-t76*t101;
      partial_d_g_uu_233 = -t22*t88-2.0*t40*t90-2.0*t53*t93-t65*t96-2.0*t76*t98
-t86*t101;
      t148 = partial_d_g_dd_311;
      t150 = partial_d_g_dd_312;
      t153 = partial_d_g_dd_313;
      t156 = partial_d_g_dd_322;
      t158 = partial_d_g_dd_323;
      t161 = partial_d_g_dd_333;
      partial_d_g_uu_311 = -t2*t148-2.0*t6*t150-2.0*t11*t153-t15*t156-2.0*t18*
t158-t22*t161;
      partial_d_g_uu_312 = -t6*t148-t15*t150-t18*t153-t29*t150-t31*t156-t33*
t158-t36*t153-t38*t158-t40*t161;
      partial_d_g_uu_313 = -t11*t148-t18*t150-t22*t153-t36*t150-t38*t156-t40*
t158-t49*t153-t51*t158-t53*t161;
      partial_d_g_uu_322 = -t15*t148-2.0*t31*t150-2.0*t38*t153-t60*t156-2.0*t62
*t158-t65*t161;
      partial_d_g_uu_323 = -t18*t148-t33*t150-t40*t153-t38*t150-t62*t156-t65*
t158-t51*t153-t74*t158-t76*t161;
      partial_d_g_uu_333 = -t22*t148-2.0*t40*t150-2.0*t53*t153-t65*t156-2.0*t76
*t158-t86*t161;

```

gr.cg/inverse_metric.c:
```
/*
 * inputs = {g_dd}
 * outputs = {g_uu}
 * cost = 18*assignments+24*multiplications+divisions+13*additions
 */
fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15;
fp t18, t21;
      t1 = g_dd_22;
      t2 = g_dd_33;
      t4 = g_dd_23;
      t5 = t4*t4;
      t7 = g_dd_11;
      t8 = t7*t1;
      t11 = g_dd_12;
      t12 = t11*t11;
      t14 = g_dd_13;
      t15 = t11*t14;
      t18 = t14*t14;
      t21 = 1/(t8*t2-t7*t5-t12*t2+2.0*t15*t4-t18*t1);
      g_uu_11 = (t1*t2-t5)*t21;
      g_uu_12 = -(t11*t2-t14*t4)*t21;
      g_uu_13 = -(-t11*t4+t14*t1)*t21;
      g_uu_22 = (t7*t2-t18)*t21;
      g_uu_23 = -(t7*t4-t15)*t21;
      g_uu_33 = (t8-t12)*t21;

```

gr.cg/extrinsic_curvature_trace_raise.c:
```
/*
 * inputs = {K_dd, g_uu}
 * outputs = {K_uu, K}
 * cost = 37*assignments+44*additions+84*multiplications
 */
fp t1, t2, t4, t5, t8, t9, t12, t13, t15, t16;
fp t19, t20, t22, t24, t27, t30, t32, t35, t42, t44;
fp t46, t48, t50, t60, t62, t69, t71, t74, t85, t95;
      t1 = g_uu_11;
      t2 = K_dd_11;
      t4 = g_uu_12;
      t5 = K_dd_12;
      t8 = g_uu_13;
      t9 = K_dd_13;
      t12 = g_uu_22;
      t13 = K_dd_22;
      t15 = g_uu_23;
      t16 = K_dd_23;
      t19 = g_uu_33;
      t20 = K_dd_33;
      K = t1*t2+2.0*t4*t5+2.0*t8*t9+t12*t13+2.0*t15*t16+t19*t20;
      t22 = t1*t1;
      t24 = t4*t1;
      t27 = t8*t1;
      t30 = t4*t4;
      t32 = t8*t4;
      t35 = t8*t8;
      K_uu_11 = t22*t2+2.0*t24*t5+2.0*t27*t9+t30*t13+2.0*t32*t16+t35*t20;
      t42 = t4*t12;
      t44 = t8*t12;
      t46 = t1*t15;
      t48 = t15*t4;
      t50 = t8*t15;
      K_uu_12 = t24*t2+t30*t5+t32*t9+t1*t12*t5+t42*t13+t44*t16+t46*t9+t48*t16+
t50*t20;
      t60 = t4*t19;
      t62 = t8*t19;
      K_uu_13 = t27*t2+t32*t5+t35*t9+t46*t5+t48*t13+t50*t16+t1*t19*t9+t60*t16+
t62*t20;
      t69 = t12*t12;
      t71 = t15*t12;
      t74 = t15*t15;
      K_uu_22 = t30*t2+2.0*t42*t5+2.0*t48*t9+t69*t13+2.0*t71*t16+t74*t20;
      t85 = t15*t19;
      K_uu_23 = t32*t2+t44*t5+t50*t9+t48*t5+t71*t13+t74*t16+t60*t9+t12*t19*t16+
t85*t20;
      t95 = t19*t19;
      K_uu_33 = t35*t2+2.0*t50*t5+2.0*t62*t9+t74*t13+2.0*t85*t16+t95*t20;

```

gr.cg/README:
```
This directory holds C code fragments generated by the Maple code in ../gr/.

```

gr.cg/expansion.c:
```
/*
 * inputs = {partial_d_ln_sqrt_g, partial_d_g_uu, r, X_ud, X_udd, g_uu, K_uu, h}
 * outputs = {Theta_A, Theta_B, Theta_C, Theta_D}
 * cost = 134*assignments+3*divisions+5*functions+401*multiplications+173*additions
 */
fp t1, t2, t4, t5, t7, t8, t10, t11, t12, t14;
fp t16, t18, t19, t21, t23, t29, t31, t33, t35, t40;
fp t42, t46, t47, t48, t49, t56, t61, t63, t67, t83;
fp t87, t102, t106, t107, t108, t109, t113, t116, t123, t128;
fp t130, t134, t135, t138, t139, t140, t141, t144, t145, t148;
fp t149, t155, t156, t159, t160, t161, t162, t163, t166, t167;
fp t168, t171, t172, t173, t176, t177, t180, t181, t182, t185;
fp t186, t197, t198, t205, t207, t210, t213, t221, t226, t228;
fp t230, t241, t242, t248, t255, t258, t259, t260, t263, t270;
fp t271, t274, t277, t278, t281, t282, t285, t291, t293, t294;
fp t295, t297, t298, t301, t304, t309, t318, t323, t324, t330;
fp t333, t340, t341, t344, t363, t369, t376, t378, t380, t384;
fp t393, t396, t398, t411, t431, t440, t444, t447, t450, t465;
      t1 = g_uu_13;
      t2 = 1/r;
      t4 = X_ud_13;
      t5 = PARTIAL_RHO(h);
      t7 = X_ud_23;
      t8 = PARTIAL_SIGMA(h);
      t10 = zz*t2-t4*t5-t7*t8;
      t11 = t1*t10;
      t12 = g_uu_23;
      t14 = X_ud_12;
      t16 = X_ud_22;
      t18 = yy*t2-t14*t5-t16*t8;
      t19 = t12*t18;
      t21 = r*r;
      t23 = 1/t21/r;
      t29 = X_ud_11;
      t31 = PARTIAL_RHO_RHO(h);
      t33 = X_ud_21;
      t35 = PARTIAL_RHO_SIGMA(h);
      t40 = PARTIAL_SIGMA_SIGMA(h);
      t42 = -xx*zz*t23-X_udd_113*t5-X_udd_213*t8-t29*t4*t31-t33*t4*t35-t29*t7*
t35-t33*t7*t40;
      t46 = g_uu_12;
      t47 = t46*t18;
      t48 = yy*yy;
      t49 = zz*zz;
      t56 = t29*t29;
      t61 = t33*t33;
      t63 = (t48+t49)*t23-X_udd_111*t5-X_udd_211*t8-t56*t31-2.0*t33*t29*t35-t61
*t40;
      t67 = t12*t12;
      t83 = -yy*zz*t23-X_udd_123*t5-X_udd_223*t8-t14*t4*t31-t16*t4*t35-t14*t7*
t35-t16*t7*t40;
      t87 = t12*t10;
      t102 = -xx*yy*t23-X_udd_112*t5-X_udd_212*t8-t29*t14*t31-t33*t14*t35-t29*
t16*t35-t33*t16*t40;
      t106 = g_uu_33;
      t107 = t106*t10;
      t108 = partial_d_g_uu_312;
      t109 = t108*t18;
      t113 = xx*t2-t29*t5-t33*t8;
      t116 = xx*xx;
      t123 = t4*t4;
      t128 = t7*t7;
      t130 = (t116+t48)*t23-X_udd_133*t5-X_udd_233*t8-t123*t31-2.0*t7*t4*t35-
t128*t40;
      t134 = partial_d_g_uu_212;
      t135 = t134*t18;
      t138 = g_uu_22;
      t139 = t138*t18;
      t140 = partial_d_g_uu_213;
      t141 = t140*t10;
      t144 = partial_d_g_uu_113;
      t145 = t144*t10;
      t148 = partial_d_g_uu_313;
      t149 = t148*t10;
      t155 = t10*t10;
      t156 = t12*t155;
      t159 = -2.0*t11*t19*t42-2.0*t11*t47*t63-2.0*t67*t10*t18*t83-2.0*t87*t47*
t102-t107*t109*t113-2.0*t107*t19*t130-t87*t135*t113-t139*t141*t113-t47*t145*
t113-t19*t149*t113-2.0*t107*t139*t83-t156*t140*t113;
      t160 = g_uu_11;
      t161 = t160*t113;
      t162 = partial_d_g_uu_133;
      t163 = t162*t155;
      t166 = t46*t113;
      t167 = partial_d_g_uu_233;
      t168 = t167*t155;
      t171 = partial_d_g_uu_222;
      t172 = t18*t18;
      t173 = t171*t172;
      t176 = partial_d_g_uu_122;
      t177 = t176*t172;
      t180 = t1*t113;
      t181 = partial_d_g_uu_333;
      t182 = t181*t155;
      t185 = partial_d_g_uu_322;
      t186 = t185*t172;
      t197 = t113*t113;
      t198 = t46*t197;
      t205 = RATIONAL(-1.0,2.0)*t161*t163+RATIONAL(-1.0,2.0)*t166*t168+RATIONAL
(-1.0,2.0)*t166*t173+RATIONAL(-1.0,2.0)*t161*t177+RATIONAL(-1.0,2.0)*t180*t182+
RATIONAL(-1.0,2.0)*t180*t186+RATIONAL(-1.0,2.0)*t47*t163+RATIONAL(-1.0,2.0)*
t139*t168+RATIONAL(-1.0,2.0)*t19*t182+RATIONAL(-1.0,2.0)*t11*t177-2.0*t198*t160
*t102-2.0*t11*t139*t102;
      t207 = t160*t160;
      t210 = t106*t106;
      t213 = t46*t46;
      t221 = t14*t14;
      t226 = t16*t16;
      t228 = (t116+t49)*t23-X_udd_122*t5-X_udd_222*t8-t221*t31-2.0*t16*t14*t35-
t226*t40;
      t230 = t1*t197;
      t241 = partial_d_g_uu_112;
      t242 = t241*t18;
      t248 = t172*t18;
      t255 = t180*t130;
      t258 = -t207*t197*t63-t210*t155*t130-t213*t197*t228-2.0*t230*t160*t42-2.0
*t230*t46*t83+RATIONAL(-1.0,2.0)*t107*t186+RATIONAL(-1.0,2.0)*t87*t173-t11*t242
*t113-2.0*t47*t180*t42+RATIONAL(-1.0,2.0)*t12*t248*t185-2.0*t87*t139*t228-2.0*
t19*t255;
      t259 = t106*t155;
      t260 = t12*t83;
      t263 = t180*t83;
      t270 = partial_d_g_uu_123;
      t271 = t270*t10;
      t274 = t166*t228;
      t277 = partial_d_g_uu_211;
      t278 = t277*t197;
      t281 = partial_d_g_uu_111;
      t282 = t281*t197;
      t285 = t161*t102;
      t291 = t46*t172;
      t293 = t138*t172;
      t294 = partial_d_g_uu_223;
      t295 = t294*t10;
      t297 = partial_d_g_uu_311;
      t298 = t297*t197;
      t301 = t161*t42;
      t304 = -2.0*t259*t260-2.0*t139*t263-2.0*t213*t18*t113*t102-t161*t271*t18
-2.0*t139*t274+RATIONAL(-1.0,2.0)*t139*t278+RATIONAL(-1.0,2.0)*t47*t282-2.0*
t139*t285+RATIONAL(-1.0,2.0)*t138*t248*t171-t291*t271-t293*t295+RATIONAL(-1.0,
2.0)*t107*t298-2.0*t19*t301;
      t309 = t1*t1;
      t318 = t166*t83;
      t323 = partial_d_g_uu_323;
      t324 = t323*t10;
      t330 = t161*t63;
      t333 = t155*t10;
      t340 = RATIONAL(-1.0,2.0)*t87*t278-t309*t197*t130-t213*t172*t63+RATIONAL(
-1.0,2.0)*t11*t282+RATIONAL(-1.0,2.0)*t19*t298-2.0*t19*t318-t166*t295*t18-t180*
t324*t18+RATIONAL(-1.0,2.0)*t46*t248*t176-2.0*t47*t330+RATIONAL(-1.0,2.0)*t12*
t333*t167+RATIONAL(-1.0,2.0)*t1*t333*t162;
      t341 = t46*t102;
      t344 = t12*t172;
      t363 = t138*t138;
      t369 = t1*t42;
      t376 = -2.0*t293*t341-2.0*t344*t46*t42-2.0*t344*t138*t83+RATIONAL(-1.0,
2.0)*t106*t333*t181-t344*t324-t67*t172*t130-t309*t155*t63-t67*t155*t228-t156*
t294*t18-t363*t172*t228-2.0*t156*t1*t102-2.0*t259*t369-2.0*t309*t10*t113*t42;
      t378 = t323*t18;
      t380 = t160*t197;
      t384 = t134*t113;
      t393 = t1*t155;
      t396 = t148*t113;
      t398 = -t259*t378-t380*t242-t198*t135-t230*t109-t293*t384-t291*t241*t113-
t344*t108*t113-t198*t141-t380*t145-t230*t149-t393*t144*t113-t259*t396;
      t411 = t197*t113;
      t431 = -t393*t270*t18-2.0*t107*t47*t42-2.0*t11*t166*t102-2.0*t87*t274-2.0
*t107*t255+RATIONAL(-1.0,2.0)*t160*t411*t281+RATIONAL(-1.0,2.0)*t46*t411*t277+
RATIONAL(-1.0,2.0)*t1*t411*t297-2.0*t87*t263-2.0*t87*t285-2.0*t11*t330-2.0*t107
*t318-2.0*t107*t301;
      Theta_A = t159+t205+t258+t304+t340+t376+t398+t431;
      t440 = t281*t113+t384+t396+t242+t171*t18+t378+t145+t295+t181*t10+t160*t63
+2.0*t341+2.0*t369;
      t444 = partial_d_ln_sqrt_g_1;
      t447 = partial_d_ln_sqrt_g_2;
      t450 = partial_d_ln_sqrt_g_3;
      t465 = t138*t228+2.0*t260+t106*t130+t160*t444*t113+t46*t447*t113+t1*t450*
t113+t46*t444*t18+t138*t447*t18+t12*t450*t18+t1*t444*t10+t12*t447*t10+t106*t450
*t10;
      Theta_B = t440+t465;
      Theta_C = K_uu_11*t197+2.0*K_uu_12*t18*t113+2.0*K_uu_13*t10*t113+K_uu_22*
t172+2.0*K_uu_23*t10*t18+K_uu_33*t155;
      Theta_D = t380+2.0*t47*t113+2.0*t11*t113+t293+2.0*t87*t18+t259;

```

gr.cg/expansion_Jacobian.c:
```
/*
 * inputs = {partial_d_ln_sqrt_g, partial_d_g_uu, r, X_ud, X_udd, g_uu, K_uu, Theta_A, Theta_B, Theta_C, Theta_D, h}
 * outputs = {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}
 * cost = 466*assignments+10*divisions+7*functions+1722*multiplications+728*additions
 */
fp t1, t2, t4, t5, t7, t8, t10, t11, t12, t14;
fp t16, t18, t19, t20, t24, t25, t26, t28, t30, t32;
fp t34, t36, t38, t40, t41, t42, t44, t47, t49, t50;
fp t53, t54, t55, t56, t59, t60, t61, t68, t69, t70;
fp t71, t75, t76, t79, t80, t81, t87, t91, t93, t97;
fp t98, t101, t102, t108, t109, t112, t113, t114, t115, t117;
fp t118, t119, t120, t123, t124, t126, t127, t128, t131, t133;
fp t136, t137, t139, t140, t144, t146, t148, t151, t153, t154;
fp t157, t160, t161, t162, t165, t166, t167, t169, t170, t171;
fp t173, t177, t178, t179, t181, t184, t186, t190, t192, t196;
fp t197, t198, t201, t203, t206, t207, t208, t209, t212, t213;
fp t216, t218, t221, t222, t223, t226, t227, t228, t230, t232;
fp t235, t237, t239, t241, t244, t246, t247, t251, t252, t254;
fp t255, t257, t258, t262, t263, t265, t269, t271, t272, t273;
fp t275, t278, t279, t284, t287, t288, t291, t294, t295, t298;
fp t301, t307, t311, t312, t314, t317, t318, t322, t328, t330;
fp t333, t337, t339, t341, t345, t357, t360, t363, t364, t365;
fp t370, t372, t374, t377, t379, t380, t383, t384, t385, t387;
fp t390, t397, t400, t405, t408, t410, t411, t412, t414, t419;
fp t427, t430, t433, t436, t439, t443, t446, t447, t448, t451;
fp t452, t454, t457, t458, t459, t462, t465, t471, t474, t478;
fp t479, t481, t485, t489, t493, t499, t503, t508, t511, t513;
fp t514, t521, t528, t534, t537, t539, t544, t550, t553, t556;
fp t560, t564, t565, t574, t580, t582, t587, t595, t611, t616;
fp t625, t627, t628, t629, t631, t632, t637, t639, t648, t652;
fp t663, t676, t680, t681, t682, t698, t703, t709, t715, t718;
fp t731, t735, t740, t742, t745, t747, t751, t759, t785, t790;
fp t792, t797, t801, t802, t804, t805, t807, t808, t810, t812;
fp t814, t816, t818, t820, t822, t824, t836, t837, t844, t846;
fp t847, t849, t850, t852, t854, t856, t858, t860, t862, t866;
fp t868, t873, t877, t879, t881, t884, t886, t890, t894, t895;
fp t898, t902, t905, t910, t912, t914, t921, t926, t931, t934;
fp t938, t940, t944, t946, t947, t950, t951, t956, t960, t964;
fp t967, t970, t973, t976, t980, t983, t986, t991, t994, t999;
fp t1005, t1009, t1012, t1015, t1016, t1024, t1030, t1034, t1037, t1044;
fp t1057, t1066, t1076, t1089, t1101, t1112, t1123, t1130, t1143, t1162;
fp t1172, t1185, t1206, t1230, t1236, t1272, t1283, t1313, t1326, t1332;
fp t1341, t1346, t1351, t1380, t1389, t1402, t1415, t1418, t1420, t1423;
fp t1425, t1428, t1431, t1433, t1436, t1439, t1443, t1446, t1465, t1466;
fp t1467, t1470, t1476, t1477, t1478, t1481, t1484, t1485, t1490, t1497;
fp t1500, t1501, t1504, t1506, t1511, t1514, t1518, t1524, t1532, t1537;
fp t1540, t1543, t1556, t1560, t1567, t1568, t1582, t1585, t1588, t1600;
fp t1601, t1606, t1610, t1613, t1631, t1635, t1641, t1646, t1652, t1662;
fp t1668, t1673, t1674, t1688, t1694, t1695, t1704, t1705, t1711, t1739;
fp t1749, t1752, t1755, t1766, t1769, t1772, t1777, t1782, t1791, t1794;
fp t1803, t1809, t1819, t1830, t1834, t1855;
      t1 = g_uu_13;
      t2 = 1/r;
      t4 = X_ud_13;
      t5 = PARTIAL_RHO(h);
      t7 = X_ud_23;
      t8 = PARTIAL_SIGMA(h);
      t10 = zz*t2-t4*t5-t7*t8;
      t11 = t1*t10;
      t12 = g_uu_12;
      t14 = X_ud_12;
      t16 = X_ud_22;
      t18 = yy*t2-t14*t5-t16*t8;
      t19 = t12*t18;
      t20 = X_udd_111;
      t24 = g_uu_23;
      t25 = t24*t10;
      t26 = t12*t14;
      t28 = r*r;
      t30 = 1/t28/r;
      t32 = X_udd_112;
      t34 = X_udd_212;
      t36 = X_ud_11;
      t38 = PARTIAL_RHO_RHO(h);
      t40 = X_ud_21;
      t41 = t40*t14;
      t42 = PARTIAL_RHO_SIGMA(h);
      t44 = t36*t16;
      t47 = PARTIAL_SIGMA_SIGMA(h);
      t49 = -xx*yy*t30-t32*t5-t34*t8-t36*t14*t38-t41*t42-t44*t42-t40*t16*t47;
      t50 = t26*t49;
      t53 = t1*t4;
      t54 = partial_d_g_uu_122;
      t55 = t18*t18;
      t56 = t54*t55;
      t59 = g_uu_33;
      t60 = t59*t10;
      t61 = X_udd_113;
      t68 = xx*t2-t36*t5-t40*t8;
      t69 = t68*t68;
      t70 = t12*t69;
      t71 = g_uu_11;
      t75 = t24*t4;
      t76 = t19*t49;
      t79 = partial_d_g_uu_112;
      t80 = t79*t68;
      t81 = t80*t14;
      t87 = X_udd_213;
      t91 = t40*t4;
      t93 = t36*t7;
      t97 = -xx*zz*t30-t61*t5-t87*t8-t36*t4*t38-t91*t42-t93*t42-t40*t7*t47;
      t98 = t26*t97;
      t101 = g_uu_22;
      t102 = t101*t18;
      t108 = t59*t4;
      t109 = t19*t97;
      t112 = t71*t68;
      t113 = partial_d_g_uu_133;
      t114 = t113*t10;
      t115 = t114*t4;
      t117 = t12*t68;
      t118 = partial_d_g_uu_213;
      t119 = t118*t10;
      t120 = t119*t36;
      t123 = t79*t18;
      t124 = t123*t36;
      t126 = 2.0*t11*t19*t20+2.0*t25*t50+RATIONAL(1.0,2.0)*t53*t56+2.0*t60*t19*
t61+2.0*t70*t71*t32+2.0*t75*t76+2.0*t19*t81+2.0*t60*t98+4.0*t102*t50+2.0*t11*
t102*t32+2.0*t108*t109+t112*t115+2.0*t117*t120+t11*t124;
      t127 = t101*t55;
      t128 = t12*t32;
      t131 = partial_d_g_uu_313;
      t133 = t131*t68*t4;
      t136 = t54*t18;
      t137 = t136*t14;
      t139 = yy*yy;
      t140 = zz*zz;
      t144 = X_udd_211;
      t146 = t36*t36;
      t148 = t40*t36;
      t151 = t40*t40;
      t153 = (t139+t140)*t30-t20*t5-t144*t8-t146*t38-2.0*t148*t42-t151*t47;
      t154 = t19*t153;
      t157 = t102*t49;
      t160 = partial_d_g_uu_123;
      t161 = t160*t10;
      t162 = t161*t14;
      t165 = partial_d_g_uu_312;
      t166 = t165*t18;
      t167 = t166*t36;
      t169 = partial_d_g_uu_233;
      t170 = t169*t10;
      t171 = t170*t4;
      t173 = t101*t14;
      t177 = partial_d_g_uu_222;
      t178 = t177*t18;
      t179 = t178*t14;
      t181 = t24*t18;
      t184 = X_udd_123;
      t186 = X_udd_223;
      t190 = t16*t4;
      t192 = t14*t7;
      t196 = -yy*zz*t30-t184*t5-t186*t8-t14*t4*t38-t190*t42-t192*t42-t16*t7*t47
;
      t197 = t101*t196;
      t198 = t197*t14;
      t201 = t12*t12;
      t203 = t68*t49;
      t206 = t1*t36;
      t207 = partial_d_g_uu_333;
      t208 = t10*t10;
      t209 = t207*t208;
      t212 = partial_d_g_uu_322;
      t213 = t212*t55;
      t216 = 2.0*t127*t128+2.0*t60*t133+t112*t137+2.0*t53*t154+2.0*t53*t157+2.0
*t19*t162+t60*t167+t117*t171+2.0*t11*t173*t49+t117*t179+4.0*t181*t198+2.0*t201*
t14*t203+RATIONAL(1.0,2.0)*t206*t209+RATIONAL(1.0,2.0)*t206*t213;
      t218 = t113*t208;
      t221 = t24*t24;
      t222 = t221*t55;
      t223 = X_udd_133;
      t226 = t1*t68;
      t227 = t212*t18;
      t228 = t227*t14;
      t230 = t166*t68;
      t232 = xx*xx;
      t235 = X_udd_122;
      t237 = X_udd_222;
      t239 = t14*t14;
      t241 = t16*t14;
      t244 = t16*t16;
      t246 = (t232+t140)*t30-t235*t5-t237*t8-t239*t38-2.0*t241*t42-t244*t47;
      t247 = t102*t246;
      t251 = partial_d_g_uu_212;
      t252 = t251*t14;
      t254 = t1*t1;
      t255 = t254*t208;
      t257 = t207*t10;
      t258 = t257*t4;
      t262 = t251*t18;
      t263 = t262*t68;
      t265 = t262*t36;
      t269 = RATIONAL(1.0,2.0)*t26*t218+t222*t223+t19*t115+t226*t228+t108*t230+
2.0*t75*t247+t11*t81+t70*t252+t255*t20+t226*t258+2.0*t112*t124+t75*t263+t25*
t265+2.0*t60*t198;
      t271 = t24*t14;
      t272 = t131*t10;
      t273 = t272*t68;
      t275 = t226*t223;
      t278 = t165*t14;
      t279 = t278*t68;
      t284 = t71*t36;
      t287 = t12*t36;
      t288 = t177*t55;
      t291 = t169*t208;
      t294 = t24*t208;
      t295 = partial_d_g_uu_223;
      t298 = t1*t208;
      t301 = t12*t55;
      t307 = t254*t10;
      t311 = t71*t71;
      t312 = t311*t69;
      t314 = t181*t133+t271*t273+2.0*t60*t275+t60*t279+2.0*t25*t102*t235+
RATIONAL(1.0,2.0)*t284*t56+RATIONAL(1.0,2.0)*t287*t288+RATIONAL(1.0,2.0)*t287*
t291+t294*t295*t14+t298*t160*t14+RATIONAL(3.0,2.0)*t301*t54*t14+2.0*t226*t167+
2.0*t307*t68*t61+t312*t20;
      t317 = t59*t208;
      t318 = t1*t61;
      t322 = t118*t68*t4;
      t328 = t221*t208;
      t330 = t102*t196;
      t333 = t1*t97;
      t337 = t272*t36;
      t339 = t252*t68;
      t341 = t221*t10;
      t345 = t1*t69;
      t357 = 2.0*t317*t318+2.0*t25*t322+2.0*t25*t19*t32+t328*t235+2.0*t108*t330
+4.0*t60*t333*t4+t181*t337+t25*t339+2.0*t341*t18*t184+t345*t278+RATIONAL(1.0,
2.0)*t284*t218+t294*t118*t36+2.0*t60*t102*t184+2.0*t25*t173*t246;
      t360 = t112*t97;
      t363 = partial_d_g_uu_111;
      t364 = t363*t68;
      t365 = t364*t36;
      t370 = X_udd_233;
      t372 = t4*t4;
      t374 = t7*t4;
      t377 = t7*t7;
      t379 = (t232+t139)*t30-t223*t5-t370*t8-t372*t38-2.0*t374*t42-t377*t47;
      t380 = t181*t379;
      t383 = partial_d_g_uu_311;
      t384 = t383*t68;
      t385 = t384*t36;
      t387 = t226*t196;
      t390 = t201*t68;
      t397 = t206*t196;
      t400 = t383*t69;
      t405 = t112*t61;
      t408 = t201*t69;
      t410 = partial_d_g_uu_211;
      t411 = t410*t68;
      t412 = t411*t36;
      t414 = 2.0*t117*t265+2.0*t271*t360+t11*t365+2.0*t108*t380+t181*t385+2.0*
t75*t387+2.0*t390*t246*t36+2.0*t11*t26*t153+2.0*t25*t397+RATIONAL(1.0,2.0)*t271
*t400+t345*t131*t4+2.0*t181*t405+t408*t235+t25*t412;
      t419 = t284*t97;
      t427 = t226*t379;
      t430 = t117*t184;
      t433 = t181*t97;
      t436 = t117*t246;
      t439 = t24*t196;
      t443 = t287*t196;
      t446 = partial_d_g_uu_323;
      t447 = t446*t18;
      t448 = t447*t4;
      t451 = t295*t10;
      t452 = t451*t14;
      t454 = t117*t235;
      t457 = 2.0*t60*t181*t223+2.0*t181*t419+t60*t385+t102*t412+2.0*t60*t271*
t379+2.0*t271*t427+2.0*t181*t430+2.0*t53*t433+2.0*t173*t436+4.0*t60*t439*t4+2.0
*t181*t443+2.0*t60*t448+t117*t452+2.0*t102*t454;
      t458 = t295*t18;
      t459 = t458*t4;
      t462 = t287*t246;
      t465 = t117*t196;
      t471 = t177*t14;
      t474 = t24*t55;
      t478 = t446*t10;
      t479 = t478*t14;
      t481 = t1*t49;
      t485 = t206*t379;
      t489 = t160*t18*t4;
      t493 = t112*t20;
      t499 = 2.0*t25*t459+2.0*t102*t462+2.0*t271*t465+2.0*t11*t271*t97+RATIONAL
(3.0,2.0)*t127*t471+RATIONAL(3.0,2.0)*t474*t212*t14+t226*t479+4.0*t25*t481*t4+
2.0*t181*t485+2.0*t11*t489+t117*t459+2.0*t19*t493+2.0*t108*t360+t19*t365;
      t503 = t161*t18;
      t508 = t284*t49;
      t511 = t451*t18;
      t513 = t59*t59;
      t514 = t513*t10;
      t521 = t478*t18;
      t528 = t112*t153;
      t534 = t207*t4;
      t537 = t446*t14;
      t539 = t284*t503+2.0*t307*t153*t4+2.0*t25*t508+t287*t511+2.0*t514*t379*t4
+t226*t448+2.0*t181*t275+t206*t521+2.0*t11*t181*t61+2.0*t102*t397+2.0*t26*t528+
RATIONAL(3.0,2.0)*t298*t113*t4+RATIONAL(3.0,2.0)*t317*t534+t317*t537;
      t544 = t112*t32;
      t550 = t24*t184;
      t553 = t226*t184;
      t556 = t254*t68;
      t560 = t201*t18;
      t564 = t101*t101;
      t565 = t564*t18;
      t574 = t112*t49;
      t580 = 2.0*t294*t1*t32+t112*t162+2.0*t25*t544+t112*t489+2.0*t60*t419+2.0*
t317*t550+2.0*t102*t553+2.0*t556*t379*t36+2.0*t560*t153*t14+2.0*t565*t246*t14+
2.0*t60*t405+2.0*t341*t246*t4+2.0*t75*t574+2.0*t19*t226*t61;
      t582 = t284*t153;
      t587 = t131*t36;
      t595 = t68*t97;
      t611 = t363*t69;
      t616 = 2.0*t19*t582+2.0*t53*t528+t317*t587+2.0*t19*t206*t97+2.0*t60*t430+
2.0*t254*t4*t595+2.0*t307*t36*t97+2.0*t108*t465+4.0*t181*t98+2.0*t181*t479+2.0*
t173*t574+2.0*t102*t452+RATIONAL(1.0,2.0)*t26*t611+2.0*t102*t544;
      t625 = t564*t55;
      t627 = partial_d_g_uu_113;
      t628 = t627*t10;
      t629 = t628*t36;
      t631 = t627*t68;
      t632 = t631*t4;
      t637 = t201*t55;
      t639 = t628*t68;
      t648 = 2.0*t60*t485+2.0*t25*t454+2.0*t108*t427+2.0*t60*t443+t625*t235+t19
*t629+2.0*t11*t632+2.0*t25*t462+t637*t20+t26*t639+2.0*t226*t337+t19*t632+t474*
t165*t36+2.0*t11*t493;
      t652 = t119*t68;
      t663 = t221*t18;
      t676 = t251*t36;
      t680 = t102*t322+t173*t652+2.0*t75*t436+2.0*t173*t387+2.0*t181*t279+t70*
t118*t4+t102*t120+2.0*t663*t379*t14+2.0*t112*t629+2.0*t102*t339+2.0*t11*t117*
t32+2.0*t11*t582+t127*t676+t301*t160*t4;
      t681 = t71*t69;
      t682 = t363*t36;
      t698 = t226*t97;
      t703 = t311*t68;
      t709 = t410*t69;
      t715 = t18*t196;
      t718 = RATIONAL(3.0,2.0)*t681*t682+t298*t627*t36+RATIONAL(3.0,2.0)*t294*
t169*t4+2.0*t11*t287*t49+t181*t258+t102*t171+2.0*t474*t12*t61+2.0*t26*t698+
RATIONAL(1.0,2.0)*t271*t209+2.0*t703*t153*t36+RATIONAL(1.0,2.0)*t53*t611+
RATIONAL(1.0,2.0)*t173*t709+RATIONAL(1.0,2.0)*t75*t709+2.0*t221*t4*t715;
      t731 = t295*t4;
      t735 = t627*t4;
      t740 = t79*t14;
      t742 = t117*t49;
      t745 = t513*t208;
      t747 = t123*t68;
      t751 = 2.0*t341*t14*t196+RATIONAL(1.0,2.0)*t173*t291+RATIONAL(3.0,2.0)*
t70*t410*t36+RATIONAL(3.0,2.0)*t345*t383*t36+t127*t731+t474*t446*t4+t681*t735+
t301*t79*t36+t11*t137+t681*t740+2.0*t53*t742+t745*t223+t53*t747+2.0*t102*t508;
      t759 = t254*t69;
      t785 = RATIONAL(1.0,2.0)*t108*t400+2.0*t474*t101*t184+2.0*t25*t553+t759*
t223+t25*t179+4.0*t226*t443+t60*t228+4.0*t226*t419+2.0*t345*t12*t184+2.0*t560*
t36*t49+2.0*t560*t68*t32+RATIONAL(1.0,2.0)*t75*t288+RATIONAL(1.0,2.0)*t108*t213
+2.0*t345*t71*t61+4.0*t117*t508;
      t790 = pow(Theta_D,1.0*RATIONAL(1.0,2.0));
      t792 = 1/t790/Theta_D;
      t797 = -t682-t676-t587-t740-t471-t537-t735-t731-t534-t71*t20-2.0*t128-2.0
*t318;
      t801 = partial_d_ln_sqrt_g_1;
      t802 = t71*t801;
      t804 = partial_d_ln_sqrt_g_2;
      t805 = t12*t804;
      t807 = partial_d_ln_sqrt_g_3;
      t808 = t1*t807;
      t810 = t12*t801;
      t812 = t101*t804;
      t814 = t24*t807;
      t816 = t1*t801;
      t818 = t24*t804;
      t820 = t59*t807;
      t822 = -t101*t235-2.0*t550-t59*t223-t802*t36-t805*t36-t808*t36-t810*t14-
t812*t14-t814*t14-t816*t4-t818*t4-t820*t4;
      t824 = 1/t790;
      t836 = -2.0*t112*t36-2.0*t26*t68-2.0*t19*t36-2.0*t53*t68-2.0*t11*t36-2.0*
t102*t14-2.0*t75*t18-2.0*t25*t14-2.0*t60*t4;
      t837 = Theta_D*Theta_D;
      t844 = RATIONAL(3.0,2.0)*Theta_A/t790/t837+RATIONAL(1.0,2.0)*Theta_B*t792
;
      partial_Theta_X_wrt_partial_d_h_1 = (t126+t216+t269+t314+t357+t414+t457+
t499+t539+t580+t616+t648+t680+t718+t751+t785)*t792+(t797+t822)*t824-t836*t844;
      t846 = t118*t7;
      t847 = t846*t68;
      t849 = t131*t7;
      t850 = t849*t68;
      t852 = t272*t40;
      t854 = t251*t16;
      t856 = t79*t16;
      t858 = t119*t40;
      t860 = t627*t7;
      t862 = t1*t40;
      t866 = t384*t40;
      t868 = t59*t7;
      t873 = t12*t40;
      t877 = t628*t40;
      t879 = t166*t40;
      t881 = t102*t847+t181*t850+t181*t852+t70*t854+t681*t856+t102*t858+t681*
t860+2.0*t19*t862*t97+t60*t866+2.0*t868*t360+t474*t165*t40+2.0*t11*t873*t49+t19
*t877+t60*t879;
      t884 = t251*t40;
      t886 = t862*t379;
      t890 = t131*t40;
      t894 = t71*t40;
      t895 = t894*t97;
      t898 = t12*t16;
      t902 = t631*t7;
      t905 = t226*t370;
      t910 = t24*t7;
      t912 = t854*t68;
      t914 = 2.0*t226*t852+t127*t884+2.0*t60*t886+t70*t846+t317*t890+2.0*t868*
t427+2.0*t60*t895+t898*t639+RATIONAL(1.0,2.0)*t898*t218+2.0*t11*t902+2.0*t60*
t905+RATIONAL(1.0,2.0)*t862*t213+t910*t263+t25*t912;
      t921 = t451*t16;
      t926 = t161*t16;
      t931 = t862*t196;
      t934 = t478*t16;
      t938 = t262*t40;
      t940 = t873*t246;
      t944 = t446*t16;
      t946 = 4.0*t25*t481*t7+t294*t118*t40+2.0*t102*t921+2.0*t910*t387+2.0*t19*
t926+t862*t521+t894*t503+2.0*t25*t931+t226*t934+2.0*t181*t934+t25*t938+2.0*t25*
t940+t112*t926+t317*t944;
      t947 = t226*t186;
      t950 = t160*t7;
      t951 = t950*t18;
      t956 = t170*t7;
      t960 = t112*t144;
      t964 = t1*t7;
      t967 = t894*t153;
      t970 = t117*t237;
      t973 = t112*t34;
      t976 = t894*t49;
      t980 = 2.0*t25*t947+t112*t951+2.0*t19*t226*t87+t102*t956+t759*t370+t625*
t237+2.0*t19*t960+t637*t144+2.0*t964*t742+2.0*t19*t967+2.0*t25*t970+2.0*t102*
t973+2.0*t102*t976+t312*t144;
      t983 = t136*t16;
      t986 = t257*t7;
      t991 = t12*t196*t40;
      t994 = t101*t16;
      t999 = t112*t87;
      t1005 = t80*t16;
      t1009 = t24*t16;
      t1012 = t123*t40;
      t1015 = t11*t983+t408*t237+t181*t986+2.0*t102*t931+4.0*t226*t991+2.0*t994
*t387+4.0*t226*t895+2.0*t181*t999+t964*t747+4.0*t117*t976+2.0*t19*t1005+t181*
t866+2.0*t1009*t465+2.0*t112*t1012;
      t1016 = t411*t40;
      t1024 = t227*t16;
      t1030 = t458*t7;
      t1034 = t117*t186;
      t1037 = t364*t40;
      t1044 = t102*t1016+2.0*t226*t879+RATIONAL(1.0,2.0)*t894*t218+RATIONAL(1.0
,2.0)*t873*t291+t60*t1024+2.0*t181*t991+2.0*t1009*t360+2.0*t25*t1030+t255*t144+
2.0*t181*t1034+t11*t1037+2.0*t181*t895+2.0*t112*t877+t11*t1005;
      t1057 = t447*t7;
      t1066 = t197*t16;
      t1076 = 2.0*t181*t905+2.0*t898*t528+t11*t1012+2.0*t994*t574+2.0*t11*t181*
t87+t868*t230+2.0*t60*t1057+2.0*t60*t19*t87+4.0*t60*t333*t7+4.0*t181*t1066+2.0*
t994*t436+t25*t1016+2.0*t910*t436+2.0*t102*t970;
      t1089 = t12*t97*t16;
      t1101 = t898*t49;
      t1112 = 2.0*t102*t940+t226*t1057+2.0*t117*t938+2.0*t181*t886+2.0*t1009*
t427+2.0*t910*t76+4.0*t181*t1089+2.0*t60*t1009*t379+2.0*t11*t19*t144+2.0*t25*
t19*t34+2.0*t25*t1101+4.0*t60*t439*t7+2.0*t910*t247+2.0*t60*t181*t370;
      t1123 = t178*t16;
      t1130 = t114*t7;
      t1143 = 2.0*t868*t109+2.0*t25*t994*t246+4.0*t102*t1101+t25*t1123+2.0*t102
*t947+2.0*t964*t154+t117*t956+t112*t1130+2.0*t60*t1089+2.0*t25*t102*t237+t345*
t849+2.0*t25*t847+t117*t1123+2.0*t60*t1066;
      t1162 = t165*t68*t16;
      t1172 = 2.0*t868*t380+t873*t511+RATIONAL(1.0,2.0)*t862*t209+2.0*t898*t698
+2.0*t11*t994*t49+t745*t370+2.0*t60*t850+2.0*t868*t330+t19*t902+t226*t1024+2.0*
t181*t1162+2.0*t201*t16*t203+2.0*t102*t912+t298*t627*t40;
      t1185 = t12*t34;
      t1206 = t226*t986+2.0*t60*t102*t186+t112*t983+2.0*t560*t40*t49+2.0*t560*
t68*t34+2.0*t127*t1185+2.0*t514*t379*t7+2.0*t221*t7*t715+2.0*t11*t898*t153+
RATIONAL(1.0,2.0)*t894*t56+2.0*t11*t102*t34+t117*t1030+2.0*t964*t157+t19*t1130;
      t1230 = t24*t186;
      t1236 = 2.0*t60*t991+t60*t1162+2.0*t868*t465+t328*t237+2.0*t117*t858+2.0*
t60*t999+t19*t1037+2.0*t60*t1034+t222*t370+2.0*t11*t1009*t97+2.0*t341*t16*t196+
2.0*t341*t18*t186+2.0*t317*t1230+2.0*t556*t379*t40;
      t1272 = 2.0*t390*t246*t40+2.0*t565*t246*t16+2.0*t703*t153*t40+RATIONAL(
1.0,2.0)*t994*t291+RATIONAL(1.0,2.0)*t1009*t209+RATIONAL(1.0,2.0)*t964*t56+2.0*
t70*t71*t34+2.0*t345*t71*t87+2.0*t345*t12*t186+RATIONAL(1.0,2.0)*t868*t213+
RATIONAL(1.0,2.0)*t910*t288+t301*t79*t40+t994*t652+2.0*t964*t433;
      t1283 = t1*t87;
      t1313 = 2.0*t11*t117*t34+2.0*t11*t967+2.0*t964*t528+2.0*t474*t101*t186+
2.0*t317*t1283+2.0*t254*t7*t595+2.0*t307*t40*t97+2.0*t307*t68*t87+2.0*t560*t153
*t16+2.0*t307*t153*t7+2.0*t474*t12*t87+2.0*t341*t246*t7+RATIONAL(3.0,2.0)*t70*
t410*t40+RATIONAL(3.0,2.0)*t345*t383*t40;
      t1326 = t177*t16;
      t1332 = t207*t7;
      t1341 = t295*t7;
      t1346 = t363*t40;
      t1351 = 2.0*t294*t1*t34+2.0*t663*t379*t16+t298*t160*t16+RATIONAL(3.0,2.0)
*t474*t212*t16+RATIONAL(3.0,2.0)*t127*t1326+RATIONAL(3.0,2.0)*t301*t54*t16+
RATIONAL(3.0,2.0)*t317*t1332+RATIONAL(3.0,2.0)*t294*t169*t7+RATIONAL(3.0,2.0)*
t298*t113*t7+t127*t1341+t474*t446*t7+t301*t950+RATIONAL(3.0,2.0)*t681*t1346+
t345*t165*t16;
      t1380 = t294*t295*t16+RATIONAL(1.0,2.0)*t994*t709+RATIONAL(1.0,2.0)*t1009
*t400+RATIONAL(1.0,2.0)*t964*t611+RATIONAL(1.0,2.0)*t898*t611+RATIONAL(1.0,2.0)
*t910*t709+RATIONAL(1.0,2.0)*t868*t400+RATIONAL(1.0,2.0)*t873*t288+t117*t921+
2.0*t910*t574+2.0*t11*t951+2.0*t11*t960+2.0*t25*t973+2.0*t25*t976+t1009*t273;
      t1389 = -t1346-t884-t890-t856-t1326-t944-t860-t1341-t1332-t71*t144-2.0*
t1185-2.0*t1283;
      t1402 = -t101*t237-2.0*t1230-t59*t370-t802*t40-t805*t40-t808*t40-t810*t16
-t812*t16-t814*t16-t816*t7-t818*t7-t820*t7;
      t1415 = -2.0*t112*t40-2.0*t898*t68-2.0*t19*t40-2.0*t964*t68-2.0*t11*t40
-2.0*t102*t16-2.0*t910*t18-2.0*t25*t16-2.0*t60*t7;
      partial_Theta_X_wrt_partial_d_h_2 = (t881+t914+t946+t980+t1015+t1044+
t1076+t1112+t1143+t1172+t1206+t1236+t1272+t1313+t1351+t1380)*t792+(t1389+t1402)
*t824-t1415*t844;
      t1418 = K_uu_11*t68;
      t1420 = K_uu_12;
      t1423 = t1420*t18;
      t1425 = K_uu_13;
      t1428 = t1425*t10;
      t1431 = K_uu_22*t18;
      t1433 = K_uu_23;
      t1436 = t1433*t10;
      t1439 = K_uu_33*t10;
      t1443 = 1/Theta_D;
      t1446 = 1/t837;
      partial_Theta_Y_wrt_partial_d_h_1 = (-2.0*t1418*t36-2.0*t1420*t14*t68-2.0
*t1423*t36-2.0*t1425*t4*t68-2.0*t1428*t36-2.0*t1431*t14-2.0*t1433*t4*t18-2.0*
t1436*t14-2.0*t1439*t4)*t1443-t836*Theta_C*t1446;
      partial_Theta_Y_wrt_partial_d_h_2 = (-2.0*t1418*t40-2.0*t1420*t16*t68-2.0
*t1423*t40-2.0*t1425*t7*t68-2.0*t1428*t40-2.0*t1431*t16-2.0*t1433*t7*t18-2.0*
t1436*t16-2.0*t1439*t7)*t1443-t1415*Theta_C*t1446;
      t1465 = t11*t24;
      t1466 = t18*t36;
      t1467 = t1466*t4;
      t1470 = t112*t146;
      t1476 = t60*t71;
      t1477 = t68*t36;
      t1478 = t1477*t4;
      t1481 = t181*t71;
      t1484 = t102*t71;
      t1485 = t1477*t14;
      t1490 = t117*t239;
      t1497 = t25*t71;
      t1500 = 2.0*t1465*t1467+2.0*t19*t1470+2.0*t294*t206*t14+2.0*t1476*t1478+
2.0*t1481*t1478+2.0*t1484*t1485+2.0*t11*t1470+2.0*t102*t1490+2.0*t345*t284*t4+
t408*t239+2.0*t1497*t1485;
      t1501 = t287*t14;
      t1504 = t102*t1;
      t1506 = t68*t14*t4;
      t1511 = t226*t372;
      t1514 = t19*t1;
      t1518 = t18*t14*t4;
      t1524 = t181*t12;
      t1532 = 2.0*t127*t1501+2.0*t1504*t1506+2.0*t560*t1485+2.0*t181*t1511+2.0*
t1514*t1478+2.0*t341*t1518+2.0*t70*t284*t14+2.0*t1524*t1506+2.0*t60*t1511+t328*
t239+2.0*t1465*t1506;
      t1537 = t206*t4;
      t1540 = t11*t12;
      t1543 = t60*t12;
      t1556 = t271*t4;
      t1560 = 2.0*t345*t26*t4+2.0*t317*t1537+2.0*t1540*t1485+2.0*t1543*t1467+
2.0*t307*t1478+t255*t146+t222*t372+2.0*t11*t19*t146+2.0*t25*t102*t239+2.0*t317*
t1556+t637*t146;
      t1567 = t25*t12;
      t1568 = t1466*t14;
      t1582 = t11*t101;
      t1585 = t60*t101;
      t1588 = 2.0*t25*t1490+t759*t372+2.0*t474*t173*t4+2.0*t1567*t1568+t625*
t239+2.0*t1543*t1506+2.0*t474*t287*t4+t745*t372+t312*t146+2.0*t60*t181*t372+2.0
*t1582*t1568+2.0*t1585*t1518;
      partial_Theta_X_wrt_partial_dd_h_11 = (t1500+t1532+t1560+t1588)*t792+(-
t71*t146-2.0*t1501-2.0*t1537-t101*t239-2.0*t1556-t59*t372)*t824;
      t1600 = -t91-t93;
      t1601 = t1*t1600;
      t1606 = -t190-t192;
      t1610 = t117*t1606;
      t1613 = -t41-t44;
      t1631 = t18*t40;
      t1635 = -2.0*t317*t1601+2.0*t408*t241-2.0*t345*t12*t1606-2.0*t181*t1610
-2.0*t25*t19*t1613+2.0*t328*t241-2.0*t19*t226*t1600-2.0*t60*t19*t1600-2.0*t11*
t102*t1613-2.0*t345*t71*t1600+4.0*t1540*t1631*t36;
      t1641 = t112*t1600;
      t1646 = t112*t1613;
      t1652 = t18*t16;
      t1662 = t24*t1606;
      t1668 = 2.0*t255*t148-2.0*t70*t71*t1613-2.0*t60*t1641+2.0*t625*t241-2.0*
t25*t1646+2.0*t312*t148+4.0*t25*t101*t1652*t14-2.0*t11*t181*t1600-2.0*t341*t18*
t1606-2.0*t317*t1662-2.0*t560*t68*t1613;
      t1673 = t68*t40;
      t1674 = t1673*t36;
      t1688 = t68*t7*t4;
      t1694 = t68*t16;
      t1695 = t1694*t14;
      t1704 = -2.0*t60*t1610+4.0*t11*t71*t1674+2.0*t759*t374-2.0*t294*t1*t1613+
2.0*t637*t148+2.0*t222*t374+4.0*t60*t1*t1688-2.0*t474*t12*t1600+4.0*t1567*t1695
-2.0*t474*t101*t1606-2.0*t11*t117*t1613;
      t1705 = t226*t1606;
      t1711 = t12*t1613;
      t1739 = -2.0*t25*t1705-2.0*t307*t68*t1600-2.0*t127*t1711-2.0*t181*t1641+
4.0*t181*t1*t1688-2.0*t102*t1705+4.0*t102*t12*t1695+4.0*t19*t71*t1674+2.0*t745*
t374+4.0*t60*t24*t18*t7*t4-2.0*t102*t1646-2.0*t60*t102*t1606;
      partial_Theta_X_wrt_partial_dd_h_12 = (t1635+t1668+t1704+t1739)*t792+(
-2.0*t894*t36+2.0*t1711+2.0*t1601-2.0*t994*t14+2.0*t1662-2.0*t868*t4)*t824;
      t1749 = t226*t377;
      t1752 = t1673*t7;
      t1755 = t1694*t7;
      t1766 = t873*t16;
      t1769 = t1673*t16;
      t1772 = t1631*t7;
      t1777 = 2.0*t181*t1749+2.0*t1481*t1752+2.0*t1524*t1755+2.0*t345*t898*t7+
t408*t244+t745*t377+2.0*t345*t894*t7+2.0*t127*t1766+2.0*t560*t1769+2.0*t1543*
t1772+2.0*t1514*t1752;
      t1782 = t117*t244;
      t1791 = t1652*t7;
      t1794 = t862*t7;
      t1803 = 2.0*t474*t994*t7+t255*t151+2.0*t102*t1782+2.0*t25*t102*t244+2.0*
t70*t894*t16+2.0*t341*t1791+2.0*t317*t1794+t759*t377+2.0*t60*t1749+t222*t377+
2.0*t307*t1752;
      t1809 = t1009*t7;
      t1819 = t112*t151;
      t1830 = 2.0*t1540*t1769+2.0*t25*t1782+2.0*t317*t1809+2.0*t1543*t1755+t328
*t244+2.0*t1465*t1755+2.0*t1476*t1752+2.0*t11*t1819+2.0*t60*t181*t377+2.0*t474*
t873*t7+2.0*t1497*t1769;
      t1834 = t1631*t16;
      t1855 = 2.0*t11*t19*t151+2.0*t1582*t1834+2.0*t1465*t1772+2.0*t1504*t1755+
2.0*t294*t862*t16+2.0*t1567*t1834+t637*t151+t625*t244+t312*t151+2.0*t19*t1819+
2.0*t1484*t1769+2.0*t1585*t1791;
      partial_Theta_X_wrt_partial_dd_h_22 = (t1777+t1803+t1830+t1855)*t792+(-
t71*t151-2.0*t1766-2.0*t1794-t101*t244-2.0*t1809-t59*t377)*t824;
      partial_Theta_Y_wrt_partial_dd_h_11 = RATIONAL(0.0,1.0);
      partial_Theta_Y_wrt_partial_dd_h_12 = RATIONAL(0.0,1.0);
      partial_Theta_Y_wrt_partial_dd_h_22 = RATIONAL(0.0,1.0);

```

gr.cg/metric_det_gradient.c:
```
/*
 * inputs = {g_uu, partial_d_g_dd}
 * outputs = {partial_d_ln_sqrt_g}
 * cost = 9*assignments+15*additions+27*multiplications
 */
fp t1, t5, t8, t11, t15, t18;
      t1 = g_uu_11;
      t5 = g_uu_12;
      t8 = g_uu_13;
      t11 = g_uu_22;
      t15 = g_uu_23;
      t18 = g_uu_33;
      partial_d_ln_sqrt_g_1 = RATIONAL(1.0,2.0)*t1*partial_d_g_dd_111+t5*
partial_d_g_dd_112+t8*partial_d_g_dd_113+RATIONAL(1.0,2.0)*t11*
partial_d_g_dd_122+t15*partial_d_g_dd_123+RATIONAL(1.0,2.0)*t18*
partial_d_g_dd_133;
      partial_d_ln_sqrt_g_2 = RATIONAL(1.0,2.0)*t1*partial_d_g_dd_211+t5*
partial_d_g_dd_212+t8*partial_d_g_dd_213+RATIONAL(1.0,2.0)*t11*
partial_d_g_dd_222+t15*partial_d_g_dd_223+RATIONAL(1.0,2.0)*t18*
partial_d_g_dd_233;
      partial_d_ln_sqrt_g_3 = RATIONAL(1.0,2.0)*t1*partial_d_g_dd_311+t5*
partial_d_g_dd_312+t8*partial_d_g_dd_313+RATIONAL(1.0,2.0)*t11*
partial_d_g_dd_322+t15*partial_d_g_dd_323+RATIONAL(1.0,2.0)*t18*
partial_d_g_dd_333;

```


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:       subroutine y12mcf(n,z,a,snr,nn,rnr,nn1,pivot,b,ha,iha, aflag,iflag
     *,ifail)
c
c  systens of linear equations are solved by use of sparse matrix tech-
c  nique and by gaussian elimination.
c
      implicit double precision(a-b,g,p,t-y),integer(c,f,h-n,r-s,z)
      double precision a(nn),b(n),pivot(n),aflag(8)
c
c  information which is necessary to begin the elimination is stored.
c
      integer snr(nn),rnr(nn1),ha(iha,11), iflag(10)
      ifail=0
      if(iflag(1).ne.-1)ifail=2
      if(aflag(1).lt.1.0d0)aflag(1)=1.0005 d0
      if(aflag(3).lt.1.0d+5)aflag(3)=1.0d+5
      if(aflag(4).lt.0.0d0)aflag(4)=-aflag(4)
      if(iflag(2).lt.1)ifail=19
      if(iflag(3).lt.0.or.iflag(3).gt.2)ifail=20
      if(iflag(5).lt.1.or.iflag(5).gt.3)ifail=21
      if(iflag(5).eq.3)ifail=22
      if(ifail.gt.0)go to 1110
      snr(z+1)=0
      rnr(z+1)=0
      n8=n+1
      n7=n-1
      u=aflag(1)
      grmin=aflag(4)*aflag(6)
c
c  use the information about fill-ins if it is possible.
c
      zz=z
      nr=n*n
      if(iflag(4).ne.2)go to 100
      if(iflag(10).gt.nn)go to 50
      l1=iflag(10)
      l5=l1+1
      if(l5.le.nn)snr(l5)=0
      do 40 i=1,n
      l=n8-i
      l2=ha(l,3)+1
      l3=l2-ha(l,1)
      do 10 j=1,l3
      snr(l5-j)=snr(l2-j)
   10 a(l5-j)=a(l2-j)
      ha(l,3)=l1
      ha(l,1)=l5-l3
      l6=l1-l3
      l5=l5-ha(l,9)
      if(l5.gt.l6)go to 30
      do 20 j=l5,l6
   20 snr(j)=0
   30 continue
   40 l1=l5-1
   50 if(iflag(9).gt.nn1)go to 100
      l2=iflag(9)
      l5=l2+1
      if(l5.le.nn1)rnr(l5)=0
      do 90 i=1,n
      l=n8-i
      l1=ha(l,6)+1
      l4=l1-ha(l,4)
      do 60 j=1,l4
   60 rnr(l5-j)=rnr(l1-j)
      ha(l,4)=l5-l4
      ha(l,6)=l2
      l6=l2-l4
      l5=l5-ha(l,10)
      if(l5.gt.l6)go to 80
      do 70 j=l5,l6
   70 rnr(j)=0
   80 continue
   90 l2=l5-1
  100 r4=ha(n,3)
      r5=ha(n,6)
      aflag(7)=aflag(6)
      aflag(8)=aflag(6)
      do 110 i=1,n
      pivot(i)=0.0 d0
      ha(i,2)=ha(i,1)
  110 ha(i,5)=ha(i,4)
      index=ha(n,8)
c
c  start of gaussian elimination.
c
      slut=ha(index,3)-ha(index,2)+1
      do 950 i=1,n7
      rr3=ha(i,2)
      rr4=ha(i,3)
      c1=ha(i,4)
      cr4=ha(i,6)
      if(iflag(3).eq.0)go to 350
      if(iflag(4).ne.2)go to 120
      rrow=ha(i,7)
      rcoll=ha(i,8)
      go to 220
  120 l4=ha(i,8)
      if(iflag(3).eq.1)go to 130
      rrow=l4
      rcoll=rrow
      rpivot=i
      go to 170
  130 r=nr
      v=0.0 d0
      index=iflag(2)
      do 160 kk=1,index
      l1=i-1+kk
      if(l1.gt.n)go to 170
      j=ha(l1,8)
      r7=ha(j,2)
      r8=ha(j,3)
      r9=r8-r7
      t=0.0 d0
      do 140 k=r7,r8
      td=dabs(a(k))
  140 if(t.lt.td)t=td
      t=t/u
      do 160 k=r7,r8
      td=dabs(a(k))
      if(td.lt.t)go to 150
      r6=snr(k)
      r3=r9*(ha(r6,6)-ha(r6,5))
      if(r3.gt.r)go to 150
      if(r3.lt.r)go to 151
      if(v.ge.td)go to 150
  151 v=td
      rrow=j
      rcoll=r6
      r=r3
      rpivot=l1
  150 continue
  160 continue
  170 r3=ha(rcoll,10)
      ha(rcoll,10)=ha(i,10)
      ha(i,10)=r3
      r3=ha(rrow,9)
      ha(rrow,9)=ha(i,9)
c
c  remove the pivot row of the list where the rows are ordered by
c  increasing numbers of non-zero elements.
c
      ha(i,9)=r3
      l1=0
      l=i
      l2=ha(l4,3)-ha(l4,2)+1
  180 l=l+1
      if(l2.gt.l1)ha(l2,11)=l
      if(l.gt.n)go to 190
      l5=ha(l,8)
      l3=ha(l5,3)-ha(l5,2)+1
      if(rpivot.lt.l)go to 190
      ha(l4,7)=l
      ha(l,8)=l4
      l4=l5
      l1=l2
      l2=l3
      l3=n8
      go to 180
  190 if(l2.eq.l1)go to 200
      if(l3.eq.l2)go to 200
      ha(l2,11)=0
  200 l5=ha(i,7)
      if(rrow.eq.i)go to 210
      ha(l5,8)=rrow
      ha(rrow,7)=l5
  210 ha(i,7)=rrow
c
c  row interchanges.
c
      ha(i,8)=rcoll
  220 if(rrow.eq.i)go to 290
      t=b(rrow)
      b(rrow)=b(i)
      b(i)=t
      do 250 j=rr3,rr4
      l1=snr(j)
      r=ha(l1,5)-1
      r10=ha(l1,6)
  240 r=r+1
      if(rnr(r).ne.i)go to 240
      rnr(r)=rnr(r10)
  250 rnr(r10)=rrow
      rr3=ha(rrow,2)
      rr4=ha(rrow,3)
      do 270 j=rr3,rr4
      l1=snr(j)
      r=ha(l1,5)-1
  260 r=r+1
      if(rnr(r).ne.rrow)go to 260
  270 rnr(r)=i
      do 280 j=1,3
      r3=ha(rrow,j)
      ha(rrow,j)=ha(i,j)
c
c  column interchanges.
c
  280 ha(i,j)=r3
  290 if(rcoll.eq.i)go to 350
      do 310 j=c1,cr4
      l1=rnr(j)
      r=ha(l1,2)-1
      r10=ha(l1,3)
  300 r=r+1
      if(snr(r).ne.i)go to 300
      t=a(r10)
      a(r10)=a(r)
      a(r)=t
      snr(r)=snr(r10)
  310 snr(r10)=rcoll
      c1=ha(rcoll,4)
      cr4=ha(rcoll,6)
      do 330 j=c1,cr4
      l1=rnr(j)
      r=ha(l1,2)-1
  320 r=r+1
      if(snr(r).ne.rcoll)go to 320
  330 snr(r)=i
      do 340 j=4,6
      r3=ha(rcoll,j)
      ha(rcoll,j)=ha(i,j)
c
c end of the interchanges.
c the row ordered list and the column ordered list are prepared to
c begin step i of the elimination.
c
  340 ha(i,j)=r3
  350 r9=rr4-rr3
      do 360 rr=rr3,rr4
      if(snr(rr).eq.i)go to 370
  360 continue
      ifail=9
      go to 1110
  370 v=a(rr)
      pivot(i)=v
      td=dabs(v)
      if(td.lt.aflag(8))aflag(8)=td
      if(td.ge.grmin)go to 380
      ifail=3
      go to 1110
  380 r2=ha(i,1)
      a(rr)=a(rr3)
      snr(rr)=snr(rr3)
      a(rr3)=a(r2)
      snr(rr3)=snr(r2)
      snr(r2)=0
      z=z-1
      rr3=rr3+1
      ha(i,2)=rr3
      ha(i,1)=r2+1
      cr3=ha(i,5)
      if(r9.le.0)go to 431
      do 430 j=rr3,rr4
      index=snr(j)
  430 pivot(index)=a(j)
  431 r7=cr4-cr3+1
      do 880 k=1,r7
      r1=rnr(cr3-1+k)
      if(r1.eq.i)go to 870
      i1=ha(r1,1)
      rr1=ha(r1,2)
      rr2=ha(r1,3)
      l2=rr2-rr1+1
      l=rr1-1
  390 l=l+1
      if(snr(l).ne.i)go to 390
      t=a(l)/v
      if(iflag(5).eq.2)go to 400
      a(l)=a(i1)
      snr(l)=snr(i1)
      snr(i1)=0
      i1=i1+1
      ha(r1,1)=i1
      z=z-1
      go to 410
  400 a(l)=a(rr1)
      a(rr1)=t
      r3=snr(rr1)
      snr(rr1)=snr(l)
      snr(l)=r3
  410 rr1=rr1+1
      ha(r1,2)=rr1
      b(r1)=b(r1)-b(i)*t
      if(r9.le.0)go to 669
      r=rr1
      if(r.gt.rr2)go to 470
      do 460 l=r,rr2
      l1=snr(l)
      td=pivot(l1)
      if(td.eq.0.0d0)go to 450
      pivot(l1)=0.0 d0
      td=a(l)-td*t
      a(l)=td
      td1=dabs(td)
      if(td1.gt.aflag(7))aflag(7)=td1
c
c  too small element is created.remove it from the lists.
c
      if(td1.gt.aflag(2))go to 450
      z=z-1
      a(l)=a(rr1)
      snr(l)=snr(rr1)
      a(rr1)=a(i1)
      snr(rr1)=snr(i1)
      snr(i1)=0
      rr1=rr1+1
      i1=i1+1
      ha(r1,2)=rr1
      ha(r1,1)=i1
      r3=ha(l1,5)
      r2=r3-1
      l4=ha(l1,4)
      l5=rnr(l4)
      l6=rnr(r3)
  440 r2=r2+1
      if(rnr(r2).ne.r1)go to 440
      rnr(r2)=l6
      rnr(r3)=l5
      rnr(l4)=0
      ha(l1,5)=r3+1
      ha(l1,4)=l4+1
  450 continue
  460 continue
  470 continue
      do 750 j=1,r9
      r=rr3-1+j
      r2=snr(r)
      tol2=pivot(r2)
      pivot(r2)=a(r)
      if(tol2.eq.0.0d0)go to 740
      tol3=-tol2*t
      tol1=dabs(tol3)
      if(tol1.lt.aflag(2))go to 740
      c2=ha(r2,4)
      cr2=ha(r2,6)
      cr1=ha(r2,5)
      lfr=rr2-i1+2
      lfc=cr2-c2+2
      if(iflag(4).ne.1)go to 480
      if(lfr.gt.ha(r1,9))ha(r1,9)=lfr
      if(lfc.gt.ha(r2,10))ha(r2,10)=lfc
  480 if(i1.eq.1)go to 490
      if(snr(i1-1).eq.0)go to 600
  490 if(rr2.eq.nn)go to 500
      if(snr(rr2+1).eq.0)go to 580
c
c  collection in row ordered list.
c
  500 r10=nn-lfr
      if(r10.ge.r4)go to 560
      iflag(6)=iflag(6)+1
      do 520 jj=1,n
      l1=ha(jj,3)
      if(l1.lt.ha(jj,1))go to 510
      ha(jj,3)=snr(l1)
      snr(l1)=-jj
  510 continue
  520 continue
      l3=0
      l4=1
      do 550 jj=1,r4
      if(snr(jj).eq.0)go to 540
      l3=l3+1
      if(snr(jj).gt.0)go to 530
      l5=-snr(jj)
      snr(jj)=ha(l5,3)
      ha(l5,3)=l3
      l6=l4+ha(l5,2)-ha(l5,1)
      ha(l5,2)=l6
      ha(l5,1)=l4
      l4=l3+1
  530 a(l3)=a(jj)
      snr(l3)=snr(jj)
  540 continue
  550 continue
      r4=l3
      snr(l3+1)=0
      rr3=ha(i,2)
      rr4=ha(i,3)
      i1=ha(r1,1)
      rr1=ha(r1,2)
      r=rr3-1+j
      if(r10.ge.r4)go to 560
      ifail=5
c
c fill-in takes place in the row ordered list.
c
      go to 1110
  560 r8=lfr-1
      rr2=r4+lfr
      if(r8.le.0)go to 579
      l3=i1-1
      do 570 ll=1,r8
      l4=r4+ll
      l5=l3+ll
      a(l4)=a(l5)
      snr(l4)=snr(l5)
  570 snr(l5)=0
  579 rr1=r4+rr1-i1+1
      ha(r1,3)=rr2
      ha(r1,2)=rr1
      i1=r4+1
      ha(r1,1)=i1
      l1=rr2
      go to 590
  580 rr2=rr2+1
      ha(r1,3)=rr2
      l1=rr2
      if(rr2.le.r4)go to 610
  590 r4=rr2
      if(r4.lt.nn)snr(r4+1)=0
      go to 610
  600 rr1=rr1-1
      i1=i1-1
      ha(r1,1)=i1
      ha(r1,2)=rr1
      l1=rr1
      snr(i1)=snr(l1)
      a(i1)=a(l1)
  610 a(l1)=tol3
      snr(l1)=snr(r)
      td=dabs(a(l1))
      if(td.gt.aflag(7))aflag(7)=td
      z=z+1
      if(iflag(8).lt.z) iflag(8)=z
      if(c2.eq.1)go to 620
      if(rnr(c2-1).eq.0)go to 720
  620 if(cr2.eq.nn1)go to 630
      if(rnr(cr2+1).eq.0)go to 700
c
c  collection in column ordered list.
c
  630 r10=nn1-lfc
      if(r10.ge.r5)go to 680
      iflag(7)=iflag(7)+1
      do 640 jj=i,n
      l1=ha(jj,6)
      ha(jj,6)=rnr(l1)
  640 rnr(l1)=-jj
      l3=0
      l4=1
      do 670 jj=1,r5
      if(rnr(jj).eq.0)go to 660
      l3=l3+1
      if(rnr(jj).gt.0)go to 650
      l5=-rnr(jj)
      rnr(jj)=ha(l5,6)
      ha(l5,6)=l3
      l6=l4+ha(l5,5)-ha(l5,4)
      ha(l5,5)=l6
      ha(l5,4)=l4
      l4=l3+1
  650 rnr(l3)=rnr(jj)
  660 continue
  670 continue
      r5=l3
      rnr(r5+1)=0
      c2=ha(r2,4)
      cr3=ha(i,5)
      cr4=ha(i,6)
      cr1=ha(r2,5)
      if(r10.ge.r5)go to 680
      ifail=6
c
c fill-in takes place in the column ordered list.
c
      go to 1110
  680 r8=lfc-1
      cr2=r5+lfc
      if(r8.le.0)go to 699
      l3=c2-1
      do 690 l=1,r8
      l4=r5+l
      l5=l3+l
      rnr(l4)=rnr(l5)
  690 rnr(l5)=0
  699 cr1=r5+cr1-c2+1
      c2=r5+1
      ha(r2,6)=cr2
      ha(r2,4)=c2
      ha(r2,5)=cr1
      r=cr2
      go to 710
  700 cr2=cr2+1
      ha(r2,6)=cr2
      r=cr2
      if(cr2.le.r5)go to 730
  710 r5=cr2
      if(r5.lt.nn1)rnr(r5+1)=0
      go to 730
  720 cr1=cr1-1
      c2=c2-1
      ha(r2,4)=c2
      ha(r2,5)=cr1
      r=cr1
      rnr(c2)=rnr(r)
  730 rnr(r)=r1
  740 continue
  750 continue
  669 if(rr1.le.rr2)go to 760
      ifail=7
c
c  update the information in the list where the rows are ordered by
c  increasing numbers of the non-zero elements.
c
      go to 1110
  760 if(iflag(4).eq.2)go to 870
      if(iflag(3).eq.0)go to 870
      l1=rr2-rr1+1
      if(l1.eq.l2)go to 870
      l6=ha(r1,7)
      l4=ha(l2,11)
      if(l1.gt.l2)go to 820
      if(l6.gt.l4)go to 780
      if(l4.eq.n)go to 770
      l=ha(l4+1,8)
      l5=ha(l,3)-ha(l,2)+1
      if(l5.eq.l2)go to 790
  770 ha(l2,11)=0
      go to 800
  780 l5=ha(l4,8)
      l3=ha(l6,8)
      ha(l4,8)=l3
      ha(l6,8)=l5
      ha(l5,7)=l6
      ha(l3,7)=l4
      l6=l4
  790 ha(l2,11)=l4+1
  800 if(l4.eq.i+1)go to 810
      l=ha(l6-1,8)
      l2=ha(l,3)-ha(l,2)+1
      l4=ha(l2,11)
      if(l1.lt.l2)go to 780
  810 if(l1.ne.l2)ha(l1,11)=l6
      go to 870
  820 if(l6.gt.l4)go to 840
      if(l4.eq.n)go to 830
      l=ha(l4+1,8)
      l5=ha(l,3)-ha(l,2)+1
      if(l5.eq.l2)go to 840
  830 ha(l2,11)=0
  840 l2=l2+1
      if(l2.le.slut)go to 850
      l3=n
      slut=l1
      l2=l1
      go to 860
  850 l3=ha(l2,11)-1
      if(l3.eq.-1)go to 840
      if(l2.gt.l1)l2=l1
  860 ha(l2,11)=l3
      l4=ha(l3,8)
      l7=ha(l6,8)
      ha(l3,8)=l7
      ha(l6,8)=l4
      ha(l7,7)=l3
      ha(l4,7)=l6
      l6=l3
      if(l2.lt.l1)go to 840
  870 continue
  880 continue
      if(r9.le.0)go to 882
      do 881 j=rr3,rr4
      index=snr(j)
  881 pivot(index)=0.0 d0
  882 continue
      cr3=ha(i,4)
      do 890 j=cr3,cr4
  890 rnr(j)=0
      if(r9.le.0)go to 930
      l2=ha(i,2)-1
      do 920 ll=1,r9
      r=snr(l2+ll)
      r1=ha(r,5)
      r2=ha(r,6)
      if(r2.gt.r1)go to 900
      ifail=8
      go to 1110
  900 ha(r,5)=r1+1
      r3=r1-1
  910 r3=r3+1
      if(rnr(r3).ne.i)go to 910
      rnr(r3)=rnr(r1)
  920 rnr(r1)=i
  930 aflag(5)=aflag(7)/aflag(6)
      if(aflag(5).lt.aflag(3))go to 940
      ifail=4
      go to 1110
  940 continue
c
c  preparation to begin the back substitution.
c
  950 continue
      index=ha(n,2)
      pivot(n)=a(index)
      a(index)=0.0 d0
      td=dabs(pivot(n))
      if(td.gt.aflag(7))aflag(7)=td
      if(td.lt.aflag(8))aflag(8)=td
      if(td.gt.grmin)go to 960
      ifail=3
      go to 1110
  960 if(iflag(4).ne.1)go to 1060
      iflag(10)=ha(n,9)
      iflag(9)=ha(n,10)
      do 990 i=1,n7
      r1=n-i
      iflag(10)=iflag(10)+ha(r1,9)
      iflag(9)=iflag(9)+ha(r1,10)
      if(iflag(3).eq.0)go to 980
      do 970 j=9,10
      r2=ha(r1,j-2)
      r6=ha(r2,j)
      ha(r2,j)=ha(r1,j)
  970 ha(r1,j)=r6
  980 continue
  990 continue
1060  continue
      aflag(5)=aflag(7)/aflag(6)
      iflag(1)=-2
 1110 z=zz
      return
      end