summaryrefslogtreecommitdiffstats
path: root/ast
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2017-12-08 19:30:07 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2017-12-08 19:30:07 (GMT)
commit9c81a48e2a38ab4487b8849d2b2db6ebbaeca9a7 (patch)
tree3de4f1c5f35381ecc749da5e05bfc3837d7cedaf /ast
parent4432c8d7e1ccb371db03e13cdb5378fceaa5ad04 (diff)
downloadblt-9c81a48e2a38ab4487b8849d2b2db6ebbaeca9a7.zip
blt-9c81a48e2a38ab4487b8849d2b2db6ebbaeca9a7.tar.gz
blt-9c81a48e2a38ab4487b8849d2b2db6ebbaeca9a7.tar.bz2
upgrade AST
Diffstat (limited to 'ast')
-rw-r--r--ast/ast_link_adam406
-rw-r--r--ast/cminpack/.deps/libast_la-dpmpar.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-enorm.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-lmder.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-lmder1.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-lmpar.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-qrfac.Plo1
-rw-r--r--ast/cminpack/.deps/libast_la-qrsolv.Plo1
-rw-r--r--ast/cminpack/CopyrightMINPACK.txt52
-rw-r--r--ast/cminpack/README.md128
-rw-r--r--ast/cminpack/cminpack.h370
-rw-r--r--ast/cminpack/cminpackP.h62
-rw-r--r--ast/cminpack/dpmpar.c201
-rw-r--r--ast/cminpack/enorm.c157
-rw-r--r--ast/cminpack/lmder.c526
-rw-r--r--ast/cminpack/lmder1.c167
-rw-r--r--ast/cminpack/lmpar.c338
-rw-r--r--ast/cminpack/qrfac.c285
-rw-r--r--ast/cminpack/qrsolv.c218
-rw-r--r--ast/config.h.in3
-rw-r--r--ast/f77.h1096
-rw-r--r--ast/object.h1934
22 files changed, 0 insertions, 5950 deletions
diff --git a/ast/ast_link_adam b/ast/ast_link_adam
deleted file mode 100644
index f776bb7..0000000
--- a/ast/ast_link_adam
+++ /dev/null
@@ -1,406 +0,0 @@
-
-# N.B. the previous line should be blank.
-#++
-# Name:
-# ast_link_adam
-
-# Purpose:
-# Link an ADAM program with the AST library.
-
-# Type of Module:
-# Shell script.
-
-# Description:
-# This command should only be used when building Starlink ADAM programs
-# which use the AST library, in order to generate the correct arguments
-# to allow the ADAM ``alink'' command to link the program. The arguments
-# generated are written to standard output but may be substituted into
-# the ``alink'' command line in the standard UNIX way using backward
-# quotes (see below).
-#
-# By default, it is assumed that you are building an ADAM program which
-# does not produce graphical output. However, switches are provided for
-# linking other types of program. This command should not be used when
-# building stand-alone (non-ADAM) programs. Use the ``ast_link'' command
-# instead.
-
-# Invocation:
-#c alink program.o -L/star/lib `ast_link_adam [switches]`
-#f alink program.f -L/star/lib `ast_link_adam [switches]`
-
-# Switches:
-# The following switches may optionally be given to this command to
-# modify its behaviour:
-#
-# - ``-csla'': Ignored. Provided for backward compatibility only.
-#
-# - ``-fsla'': Ignored. Provided for backward compatibility only.
-#
-# - ``-grf'': Requests that no arguments be generated to specify which
-# 2D graphics system is used to display output from the AST library. You
-# should use this option only if you have implemented an interface to a
-# new graphics system yourself and wish to provide your own arguments for
-# linking with it. This switch differs from the other ``grf'' switches in
-# that it assumes that your graphics module implements the complete
-# interface required by the current version of AST. If future versions of
-# AST introduce new functions to the graphics interface, this switch will
-# cause ``unresolved symbol'' errors to occur during linking, warning you
-# that you need to implement new functions in your graphics module. To
-# avoid such errors, you can use one of the other, version-specific,
-# switches in place of the ``-grf'' switch, but these will cause run-time
-# errors to be reported if any AST function is invoked which requires
-# facilities not in the implemented interface.
-#
-# - ``-grf_v2.0'': This switch is equivalent to the ``-mygrf'' switch.
-# It indicates that you want to link with your own graphics module which
-# implements the 2D graphics interface required by V2.0 of AST.
-#
-# - ``-grf_v3.2'': Indicates that you want to link with your own graphics
-# module which implements the 2D graphics interface required by V3.2 of AST.
-#
-# - ``-grf_v5.6'': Indicates that you want to link with your own graphics
-# module which implements the 2D graphics interface required by V5.6 of AST.
-#
-# - ``-myerr'': Requests that no arguments be generated to specify how
-# error messages produced by the AST library should be delivered. You
-# should use this option only if you have implemented an interface to a
-# new error delivery system yourself and wish to provide your own
-# arguments for linking with it. By default, error messages are delivered
-# in the standard ADAM way via the EMS Error Message Service (Starlink
-# System Note SSN/4).
-#
-# - ``-mygrf'': This switch has been superceeded by the ``-grf'' switch,
-# but is retained in order to allow applications to be linked with a
-# graphics module which implements the interface used by AST V2.0. It is
-# equivalent to the ``-grf_v2.0'' switch.
-#
-# - ``-pgp'': Requests that the program be linked so that 2D
-# graphical output from the AST library is displayed via the
-# Starlink version of the PGPLOT graphics package (which uses GKS
-# for its output). By default, no graphics package is linked and
-# this will result in an error at run time if AST routines are
-# invoked that attempt to generate graphical output.
-#
-# - ``-pgplot'': Requests that the program be linked so that 2D
-# graphical output from the AST library is displayed via the
-# standard (or ``native'') version of the PGPLOT graphics
-# package. By default, no graphics package is linked and this will
-# result in an error at run time if AST routines are invoked that
-# attempt to generate graphical output.
-#
-# - ``-grf3d'': Requests that no arguments be generated to specify which
-# 3D graphics system is used to display output from the AST library. You
-# should use this option only if you have implemented an interface to a
-# new 3D graphics system yourself and wish to provide your own arguments
-# for linking with it.
-#
-# - ``-pgp3d'': Requests that the program be linked so that 3D
-# graphical output from the AST library is displayed via the
-# Starlink version of the PGPLOT graphics package (which uses GKS
-# for its output). By default, no 3D graphics package is linked and
-# this will result in an error at run time if AST routines are
-# invoked that attempt to generate graphical output.
-#
-# - ``-pgplot3d'': Requests that the program be linked so that 3D
-# graphical output from the AST library is displayed via
-# the standard (or ``native'') version of the PGPLOT graphics
-# package. By default, no 3D graphics package is linked and this will
-# result in an error at run time if AST routines are invoked that
-# attempt to generate graphical output.
-
-# SLALIB:
-# The AST distribution includes a cut down subset of the C version of
-# the SLALIB library written by Pat Wallace. This subset contains only
-# the functions needed by the AST library. It is built as part of the
-# process of building AST and is distributed under GPL (and is thus
-# compatible with the AST license). Previous version of this script
-# allowed AST applications to be linked against external SLALIB
-# libraries (either Fortran or C) rather than the internal version.
-# The current version of this script does not provide this option,
-# and always uses the internal SLALIB library. However, for backward
-# compatibility, this script still allows the "-fsla" and "-csla" flags
-# (previously used for selecting which version of SLALIB to use) to be
-# specified, but they will be ignored.
-
-# Examples:
-#c alink display.o -L/star/lib `ast_link_adam -pgplot`
-#c Links an ADAM program ``display'' which uses the standard
-#c version of PGPLOT for graphical output.
-#c alink plotit.o -L. -L/star/lib `ast_link_adam -grf` -lgrf
-#c Links an ADAM program ``plotit'', written in C. The ``-grf''
-#c switch indicates that graphical output will be delivered through
-#c a graphical interface which you have implemented yourself, which
-#c corresponds to the interface required by the current version of AST.
-#c Here, this interface is supplied by means of the ``-lgrf'' library
-#c reference.
-#c alink plotit.o -L. -L/star/lib `ast_link_adam -grf_v2.0` -lgrf
-#c Links an ADAM program ``plotit'', written in C. The ``-grf_v2.0''
-#c switch indicates that graphical output will be delivered through
-#c a graphical interface which you have implemented yourself, which
-#c corresponds to the interface required by version 2.0 of AST. Here,
-#c this interface is supplied by means of the ``-lgrf'' library
-#c reference.
-#f alink display.f -L/star/lib `ast_link_adam -pgplot`
-#f Compiles and links an ADAM Fortran program called ``display'' which
-#f uses the standard version of PGPLOT for graphical output.
-#f alink plotit.f -L. -L/star/lib `ast_link_adam -grf` -lgrf
-#f Compiles and links an ADAM Fortran program ``plotit''. The ``-grf''
-#f switch indicates that graphical output will be delivered through
-#f a graphical interface which you have implemented yourself, which
-#f corresponds to the interface required by the current version of AST.
-#f Here, this interface is supplied by means of the ``-lgrf'' library
-#f reference.
-#f alink plotit.f -L. -L/star/lib `ast_link_adam -grf_v2.0` -lgrf
-#f Compiles and links an ADAM Fortran program ``plotit''. The ``-grf_v2.0''
-#f switch indicates that graphical output will be delivered through
-#f a graphical interface which you have implemented yourself, which
-#f corresponds to the interface required by version 2.0 of AST.
-#f Here, this interface is supplied by means of the ``-lgrf'' library
-#f reference.
-
-# Copyright:
-# Copyright (C) 1997-2006 Council for the Central Laboratory of the Research Councils
-
-# Authors:
-# RFWS: R.F. Warren-Smith (STARLINK)
-# {enter_new_authors_here}
-
-# History:
-# 11-NOV-1996 (RFWS):
-# Original version.
-# 18-NOV-1997 (RFWS):
-# Adapted prologue for document extraction.
-# 28-SEP-1998 (RFWS):
-# Distinguish between -pgp and -pgplot options.
-# 23-JAN-2004 (DSB):
-# Added switches to support older grf implementations.
-# 21-APR-2005 (DSB):
-# Added "-fsla" option.
-# 16-JUN-2006 (DSB):
-# Ignore "-fsla" and "-clsa" options, and always use PAL.
-# 22-AUG-2007 (DSB):
-# Added "-grf3d", "-pgplot3d" and "-pgp3d" flags.
-# 4-MAR-2011 (DSB):
-# Added v5.6 grf options.
-# {enter_changes_here}
-
-# Bugs:
-# {note_any_bugs_here}
-
-#--
-
-# This function searches the directory path specified in PATH, looking for
-# an executable file which is not a directory. If found, it echos the full
-# file name to standard output. Otherwise, it outputs nothing.
- find() { IFS=':'; for d in $PATH; do f="${d:=.}/${1}"
- test -x "${f}" -a ! -d "${f}" && echo "${f}" && break
- done;
- }
-
-# Initialise linking options.
- err=''
- grf=''
- grf3d=''
- sla=''
-
-# Interpret command line switches.
-# --------------------------------
- while :; do
- case "${1}" in
-
-# -csla - Previously used to request C version of SLALIB. Now ignored.
- -csla)
-# sla='c'
- shift;;
-
-# -fsla - Previously used to request Fortran version of SLALIB. Now ignored.
- -fsla)
-# sla='f'
- shift;;
-
-# -myerr - Requests no error reporting.
- -myerr)
- err='my'
- shift;;
-
-# -grf - Requests no 2D graphics.
- -grf)
- grf='current'
- shift;;
-
-# -mygrf - Requests no 2D graphics, except for null implementations of
-# functions aded to the grf interface after AST V2.0.
- -mygrf)
- grf='v2.0'
- shift;;
-
-# -grf_v2.0 - Requests no 2D graphics, except for null implementations of
-# functions aded to the grf interface after AST V2.0.
- -grf_v2.0)
- grf='v2.0'
- shift;;
-
-# -grf_v3.2 - Requests no 2D graphics, except for null implementations of
-# functions aded to the grf interface after AST V3.2.
- -grf_v3.2)
- grf='v3.2'
- shift;;
-
-# -grf_v5.6 - Requests no 2D graphics, except for null implementations of
-# functions added to the grf interface after AST V5.6.
- -grf_v5.6)
- grf='v5.6'
- shift;;
-
-# -pgp - Requests 2D graphical output through Starlink PGPLOT.
- -pgp)
- grf='pgp'
- shift;;
-
-# -pgplot - Requests 2D graphical output through native PGPLOT.
- -pgplot)
- grf='pgplot'
- shift;;
-
-# -grf3d - Requests no 3D graphics.
- -grf3d)
- grf3d='current'
- shift;;
-
-# -pgp3d - Requests 3D graphical output through Starlink PGPLOT.
- -pgp3d)
- grf3d='pgp'
- shift;;
-
-# -pgplot3d - Requests 3D graphical output through native PGPLOT.
- -pgplot3d)
- grf3d='pgplot'
- shift;;
-
-# Once all switches have been read, continue with the rest of the script.
- '') break;;
-
-# Catch unrecognised switches and report an error.
- *)
- echo >&2 "ast_link_adam: unknown argument \""${1}"\" given"
- exit 1;;
- esac
- done
-
-# Link with the main AST library.
-# -------------------------------
-# Start forming the list of arguments with the main AST library itself.
- args='-last'
-
-# Generate arguments for linking PAL.
-# -----------------------------------
-
- case "0" in
-
-# If we configured --with-external_pal include a link option to pick up
-# an external PAL library.
- 1) args="${args} -lpal";;
-
-# Otherwise, use the internal PAL & ERFA libraries.
- *) args="${args} -last_pal";;
-
- esac
-
-# Generate arguments for linking the 2D graphics system.
-# ------------------------------------------------------
- case "${grf}" in
-
-# If using Starlink PGPLOT, link with the AST PGPLOT interface and
-# the Fortran library via the PGP link script.
- pgp) args="${args} -last_pgplot `pgp_link_adam`";;
-
-# If using native PGPLOT, link with the AST PGPLOT interface and
-# the Fortran library via the PGPLOT link script.
- pgplot) args="${args} -last_pgplot `pgplot_link_adam`";;
-
-# If using own graphics which conform to the requirements of the current
-# version of AST, do not produce any arguments.
- current) :;;
-
-# If using own graphics which conform to the requirements of version 5.6
-# of AST, produce arguments which link in dummy implementations of any
-# functions which are required by the current version of AST but which were
-# not required by version 5.6.
- v5.6) :;;
-
-# If using own graphics which conform to the requirements of version 3.2
-# of AST, produce arguments which link in dummy implementations of any
-# functions which are required by the current version of AST but which were
-# not required by version 3.2.
- v3.2) args="${args} -last_grf_5.6";;
-
-# If using own graphics which conform to the requirements of version 2.0
-# of AST, produce arguments which link in dummy implementations of any
-# functions which are required by the current version of AST but which were
-# not required by version 2.0.
- v2.0) args="${args} -last_grf_3.2 -last_grf_5.6";;
-
-# Default graphics (none) requires linking with all the default (null) AST
-# "grf" modules.
- *) args="${args} -last_grf_2.0 -last_grf_3.2 -last_grf_5.6";;
- esac
-
-# Generate arguments for linking the 3D graphics system.
-# ------------------------------------------------------
- case "${grf3d}" in
-
-# If using Starlink PGPLOT, link with the AST 3D PGPLOT interface and
-# the Fortran library via the PGP link script (if found).
- pgp) args="${args} -last_pgplot3d `\`find pgp_link\``"
- f77='y';;
-
-# If using native PGPLOT, link with the AST 3D PGPLOT interface and the
-# Fortran library via the PGPLOT link script (if found).
- pgplot) args="${args} -last_pgplot3d `\`find pgplot_link\``"
- f77='y';;
-
-# If using own 3D graphics which conform to the requirements of the current
-# version of AST, do not produce any arguments.
- current) :;;
-
-# Default graphics (none) requires linking with all the default (null) AST
-# "grf3d" modules.
- *) args="${args} -last_grf3d";;
- esac
-
-# Make a second pass through the AST library.
-# -------------------------------------------
-# This library is a link to the main AST library and results in a second
-# pass to resolve any backward references generated by the other modules
-# used above. A different library name must be used to avoid the two passes
-# being merged into one (either below, or by other link scripts).
- args="${args} -last_pass2"
-
-# Generate arguments for linking the error reporting system.
-# ----------------------------------------------------------
- case "${err}" in
-
-# If using own error reporting, do not produce any arguments.
- my) :;;
-
-# Default error reporting requires linking with the AST EMS interface and
-# the EMS library via the link script.
- *) args="${args} -last_ems `ems_link_adam`";;
- esac
-
-# Link with the maths library.
-# ----------------------------
- args="${args} -lm"
-
-# Link with the starmem library, if available.
-# --------------------------------------------
- args="${args} `\`find starmem_link\``"
-
-# Pass the resulting argument list through an awk script which eliminates
-# all except the last reference to each library.
- echo "${args}" \
- | awk 'BEGIN{RS=" ";FS="\n"}
- {if($1)f[i++]=$1}
- END{for(;i--;)if(!w[f[i]]++)l=f[i]" "l;print l}'
-
-# End of script.
diff --git a/ast/cminpack/.deps/libast_la-dpmpar.Plo b/ast/cminpack/.deps/libast_la-dpmpar.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-dpmpar.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-enorm.Plo b/ast/cminpack/.deps/libast_la-enorm.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-enorm.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-lmder.Plo b/ast/cminpack/.deps/libast_la-lmder.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-lmder.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-lmder1.Plo b/ast/cminpack/.deps/libast_la-lmder1.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-lmder1.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-lmpar.Plo b/ast/cminpack/.deps/libast_la-lmpar.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-lmpar.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-qrfac.Plo b/ast/cminpack/.deps/libast_la-qrfac.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-qrfac.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/.deps/libast_la-qrsolv.Plo b/ast/cminpack/.deps/libast_la-qrsolv.Plo
deleted file mode 100644
index 9ce06a8..0000000
--- a/ast/cminpack/.deps/libast_la-qrsolv.Plo
+++ /dev/null
@@ -1 +0,0 @@
-# dummy
diff --git a/ast/cminpack/CopyrightMINPACK.txt b/ast/cminpack/CopyrightMINPACK.txt
deleted file mode 100644
index ae7984d..0000000
--- a/ast/cminpack/CopyrightMINPACK.txt
+++ /dev/null
@@ -1,52 +0,0 @@
-Minpack Copyright Notice (1999) University of Chicago. All rights reserved
-
-Redistribution and use in source and binary forms, with or
-without modification, are permitted provided that the
-following conditions are met:
-
-1. Redistributions of source code must retain the above
-copyright notice, this list of conditions and the following
-disclaimer.
-
-2. Redistributions in binary form must reproduce the above
-copyright notice, this list of conditions and the following
-disclaimer in the documentation and/or other materials
-provided with the distribution.
-
-3. The end-user documentation included with the
-redistribution, if any, must include the following
-acknowledgment:
-
- "This product includes software developed by the
- University of Chicago, as Operator of Argonne National
- Laboratory.
-
-Alternately, this acknowledgment may appear in the software
-itself, if and wherever such third-party acknowledgments
-normally appear.
-
-4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
-WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
-UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
-THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
-OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
-OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
-OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
-USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
-THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
-DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
-UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
-BE CORRECTED.
-
-5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
-HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
-ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
-INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
-ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
-PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
-SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
-(INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
-EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
-POSSIBILITY OF SUCH LOSS OR DAMAGES.
-
diff --git a/ast/cminpack/README.md b/ast/cminpack/README.md
deleted file mode 100644
index 66bbc6f..0000000
--- a/ast/cminpack/README.md
+++ /dev/null
@@ -1,128 +0,0 @@
-C/C++ Minpack [![Build Status](https://api.travis-ci.org/devernay/cminpack.png?branch=master)](https://travis-ci.org/devernay/cminpack)
-==========
-
-This is a C version of the minpack minimization package.
-It has been derived from the fortran code using f2c and
-some limited manual editing. Note that you need to link
-against libf2c to use this version of minpack. Extern "C"
-linkage permits the package routines to be called from C++.
-Check ftp://netlib.bell-labs.com/netlib/f2c for the latest
-f2c version. For general minpack info and test programs, see
-the accompanying readme.txt and http://www.netlib.org/minpack/.
-
-Type `make` to compile and `make install` to install in /usr/local
-or modify the makefile to suit your needs.
-
-This software has been tested on a RedHat 7.3 Linux machine -
-usual 'use at your own risk' warnings apply.
-
-Manolis Lourakis -- lourakis at ics forth gr, July 2002
- Institute of Computer Science,
- Foundation for Research and Technology - Hellas
- Heraklion, Crete, Greece
-
-Repackaging by Frederic Devernay -- frederic dot devernay at m4x dot org
-
-The project home page is at http://devernay.free.fr/hacks/cminpack/
-
-History
-------
-
-* version 1.3.3 (04/02/2014)::
- - Add documentation and examples abouts how to add box constraints to the variables.
- - continuous integration https://travis-ci.org/devernay/cminpack
-
-* version 1.3.2 (27/10/2013):
- - Minor change in the CMake build: also set SOVERSION.
-
-* version 1.3.1 (02/10/2013):
- - Fix CUDA examples compilation, and remove non-free files.
-
-* version 1.3.0 (09/06/2012):
- - Optionally use LAPACK and CBLAS in lmpar, qrfac, and qrsolv. Added
- "make lapack" to build the LAPACK-based cminpack and "make
- checklapack" to test it (results of the test may depend on the
- underlying LAPACK and BLAS implementations).
- On 64-bits architectures, the preprocessor symbol __LP64__ must be
- defined (see cminpackP.h) if the LAPACK library uses the LP64
- interface (i.e. 32-bits integer, vhereas the ILP interface uses 64
- bits integers).
-
-* version 1.2.2 (16/05/2012):
- - Update Makefiles and documentation (see "Using CMinpack" above) for
- easier building and testing.
-
-* version 1.2.1 (15/05/2012):
- - The library can now be built as double, float or half
- versions. Standard tests in the "examples" directory can now be
- lauched using "make check" (to run common tests, including against
- the float version), "make checkhalf" (to test the half version) and
- "make checkfail" (to run all the tests, even those that fail).
-
-* version 1.2.0 (14/05/2012):
-- Added original FORTRAN sources for better testing (type "make" in
- directory fortran, then "make" in examples and follow the
- instructions). Added driver tests lmsdrv, chkdrv, hyjdrv,
- hybdrv. Typing "make alltest" in the examples directory will run all
- possible test combinations (make sure you have gfortran installed).
-
-* version 1.1.5 (04/05/2012):
- - cminpack now works in CUDA, thanks to Jordi Bataller Mascarell, type
- "make" in the "cuda" subdir (be careful, though: this is a
- straightforward port from C, and each problem is solved using a
- single thread). cminpack can now also be compiled with
- single-precision floating point computation (define
- __cminpack_real__ to float when compiling and using the
- library). Fix cmake support for CMINPACK_LIB_INSTALL_DIR. Update the
- reference files for tests.
-
-* version 1.1.4 (30/10/2011):
- - Translated all the Levenberg-Marquardt code (lmder, lmdif, lmstr,
- lmder1, lmdif1, lmstr1, lmpar, qrfac, qrsolv, fdjac2, chkder) to use
- C-style indices.
-
-* version 1.1.3 (16/03/2011):
- - Minor fix: Change non-standard strnstr() to strstr() in
- genf77tests.c.
-
-* version 1.1.2 (07/01/2011):
- - Fix Windows DLL building (David Graeff) and document covar in
- cminpack.h.
-
-* version 1.1.1 (04/12/2010):
- - Complete rewrite of the C functions (without trailing underscore in
- the function name). Using the original FORTRAN code, the original
- algorithms structure was recovered, and many goto's were converted
- to if...then...else. The code should now be both more readable and
- easier to optimize, both for humans and for compilers. Added lmddrv
- and lmfdrv test drivers, which test a lot of difficult functions
- (these functions are explained in Testing Unconstrained Optimization
- Software by Moré et al.). Also added the pkg-config files to the
- cmake build, as well as an "uninstall" target, contributed by
- Geoffrey Biggs.
-
-* version 1.0.4 (18/10/2010):
- - Support for shared library building using CMake, thanks to Goeffrey
- Biggs and Radu Bogdan Rusu from Willow Garage. Shared libraries can be
- enabled using cmake options, as in;
- cmake -DUSE_FPIC=ON -DSHARED_LIBS=ON -DBUILD_EXAMPLES=OFF path_to_sources
-
-* version 1.0.3 (18/03/2010):
- - Added CMake support.
- - XCode build is now Universal.
- - Added tfdjac2_ and tfdjac2c examples, which test the accuracy of a
- finite-differences approximation of the Jacobian.
- - Bug fix in tlmstr1 (signaled by Thomas Capricelli).
-
-* version 1.0.2 (27/02/2009):
- - Added Xcode and Visual Studio project files
-
-* version 1.0.1 (17/12/2007):
- - bug fix in covar() and covar_(), the computation of tolr caused a
- segfault (signaled by Timo Hartmann).
-
-* version 1.0.0 (24/04/2007):
- - Added fortran and C examples
- - Added documentation from Debian man pages
- - Wrote pure C version
- - Added covar() and covar_(), and use it in tlmdef/tlmdif
diff --git a/ast/cminpack/cminpack.h b/ast/cminpack/cminpack.h
deleted file mode 100644
index 6d3f757..0000000
--- a/ast/cminpack/cminpack.h
+++ /dev/null
@@ -1,370 +0,0 @@
-/* Header file for cminpack, by Frederic Devernay.
- The documentation for all functions can be found in the file
- minpack-documentation.txt from the distribution, or in the source
- code of each function. */
-
-#ifndef __CMINPACK_H__
-#define __CMINPACK_H__
-
-/* The default floating-point type is "double" for C/C++ and "float" for CUDA,
- but you can change this by defining one of the following symbols when
- compiling the library, and before including cminpack.h when using it:
- __cminpack_double__ for double
- __cminpack_float__ for float
- __cminpack_half__ for half from the OpenEXR library (in this case, you must
- compile cminpack with a C++ compiler)
-*/
-#ifdef __cminpack_double__
-#define __cminpack_real__ double
-#endif
-
-#ifdef __cminpack_float__
-#define __cminpack_real__ float
-#endif
-
-#ifdef __cminpack_half__
-#include <OpenEXR/half.h>
-#define __cminpack_real__ half
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif /* __cplusplus */
-
-/* Cmake will define cminpack_EXPORTS on Windows when it
-configures to build a shared library. If you are going to use
-another build system on windows or create the visual studio
-projects by hand you need to define cminpack_EXPORTS when
-building a DLL on windows.
-*/
-#if defined (__GNUC__)
-#define CMINPACK_DECLSPEC_EXPORT __declspec(__dllexport__)
-#define CMINPACK_DECLSPEC_IMPORT __declspec(__dllimport__)
-#endif
-#if defined (_MSC_VER) || defined (__BORLANDC__)
-#define CMINPACK_DECLSPEC_EXPORT __declspec(dllexport)
-#define CMINPACK_DECLSPEC_IMPORT __declspec(dllimport)
-#endif
-#ifdef __WATCOMC__
-#define CMINPACK_DECLSPEC_EXPORT __export
-#define CMINPACK_DECLSPEC_IMPORT __import
-#endif
-#ifdef __IBMC__
-#define CMINPACK_DECLSPEC_EXPORT _Export
-#define CMINPACK_DECLSPEC_IMPORT _Import
-#endif
-
-#if !defined(CMINPACK_NO_DLL) && (defined(__WIN32__) || defined(WIN32) || defined (_WIN32))
-#if defined(cminpack_EXPORTS) || defined(CMINPACK_EXPORTS) || defined(CMINPACK_DLL_EXPORTS)
- #define CMINPACK_EXPORT CMINPACK_DECLSPEC_EXPORT
- #else
- #define CMINPACK_EXPORT CMINPACK_DECLSPEC_IMPORT
- #endif /* cminpack_EXPORTS */
-#else /* defined (_WIN32) */
- #define CMINPACK_EXPORT
-#endif
-
-#if defined(__CUDA_ARCH__) || defined(__CUDACC__)
-#define __cminpack_attr__ __device__
-#ifndef __cminpack_real__
-#define __cminpack_float__
-#define __cminpack_real__ float
-#endif
-#define __cminpack_type_fcn_nn__ __cminpack_attr__ int fcn_nn
-#define __cminpack_type_fcnder_nn__ __cminpack_attr__ int fcnder_nn
-#define __cminpack_type_fcn_mn__ __cminpack_attr__ int fcn_mn
-#define __cminpack_type_fcnder_mn__ __cminpack_attr__ int fcnder_mn
-#define __cminpack_type_fcnderstr_mn__ __cminpack_attr__ int fcnderstr_mn
-#define __cminpack_decl_fcn_nn__
-#define __cminpack_decl_fcnder_nn__
-#define __cminpack_decl_fcn_mn__
-#define __cminpack_decl_fcnder_mn__
-#define __cminpack_decl_fcnderstr_mn__
-#define __cminpack_param_fcn_nn__
-#define __cminpack_param_fcnder_nn__
-#define __cminpack_param_fcn_mn__
-#define __cminpack_param_fcnder_mn__
-#define __cminpack_param_fcnderstr_mn__
-#else
-#define __cminpack_attr__
-#ifndef __cminpack_real__
-#define __cminpack_double__
-#define __cminpack_real__ double
-#endif
-#define __cminpack_type_fcn_nn__ typedef int (*cminpack_func_nn)
-#define __cminpack_type_fcnder_nn__ typedef int (*cminpack_funcder_nn)
-#define __cminpack_type_fcn_mn__ typedef int (*cminpack_func_mn)
-#define __cminpack_type_fcnder_mn__ typedef int (*cminpack_funcder_mn)
-#define __cminpack_type_fcnderstr_mn__ typedef int (*cminpack_funcderstr_mn)
-#define __cminpack_decl_fcn_nn__ cminpack_func_nn fcn_nn,
-#define __cminpack_decl_fcnder_nn__ cminpack_funcder_nn fcnder_nn,
-#define __cminpack_decl_fcn_mn__ cminpack_func_mn fcn_mn,
-#define __cminpack_decl_fcnder_mn__ cminpack_funcder_mn fcnder_mn,
-#define __cminpack_decl_fcnderstr_mn__ cminpack_funcderstr_mn fcnderstr_mn,
-#define __cminpack_param_fcn_nn__ fcn_nn,
-#define __cminpack_param_fcnder_nn__ fcnder_nn,
-#define __cminpack_param_fcn_mn__ fcn_mn,
-#define __cminpack_param_fcnder_mn__ fcnder_mn,
-#define __cminpack_param_fcnderstr_mn__ fcnderstr_mn,
-#endif
-
-#ifdef __cminpack_double__
-#define __cminpack_func__(func) func
-#endif
-
-#ifdef __cminpack_float__
-#define __cminpack_func__(func) s ## func
-#endif
-
-#ifdef __cminpack_half__
-#define __cminpack_func__(func) h ## func
-#endif
-
-/* Declarations for minpack */
-
-/* Function types: */
-/* The first argument can be used to store extra function parameters, thus */
-/* avoiding the use of global variables. */
-/* the iflag parameter is input-only (with respect to the FORTRAN */
-/* version), the output iflag value is the return value of the function. */
-/* If iflag=0, the function shoulkd just print the current values (see */
-/* the nprint parameters below). */
-
-/* for hybrd1 and hybrd: */
-/* calculate the functions at x and */
-/* return this vector in fvec. */
-/* return a negative value to terminate hybrd1/hybrd */
-__cminpack_type_fcn_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, int iflag );
-
-/* for hybrj1 and hybrj */
-/* if iflag = 1 calculate the functions at x and */
-/* return this vector in fvec. do not alter fjac. */
-/* if iflag = 2 calculate the jacobian at x and */
-/* return this matrix in fjac. do not alter fvec. */
-/* return a negative value to terminate hybrj1/hybrj */
-__cminpack_type_fcnder_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, int iflag );
-
-/* for lmdif1 and lmdif */
-/* calculate the functions at x and */
-/* return this vector in fvec. */
-/* if iflag = 1 the result is used to compute the residuals. */
-/* if iflag = 2 the result is used to compute the Jacobian by finite differences. */
-/* Jacobian computation requires exactly n function calls with iflag = 2. */
-/* return a negative value to terminate lmdif1/lmdif */
-__cminpack_type_fcn_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
- int iflag );
-
-/* for lmder1 and lmder */
-/* if iflag = 1 calculate the functions at x and */
-/* return this vector in fvec. do not alter fjac. */
-/* if iflag = 2 calculate the jacobian at x and */
-/* return this matrix in fjac. do not alter fvec. */
-/* return a negative value to terminate lmder1/lmder */
-__cminpack_type_fcnder_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
- __cminpack_real__ *fjac, int ldfjac, int iflag );
-
-/* for lmstr1 and lmstr */
-/* if iflag = 1 calculate the functions at x and */
-/* return this vector in fvec. */
-/* if iflag = i calculate the (i-1)-st row of the */
-/* jacobian at x and return this vector in fjrow. */
-/* return a negative value to terminate lmstr1/lmstr */
-__cminpack_type_fcnderstr_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
- __cminpack_real__ *fjrow, int iflag );
-
-
-
-
-
-
-/* MINPACK functions: */
-/* the info parameter was removed from most functions: the return */
-/* value of the function is used instead. */
-/* The argument 'p' can be used to store extra function parameters, thus */
-/* avoiding the use of global variables. You can also think of it as a */
-/* 'this' pointer a la C++. */
-
-/* find a zero of a system of N nonlinear functions in N variables by
- a modification of the Powell hybrid method (Jacobian calculated by
- a forward-difference approximation) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(hybrd1)( __cminpack_decl_fcn_nn__
- void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
- __cminpack_real__ *wa, int lwa );
-
-/* find a zero of a system of N nonlinear functions in N variables by
- a modification of the Powell hybrid method (Jacobian calculated by
- a forward-difference approximation, more general). */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(hybrd)( __cminpack_decl_fcn_nn__
- void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ xtol, int maxfev,
- int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *diag, int mode,
- __cminpack_real__ factor, int nprint, int *nfev,
- __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ *r, int lr, __cminpack_real__ *qtf,
- __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3, __cminpack_real__ *wa4);
-
-/* find a zero of a system of N nonlinear functions in N variables by
- a modification of the Powell hybrid method (user-supplied Jacobian) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(hybrj1)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
- __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ tol,
- __cminpack_real__ *wa, int lwa );
-
-/* find a zero of a system of N nonlinear functions in N variables by
- a modification of the Powell hybrid method (user-supplied Jacobian,
- more general) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(hybrj)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
- __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ xtol,
- int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
- int nprint, int *nfev, int *njev, __cminpack_real__ *r,
- int lr, __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2,
- __cminpack_real__ *wa3, __cminpack_real__ *wa4 );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (Jacobian calculated by a forward-difference approximation) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmdif1)( __cminpack_decl_fcn_mn__
- void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
- int *iwa, __cminpack_real__ *wa, int lwa );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (Jacobian calculated by a forward-difference approximation, more
- general) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmdif)( __cminpack_decl_fcn_mn__
- void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ ftol,
- __cminpack_real__ xtol, __cminpack_real__ gtol, int maxfev, __cminpack_real__ epsfcn,
- __cminpack_real__ *diag, int mode, __cminpack_real__ factor, int nprint,
- int *nfev, __cminpack_real__ *fjac, int ldfjac, int *ipvt,
- __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
- __cminpack_real__ *wa4 );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (user-supplied Jacobian) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmder1)( __cminpack_decl_fcnder_mn__
- void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, __cminpack_real__ tol, int *ipvt,
- __cminpack_real__ *wa, int lwa );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (user-supplied Jacobian, more general) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmder)( __cminpack_decl_fcnder_mn__
- void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
- int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
- int nprint, int *nfev, int *njev, int *ipvt,
- __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
- __cminpack_real__ *wa4 );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (user-supplied Jacobian, minimal storage) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmstr1)( __cminpack_decl_fcnderstr_mn__ void *p, int m, int n,
- __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
- __cminpack_real__ tol, int *ipvt, __cminpack_real__ *wa, int lwa );
-
-/* minimize the sum of the squares of nonlinear functions in N
- variables by a modification of the Levenberg-Marquardt algorithm
- (user-supplied Jacobian, minimal storage, more general) */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(lmstr)( __cminpack_decl_fcnderstr_mn__ void *p, int m,
- int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
- int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
- int nprint, int *nfev, int *njev, int *ipvt,
- __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
- __cminpack_real__ *wa4 );
-
-__cminpack_attr__
-void CMINPACK_EXPORT __cminpack_func__(chkder)( int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, __cminpack_real__ *xp, __cminpack_real__ *fvecp, int mode,
- __cminpack_real__ *err );
-
-__cminpack_attr__
-__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(dpmpar)( int i );
-
-__cminpack_attr__
-__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(enorm)( int n, const __cminpack_real__ *x );
-
-/* compute a forward-difference approximation to the m by n jacobian
- matrix associated with a specified problem of m functions in n
- variables. */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(fdjac2)(__cminpack_decl_fcn_mn__
- void *p, int m, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac,
- int ldfjac, __cminpack_real__ epsfcn, __cminpack_real__ *wa);
-
-/* compute a forward-difference approximation to the n by n jacobian
- matrix associated with a specified problem of n functions in n
- variables. if the jacobian has a banded form, then function
- evaluations are saved by only approximating the nonzero terms. */
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(fdjac1)(__cminpack_decl_fcn_nn__
- void *p, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
- int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *wa1,
- __cminpack_real__ *wa2);
-
-/* compute inverse(JtJ) after a run of lmdif or lmder. The covariance matrix is obtained
- by scaling the result by enorm(y)**2/(m-n). If JtJ is singular and k = rank(J), the
- pseudo-inverse is computed, and the result has to be scaled by enorm(y)**2/(m-k). */
-__cminpack_attr__
-void CMINPACK_EXPORT __cminpack_func__(covar)(int n, __cminpack_real__ *r, int ldr,
- const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
-
-/* covar1 estimates the variance-covariance matrix:
- C = sigma**2 (JtJ)**+
- where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
- and sigma**2 = fsumsq / (m - k)
- where fsumsq is the residual sum of squares and k is the rank of J.
- The function returns 0 if J has full rank, else the rank of J.
-*/
-__cminpack_attr__
-int CMINPACK_EXPORT __cminpack_func__(covar1)(int m, int n, __cminpack_real__ fsumsq, __cminpack_real__ *r, int ldr,
- const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
-
-/* internal MINPACK subroutines */
-__cminpack_attr__
-void __cminpack_func__(dogleg)(int n, const __cminpack_real__ *r, int lr,
- const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta, __cminpack_real__ *x,
- __cminpack_real__ *wa1, __cminpack_real__ *wa2);
-__cminpack_attr__
-void __cminpack_func__(qrfac)(int m, int n, __cminpack_real__ *a, int
- lda, int pivot, int *ipvt, int lipvt, __cminpack_real__ *rdiag,
- __cminpack_real__ *acnorm, __cminpack_real__ *wa);
-__cminpack_attr__
-void __cminpack_func__(qrsolv)(int n, __cminpack_real__ *r, int ldr,
- const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ *x,
- __cminpack_real__ *sdiag, __cminpack_real__ *wa);
-__cminpack_attr__
-void __cminpack_func__(qform)(int m, int n, __cminpack_real__ *q, int
- ldq, __cminpack_real__ *wa);
-__cminpack_attr__
-void __cminpack_func__(r1updt)(int m, int n, __cminpack_real__ *s, int
- ls, const __cminpack_real__ *u, __cminpack_real__ *v, __cminpack_real__ *w, int *sing);
-__cminpack_attr__
-void __cminpack_func__(r1mpyq)(int m, int n, __cminpack_real__ *a, int
- lda, const __cminpack_real__ *v, const __cminpack_real__ *w);
-__cminpack_attr__
-void __cminpack_func__(lmpar)(int n, __cminpack_real__ *r, int ldr,
- const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta,
- __cminpack_real__ *par, __cminpack_real__ *x, __cminpack_real__ *sdiag, __cminpack_real__ *wa1,
- __cminpack_real__ *wa2);
-__cminpack_attr__
-void __cminpack_func__(rwupdt)(int n, __cminpack_real__ *r, int ldr,
- const __cminpack_real__ *w, __cminpack_real__ *b, __cminpack_real__ *alpha, __cminpack_real__ *cos,
- __cminpack_real__ *sin);
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-
-#endif /* __CMINPACK_H__ */
diff --git a/ast/cminpack/cminpackP.h b/ast/cminpack/cminpackP.h
deleted file mode 100644
index 4e8ba7b..0000000
--- a/ast/cminpack/cminpackP.h
+++ /dev/null
@@ -1,62 +0,0 @@
-/* Internal header file for cminpack, by Frederic Devernay. */
-#ifndef __CMINPACKP_H__
-#define __CMINPACKP_H__
-
-#ifndef __CMINPACK_H__
-#error "cminpackP.h in an internal cminpack header, and must be included after all other headers (including cminpack.h)"
-#endif
-
-#if (defined (USE_CBLAS) || defined (USE_LAPACK)) && !defined (__cminpack_double__)
-#error "cminpack can use cblas and lapack only in double precision mode"
-#endif
-
-#ifdef USE_CBLAS
-#ifdef __APPLE__
-#include <Accelerate/Accelerate.h>
-#else
-#include <cblas.h>
-#endif
-#define __cminpack_enorm__(n,x) cblas_dnrm2(n,x,1)
-#else
-#define __cminpack_enorm__(n,x) __cminpack_func__(enorm)(n,x)
-#endif
-
-#ifdef USE_LAPACK
-#ifdef __APPLE__
-#include <Accelerate/Accelerate.h>
-#else
-#if defined(__LP64__) /* In LP64 match sizes with the 32 bit ABI */
-typedef int __CLPK_integer;
-typedef int __CLPK_logical;
-typedef float __CLPK_real;
-typedef double __CLPK_doublereal;
-typedef __CLPK_logical (*__CLPK_L_fp)();
-typedef int __CLPK_ftnlen;
-#else
-typedef long int __CLPK_integer;
-typedef long int __CLPK_logical;
-typedef float __CLPK_real;
-typedef double __CLPK_doublereal;
-typedef __CLPK_logical (*__CLPK_L_fp)();
-typedef long int __CLPK_ftnlen;
-#endif
-//extern void dlartg_(double *f, double *g, double *cs, double *sn, double *r__);
-int dlartg_(__CLPK_doublereal *f, __CLPK_doublereal *g, __CLPK_doublereal *cs,
- __CLPK_doublereal *sn, __CLPK_doublereal *r__)
-//extern void dgeqp3_(int *m, int *n, double *a, int *lda, int *jpvt, double *tau, double *work, int *lwork, int *info);
-int dgeqp3_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
- lda, __CLPK_integer *jpvt, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork,
- __CLPK_integer *info)
-//extern void dgeqrf_(int *m, int *n, double *a, int *lda, double *tau, double *work, int *lwork, int *info);
-int dgeqrf_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
- lda, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork, __CLPK_integer *info)
-#endif
-#endif
-
-#define real __cminpack_real__
-#define min(a,b) ((a) <= (b) ? (a) : (b))
-#define max(a,b) ((a) >= (b) ? (a) : (b))
-#define TRUE_ (1)
-#define FALSE_ (0)
-
-#endif /* !__CMINPACKP_H__ */
diff --git a/ast/cminpack/dpmpar.c b/ast/cminpack/dpmpar.c
deleted file mode 100644
index 81c6fcd..0000000
--- a/ast/cminpack/dpmpar.c
+++ /dev/null
@@ -1,201 +0,0 @@
-#include "cminpack.h"
-#include <float.h>
-#include "cminpackP.h"
-
-#define double_EPSILON DBL_EPSILON
-#define double_MIN DBL_MIN
-#define double_MAX DBL_MAX
-#define float_EPSILON FLT_EPSILON
-#define float_MIN FLT_MIN
-#define float_MAX FLT_MAX
-#define half_EPSILON HALF_EPSILON
-#define half_MIN HALF_NRM_MIN
-#define half_MAX HALF_MAX
-
-#define DPMPAR(type,X) _DPMPAR(type,X)
-#define _DPMPAR(type,X) type ## _ ## X
-
-__cminpack_attr__
-real __cminpack_func__(dpmpar)(int i)
-{
-/* ********** */
-
-/* Function dpmpar */
-
-/* This function provides double precision machine parameters */
-/* when the appropriate set of data statements is activated (by */
-/* removing the c from column 1) and all other data statements are */
-/* rendered inactive. Most of the parameter values were obtained */
-/* from the corresponding Bell Laboratories Port Library function. */
-
-/* The function statement is */
-
-/* double precision function dpmpar(i) */
-
-/* where */
-
-/* i is an integer input variable set to 1, 2, or 3 which */
-/* selects the desired machine parameter. If the machine has */
-/* t base b digits and its smallest and largest exponents are */
-/* emin and emax, respectively, then these parameters are */
-
-/* dpmpar(1) = b**(1 - t), the machine precision, */
-
-/* dpmpar(2) = b**(emin - 1), the smallest magnitude, */
-
-/* dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. */
-
-/* Argonne National Laboratory. MINPACK Project. November 1996. */
-/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' */
-
-/* ********** */
-
-/* Machine constants for the IBM 360/370 series, */
-/* the Amdahl 470/V6, the ICL 2900, the Itel AS/6, */
-/* the Xerox Sigma 5/7/9 and the Sel systems 85/86. */
-
-/* data mcheps(1),mcheps(2) / z34100000, z00000000 / */
-/* data minmag(1),minmag(2) / z00100000, z00000000 / */
-/* data maxmag(1),maxmag(2) / z7fffffff, zffffffff / */
-
-/* Machine constants for the Honeywell 600/6000 series. */
-
-/* data mcheps(1),mcheps(2) / o606400000000, o000000000000 / */
-/* data minmag(1),minmag(2) / o402400000000, o000000000000 / */
-/* data maxmag(1),maxmag(2) / o376777777777, o777777777777 / */
-
-/* Machine constants for the CDC 6000/7000 series. */
-
-/* data mcheps(1) / 15614000000000000000b / */
-/* data mcheps(2) / 15010000000000000000b / */
-
-/* data minmag(1) / 00604000000000000000b / */
-/* data minmag(2) / 00000000000000000000b / */
-
-/* data maxmag(1) / 37767777777777777777b / */
-/* data maxmag(2) / 37167777777777777777b / */
-
-/* Machine constants for the PDP-10 (KA processor). */
-
-/* data mcheps(1),mcheps(2) / "114400000000, "000000000000 / */
-/* data minmag(1),minmag(2) / "033400000000, "000000000000 / */
-/* data maxmag(1),maxmag(2) / "377777777777, "344777777777 / */
-
-/* Machine constants for the PDP-10 (KI processor). */
-
-/* data mcheps(1),mcheps(2) / "104400000000, "000000000000 / */
-/* data minmag(1),minmag(2) / "000400000000, "000000000000 / */
-/* data maxmag(1),maxmag(2) / "377777777777, "377777777777 / */
-
-/* Machine constants for the PDP-11. */
-
-/* data mcheps(1),mcheps(2) / 9472, 0 / */
-/* data mcheps(3),mcheps(4) / 0, 0 / */
-
-/* data minmag(1),minmag(2) / 128, 0 / */
-/* data minmag(3),minmag(4) / 0, 0 / */
-
-/* data maxmag(1),maxmag(2) / 32767, -1 / */
-/* data maxmag(3),maxmag(4) / -1, -1 / */
-
-/* Machine constants for the Burroughs 6700/7700 systems. */
-
-/* data mcheps(1) / o1451000000000000 / */
-/* data mcheps(2) / o0000000000000000 / */
-
-/* data minmag(1) / o1771000000000000 / */
-/* data minmag(2) / o7770000000000000 / */
-
-/* data maxmag(1) / o0777777777777777 / */
-/* data maxmag(2) / o7777777777777777 / */
-
-/* Machine constants for the Burroughs 5700 system. */
-
-/* data mcheps(1) / o1451000000000000 / */
-/* data mcheps(2) / o0000000000000000 / */
-
-/* data minmag(1) / o1771000000000000 / */
-/* data minmag(2) / o0000000000000000 / */
-
-/* data maxmag(1) / o0777777777777777 / */
-/* data maxmag(2) / o0007777777777777 / */
-
-/* Machine constants for the Burroughs 1700 system. */
-
-/* data mcheps(1) / zcc6800000 / */
-/* data mcheps(2) / z000000000 / */
-
-/* data minmag(1) / zc00800000 / */
-/* data minmag(2) / z000000000 / */
-
-/* data maxmag(1) / zdffffffff / */
-/* data maxmag(2) / zfffffffff / */
-
-/* Machine constants for the Univac 1100 series. */
-
-/* data mcheps(1),mcheps(2) / o170640000000, o000000000000 / */
-/* data minmag(1),minmag(2) / o000040000000, o000000000000 / */
-/* data maxmag(1),maxmag(2) / o377777777777, o777777777777 / */
-
-/* Machine constants for the Data General Eclipse S/200. */
-
-/* Note - it may be appropriate to include the following card - */
-/* static dmach(3) */
-
-/* data minmag/20k,3*0/,maxmag/77777k,3*177777k/ */
-/* data mcheps/32020k,3*0/ */
-
-/* Machine constants for the Harris 220. */
-
-/* data mcheps(1),mcheps(2) / '20000000, '00000334 / */
-/* data minmag(1),minmag(2) / '20000000, '00000201 / */
-/* data maxmag(1),maxmag(2) / '37777777, '37777577 / */
-
-/* Machine constants for the Cray-1. */
-
-/* data mcheps(1) / 0376424000000000000000b / */
-/* data mcheps(2) / 0000000000000000000000b / */
-
-/* data minmag(1) / 0200034000000000000000b / */
-/* data minmag(2) / 0000000000000000000000b / */
-
-/* data maxmag(1) / 0577777777777777777777b / */
-/* data maxmag(2) / 0000007777777777777776b / */
-
-/* Machine constants for the Prime 400. */
-
-/* data mcheps(1),mcheps(2) / :10000000000, :00000000123 / */
-/* data minmag(1),minmag(2) / :10000000000, :00000100000 / */
-/* data maxmag(1),maxmag(2) / :17777777777, :37777677776 / */
-
-/* Machine constants for the VAX-11. */
-
-/* data mcheps(1),mcheps(2) / 9472, 0 / */
-/* data minmag(1),minmag(2) / 128, 0 / */
-/* data maxmag(1),maxmag(2) / -32769, -1 / */
-
-/* Machine constants for IEEE machines. */
-
-/* data dmach(1) /2.22044604926d-16/ */
-/* data dmach(2) /2.22507385852d-308/ */
-/* data dmach(3) /1.79769313485d+308/ */
-
- switch(i) {
- case 1:
- return DPMPAR(real,EPSILON); /* 2.2204460492503131e-16 | 1.19209290e-07F */
- case 2:
- return DPMPAR(real,MIN); /* 2.2250738585072014e-308 | 1.17549435e-38F */
- default:
- return DPMPAR(real,MAX); /* 1.7976931348623157e+308 | 3.40282347e+38F */
- }
-
-/* Last card of function dpmpar. */
-
-} /* dpmpar_ */
-
-#undef mcheps
-#undef maxmag
-#undef minmag
-#undef dmach
-
-
diff --git a/ast/cminpack/enorm.c b/ast/cminpack/enorm.c
deleted file mode 100644
index ad10824..0000000
--- a/ast/cminpack/enorm.c
+++ /dev/null
@@ -1,157 +0,0 @@
-#include "cminpack.h"
-#include <math.h>
-#include "cminpackP.h"
-
-/*
- About the values for rdwarf and rgiant.
-
- The original values, both in signe-precision FORTRAN source code and in double-precision code were:
-#define rdwarf 3.834e-20
-#define rgiant 1.304e19
- See for example:
- http://www.netlib.org/slatec/src/denorm.f
- http://www.netlib.org/slatec/src/enorm.f
- However, rdwarf is smaller than sqrt(FLT_MIN) = 1.0842021724855044e-19, so that rdwarf**2 will
- underflow. This contradicts the constraints expressed in the comments below.
-
- We changed these constants to be sqrt(dpmpar(2))*0.9 and sqrt(dpmpar(3))*0.9, as proposed by the
- implementation found in MPFIT http://cow.physics.wisc.edu/~craigm/idl/fitting.html
-*/
-
-#define double_dwarf (1.4916681462400413e-154*0.9)
-#define double_giant (1.3407807929942596e+154*0.9)
-#define float_dwarf (1.0842021724855044e-19f*0.9f)
-#define float_giant (1.8446743523953730e+19f*0.9f)
-#define half_dwarf (2.4414062505039999e-4f*0.9f)
-#define half_giant (255.93749236874225497222f*0.9f)
-
-#define dwarf(type) _dwarf(type)
-#define _dwarf(type) type ## _dwarf
-#define giant(type) _giant(type)
-#define _giant(type) type ## _giant
-
-#define rdwarf dwarf(real)
-#define rgiant giant(real)
-
-__cminpack_attr__
-real __cminpack_func__(enorm)(int n, const real *x)
-{
-#ifdef USE_CBLAS
- return cblas_dnrm2(n, x, 1);
-#else /* !USE_CBLAS */
- /* System generated locals */
- real ret_val, d1;
-
- /* Local variables */
- int i;
- real s1, s2, s3, xabs, x1max, x3max, agiant, floatn;
-
-/* ********** */
-
-/* function enorm */
-
-/* given an n-vector x, this function calculates the */
-/* euclidean norm of x. */
-
-/* the euclidean norm is computed by accumulating the sum of */
-/* squares in three different sums. the sums of squares for the */
-/* small and large components are scaled so that no overflows */
-/* occur. non-destructive underflows are permitted. underflows */
-/* and overflows do not occur in the computation of the unscaled */
-/* sum of squares for the intermediate components. */
-/* the definitions of small, intermediate and large components */
-/* depend on two constants, rdwarf and rgiant. the main */
-/* restrictions on these constants are that rdwarf**2 not */
-/* underflow and rgiant**2 not overflow. the constants */
-/* given here are suitable for every known computer. */
-
-/* the function statement is */
-
-/* double precision function enorm(n,x) */
-
-/* where */
-
-/* n is a positive integer input variable. */
-
-/* x is an input array of length n. */
-
-/* subprograms called */
-
-/* fortran-supplied ... dabs,dsqrt */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
-
- s1 = 0.;
- s2 = 0.;
- s3 = 0.;
- x1max = 0.;
- x3max = 0.;
- floatn = (real) (n);
- agiant = rgiant / floatn;
- for (i = 0; i < n; ++i) {
- xabs = fabs(x[i]);
- if (xabs <= rdwarf || xabs >= agiant) {
- if (xabs > rdwarf) {
-
-/* sum for large components. */
-
- if (xabs > x1max) {
- /* Computing 2nd power */
- d1 = x1max / xabs;
- s1 = 1. + s1 * (d1 * d1);
- x1max = xabs;
- } else {
- /* Computing 2nd power */
- d1 = xabs / x1max;
- s1 += d1 * d1;
- }
- } else {
-
-/* sum for small components. */
-
- if (xabs > x3max) {
- /* Computing 2nd power */
- d1 = x3max / xabs;
- s3 = 1. + s3 * (d1 * d1);
- x3max = xabs;
- } else {
- if (xabs != 0.) {
- /* Computing 2nd power */
- d1 = xabs / x3max;
- s3 += d1 * d1;
- }
- }
- }
- } else {
-
-/* sum for intermediate components. */
-
- /* Computing 2nd power */
- s2 += xabs * xabs;
- }
- }
-
-/* calculation of norm. */
-
- if (s1 != 0.) {
- ret_val = x1max * sqrt(s1 + (s2 / x1max) / x1max);
- } else {
- if (s2 != 0.) {
- if (s2 >= x3max) {
- ret_val = sqrt(s2 * (1. + (x3max / s2) * (x3max * s3)));
- } else {
- ret_val = sqrt(x3max * ((s2 / x3max) + (x3max * s3)));
- }
- } else {
- ret_val = x3max * sqrt(s3);
- }
- }
- return ret_val;
-
-/* last card of function enorm. */
-#endif /* !USE_CBLAS */
-} /* enorm_ */
-
diff --git a/ast/cminpack/lmder.c b/ast/cminpack/lmder.c
deleted file mode 100644
index 7f57428..0000000
--- a/ast/cminpack/lmder.c
+++ /dev/null
@@ -1,526 +0,0 @@
-#include "cminpack.h"
-#include <math.h>
-#include "cminpackP.h"
-
-__cminpack_attr__
-int __cminpack_func__(lmder)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
- real *fvec, real *fjac, int ldfjac, real ftol,
- real xtol, real gtol, int maxfev, real *
- diag, int mode, real factor, int nprint,
- int *nfev, int *njev, int *ipvt, real *qtf,
- real *wa1, real *wa2, real *wa3, real *wa4)
-{
- /* Initialized data */
-
-#define p1 .1
-#define p5 .5
-#define p25 .25
-#define p75 .75
-#define p0001 1e-4
-
- /* System generated locals */
- real d1, d2;
-
- /* Local variables */
- int i, j, l;
- real par, sum;
- int iter;
- real temp, temp1, temp2;
- int iflag;
- real delta = 0.;
- real ratio;
- real fnorm, gnorm, pnorm, xnorm = 0., fnorm1, actred, dirder,
- epsmch, prered;
- int info;
-
-/* ********** */
-
-/* subroutine lmder */
-
-/* the purpose of lmder is to minimize the sum of the squares of */
-/* m nonlinear functions in n variables by a modification of */
-/* the levenberg-marquardt algorithm. the user must provide a */
-/* subroutine which calculates the functions and the jacobian. */
-
-/* the subroutine statement is */
-
-/* subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
-/* maxfev,diag,mode,factor,nprint,info,nfev, */
-/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
-
-/* where */
-
-/* fcn is the name of the user-supplied subroutine which */
-/* calculates the functions and the jacobian. fcn must */
-/* be declared in an external statement in the user */
-/* calling program, and should be written as follows. */
-
-/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
-/* integer m,n,ldfjac,iflag */
-/* double precision x(n),fvec(m),fjac(ldfjac,n) */
-/* ---------- */
-/* if iflag = 1 calculate the functions at x and */
-/* return this vector in fvec. do not alter fjac. */
-/* if iflag = 2 calculate the jacobian at x and */
-/* return this matrix in fjac. do not alter fvec. */
-/* ---------- */
-/* return */
-/* end */
-
-/* the value of iflag should not be changed by fcn unless */
-/* the user wants to terminate execution of lmder. */
-/* in this case set iflag to a negative integer. */
-
-/* m is a positive integer input variable set to the number */
-/* of functions. */
-
-/* n is a positive integer input variable set to the number */
-/* of variables. n must not exceed m. */
-
-/* x is an array of length n. on input x must contain */
-/* an initial estimate of the solution vector. on output x */
-/* contains the final estimate of the solution vector. */
-
-/* fvec is an output array of length m which contains */
-/* the functions evaluated at the output x. */
-
-/* fjac is an output m by n array. the upper n by n submatrix */
-/* of fjac contains an upper triangular matrix r with */
-/* diagonal elements of nonincreasing magnitude such that */
-
-/* t t t */
-/* p *(jac *jac)*p = r *r, */
-
-/* where p is a permutation matrix and jac is the final */
-/* calculated jacobian. column j of p is column ipvt(j) */
-/* (see below) of the identity matrix. the lower trapezoidal */
-/* part of fjac contains information generated during */
-/* the computation of r. */
-
-/* ldfjac is a positive integer input variable not less than m */
-/* which specifies the leading dimension of the array fjac. */
-
-/* ftol is a nonnegative input variable. termination */
-/* occurs when both the actual and predicted relative */
-/* reductions in the sum of squares are at most ftol. */
-/* therefore, ftol measures the relative error desired */
-/* in the sum of squares. */
-
-/* xtol is a nonnegative input variable. termination */
-/* occurs when the relative error between two consecutive */
-/* iterates is at most xtol. therefore, xtol measures the */
-/* relative error desired in the approximate solution. */
-
-/* gtol is a nonnegative input variable. termination */
-/* occurs when the cosine of the angle between fvec and */
-/* any column of the jacobian is at most gtol in absolute */
-/* value. therefore, gtol measures the orthogonality */
-/* desired between the function vector and the columns */
-/* of the jacobian. */
-
-/* maxfev is a positive integer input variable. termination */
-/* occurs when the number of calls to fcn with iflag = 1 */
-/* has reached maxfev. */
-
-/* diag is an array of length n. if mode = 1 (see */
-/* below), diag is internally set. if mode = 2, diag */
-/* must contain positive entries that serve as */
-/* multiplicative scale factors for the variables. */
-
-/* mode is an integer input variable. if mode = 1, the */
-/* variables will be scaled internally. if mode = 2, */
-/* the scaling is specified by the input diag. other */
-/* values of mode are equivalent to mode = 1. */
-
-/* factor is a positive input variable used in determining the */
-/* initial step bound. this bound is set to the product of */
-/* factor and the euclidean norm of diag*x if nonzero, or else */
-/* to factor itself. in most cases factor should lie in the */
-/* interval (.1,100.).100. is a generally recommended value. */
-
-/* nprint is an integer input variable that enables controlled */
-/* printing of iterates if it is positive. in this case, */
-/* fcn is called with iflag = 0 at the beginning of the first */
-/* iteration and every nprint iterations thereafter and */
-/* immediately prior to return, with x, fvec, and fjac */
-/* available for printing. fvec and fjac should not be */
-/* altered. if nprint is not positive, no special calls */
-/* of fcn with iflag = 0 are made. */
-
-/* info is an integer output variable. if the user has */
-/* terminated execution, info is set to the (negative) */
-/* value of iflag. see description of fcn. otherwise, */
-/* info is set as follows. */
-
-/* info = 0 improper input parameters. */
-
-/* info = 1 both actual and predicted relative reductions */
-/* in the sum of squares are at most ftol. */
-
-/* info = 2 relative error between two consecutive iterates */
-/* is at most xtol. */
-
-/* info = 3 conditions for info = 1 and info = 2 both hold. */
-
-/* info = 4 the cosine of the angle between fvec and any */
-/* column of the jacobian is at most gtol in */
-/* absolute value. */
-
-/* info = 5 number of calls to fcn with iflag = 1 has */
-/* reached maxfev. */
-
-/* info = 6 ftol is too small. no further reduction in */
-/* the sum of squares is possible. */
-
-/* info = 7 xtol is too small. no further improvement in */
-/* the approximate solution x is possible. */
-
-/* info = 8 gtol is too small. fvec is orthogonal to the */
-/* columns of the jacobian to machine precision. */
-
-/* nfev is an integer output variable set to the number of */
-/* calls to fcn with iflag = 1. */
-
-/* njev is an integer output variable set to the number of */
-/* calls to fcn with iflag = 2. */
-
-/* ipvt is an integer output array of length n. ipvt */
-/* defines a permutation matrix p such that jac*p = q*r, */
-/* where jac is the final calculated jacobian, q is */
-/* orthogonal (not stored), and r is upper triangular */
-/* with diagonal elements of nonincreasing magnitude. */
-/* column j of p is column ipvt(j) of the identity matrix. */
-
-/* qtf is an output array of length n which contains */
-/* the first n elements of the vector (q transpose)*fvec. */
-
-/* wa1, wa2, and wa3 are work arrays of length n. */
-
-/* wa4 is a work array of length m. */
-
-/* subprograms called */
-
-/* user-supplied ...... fcn */
-
-/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac */
-
-/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
-
-/* epsmch is the machine precision. */
-
- epsmch = __cminpack_func__(dpmpar)(1);
-
- info = 0;
- iflag = 0;
- *nfev = 0;
- *njev = 0;
-
-/* check the input parameters for errors. */
-
- if (n <= 0 || m < n || ldfjac < m || ftol < 0. || xtol < 0. ||
- gtol < 0. || maxfev <= 0 || factor <= 0.) {
- goto TERMINATE;
- }
- if (mode == 2) {
- for (j = 0; j < n; ++j) {
- if (diag[j] <= 0.) {
- goto TERMINATE;
- }
- }
- }
-
-/* evaluate the function at the starting point */
-/* and calculate its norm. */
-
- iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 1);
- *nfev = 1;
- if (iflag < 0) {
- goto TERMINATE;
- }
- fnorm = __cminpack_enorm__(m, fvec);
-
-/* initialize levenberg-marquardt parameter and iteration counter. */
-
- par = 0.;
- iter = 1;
-
-/* beginning of the outer loop. */
-
- for (;;) {
-
-/* calculate the jacobian matrix. */
-
- iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 2);
- ++(*njev);
- if (iflag < 0) {
- goto TERMINATE;
- }
-
-/* if requested, call fcn to enable printing of iterates. */
-
- if (nprint > 0) {
- iflag = 0;
- if ((iter - 1) % nprint == 0) {
- iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
- }
- if (iflag < 0) {
- goto TERMINATE;
- }
- }
-
-/* compute the qr factorization of the jacobian. */
-
- __cminpack_func__(qrfac)(m, n, fjac, ldfjac, TRUE_, ipvt, n,
- wa1, wa2, wa3);
-
-/* on the first iteration and if mode is 1, scale according */
-/* to the norms of the columns of the initial jacobian. */
-
- if (iter == 1) {
- if (mode != 2) {
- for (j = 0; j < n; ++j) {
- diag[j] = wa2[j];
- if (wa2[j] == 0.) {
- diag[j] = 1.;
- }
- }
- }
-
-/* on the first iteration, calculate the norm of the scaled x */
-/* and initialize the step bound delta. */
-
- for (j = 0; j < n; ++j) {
- wa3[j] = diag[j] * x[j];
- }
- xnorm = __cminpack_enorm__(n, wa3);
- delta = factor * xnorm;
- if (delta == 0.) {
- delta = factor;
- }
- }
-
-/* form (q transpose)*fvec and store the first n components in */
-/* qtf. */
-
- for (i = 0; i < m; ++i) {
- wa4[i] = fvec[i];
- }
- for (j = 0; j < n; ++j) {
- if (fjac[j + j * ldfjac] != 0.) {
- sum = 0.;
- for (i = j; i < m; ++i) {
- sum += fjac[i + j * ldfjac] * wa4[i];
- }
- temp = -sum / fjac[j + j * ldfjac];
- for (i = j; i < m; ++i) {
- wa4[i] += fjac[i + j * ldfjac] * temp;
- }
- }
- fjac[j + j * ldfjac] = wa1[j];
- qtf[j] = wa4[j];
- }
-
-/* compute the norm of the scaled gradient. */
-
- gnorm = 0.;
- if (fnorm != 0.) {
- for (j = 0; j < n; ++j) {
- l = ipvt[j]-1;
- if (wa2[l] != 0.) {
- sum = 0.;
- for (i = 0; i <= j; ++i) {
- sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
- }
- /* Computing MAX */
- d1 = fabs(sum / wa2[l]);
- gnorm = max(gnorm,d1);
- }
- }
- }
-
-/* test for convergence of the gradient norm. */
-
- if (gnorm <= gtol) {
- info = 4;
- }
- if (info != 0) {
- goto TERMINATE;
- }
-
-/* rescale if necessary. */
-
- if (mode != 2) {
- for (j = 0; j < n; ++j) {
- /* Computing MAX */
- d1 = diag[j], d2 = wa2[j];
- diag[j] = max(d1,d2);
- }
- }
-
-/* beginning of the inner loop. */
-
- do {
-
-/* determine the levenberg-marquardt parameter. */
-
- __cminpack_func__(lmpar)(n, fjac, ldfjac, ipvt, diag, qtf, delta,
- &par, wa1, wa2, wa3, wa4);
-
-/* store the direction p and x + p. calculate the norm of p. */
-
- for (j = 0; j < n; ++j) {
- wa1[j] = -wa1[j];
- wa2[j] = x[j] + wa1[j];
- wa3[j] = diag[j] * wa1[j];
- }
- pnorm = __cminpack_enorm__(n, wa3);
-
-/* on the first iteration, adjust the initial step bound. */
-
- if (iter == 1) {
- delta = min(delta,pnorm);
- }
-
-/* evaluate the function at x + p and calculate its norm. */
-
- iflag = fcnder_mn(p, m, n, wa2, wa4, fjac, ldfjac, 1);
- ++(*nfev);
- if (iflag < 0) {
- goto TERMINATE;
- }
- fnorm1 = __cminpack_enorm__(m, wa4);
-
-/* compute the scaled actual reduction. */
-
- actred = -1.;
- if (p1 * fnorm1 < fnorm) {
- /* Computing 2nd power */
- d1 = fnorm1 / fnorm;
- actred = 1. - d1 * d1;
- }
-
-/* compute the scaled predicted reduction and */
-/* the scaled directional derivative. */
-
- for (j = 0; j < n; ++j) {
- wa3[j] = 0.;
- l = ipvt[j]-1;
- temp = wa1[l];
- for (i = 0; i <= j; ++i) {
- wa3[i] += fjac[i + j * ldfjac] * temp;
- }
- }
- temp1 = __cminpack_enorm__(n, wa3) / fnorm;
- temp2 = (sqrt(par) * pnorm) / fnorm;
- prered = temp1 * temp1 + temp2 * temp2 / p5;
- dirder = -(temp1 * temp1 + temp2 * temp2);
-
-/* compute the ratio of the actual to the predicted */
-/* reduction. */
-
- ratio = 0.;
- if (prered != 0.) {
- ratio = actred / prered;
- }
-
-/* update the step bound. */
-
- if (ratio <= p25) {
- if (actred >= 0.) {
- temp = p5;
- } else {
- temp = p5 * dirder / (dirder + p5 * actred);
- }
- if (p1 * fnorm1 >= fnorm || temp < p1) {
- temp = p1;
- }
- /* Computing MIN */
- d1 = pnorm / p1;
- delta = temp * min(delta,d1);
- par /= temp;
- } else {
- if (par == 0. || ratio >= p75) {
- delta = pnorm / p5;
- par = p5 * par;
- }
- }
-
-/* test for successful iteration. */
-
- if (ratio >= p0001) {
-
-/* successful iteration. update x, fvec, and their norms. */
-
- for (j = 0; j < n; ++j) {
- x[j] = wa2[j];
- wa2[j] = diag[j] * x[j];
- }
- for (i = 0; i < m; ++i) {
- fvec[i] = wa4[i];
- }
- xnorm = __cminpack_enorm__(n, wa2);
- fnorm = fnorm1;
- ++iter;
- }
-
-/* tests for convergence. */
-
- if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
- info = 1;
- }
- if (delta <= xtol * xnorm) {
- info = 2;
- }
- if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
- info = 3;
- }
- if (info != 0) {
- goto TERMINATE;
- }
-
-/* tests for termination and stringent tolerances. */
-
- if (*nfev >= maxfev) {
- info = 5;
- }
- if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
- info = 6;
- }
- if (delta <= epsmch * xnorm) {
- info = 7;
- }
- if (gnorm <= epsmch) {
- info = 8;
- }
- if (info != 0) {
- goto TERMINATE;
- }
-
-/* end of the inner loop. repeat if iteration unsuccessful. */
-
- } while (ratio < p0001);
-
-/* end of the outer loop. */
-
- }
-TERMINATE:
-
-/* termination, either normal or user imposed. */
-
- if (iflag < 0) {
- info = iflag;
- }
- if (nprint > 0) {
- fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
- }
- return info;
-
-/* last card of subroutine lmder. */
-
-} /* lmder_ */
-
diff --git a/ast/cminpack/lmder1.c b/ast/cminpack/lmder1.c
deleted file mode 100644
index 581462e..0000000
--- a/ast/cminpack/lmder1.c
+++ /dev/null
@@ -1,167 +0,0 @@
-#include "cminpack.h"
-#include "cminpackP.h"
-
-__cminpack_attr__
-int __cminpack_func__(lmder1)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
- real *fvec, real *fjac, int ldfjac, real tol,
- int *ipvt, real *wa, int lwa)
-{
- /* Initialized data */
-
- const real factor = 100.;
-
- /* Local variables */
- int mode, nfev, njev;
- real ftol, gtol, xtol;
- int maxfev, nprint;
- int info;
-
-/* ********** */
-
-/* subroutine lmder1 */
-
-/* the purpose of lmder1 is to minimize the sum of the squares of */
-/* m nonlinear functions in n variables by a modification of the */
-/* levenberg-marquardt algorithm. this is done by using the more */
-/* general least-squares solver lmder. the user must provide a */
-/* subroutine which calculates the functions and the jacobian. */
-
-/* the subroutine statement is */
-
-/* subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
-/* ipvt,wa,lwa) */
-
-/* where */
-
-/* fcn is the name of the user-supplied subroutine which */
-/* calculates the functions and the jacobian. fcn must */
-/* be declared in an external statement in the user */
-/* calling program, and should be written as follows. */
-
-/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
-/* integer m,n,ldfjac,iflag */
-/* double precision x(n),fvec(m),fjac(ldfjac,n) */
-/* ---------- */
-/* if iflag = 1 calculate the functions at x and */
-/* return this vector in fvec. do not alter fjac. */
-/* if iflag = 2 calculate the jacobian at x and */
-/* return this matrix in fjac. do not alter fvec. */
-/* ---------- */
-/* return */
-/* end */
-
-/* the value of iflag should not be changed by fcn unless */
-/* the user wants to terminate execution of lmder1. */
-/* in this case set iflag to a negative integer. */
-
-/* m is a positive integer input variable set to the number */
-/* of functions. */
-
-/* n is a positive integer input variable set to the number */
-/* of variables. n must not exceed m. */
-
-/* x is an array of length n. on input x must contain */
-/* an initial estimate of the solution vector. on output x */
-/* contains the final estimate of the solution vector. */
-
-/* fvec is an output array of length m which contains */
-/* the functions evaluated at the output x. */
-
-/* fjac is an output m by n array. the upper n by n submatrix */
-/* of fjac contains an upper triangular matrix r with */
-/* diagonal elements of nonincreasing magnitude such that */
-
-/* t t t */
-/* p *(jac *jac)*p = r *r, */
-
-/* where p is a permutation matrix and jac is the final */
-/* calculated jacobian. column j of p is column ipvt(j) */
-/* (see below) of the identity matrix. the lower trapezoidal */
-/* part of fjac contains information generated during */
-/* the computation of r. */
-
-/* ldfjac is a positive integer input variable not less than m */
-/* which specifies the leading dimension of the array fjac. */
-
-/* tol is a nonnegative input variable. termination occurs */
-/* when the algorithm estimates either that the relative */
-/* error in the sum of squares is at most tol or that */
-/* the relative error between x and the solution is at */
-/* most tol. */
-
-/* info is an integer output variable. if the user has */
-/* terminated execution, info is set to the (negative) */
-/* value of iflag. see description of fcn. otherwise, */
-/* info is set as follows. */
-
-/* info = 0 improper input parameters. */
-
-/* info = 1 algorithm estimates that the relative error */
-/* in the sum of squares is at most tol. */
-
-/* info = 2 algorithm estimates that the relative error */
-/* between x and the solution is at most tol. */
-
-/* info = 3 conditions for info = 1 and info = 2 both hold. */
-
-/* info = 4 fvec is orthogonal to the columns of the */
-/* jacobian to machine precision. */
-
-/* info = 5 number of calls to fcn with iflag = 1 has */
-/* reached 100*(n+1). */
-
-/* info = 6 tol is too small. no further reduction in */
-/* the sum of squares is possible. */
-
-/* info = 7 tol is too small. no further improvement in */
-/* the approximate solution x is possible. */
-
-/* ipvt is an integer output array of length n. ipvt */
-/* defines a permutation matrix p such that jac*p = q*r, */
-/* where jac is the final calculated jacobian, q is */
-/* orthogonal (not stored), and r is upper triangular */
-/* with diagonal elements of nonincreasing magnitude. */
-/* column j of p is column ipvt(j) of the identity matrix. */
-
-/* wa is a work array of length lwa. */
-
-/* lwa is a positive integer input variable not less than 5*n+m. */
-
-/* subprograms called */
-
-/* user-supplied ...... fcn */
-
-/* minpack-supplied ... lmder */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
-
-/* check the input parameters for errors. */
-
- if (n <= 0 || m < n || ldfjac < m || tol < 0. || lwa < n * 5 + m) {
- return 0;
- }
-
-/* call lmder. */
-
- maxfev = (n + 1) * 100;
- ftol = tol;
- xtol = tol;
- gtol = 0.;
- mode = 1;
- nprint = 0;
- info = __cminpack_func__(lmder)(__cminpack_param_fcnder_mn__ p, m, n, x, fvec, fjac, ldfjac,
- ftol, xtol, gtol, maxfev, wa, mode, factor, nprint,
- &nfev, &njev, ipvt, &wa[n], &wa[(n << 1)], &
- wa[n * 3], &wa[(n << 2)], &wa[n * 5]);
- if (info == 8) {
- info = 4;
- }
- return info;
-
-/* last card of subroutine lmder1. */
-
-} /* lmder1_ */
-
diff --git a/ast/cminpack/lmpar.c b/ast/cminpack/lmpar.c
deleted file mode 100644
index 108e687..0000000
--- a/ast/cminpack/lmpar.c
+++ /dev/null
@@ -1,338 +0,0 @@
-/* lmpar.f -- translated by f2c (version 20020621).
- You must link the resulting object file with the libraries:
- -lf2c -lm (in that order)
-*/
-
-#include "cminpack.h"
-#include <math.h>
-#include "cminpackP.h"
-
-__cminpack_attr__
-void __cminpack_func__(lmpar)(int n, real *r, int ldr,
- const int *ipvt, const real *diag, const real *qtb, real delta,
- real *par, real *x, real *sdiag, real *wa1,
- real *wa2)
-{
- /* Initialized data */
-
-#define p1 .1
-#define p001 .001
-
- /* System generated locals */
- real d1, d2;
-
- /* Local variables */
- int j, l;
- real fp;
- real parc, parl;
- int iter;
- real temp, paru, dwarf;
- int nsing;
- real gnorm;
- real dxnorm;
-
-/* ********** */
-
-/* subroutine lmpar */
-
-/* given an m by n matrix a, an n by n nonsingular diagonal */
-/* matrix d, an m-vector b, and a positive number delta, */
-/* the problem is to determine a value for the parameter */
-/* par such that if x solves the system */
-
-/* a*x = b , sqrt(par)*d*x = 0 , */
-
-/* in the least squares sense, and dxnorm is the euclidean */
-/* norm of d*x, then either par is zero and */
-
-/* (dxnorm-delta) .le. 0.1*delta , */
-
-/* or par is positive and */
-
-/* abs(dxnorm-delta) .le. 0.1*delta . */
-
-/* this subroutine completes the solution of the problem */
-/* if it is provided with the necessary information from the */
-/* qr factorization, with column pivoting, of a. that is, if */
-/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
-/* columns, and r is an upper triangular matrix with diagonal */
-/* elements of nonincreasing magnitude, then lmpar expects */
-/* the full upper triangle of r, the permutation matrix p, */
-/* and the first n components of (q transpose)*b. on output */
-/* lmpar also provides an upper triangular matrix s such that */
-
-/* t t t */
-/* p *(a *a + par*d*d)*p = s *s . */
-
-/* s is employed within lmpar and may be of separate interest. */
-
-/* only a few iterations are generally needed for convergence */
-/* of the algorithm. if, however, the limit of 10 iterations */
-/* is reached, then the output par will contain the best */
-/* value obtained so far. */
-
-/* the subroutine statement is */
-
-/* subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, */
-/* wa1,wa2) */
-
-/* where */
-
-/* n is a positive integer input variable set to the order of r. */
-
-/* r is an n by n array. on input the full upper triangle */
-/* must contain the full upper triangle of the matrix r. */
-/* on output the full upper triangle is unaltered, and the */
-/* strict lower triangle contains the strict upper triangle */
-/* (transposed) of the upper triangular matrix s. */
-
-/* ldr is a positive integer input variable not less than n */
-/* which specifies the leading dimension of the array r. */
-
-/* ipvt is an integer input array of length n which defines the */
-/* permutation matrix p such that a*p = q*r. column j of p */
-/* is column ipvt(j) of the identity matrix. */
-
-/* diag is an input array of length n which must contain the */
-/* diagonal elements of the matrix d. */
-
-/* qtb is an input array of length n which must contain the first */
-/* n elements of the vector (q transpose)*b. */
-
-/* delta is a positive input variable which specifies an upper */
-/* bound on the euclidean norm of d*x. */
-
-/* par is a nonnegative variable. on input par contains an */
-/* initial estimate of the levenberg-marquardt parameter. */
-/* on output par contains the final estimate. */
-
-/* x is an output array of length n which contains the least */
-/* squares solution of the system a*x = b, sqrt(par)*d*x = 0, */
-/* for the output par. */
-
-/* sdiag is an output array of length n which contains the */
-/* diagonal elements of the upper triangular matrix s. */
-
-/* wa1 and wa2 are work arrays of length n. */
-
-/* subprograms called */
-
-/* minpack-supplied ... dpmpar,enorm,qrsolv */
-
-/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
-
-/* dwarf is the smallest positive magnitude. */
-
- dwarf = __cminpack_func__(dpmpar)(2);
-
-/* compute and store in x the gauss-newton direction. if the */
-/* jacobian is rank-deficient, obtain a least squares solution. */
-
- nsing = n;
- for (j = 0; j < n; ++j) {
- wa1[j] = qtb[j];
- if (r[j + j * ldr] == 0. && nsing == n) {
- nsing = j;
- }
- if (nsing < n) {
- wa1[j] = 0.;
- }
- }
-# ifdef USE_CBLAS
- cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
-# else
- if (nsing >= 1) {
- int k;
- for (k = 1; k <= nsing; ++k) {
- j = nsing - k;
- wa1[j] /= r[j + j * ldr];
- temp = wa1[j];
- if (j >= 1) {
- int i;
- for (i = 0; i < j; ++i) {
- wa1[i] -= r[i + j * ldr] * temp;
- }
- }
- }
- }
-# endif
- for (j = 0; j < n; ++j) {
- l = ipvt[j]-1;
- x[l] = wa1[j];
- }
-
-/* initialize the iteration counter. */
-/* evaluate the function at the origin, and test */
-/* for acceptance of the gauss-newton direction. */
-
- iter = 0;
- for (j = 0; j < n; ++j) {
- wa2[j] = diag[j] * x[j];
- }
- dxnorm = __cminpack_enorm__(n, wa2);
- fp = dxnorm - delta;
- if (fp <= p1 * delta) {
- goto TERMINATE;
- }
-
-/* if the jacobian is not rank deficient, the newton */
-/* step provides a lower bound, parl, for the zero of */
-/* the function. otherwise set this bound to zero. */
-
- parl = 0.;
- if (nsing >= n) {
- for (j = 0; j < n; ++j) {
- l = ipvt[j]-1;
- wa1[j] = diag[l] * (wa2[l] / dxnorm);
- }
-# ifdef USE_CBLAS
- cblas_dtrsv(CblasColMajor, CblasUpper, CblasTrans, CblasNonUnit, n, r, ldr, wa1, 1);
-# else
- for (j = 0; j < n; ++j) {
- real sum = 0.;
- if (j >= 1) {
- int i;
- for (i = 0; i < j; ++i) {
- sum += r[i + j * ldr] * wa1[i];
- }
- }
- wa1[j] = (wa1[j] - sum) / r[j + j * ldr];
- }
-# endif
- temp = __cminpack_enorm__(n, wa1);
- parl = fp / delta / temp / temp;
- }
-
-/* calculate an upper bound, paru, for the zero of the function. */
-
- for (j = 0; j < n; ++j) {
- real sum;
-# ifdef USE_CBLAS
- sum = cblas_ddot(j+1, &r[j*ldr], 1, qtb, 1);
-# else
- int i;
- sum = 0.;
- for (i = 0; i <= j; ++i) {
- sum += r[i + j * ldr] * qtb[i];
- }
-# endif
- l = ipvt[j]-1;
- wa1[j] = sum / diag[l];
- }
- gnorm = __cminpack_enorm__(n, wa1);
- paru = gnorm / delta;
- if (paru == 0.) {
- paru = dwarf / min(delta,(real)p1) /* / p001 ??? */;
- }
-
-/* if the input par lies outside of the interval (parl,paru), */
-/* set par to the closer endpoint. */
-
- *par = max(*par,parl);
- *par = min(*par,paru);
- if (*par == 0.) {
- *par = gnorm / dxnorm;
- }
-
-/* beginning of an iteration. */
-
- for (;;) {
- ++iter;
-
-/* evaluate the function at the current value of par. */
-
- if (*par == 0.) {
- /* Computing MAX */
- d1 = dwarf, d2 = p001 * paru;
- *par = max(d1,d2);
- }
- temp = sqrt(*par);
- for (j = 0; j < n; ++j) {
- wa1[j] = temp * diag[j];
- }
- __cminpack_func__(qrsolv)(n, r, ldr, ipvt, wa1, qtb, x, sdiag, wa2);
- for (j = 0; j < n; ++j) {
- wa2[j] = diag[j] * x[j];
- }
- dxnorm = __cminpack_enorm__(n, wa2);
- temp = fp;
- fp = dxnorm - delta;
-
-/* if the function is small enough, accept the current value */
-/* of par. also test for the exceptional cases where parl */
-/* is zero or the number of iterations has reached 10. */
-
- if (fabs(fp) <= p1 * delta || (parl == 0. && fp <= temp && temp < 0.) || iter == 10) {
- goto TERMINATE;
- }
-
-/* compute the newton correction. */
-
-# ifdef USE_CBLAS
- for (j = 0; j < nsing; ++j) {
- l = ipvt[j]-1;
- wa1[j] = diag[l] * (wa2[l] / dxnorm);
- }
- for (j = nsing; j < n; ++j) {
- wa1[j] = 0.;
- }
- /* exchange the diagonal of r with sdiag */
- cblas_dswap(n, r, ldr+1, sdiag, 1);
- /* solve lower(r).x = wa1, result id put in wa1 */
- cblas_dtrsv(CblasColMajor, CblasLower, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
- /* exchange the diagonal of r with sdiag */
- cblas_dswap( n, r, ldr+1, sdiag, 1);
-# else /* !USE_CBLAS */
- for (j = 0; j < n; ++j) {
- l = ipvt[j]-1;
- wa1[j] = diag[l] * (wa2[l] / dxnorm);
- }
- for (j = 0; j < n; ++j) {
- wa1[j] /= sdiag[j];
- temp = wa1[j];
- if (n > j+1) {
- int i;
- for (i = j+1; i < n; ++i) {
- wa1[i] -= r[i + j * ldr] * temp;
- }
- }
- }
-# endif /* !USE_CBLAS */
- temp = __cminpack_enorm__(n, wa1);
- parc = fp / delta / temp / temp;
-
-/* depending on the sign of the function, update parl or paru. */
-
- if (fp > 0.) {
- parl = max(parl,*par);
- }
- if (fp < 0.) {
- paru = min(paru,*par);
- }
-
-/* compute an improved estimate for par. */
-
- /* Computing MAX */
- d1 = parl, d2 = *par + parc;
- *par = max(d1,d2);
-
-/* end of an iteration. */
-
- }
-TERMINATE:
-
-/* termination. */
-
- if (iter == 0) {
- *par = 0.;
- }
-
-/* last card of subroutine lmpar. */
-
-} /* lmpar_ */
-
diff --git a/ast/cminpack/qrfac.c b/ast/cminpack/qrfac.c
deleted file mode 100644
index 1573772..0000000
--- a/ast/cminpack/qrfac.c
+++ /dev/null
@@ -1,285 +0,0 @@
-#include "cminpack.h"
-#include <math.h>
-#ifdef USE_LAPACK
-#include <stdlib.h>
-#include <string.h>
-#include <assert.h>
-#endif
-#include "cminpackP.h"
-
-__cminpack_attr__
-void __cminpack_func__(qrfac)(int m, int n, real *a, int
- lda, int pivot, int *ipvt, int lipvt, real *rdiag,
- real *acnorm, real *wa)
-{
-#ifdef USE_LAPACK
- __CLPK_integer m_ = m;
- __CLPK_integer n_ = n;
- __CLPK_integer lda_ = lda;
- __CLPK_integer *jpvt;
-
- int i, j, k;
- double t;
- double* tau = wa;
- const __CLPK_integer ltau = m > n ? n : m;
- __CLPK_integer lwork = -1;
- __CLPK_integer info = 0;
- double* work;
-
- if (pivot) {
- assert( lipvt >= n );
- if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
- jpvt = malloc(n*sizeof(__CLPK_integer));
- } else {
- /* __CLPK_integer is actually an int, just do a cast */
- jpvt = (__CLPK_integer *)ipvt;
- }
- /* set all columns free */
- memset(jpvt, 0, sizeof(int)*n);
- }
-
- /* query optimal size of work */
- lwork = -1;
- if (pivot) {
- dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,tau,&lwork,&info);
- lwork = (int)tau[0];
- assert( lwork >= 3*n+1 );
- } else {
- dgeqrf_(&m_,&n_,a,&lda_,tau,tau,&lwork,&info);
- lwork = (int)tau[0];
- assert( lwork >= 1 && lwork >= n );
- }
-
- assert( info == 0 );
-
- /* alloc work area */
- work = (double *)malloc(sizeof(double)*lwork);
- assert(work != NULL);
-
- /* set acnorm first (from the doc of qrfac, acnorm may point to the same area as rdiag) */
- if (acnorm != rdiag) {
- for (j = 0; j < n; ++j) {
- acnorm[j] = __cminpack_enorm__(m, &a[j * lda]);
- }
- }
-
- /* QR decomposition */
- if (pivot) {
- dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,work,&lwork,&info);
- } else {
- dgeqrf_(&m_,&n_,a,&lda_,tau,work,&lwork,&info);
- }
- assert(info == 0);
-
- /* set rdiag, before the diagonal is replaced */
- memset(rdiag, 0, sizeof(double)*n);
- for(i=0 ; i<n ; ++i) {
- rdiag[i] = a[i*lda+i];
- }
-
- /* modify lower trinagular part to look like qrfac's output */
- for(i=0 ; i<ltau ; ++i) {
- k = i*lda+i;
- t = tau[i];
- a[k] = t;
- for(j=i+1 ; j<m ; j++) {
- k++;
- a[k] *= t;
- }
- }
-
- free(work);
- if (pivot) {
- /* convert back jpvt to ipvt */
- if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
- for(i=0; i<n; ++i) {
- ipvt[i] = jpvt[i];
- }
- free(jpvt);
- }
- }
-#else /* !USE_LAPACK */
- /* Initialized data */
-
-#define p05 .05
-
- /* System generated locals */
- real d1;
-
- /* Local variables */
- int i, j, k, jp1;
- real sum;
- real temp;
- int minmn;
- real epsmch;
- real ajnorm;
-
-/* ********** */
-
-/* subroutine qrfac */
-
-/* this subroutine uses householder transformations with column */
-/* pivoting (optional) to compute a qr factorization of the */
-/* m by n matrix a. that is, qrfac determines an orthogonal */
-/* matrix q, a permutation matrix p, and an upper trapezoidal */
-/* matrix r with diagonal elements of nonincreasing magnitude, */
-/* such that a*p = q*r. the householder transformation for */
-/* column k, k = 1,2,...,min(m,n), is of the form */
-
-/* t */
-/* i - (1/u(k))*u*u */
-
-/* where u has zeros in the first k-1 positions. the form of */
-/* this transformation and the method of pivoting first */
-/* appeared in the corresponding linpack subroutine. */
-
-/* the subroutine statement is */
-
-/* subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) */
-
-/* where */
-
-/* m is a positive integer input variable set to the number */
-/* of rows of a. */
-
-/* n is a positive integer input variable set to the number */
-/* of columns of a. */
-
-/* a is an m by n array. on input a contains the matrix for */
-/* which the qr factorization is to be computed. on output */
-/* the strict upper trapezoidal part of a contains the strict */
-/* upper trapezoidal part of r, and the lower trapezoidal */
-/* part of a contains a factored form of q (the non-trivial */
-/* elements of the u vectors described above). */
-
-/* lda is a positive integer input variable not less than m */
-/* which specifies the leading dimension of the array a. */
-
-/* pivot is a logical input variable. if pivot is set true, */
-/* then column pivoting is enforced. if pivot is set false, */
-/* then no column pivoting is done. */
-
-/* ipvt is an integer output array of length lipvt. ipvt */
-/* defines the permutation matrix p such that a*p = q*r. */
-/* column j of p is column ipvt(j) of the identity matrix. */
-/* if pivot is false, ipvt is not referenced. */
-
-/* lipvt is a positive integer input variable. if pivot is false, */
-/* then lipvt may be as small as 1. if pivot is true, then */
-/* lipvt must be at least n. */
-
-/* rdiag is an output array of length n which contains the */
-/* diagonal elements of r. */
-
-/* acnorm is an output array of length n which contains the */
-/* norms of the corresponding columns of the input matrix a. */
-/* if this information is not needed, then acnorm can coincide */
-/* with rdiag. */
-
-/* wa is a work array of length n. if pivot is false, then wa */
-/* can coincide with rdiag. */
-
-/* subprograms called */
-
-/* minpack-supplied ... dpmpar,enorm */
-
-/* fortran-supplied ... dmax1,dsqrt,min0 */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
- (void)lipvt;
-
-/* epsmch is the machine precision. */
-
- epsmch = __cminpack_func__(dpmpar)(1);
-
-/* compute the initial column norms and initialize several arrays. */
-
- for (j = 0; j < n; ++j) {
- acnorm[j] = __cminpack_enorm__(m, &a[j * lda + 0]);
- rdiag[j] = acnorm[j];
- wa[j] = rdiag[j];
- if (pivot) {
- ipvt[j] = j+1;
- }
- }
-
-/* reduce a to r with householder transformations. */
-
- minmn = min(m,n);
- for (j = 0; j < minmn; ++j) {
- if (pivot) {
-
-/* bring the column of largest norm into the pivot position. */
-
- int kmax = j;
- for (k = j; k < n; ++k) {
- if (rdiag[k] > rdiag[kmax]) {
- kmax = k;
- }
- }
- if (kmax != j) {
- for (i = 0; i < m; ++i) {
- temp = a[i + j * lda];
- a[i + j * lda] = a[i + kmax * lda];
- a[i + kmax * lda] = temp;
- }
- rdiag[kmax] = rdiag[j];
- wa[kmax] = wa[j];
- k = ipvt[j];
- ipvt[j] = ipvt[kmax];
- ipvt[kmax] = k;
- }
- }
-
-/* compute the householder transformation to reduce the */
-/* j-th column of a to a multiple of the j-th unit vector. */
-
- ajnorm = __cminpack_enorm__(m - (j+1) + 1, &a[j + j * lda]);
- if (ajnorm != 0.) {
- if (a[j + j * lda] < 0.) {
- ajnorm = -ajnorm;
- }
- for (i = j; i < m; ++i) {
- a[i + j * lda] /= ajnorm;
- }
- a[j + j * lda] += 1.;
-
-/* apply the transformation to the remaining columns */
-/* and update the norms. */
-
- jp1 = j + 1;
- if (n > jp1) {
- for (k = jp1; k < n; ++k) {
- sum = 0.;
- for (i = j; i < m; ++i) {
- sum += a[i + j * lda] * a[i + k * lda];
- }
- temp = sum / a[j + j * lda];
- for (i = j; i < m; ++i) {
- a[i + k * lda] -= temp * a[i + j * lda];
- }
- if (pivot && rdiag[k] != 0.) {
- temp = a[j + k * lda] / rdiag[k];
- /* Computing MAX */
- d1 = 1. - temp * temp;
- rdiag[k] *= sqrt((max((real)0.,d1)));
- /* Computing 2nd power */
- d1 = rdiag[k] / wa[k];
- if (p05 * (d1 * d1) <= epsmch) {
- rdiag[k] = __cminpack_enorm__(m - (j+1), &a[jp1 + k * lda]);
- wa[k] = rdiag[k];
- }
- }
- }
- }
- }
- rdiag[j] = -ajnorm;
- }
-
-/* last card of subroutine qrfac. */
-#endif /* !USE_LAPACK */
-} /* qrfac_ */
-
diff --git a/ast/cminpack/qrsolv.c b/ast/cminpack/qrsolv.c
deleted file mode 100644
index 6ab9e98..0000000
--- a/ast/cminpack/qrsolv.c
+++ /dev/null
@@ -1,218 +0,0 @@
-#include "cminpack.h"
-#include <math.h>
-#include "cminpackP.h"
-
-__cminpack_attr__
-void __cminpack_func__(qrsolv)(int n, real *r, int ldr,
- const int *ipvt, const real *diag, const real *qtb, real *x,
- real *sdiag, real *wa)
-{
- /* Initialized data */
-
-#define p5 .5
-#define p25 .25
-
- /* Local variables */
- int i, j, k, l;
- real cos, sin, sum, temp;
- int nsing;
- real qtbpj;
-
-/* ********** */
-
-/* subroutine qrsolv */
-
-/* given an m by n matrix a, an n by n diagonal matrix d, */
-/* and an m-vector b, the problem is to determine an x which */
-/* solves the system */
-
-/* a*x = b , d*x = 0 , */
-
-/* in the least squares sense. */
-
-/* this subroutine completes the solution of the problem */
-/* if it is provided with the necessary information from the */
-/* qr factorization, with column pivoting, of a. that is, if */
-/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
-/* columns, and r is an upper triangular matrix with diagonal */
-/* elements of nonincreasing magnitude, then qrsolv expects */
-/* the full upper triangle of r, the permutation matrix p, */
-/* and the first n components of (q transpose)*b. the system */
-/* a*x = b, d*x = 0, is then equivalent to */
-
-/* t t */
-/* r*z = q *b , p *d*p*z = 0 , */
-
-/* where x = p*z. if this system does not have full rank, */
-/* then a least squares solution is obtained. on output qrsolv */
-/* also provides an upper triangular matrix s such that */
-
-/* t t t */
-/* p *(a *a + d*d)*p = s *s . */
-
-/* s is computed within qrsolv and may be of separate interest. */
-
-/* the subroutine statement is */
-
-/* subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) */
-
-/* where */
-
-/* n is a positive integer input variable set to the order of r. */
-
-/* r is an n by n array. on input the full upper triangle */
-/* must contain the full upper triangle of the matrix r. */
-/* on output the full upper triangle is unaltered, and the */
-/* strict lower triangle contains the strict upper triangle */
-/* (transposed) of the upper triangular matrix s. */
-
-/* ldr is a positive integer input variable not less than n */
-/* which specifies the leading dimension of the array r. */
-
-/* ipvt is an integer input array of length n which defines the */
-/* permutation matrix p such that a*p = q*r. column j of p */
-/* is column ipvt(j) of the identity matrix. */
-
-/* diag is an input array of length n which must contain the */
-/* diagonal elements of the matrix d. */
-
-/* qtb is an input array of length n which must contain the first */
-/* n elements of the vector (q transpose)*b. */
-
-/* x is an output array of length n which contains the least */
-/* squares solution of the system a*x = b, d*x = 0. */
-
-/* sdiag is an output array of length n which contains the */
-/* diagonal elements of the upper triangular matrix s. */
-
-/* wa is a work array of length n. */
-
-/* subprograms called */
-
-/* fortran-supplied ... dabs,dsqrt */
-
-/* argonne national laboratory. minpack project. march 1980. */
-/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
-
-/* ********** */
-
-/* copy r and (q transpose)*b to preserve input and initialize s. */
-/* in particular, save the diagonal elements of r in x. */
-
- for (j = 0; j < n; ++j) {
- for (i = j; i < n; ++i) {
- r[i + j * ldr] = r[j + i * ldr];
- }
- x[j] = r[j + j * ldr];
- wa[j] = qtb[j];
- }
-
-/* eliminate the diagonal matrix d using a givens rotation. */
-
- for (j = 0; j < n; ++j) {
-
-/* prepare the row of d to be eliminated, locating the */
-/* diagonal element using p from the qr factorization. */
-
- l = ipvt[j]-1;
- if (diag[l] != 0.) {
- for (k = j; k < n; ++k) {
- sdiag[k] = 0.;
- }
- sdiag[j] = diag[l];
-
-/* the transformations to eliminate the row of d */
-/* modify only a single element of (q transpose)*b */
-/* beyond the first n, which is initially zero. */
-
- qtbpj = 0.;
- for (k = j; k < n; ++k) {
-
-/* determine a givens rotation which eliminates the */
-/* appropriate element in the current row of d. */
-
- if (sdiag[k] != 0.) {
-# ifdef USE_LAPACK
- dlartg_( &r[k + k * ldr], &sdiag[k], &cos, &sin, &temp );
-# else /* !USE_LAPACK */
- if (fabs(r[k + k * ldr]) < fabs(sdiag[k])) {
- real cotan;
- cotan = r[k + k * ldr] / sdiag[k];
- sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
- cos = sin * cotan;
- } else {
- real tan;
- tan = sdiag[k] / r[k + k * ldr];
- cos = p5 / sqrt(p25 + p25 * (tan * tan));
- sin = cos * tan;
- }
-
-/* compute the modified diagonal element of r and */
-/* the modified element of ((q transpose)*b,0). */
-
-# endif /* !USE_LAPACK */
- temp = cos * wa[k] + sin * qtbpj;
- qtbpj = -sin * wa[k] + cos * qtbpj;
- wa[k] = temp;
-
-/* accumulate the tranformation in the row of s. */
-# ifdef USE_CBLAS
- cblas_drot( n-k, &r[k + k * ldr], 1, &sdiag[k], 1, cos, sin );
-# else /* !USE_CBLAS */
- r[k + k * ldr] = cos * r[k + k * ldr] + sin * sdiag[k];
- if (n > k+1) {
- for (i = k+1; i < n; ++i) {
- temp = cos * r[i + k * ldr] + sin * sdiag[i];
- sdiag[i] = -sin * r[i + k * ldr] + cos * sdiag[i];
- r[i + k * ldr] = temp;
- }
- }
-# endif /* !USE_CBLAS */
- }
- }
- }
-
-/* store the diagonal element of s and restore */
-/* the corresponding diagonal element of r. */
-
- sdiag[j] = r[j + j * ldr];
- r[j + j * ldr] = x[j];
- }
-
-/* solve the triangular system for z. if the system is */
-/* singular, then obtain a least squares solution. */
-
- nsing = n;
- for (j = 0; j < n; ++j) {
- if (sdiag[j] == 0. && nsing == n) {
- nsing = j;
- }
- if (nsing < n) {
- wa[j] = 0.;
- }
- }
- if (nsing >= 1) {
- for (k = 1; k <= nsing; ++k) {
- j = nsing - k;
- sum = 0.;
- if (nsing > j+1) {
- for (i = j+1; i < nsing; ++i) {
- sum += r[i + j * ldr] * wa[i];
- }
- }
- wa[j] = (wa[j] - sum) / sdiag[j];
- }
- }
-
-/* permute the components of z back to components of x. */
-
- for (j = 0; j < n; ++j) {
- l = ipvt[j]-1;
- x[l] = wa[j];
- }
- return;
-
-/* last card of subroutine qrsolv. */
-
-} /* qrsolv_ */
-
diff --git a/ast/config.h.in b/ast/config.h.in
index 5e1b304..a61a84a 100644
--- a/ast/config.h.in
+++ b/ast/config.h.in
@@ -44,9 +44,6 @@
/* The sscanf shows the non-ANSI behaviour reported by Bill Joye */
#undef HAVE_NONANSI_SSCANF
-/* Define to 1 if the Fortran compiler supports the VAX %LOC extension */
-#undef HAVE_PERCENTLOC
-
/* Use the starmem library for memory management */
#undef HAVE_STAR_MEM_H
diff --git a/ast/f77.h b/ast/f77.h
deleted file mode 100644
index 7f1a728..0000000
--- a/ast/f77.h
+++ /dev/null
@@ -1,1096 +0,0 @@
-/*
-*+
-* Name:
-* f77.h and cnf.h
-
-* Purpose:
-* C - FORTRAN interace macros and prototypes
-
-* Language:
-* C (part ANSI, part not)
-
-* Type of Module:
-* C include file
-
-* Description:
-* For historical reasons two files, F77.h and cnf.h are required
-* but the have now been combined and for new code, only one is
-* necessary.
-*
-* This file defines the macros needed to write C functions that are
-* designed to be called from FORTRAN programs, and to do so in a
-* portable way. Arguments are normally passed by reference from a
-* FORTRAN program, and so the F77 macros arrange for a pointer to
-* all arguments to be available. This requires no work on most
-* machines, but will actually generate the pointers on a machine
-* that passes FORTRAN arguments by value.
-
-* Notes:
-* - Macros are provided to handle the conversion of logical data
-* values between the way that FORTRAN represents a value and the
-* way that C represents it.
-* - Macros are provided to convert variables between the FORTRAN and
-* C method of representing them. In most cases there is no
-* conversion required, the macros just arrange for a pointer to
-* the FORTRAN variable to be set appropriately. The possibility that
-* FORTRAN and C might use different ways of representing integer
-* and floating point values is considered remote, the macros are
-* really only there for completeness and to assist in the automatic
-* generation of C interfaces.
-* - For character variables the macros convert between
-* the FORTRAN method of representing them (fixed length, blank
-* filled strings) and the C method (variable length, null
-* terminated strings) using calls to the CNF functions.
-
-* Implementation Deficiencies:
-* - The macros support the K&R style of function definition, but
-* this file may not work with all K&R compilers as it contains
-* "#if defined" statements. These could be replaced with #ifdef's
-* if necessary. This has not been done as is would make the code
-* less clear and the need for support for K&R sytle definitions
-* should disappear as ANSI compilers become the default.
-
-* Copyright:
-* Copyright (C) 1991, 1993 Science & Engineering Research Council.
-* Copyright (C) 2006 Particle Physics and Astronomy Research Council.
-* Copyright (C) 2007,2008 Science and Technology Facilities Council.
-* All Rights Reserved.
-
-* Licence:
-* This program is free software; you can redistribute it and/or
-* modify it under the terms of the GNU General Public License as
-* published by the Free Software Foundation; either version 2 of
-* the License, or (at your option) any later version.
-*
-* This program is distributed in the hope that it will be
-* useful,but WITHOUT ANY WARRANTY; without even the implied
-* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-* PURPOSE. See the GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with this program; if not, write to the Free Software
-* Foundation, Inc., 51 Franklin Street,Fifth Floor, Boston, MA
-* 02110-1301, USA
-
-* Authors:
-* PMA: Peter Allan (Starlink, RAL)
-* AJC: Alan Chipperfield (Starlink, RAL)
-* TIMJ: Tim Jenness (JAC)
-* PWD: Peter W. Draper (JAC, Durham University)
-* {enter_new_authors_here}
-
-* History:
-* 23-MAY-1991 (PMA):
-* Original version.
-* 19-JUN-1991 (PMA):
-* Removed VMS versions of IM(EX)PORT_LOGICAL macros that tried
-* to convert data representations.
-* 24-JUN-1991 (PMA):
-* Changed the names of IMPORT macros to GENPTR.
-* Removed the EXPORT macros.
-* 27-JUN-1991 (PMA):
-* Modified DECstation specific stuff to allow use of the c89
-* compiler.
-* 8-JUL-1991 (PMA):
-* Added macros to call FORTRAN from C.
-* 16-OCT-1991 (PMA):
-* Remove type_ARRAY2 definitions.
-* Remove the length argument from CHARACTER_ARRAY and the
-* dimension specifier from GENPTR_type_ARRAY.
-* Add extra brackets to F77_ISFALSE and F77_ISTRUE.
-* 25-OCT-1991 (PMA):
-* Changed "if defined(sun4)" to "if defined(sun)"
-* 2-JUN-1992 (PMA):
-* Changed "if defined(mips)" to "if defined(ultrix)" to prevent
-* those definitions being used on a Silicon Graphics machine.
-* 11-JUN-1992 (PMA):
-* Changed "if defined(ultrix)" back to "if defined(mips)" so that
-* it still works on OSF/1 on a DECstation.
-* Add support for general non-ANSI compilers, but not basic K&R
-* ones.
-* 12-JUN-1992 (PMA):
-* Change declaration of dummy scalar arguments to be const
-* pointers. Change declaration of dummy array arguments to be
-* const pointers.
-* 5-JAN-1993 (PMA):
-* Changed "if defined(mips)" so that it will recognise a
-* DECstation running Ultrix or OSF/1, but not a Silicon Graphics
-* workstation.
-* Change the definition of F77_BYTE_TYPE to add "signed".
-* Redefine this on VMS where signed is invalid syntax.
-* Add new types of UBYTE and UWORD.
-* 8-JAN-1993 (PMA):
-* Fix bug in the definition of CHARACTER_RETURN_VALUE. There was
-* an extraneous space.
-* Add a macro F77_POINTER_TYPE and use it to define POINTER.
-* 13-JAN-1993 (PMA):
-* Start to add support for K&R function definitions. These are
-* done on a per machine basis.
-* 16-APR-1993 (PMA):
-* Change the definition of F77_POINTER_TYPE from int to unsigned
-* int.
-* 7-MAY-1993 (PMA):
-* Change from using a null comment as a token concatenation
-* operator to using the internal macro _f77_x on non-ANSI
-* systems.
-* 10-MAY-1993 (PMA):
-* Finish adding K&R support. This will form version 2.0 of F77.
-* 10-MAY-1993 (PMA):
-* Add support for Alpha OSF/1.
-* 9-JUL-1993 (PMA):
-* Add further POINTER macros: POINTER_ARRAY,
-* GENPTR_POINTER_ARRAY, DECLARE_POINTER, DECLARE_POINTER_ARRAY,
-* POINTER_ARG, POINTER_ARRAY_ARG, F77_POINTER_FUNCTION,
-* KR_POINTER_ARRAY.
-* 24-AUG-1993 (PMA):
-* Add const to the VMS definitions of CHARACTER and CHARACTER_ARRAY.
-* 3-NOV-1993 (PMA):
-* Remove K&R stuff to a separate file.
-* Released on Unix as version 2.0 of CNF.
-* 11-NOV-1993 (PMA):
-* Return to using the null comment to concatenate text on non-ANSI
-* systems as _f77_x caused problems with the c89 -common flag on
-* DECstations.
-* 23-JAN-1996 (AJC):
-* Add SUBROUTINE, type_FUNCTION, SUBROUTINE_ARG,
-* type_FUNCTION_ARG, GENPTR_SUBROUTINE and GENPTR_type_FUNCTION
-* required for passed subroutine and function name.
-* 29-JAN-1996 (AJC):
-* Add the dynamic CHARACTER_ macros
-* and CHARACTER_ARG_TYPE
-* 22-FEB-1996 (AJC):
-* Add CHARACTER_RETURN_ARG
-* 23-MAY-1996 (AJC):
-* Add DECLARE_CHARACTER_ARRAY_DYN
-* F77_CREATE_CHARACTER_ARRAY
-* F77_CHARACTER_ARG_TYPE
-* 14-JUN-1996 (AJC):
-* Add DECLARE_LOGICAL_ARRAY_DYN
-* F77_CREATE_LOGICAL_ARRAY
-* 21-JUN-1996 (AJC):
-* Add cast to _ARRAY_ARGs to allow multidimensional arrays
-* 17-MAR-1998 (AJC):
-* Add DECLARE, CREATE and FREE dynamic array macros for all types
-* Changed CREATE_CHARACTER_ARRAY and CREATE_LOGICAL_ARRAY to use
-* number of elements rather than dimensions.
-* Add IMPORT, EXPORT and ASSOC macros
-* 22-JUL-1998 (AJC):
-* Combined F77.h and cnf.h
-* 23-SEP-1998 (AJC):
-* Input strings for cnf -> const char *
-* Input int arrays for cnf -> const int *
-* 4-NOV-1998 (AJC):
-* Bring cnf prototypes in line with .c routines
-* 8-FEB-1999 (AJC):
-* Added cnf_mem stuff
-* 9-FEB-1999 (AJC):
-* Use cnf_cptr/fptr for IMPORT/EXPORT_POINTER
-* 16-FEB-1999 (AJC):
-* Added missing cnf_fptr prototype
-* 23-JUN-1999 (AJC):
-* Change cnf_name to cnfName
-* and add macros for cnf_name
-* 1-DEC-1999 (AJC):
-* Add define cnf_free
-* 7-JAN-2000 (AJC):
-* Correct omission of F77_ASSOC_UBYTE_ARRAY
-* Correct F77_EXPORT_UWORD_ARRAY
-* 25-AUG-2005 (TIMJ):
-* Add cnfInitRTL
-* 23-FEB-2006 (TIMJ):
-* Add cnfRealloc
-* Use starMalloc rather than malloc in F77_CREATE_POINTER_ARRAY
-* (since it needs to match what goes on in cnfFree)
-* 21-JUN-2006 (PWD):
-* Changed to use a different return type for REAL functions. This
-* effects g77 under 64-bit, when the f2c bindings expect the return
-* value of a REAL function to be a double, not a float.
-* 25-SEP-2006 (PWD):
-* Introduced F77_CREATE_IMPORT_CHARACTER. Match length of
-* F77_CREATE_CHARACTER to result from cnfCref.
-* 13-JUL-2007 (PWD):
-* Parameterise the type of Fortran character string lengths. Can
-* be long.
-* 7-OCT-2008 (TIMJ):
-* Initialise pointers.
-* 11-MAY-2011 (DSB):
-* Added F77_LOCK
-* {enter_further_changes_here}
-*
-
-* Bugs:
-* {note_any_bugs_here}
-
-*-
-------------------------------------------------------------------------------
-*/
-#if !defined(CNF_MACROS)
-#define CNF_MACROS
-
-#include <stdlib.h>
-#include <string.h>
-/* This initial sections defines values for all macros. These are the */
-/* values that are generally appropriate to an ANSI C compiler on Unix. */
-/* For macros that have different values on other systems, the macros */
-/* should be undefined and then redefined in the system specific sections. */
-/* At the end of this section, some macros are redefined if the compiler */
-/* is non-ANSI. */
-
-#if defined(__STDC__) || defined(VMS)
-#define CNF_CONST const
-#else
-#define CNF_CONST
-#endif
-
-/* ----- Macros common to calling C from FORTRAN and FORTRAN from C ---- */
-
-
-/* --- External Names --- */
-
-/* Macro to define the name of a Fortran routine or common block. This */
-/* ends in an underscore on many Unix systems. */
-
-#define F77_EXTERNAL_NAME(X) X ## _
-
-
-/* --- Logical Values --- */
-
-/* Define the values that are used to represent the logical values TRUE */
-/* and FALSE in Fortran. */
-
-#define F77_TRUE 1
-#define F77_FALSE 0
-
-/* Define macros that evaluate to C logical values, given a FORTRAN */
-/* logical value. */
-
-#define F77_ISTRUE(X) ( X )
-#define F77_ISFALSE(X) ( !( X ) )
-
-
-/* --- Common Blocks --- */
-
-/* Macros used in referring to FORTRAN common blocks. */
-
-#define F77_BLANK_COMMON @BLANK_COMMON_SYMBOL@
-#define F77_NAMED_COMMON(B) F77_EXTERNAL_NAME(B)
-
-
-
-/* ------------------ Calling C from FORTRAN --------------------------- */
-
-
-/* --- Data Types --- */
-
-/* Define macros for all the Fortran data types (except COMPLEX, which is */
-/* not handled by this package). */
-
-#define F77_INTEGER_TYPE int
-#define F77_REAL_TYPE float
-#define F77_REAL_FUNCTION_TYPE float
-#define F77_DOUBLE_TYPE double
-#define F77_LOGICAL_TYPE int
-#define F77_CHARACTER_TYPE char
-#define F77_BYTE_TYPE signed char
-#define F77_WORD_TYPE short int
-#define F77_UBYTE_TYPE unsigned char
-#define F77_UWORD_TYPE unsigned short int
-
-/* Define macros for the type of a CHARACTER and CHARACTER_ARRAY argument */
-#define F77_CHARACTER_ARG_TYPE char
-#define F77_CHARACTER_ARRAY_ARG_TYPE char
-
-/* Define a macro to use when passing arguments that STARLINK FORTRAN */
-/* treats as a pointer. From the point of view of C, this type should be */
-/* (void *), but it is declared as type unsigned int as we actually pass */
-/* an INTEGER from the FORTRAN routine. The distinction is important for */
-/* architectures where the size of an INTEGER is not the same as the size */
-/* of a pointer. */
-
-#define F77_POINTER_TYPE unsigned int
-
-
-/* --- Subroutine Names --- */
-
-/* This declares that the C function returns a value of void. */
-
-#define F77_SUBROUTINE(X) void F77_EXTERNAL_NAME(X)
-
-
-/* --- Function Names --- */
-
-/* Macros to define the types and names of functions that return values. */
-/* Due the the different ways that function return values could be */
-/* implemented, it is better not to use functions, but to stick to using */
-/* subroutines. */
-
-/* Character functions are implemented, but in a way that cannot be */
-/* guaranteed to be portable although it will work on VMS, SunOS, Ultrix */
-/* and DEC OSF/1. It would be better to return the character value as a */
-/* subroutine argument where possible, rather than use a character */
-/* function. */
-
-#define F77_INTEGER_FUNCTION(X) F77_INTEGER_TYPE F77_EXTERNAL_NAME(X)
-#define F77_REAL_FUNCTION(X) F77_REAL_FUNCTION_TYPE F77_EXTERNAL_NAME(X)
-#define F77_DOUBLE_FUNCTION(X) F77_DOUBLE_TYPE F77_EXTERNAL_NAME(X)
-#define F77_LOGICAL_FUNCTION(X) F77_LOGICAL_TYPE F77_EXTERNAL_NAME(X)
-#define F77_CHARACTER_FUNCTION(X) void F77_EXTERNAL_NAME(X)
-#define F77_BYTE_FUNCTION(X) F77_BYTE_TYPE F77_EXTERNAL_NAME(X)
-#define F77_WORD_FUNCTION(X) F77_WORD_TYPE F77_EXTERNAL_NAME(X)
-#define F77_UBYTE_FUNCTION(X) F77_UBYTE_TYPE F77_EXTERNAL_NAME(X)
-#define F77_UWORD_FUNCTION(X) F77_UWORD_TYPE F77_EXTERNAL_NAME(X)
-#define F77_POINTER_FUNCTION(X) F77_POINTER_TYPE F77_EXTERNAL_NAME(X)
-
-
-/* --- Character return value for a function --- */
-
-#define CHARACTER_RETURN_VALUE(X) CHARACTER(X) TRAIL(X)
-#define CHARACTER_RETURN_ARG(X) CHARACTER_ARG(X) TRAIL_ARG(X)
-
-/* --- Dummy Arguments --- */
-
-/* Macros for defining subroutine arguments. All these macros take a */
-/* single argument; the name of the parameter. On most systems, a numeric */
-/* argument is passed as a pointer. */
-
-#define INTEGER(X) F77_INTEGER_TYPE *CNF_CONST X
-#define REAL(X) F77_REAL_TYPE *CNF_CONST X
-#define DOUBLE(X) F77_DOUBLE_TYPE *CNF_CONST X
-#define LOGICAL(X) F77_LOGICAL_TYPE *CNF_CONST X
-#define BYTE(X) F77_BYTE_TYPE *CNF_CONST X
-#define WORD(X) F77_WORD_TYPE *CNF_CONST X
-#define UBYTE(X) F77_UBYTE_TYPE *CNF_CONST X
-#define UWORD(X) F77_UWORD_TYPE *CNF_CONST X
-
-/* Pointer arguments. Define a pointer type for passing pointer values */
-/* between subroutines. */
-
-#define POINTER(X) F77_POINTER_TYPE *CNF_CONST X
-
-/* EXTERNAL arguments. Define a passed subroutine or function name */
-#define SUBROUTINE(X) void (*X)()
-#define INTEGER_FUNCTION(X) F77_INTEGER_TYPE (*X)()
-#define REAL_FUNCTION(X) F77_REAL_TYPE (*X)()
-#define DOUBLE_FUNCTION(X) F77_DOUBLE_TYPE (*X)()
-#define LOGICAL_FUNCTION(X) F77_LOGICAL_TYPE (*X)()
-#define CHARACTER_FUNCTION(X) F77_CHARACTER_TYPE (*X)()
-#define BYTE_FUNCTION(X) F77_BYTE_TYPE (*X)()
-#define WORD_FUNCTION(X) F77_WORD_TYPE (*X)()
-#define UBYTE_FUNCTION(X) F77_UBYTE_TYPE (*X)()
-#define UWORD_FUNCTION(X) F77_UWORD_TYPE (*X)()
-#define POINTER_FUNCTION(X) F77_POINTER_TYPE (*X)()
-
-/* Array arguments. */
-
-#define INTEGER_ARRAY(X) F77_INTEGER_TYPE *CNF_CONST X
-#define REAL_ARRAY(X) F77_REAL_TYPE *CNF_CONST X
-#define DOUBLE_ARRAY(X) F77_DOUBLE_TYPE *CNF_CONST X
-#define LOGICAL_ARRAY(X) F77_LOGICAL_TYPE *CNF_CONST X
-#define BYTE_ARRAY(X) F77_BYTE_TYPE *CNF_CONST X
-#define WORD_ARRAY(X) F77_WORD_TYPE *CNF_CONST X
-#define UBYTE_ARRAY(X) F77_UBYTE_TYPE *CNF_CONST X
-#define UWORD_ARRAY(X) F77_UWORD_TYPE *CNF_CONST X
-
-#define POINTER_ARRAY(X) F77_POINTER_TYPE *CNF_CONST X
-
-/* Macros to handle character arguments. */
-
-/* Character arguments can be passed in many ways. The purpose of these */
-/* macros and the GENPTR_CHARACTER macro (defined in the next section) is */
-/* to generate a pointer to a character variable called ARG and an integer */
-/* ARG_length containing the length of ARG. If these two variables are */
-/* available directly from the argument list of the routine, then the */
-/* GENPTR_CHARACTER macro is null, otherwise it works on intermediate */
-/* variables. */
-
-#define CHARACTER(X) F77_CHARACTER_TYPE *CNF_CONST X
-#define TRAIL(X) ,int X ## _length
-#define CHARACTER_ARRAY(X) F77_CHARACTER_TYPE *CNF_CONST X
-
-
-/* --- Getting Pointers to Arguments --- */
-
-/* Macros that ensure that a pointer to each argument is available for the */
-/* programmer to use. Usually this means that these macros are null. On */
-/* VMS, a pointer to a character variable has to be generated. If a */
-/* particular machine were to pass arguments by reference, rather than by */
-/* value, then these macros would construct the appropriate pointers. */
-
-#define GENPTR_INTEGER(X)
-#define GENPTR_REAL(X)
-#define GENPTR_DOUBLE(X)
-#define GENPTR_CHARACTER(X)
-#define GENPTR_LOGICAL(X)
-#define GENPTR_BYTE(X)
-#define GENPTR_WORD(X)
-#define GENPTR_UBYTE(X)
-#define GENPTR_UWORD(X)
-#define GENPTR_POINTER(X)
-
-#define GENPTR_INTEGER_ARRAY(X)
-#define GENPTR_REAL_ARRAY(X)
-#define GENPTR_DOUBLE_ARRAY(X)
-#define GENPTR_CHARACTER_ARRAY(X)
-#define GENPTR_LOGICAL_ARRAY(X)
-#define GENPTR_BYTE_ARRAY(X)
-#define GENPTR_WORD_ARRAY(X)
-#define GENPTR_UBYTE_ARRAY(X)
-#define GENPTR_UWORD_ARRAY(X)
-#define GENPTR_POINTER_ARRAY(X)
-
-#define GENPTR_SUBROUTINE(X)
-#define GENPTR_INTEGER_FUNCTION(X)
-#define GENPTR_REAL_FUNCTION(X)
-#define GENPTR_DOUBLE_FUNCTION(X)
-#define GENPTR_CHARACTER_FUNCTION(X)
-#define GENPTR_LOGICAL_FUNCTION(X)
-#define GENPTR_BYTE_FUNCTION(X)
-#define GENPTR_WORD_FUNCTION(X)
-#define GENPTR_UBYTE_FUNCTION(X)
-#define GENPTR_UWORD_FUNCTION(X)
-#define GENPTR_POINTER_FUNCTION(X)
-
-
-
-/* ------------------ Calling FORTRAN from C --------------------------- */
-
-
-/* --- Declare variables --- */
-
-#define DECLARE_INTEGER(X) F77_INTEGER_TYPE X
-#define DECLARE_REAL(X) F77_REAL_TYPE X
-#define DECLARE_DOUBLE(X) F77_DOUBLE_TYPE X
-#define DECLARE_LOGICAL(X) F77_LOGICAL_TYPE X
-#define DECLARE_BYTE(X) F77_BYTE_TYPE X
-#define DECLARE_WORD(X) F77_WORD_TYPE X
-#define DECLARE_UBYTE(X) F77_UBYTE_TYPE X
-#define DECLARE_UWORD(X) F77_UWORD_TYPE X
-
-#define DECLARE_POINTER(X) F77_POINTER_TYPE X
-
-#define DECLARE_CHARACTER(X,L) F77_CHARACTER_TYPE X[L]; \
- const int X##_length = L
-
-
-/* --- Declare arrays --- */
-
-#define DECLARE_INTEGER_ARRAY(X,D) F77_INTEGER_TYPE X[D]
-#define DECLARE_REAL_ARRAY(X,D) F77_REAL_TYPE X[D]
-#define DECLARE_DOUBLE_ARRAY(X,D) F77_DOUBLE_TYPE X[D]
-#define DECLARE_LOGICAL_ARRAY(X,D) F77_LOGICAL_TYPE X[D]
-#define DECLARE_BYTE_ARRAY(X,D) F77_BYTE_TYPE X[D]
-#define DECLARE_WORD_ARRAY(X,D) F77_WORD_TYPE X[D]
-#define DECLARE_UBYTE_ARRAY(X,D) F77_UBYTE_TYPE X[D]
-#define DECLARE_UWORD_ARRAY(X,D) F77_UWORD_TYPE X[D]
-#define DECLARE_POINTER_ARRAY(X,D) F77_POINTER_TYPE X[D]
-#define DECLARE_CHARACTER_ARRAY(X,L,D) F77_CHARACTER_TYPE X[D][L]; \
- const int X##_length = L
-
-/* --- Declare and construct dynamic CHARACTER arguments --- */
-#define DECLARE_CHARACTER_DYN(X) F77_CHARACTER_TYPE *X = NULL;\
- int X##_length = 0
-#define F77_CREATE_CHARACTER(X,L) X=cnfCref(L);\
- X##_length = (L>0?L:1)
-
-/* Declare Dynamic Fortran arrays */
-#define DECLARE_INTEGER_ARRAY_DYN(X) F77_INTEGER_TYPE *X = NULL
-#define DECLARE_REAL_ARRAY_DYN(X) F77_REAL_TYPE *X = NULL
-#define DECLARE_DOUBLE_ARRAY_DYN(X) F77_DOUBLE_TYPE *X = NULL
-#define DECLARE_LOGICAL_ARRAY_DYN(X) F77_LOGICAL_TYPE *X = NULL
-#define DECLARE_BYTE_ARRAY_DYN(X) F77_BYTE_TYPE *X = NULL
-#define DECLARE_WORD_ARRAY_DYN(X) F77_WORD_TYPE *X = NULL
-#define DECLARE_UBYTE_ARRAY_DYN(X) F77_UBYTE_TYPE *X = NULL
-#define DECLARE_UWORD_ARRAY_DYN(X) F77_UWORD_TYPE *X = NULL
-#define DECLARE_POINTER_ARRAY_DYN(X) F77_POINTER_TYPE *X = NULL
-#define DECLARE_CHARACTER_ARRAY_DYN(X) F77_CHARACTER_TYPE *X = NULL;\
- int X##_length = 0
-
-/* Create arrays dynamic Fortran arrays for those types which require */
-/* Separate space for Fortran and C arrays */
-/* Character and logical are already defined */
-/* For most types there is nothing to do */
-#define F77_CREATE_CHARACTER_ARRAY(X,L,N) \
- {int f77dims[1];f77dims[0]=N;X=cnfCrefa(L,1,f77dims);X##_length=L;}
-#define F77_CREATE_CHARACTER_ARRAY_M(X,L,N,D) X=cnfCrefa(L,N,D);\
- X##_length = L
-#define F77_CREATE_LOGICAL_ARRAY(X,N) \
- {int f77dims[1];f77dims[0]=N;X=cnfCrela(1,f77dims);}
-#define F77_CREATE_LOGICAL_ARRAY_M(X,N,D) X=cnfCrela(N,D)
-#define F77_CREATE_INTEGER_ARRAY(X,N)
-#define F77_CREATE_REAL_ARRAY(X,N)
-#define F77_CREATE_DOUBLE_ARRAY(X,N)
-#define F77_CREATE_BYTE_ARRAY(X,N)
-#define F77_CREATE_UBYTE_ARRAY(X,N)
-#define F77_CREATE_WORD_ARRAY(X,N)
-#define F77_CREATE_UWORD_ARRAY(X,N)
-#define F77_CREATE_POINTER_ARRAY(X,N)\
- X=(F77_POINTER_TYPE *) malloc(N*sizeof(F77_POINTER_TYPE))
-
-/* Associate Fortran arrays with C arrays */
-/* These macros ensure that there is space somewhere for the Fortran */
-/* array. They are complemetary to the CREATE_type_ARRAY macros */
-#define F77_ASSOC_CHARACTER_ARRAY(F,C)
-#define F77_ASSOC_LOGICAL_ARRAY(F,C)
-#define F77_ASSOC_INTEGER_ARRAY(F,C) F=C
-#define F77_ASSOC_REAL_ARRAY(F,C) F=C
-#define F77_ASSOC_DOUBLE_ARRAY(F,C) F=C
-#define F77_ASSOC_BYTE_ARRAY(F,C) F=C
-#define F77_ASSOC_UBYTE_ARRAY(F,C) F=C
-#define F77_ASSOC_WORD_ARRAY(F,C) F=C
-#define F77_ASSOC_UWORD_ARRAY(F,C) F=C
-#define F77_ASSOC_POINTER_ARRAY(F,C)
-
-/* Free created dynamic arrays */
-/* Character and logical are already defined */
-/* For most types there is nothing to do */
-#define F77_FREE_INTEGER(X)
-#define F77_FREE_REAL(X)
-#define F77_FREE_DOUBLE(X)
-#define F77_FREE_BYTE(X)
-#define F77_FREE_UBYTE(X)
-#define F77_FREE_WORD(X)
-#define F77_FREE_UWORD(X)
-#define F77_FREE_POINTER(X) cnfFree((void *)X);
-#define F77_FREE_CHARACTER(X) cnfFreef( X )
-#define F77_FREE_LOGICAL(X) cnfFree( (char *)X )
-
-/* --- IMPORT and EXPORT of values --- */
-/* Export C variables to Fortran variables */
-#define F77_EXPORT_CHARACTER(C,F,L) cnfExprt(C,F,L)
-#define F77_EXPORT_DOUBLE(C,F) F=C
-#define F77_EXPORT_INTEGER(C,F) F=C
-#define F77_EXPORT_LOGICAL(C,F) F=C?F77_TRUE:F77_FALSE
-#define F77_EXPORT_REAL(C,F) F=C
-#define F77_EXPORT_BYTE(C,F) F=C
-#define F77_EXPORT_WORD(C,F) F=C
-#define F77_EXPORT_UBYTE(C,F) F=C
-#define F77_EXPORT_UWORD(C,F) F=C
-#define F77_EXPORT_POINTER(C,F) F=cnfFptr(C)
-#define F77_EXPORT_LOCATOR(C,F) cnfExpch(C,F,DAT__SZLOC)
-
-/* Allow for character strings to be NULL, protects strlen. Note this
- * does not allow lengths to differ. */
-#define F77_CREATE_EXPORT_CHARACTER(C,F) \
- if (C) { \
- F77_CREATE_CHARACTER(F,strlen(C)); \
- F77_EXPORT_CHARACTER(C,F,F##_length); \
- } else { \
- F77_CREATE_CHARACTER(F,1); \
- F77_EXPORT_CHARACTER(" ",F,F##_length); \
- }
-
-/* Export C arrays to Fortran */
-/* Arrays are assumed to be 1-d so just the number of elements is given */
-/* This may be OK for n-d arrays also */
-/* CHARACTER arrays may be represented in C as arrays of arrays of char or */
-/* as arrays of pointers to char (the _P variant) */
-#define F77_EXPORT_CHARACTER_ARRAY(C,LC,F,LF,N) \
- {int f77dims[1];f77dims[0]=N;cnfExprta(C,LC,F,LF,1,f77dims);}
-#define F77_EXPORT_CHARACTER_ARRAY_P(C,F,LF,N) \
- {int f77dims[1];f77dims[0]=N;cnfExprtap(C,F,LF,1,f77dims);}
-#define F77_EXPORT_DOUBLE_ARRAY(C,F,N) F=(F77_DOUBLE_TYPE *)C
-#define F77_EXPORT_INTEGER_ARRAY(C,F,N) F=(F77_INTEGER_TYPE *)C
-#define F77_EXPORT_LOGICAL_ARRAY(C,F,N) \
- {int f77dims[1];f77dims[0]=N;cnfExpla(C,F,1,f77dims);}
-#define F77_EXPORT_REAL_ARRAY(C,F,N) F=(F77_REAL_TYPE *)C
-#define F77_EXPORT_BYTE_ARRAY(C,F,N) F=(F77_BYTE_TYPE *)C
-#define F77_EXPORT_WORD_ARRAY(C,F,N) F=(F77_WORD_TYPE *)C
-#define F77_EXPORT_UBYTE_ARRAY(C,F,N) F=(F77_UBYTE_TYPE *)C
-#define F77_EXPORT_UWORD_ARRAY(C,F,N) F=(F77_UWORD_TYPE * )C
-#define F77_EXPORT_POINTER_ARRAY(C,F,N) \
- {int f77i;for (f77i=0;f77i<N;f77i++)F[f77i]=cnfFptr(C[f77i]);}
-#define F77_EXPORT_LOCATOR_ARRAY(C,F,N) \
- {int f77i;for (f77i=0;f77i<N;f77i++)cnfExpch(C,F,DAT__SZLOC);}
-
-/* Import Fortran variables to C */
-#define F77_IMPORT_CHARACTER(F,L,C) cnfImprt(F,L,C)
-#define F77_IMPORT_DOUBLE(F,C) C=F
-#define F77_IMPORT_INTEGER(F,C) C=F
-#define F77_IMPORT_LOGICAL(F,C) C=F77_ISTRUE(F)
-#define F77_IMPORT_REAL(F,C) C=F
-#define F77_IMPORT_BYTE(F,C) C=F
-#define F77_IMPORT_WORD(F,C) C=F
-#define F77_IMPORT_UBYTE(F,C) C=F
-#define F77_IMPORT_UWORD(F,C) C=F
-#define F77_IMPORT_POINTER(F,C) C=cnfCptr(F)
-#define F77_IMPORT_LOCATOR(F,C) cnfImpch(F,DAT__SZLOC,C)
-
-/* Import Fortran arrays to C */
-/* Arrays are assumed to be 1-d so just the number of elements is given */
-/* This may be OK for n-d arrays also */
-/* CHARACTER arrays may be represented in C as arrays of arrays of char or */
-/* as arrays of pointers to char (the _P variant) */
-#define F77_IMPORT_CHARACTER_ARRAY(F,LF,C,LC,N) \
- {int f77dims[1];f77dims[0]=N;cnfImprta(F,LF,C,LC,1,f77dims);}
-#define F77_IMPORT_CHARACTER_ARRAY_P(F,LF,C,LC,N) \
- {int f77dims[1];f77dims[0]=N;cnfImprtap(F,LF,C,LC,1,f77dims);}
-#define F77_IMPORT_DOUBLE_ARRAY(F,C,N)
-#define F77_IMPORT_INTEGER_ARRAY(F,C,N)
-#define F77_IMPORT_LOGICAL_ARRAY(F,C,N) \
- {int f77dims[1];f77dims[0]=N;cnfImpla(F,C,1,f77dims);}
-#define F77_IMPORT_REAL_ARRAY(F,C,N)
-#define F77_IMPORT_BYTE_ARRAY(F,C,N)
-#define F77_IMPORT_WORD_ARRAY(F,C,N)
-#define F77_IMPORT_UBYTE_ARRAY(F,C,N)
-#define F77_IMPORT_UWORD_ARRAY(F,C,N)
-#define F77_IMPORT_POINTER_ARRAY(F,C,N) \
- {int f77i;for (f77i=0;f77i<N;f77i++)C[f77i]=cnfCptr(F[f77i]);}
-#define F77_IMPORT_LOCATOR_ARRAY(F,C,N) \
- {int f77i;for (f77i=0;f77i<N;f77i++)cnfImpch(F,DAT__SZLOC,C);}
-
-/* --- Call a FORTRAN routine --- */
-
-#define F77_CALL(X) F77_EXTERNAL_NAME(X)
-
-
-/* --- Execute code synchronised by the CNF global mutex */
-#define F77_LOCK(code) \
- cnfLock(); \
- code \
- cnfUnlock();
-
-/* --- Pass arguments to a FORTRAN routine --- */
-
-#define INTEGER_ARG(X) X
-#define REAL_ARG(X) X
-#define DOUBLE_ARG(X) X
-#define LOGICAL_ARG(X) X
-#define BYTE_ARG(X) X
-#define WORD_ARG(X) X
-#define UBYTE_ARG(X) X
-#define UWORD_ARG(X) X
-#define POINTER_ARG(X) X
-#define CHARACTER_ARG(X) X
-#define TRAIL_ARG(X) ,X##_length
-
-#define SUBROUTINE_ARG(X) X
-#define INTEGER_FUNCTION_ARG(X) X
-#define REAL_FUNCTION_ARG(X) X
-#define DOUBLE_FUNCTION_ARG(X) X
-#define LOGICAL_FUNCTION_ARG(X) X
-#define CHARACTER_FUNCTION_ARG(X) X
-#define BYTE_FUNCTION_ARG(X) X
-#define WORD_FUNCTION_ARG(X) X
-#define UBYTE_FUNCTION_ARG(X) X
-#define UWORD_FUNCTION_ARG(X) X
-#define POINTER_FUNCTION_ARG(X) X
-
-#define INTEGER_ARRAY_ARG(X) (F77_INTEGER_TYPE *)X
-#define REAL_ARRAY_ARG(X) (F77_REAL_TYPE *)X
-#define DOUBLE_ARRAY_ARG(X) (F77_DOUBLE_TYPE *)X
-#define LOGICAL_ARRAY_ARG(X) (F77_LOGICAL_TYPE *)X
-#define BYTE_ARRAY_ARG(X) (F77_BYTE_TYPE *)X
-#define WORD_ARRAY_ARG(X) (F77_WORD_TYPE *)X
-#define UBYTE_ARRAY_ARG(X) (F77_UBYTE_TYPE *)X
-#define UWORD_ARRAY_ARG(X) (F77_UWORD_TYPE *)X
-#define POINTER_ARRAY_ARG(X) (F77_POINTER_TYPE *)X
-#define CHARACTER_ARRAY_ARG(X) (F77_CHARACTER_ARRAY_ARG_TYPE *)X
-
-/* Put the 64-bit INT support in one place */
-#define F77_INTEGER8_TYPE int64_t
-#define F77_INTEGER8_FUNCTION(X) F77_INTEGER8_TYPE F77_EXTERNAL_NAME(X)
-#define INTEGER8(X) F77_INTEGER8_TYPE *CNF_CONST X
-#define INTEGER8_FUNCTION(X) F77_INTEGER8_TYPE (*X)()
-#define INTEGER8_ARRAY(X) F77_INTEGER8_TYPE *CNF_CONST X
-#define GENPTR_INTEGER8(X)
-#define GENPTR_INTEGER8_ARRAY(X)
-#define GENPTR_INTEGER8_FUNCTION(X)
-#define DECLARE_INTEGER8(X) F77_INTEGER8_TYPE X
-#define DECLARE_INTEGER8_ARRAY(X,D) F77_INTEGER8_TYPE X[D]
-#define DECLARE_INTEGER8_ARRAY_DYN(X) F77_INTEGER8_TYPE *X = NULL
-#define F77_CREATE_INTEGER8_ARRAY(X,N)
-#define F77_ASSOC_INTEGER8_ARRAY(F,C) F=C
-#define F77_FREE_INTEGER8(X)
-#define F77_EXPORT_INTEGER8(C,F) F=C
-#define F77_EXPORT_INTEGER8_ARRAY(C,F,N) F=(F77_INTEGER8_TYPE *)C
-#define F77_IMPORT_INTEGER8(F,C) C=F
-#define F77_IMPORT_INTEGER8_ARRAY(F,C,N)
-#define INTEGER8_ARG(X) X
-#define INTEGER8_FUNCTION_ARG(X) X
-#define INTEGER8_ARRAY_ARG(X) (F77_INTEGER8_TYPE *)X
-
-/* ------------------------ Non-ansi section ------------------------------ */
-
-/* The difference between ANSI and non-ANSI compilers, as far as macro */
-/* definition is concerned, is that non-ANSI compilers do not support the */
-/* token concatenation operator (##). To work around this, we use the fact */
-/* that the null comment is preprocessed to produce no characters at all */
-/* by our non-ANSI compilers. */
-/* This section does not deal with the fact that some non-ANSI compilers */
-/* cannot handle function prototypes. That is handled in the machine */
-/* specific sections. */
-
-#if !defined(__STDC__)
-
-/* --- External Name --- */
-
-/* Macro to define the name of a Fortran routine or common block. This */
-/* ends in an underscore on many Unix systems. */
-
-#undef F77_EXTERNAL_NAME
-#define F77_EXTERNAL_NAME(X) X/**/_
-
-
-/* --- Dummy Arguments --- */
-
-/* Macros to handle character dummy arguments. */
-
-#undef TRAIL
-#define TRAIL(X) ,int X/**/_length
-
-
-/* --- Declare variables --- */
-
-#undef DECLARE_CHARACTER
-#define DECLARE_CHARACTER(X,L) F77_CHARACTER_TYPE X[L]; \
- const int X/**/_length = L
-#undef DECLARE_CHARACTER_ARRAY
-#define DECLARE_CHARACTER_ARRAY(X,L,D) F77_CHARACTER_TYPE X[D][L]; \
- const int X/**/_length = L
-#undef DECLARE_CHARACTER_DYN
-#define DECLARE_CHARACTER_DYN(X) F77_CHARACTER_TYPE *X;\
- int X/**/_length
-#undef DECLARE_CHARACTER_ARRAY_DYN
-#define DECLARE_CHARACTER_ARRAY_DYN(X) F77_CHARACTER_TYPE *X;\
- int X/**/_length
-#undef F77_CREATE_CHARACTER
-#define F77_CREATE_CHARACTER(X,L) X=cnfCref(L);\
- X/**/_length = L
-#undef F77_CREATE_CHARACTER_ARRAY
-#define F77_CREATE_CHARACTER_ARRAY(X,L,N) \
- {int f77dims[1];f77dims[0]=N;X=cnfCrefa(L,1,f77dims);X/**/_length=L;}
-
-/* --- Pass arguments to a FORTRAN routine --- */
-
-#undef TRAIL_ARG
-#define TRAIL_ARG(X) ,X/**/_length
-
-
-#endif /* of non ANSI redefinitions */
-
-
-/* ----------------------------------------------------------------------- */
-
-/* The standard macros defined above are known to work with the following */
-/* systems: */
-
-/*--------
-| Sun |
----------*/
-
-/* On SunOS, the ANSI definitions work with the acc and gcc compilers. */
-/* The cc compiler uses the non ANSI definitions. It also needs the K&R */
-/* definitions in the file kr.h. */
-/* On Solaris, the standard definitions work with the cc compiler. */
-
-#if defined(sun)
-
-#if !defined(__STDC__)
-#if !defined(_F77_KR)
-#define _F77_KR
-#endif
-#endif
-
-#endif /* Sun */
-
-/* -------------------- System dependent sections ------------------------- */
-
-/*------------
-| VAX/VMS |
--------------*/
-
-/* Many macros need to be changed due to the way that VMS handles external */
-/* names, passes character arguments and handles logical values. */
-
-
-#if defined(VMS)
-
-/* --- Data Types --- */
-
-/* Redefine the macro for the byte data type as signed is not valid syntax */
-/* as the VMS compiler is not ANSI compliant. */
-
-#undef F77_BYTE_TYPE
-#define F77_BYTE_TYPE char
-
-
-/* --- External Names --- */
-
-/* Macro to define the name of a Fortran routine or common block. */
-/* Fortran and C routines names are the same on VMS. */
-
-#undef F77_EXTERNAL_NAME
-#define F77_EXTERNAL_NAME(X) X
-
-
-/* --- Dummy Arguments --- */
-
-/* Macros to handle character arguments. */
-/* Character string arguments are pointers to character string descriptors */
-/* and there are no trailing arguments. */
-
-#if( VMS != 0 )
-#include <descrip.h>
-#endif
-
-
-#undef F77_CHARACTER_ARG_TYPE
-#define F77_CHARACTER_ARG_TYPE struct dsc$descriptor_s
-#undef F77_CHARACTER_ARRAY_ARG_TYPE
-#define F77_CHARACTER_ARRAY_ARG_TYPE struct dsc$descriptor_a
-#undef CHARACTER
-#define CHARACTER(X) F77_CHARACTER_ARG_TYPE *CNF_CONST X/**/_arg
-#undef TRAIL
-#define TRAIL(X)
-#undef CHARACTER_ARRAY
-#define CHARACTER_ARRAY(X) F77_CHARACTER_ARRAY_ARG_TYPE *CNF_CONST X/**/_arg
-#undef GENPTR_CHARACTER
-#define GENPTR_CHARACTER(X) \
- F77_CHARACTER_TYPE *X = X/**/_arg->dsc$a_pointer; \
- int X/**/_length = X/**/_arg->dsc$w_length;
-#undef GENPTR_CHARACTER_ARRAY
-#define GENPTR_CHARACTER_ARRAY(X) GENPTR_CHARACTER(X)
-
-
-/* --- Logical Values --- */
-
-#undef F77_TRUE
-#define F77_TRUE -1
-#undef F77_ISTRUE
-#define F77_ISTRUE(X) ( (X)&1 )
-#undef F77_ISFALSE
-#define F77_ISFALSE(X) ( ! ( (X)&1 ) )
-
-
-/* --- Common Blocks --- */
-
-#undef F77_BLANK_COMMON
-#define F77_BLANK_COMMON $BLANK
-
-
-/* --- Declare Variables --- */
-
-#undef DECLARE_CHARACTER
-#define DECLARE_CHARACTER(X,L) \
- F77_CHARACTER_TYPE X[L]; const int X/**/_length = L; \
- F77_CHARACTER_ARG_TYPE X/**/_descr = \
- { L, DSC$K_DTYPE_T, DSC$K_CLASS_S, X }; \
- F77_CHARACTER_ARG_TYPE *X/**/_arg = &X/**/_descr
-#undef DECLARE_CHARACTER_ARRAY
-#define DECLARE_CHARACTER_ARRAY(X,L,D) \
- F77_CHARACTER_TYPE X[D][L]; const int X/**/_length = L; \
- F77_CHARACTER_ARRAY_ARG_TYPE X/**/_descr = \
- { L, DSC$K_DTYPE_T, DSC$K_CLASS_S, X }; \
- F77_CHARACTER_ARRAY_ARG_TYPE *X/**/_arg = &X/**/_descr
-
-
-/* --- The dynamic allocation of character arguments --- */
-#undef DECLARE_CHARACTER_DYN
-#define DECLARE_CHARACTER_DYN(X) int X/**/_length;\
- F77_CHARACTER_ARG_TYPE *X/**/_arg;\
- F77_CHARACTER_TYPE *X
-#undef DECLARE_CHARACTER_ARRAY_DYN
-#define DECLARE_CHARACTER_ARRAY_DYN(X) int X/**/_length;\
- F77_CHARACTER_ARRAY_ARG_TYPE *X/**/_arg;\
- F77_CHARACTER_TYPE *X
-#undef F77_CREATE_CHARACTER
-#define F77_CREATE_CHARACTER(X,L) X/**/_arg = cnfCref(L);\
- X = X/**/_arg->dsc$a_pointer; \
- X/**/_length = X/**/_arg->dsc$w_length
-#undef F77_CREATE_CHARACTER_ARRAY
-#define F77_CREATE_CHARACTER_ARRAY(X,L,N) \
- {int f77dims[1];f77dims[0]=N;X/**/_arg=cnfCrefa(L,1,f77dims);X/**/_length=L;}
-#define F77_CREATE_CHARACTER_ARRAY_M(X,L,N,D) X/**/_arg = cnfCrefa(L,N,D);\
- X = X/**/_arg->dsc$a_pointer; \
- X/**/_length = X/**/_arg->dsc$w_length
-#undef F77_FREE_CHARACTER
-#define F77_FREE_CHARACTER(X) cnfFreef( X/**/_arg )
-
-/* --- Pass arguments to a FORTRAN routine --- */
-
-#undef CHARACTER_ARG
-#define CHARACTER_ARG(X) X/**/_arg
-#undef CHARACTER_ARRAY_ARG
-#define CHARACTER_ARRAY_ARG(X) X/**/_arg
-#undef TRAIL_ARG
-#define TRAIL_ARG(X)
-
-#endif /* VMS */
-
-/* ----------------------------------------------------------------------- */
-
-/*--------------------------
-| DECstation Ultrix (cc) |
-| DECstation Ultrix (c89) |
-| DECstation OSF/1 |
-| Alpha OSF/1 |
- --------------------------*/
-
-/* Do this complicated set of definitions as a single #if cannot be */
-/* continued across multiple lines. */
-
-#if defined(mips) && defined(ultrix)
-#define _dec_unix 1
-#endif
-#if defined(__mips) && defined(__ultrix)
-#define _dec_unix 1
-#endif
-#if defined(__mips__) && defined(__osf__)
-#define _dec_unix 1
-#endif
-#if defined(__alpha) && defined(__osf__)
-#define _dec_unix 1
-#endif
-
-#if _dec_unix
-
-/* The macros for Ultrix are the same as the standard ones except for ones */
-/* dealing with logical values. The ANSI definitions work with the c89 */
-/* compiler, and the non ANSI definitions work with the cc compiler. */
-/* The same applies to DEC OSF/1, except that its cc compiler is ANSI */
-/* compliant. */
-
-
-/* --- Logical Values --- */
-
-/* Redefine macros that evaluate to a C logical value, given a FORTRAN */
-/* logical value. These definitions are only valid when used with the DEC */
-/* FORTRAN for RISC compiler. If you are using the earlier FORTRAN for */
-/* RISC compiler from MIPS, then these macros should be deleted. */
-
-#undef F77_TRUE
-#define F77_TRUE -1
-#undef F77_ISTRUE
-#define F77_ISTRUE(X) ( (X)&1 )
-#undef F77_ISFALSE
-#define F77_ISFALSE(X) ( ! ( (X)&1 ) )
-
-
-#endif /* DEC Unix */
-
-/*
-*+
-* Name:
-* cnf.h
-
-* Purpose:
-* Function prototypes for cnf routines
-
-* Language:
-* ANSI C
-
-* Type of Module:
-* C include file
-
-* Description:
-* These are the prototype definitions for the functions in the CNF
-* library. They are used used in mixing C and FORTRAN programs.
-
-* Copyright:
-* Copyright (C) 1991 Science & Engineering Research Council
-
-* Authors:
-* PMA: Peter Allan (Starlink, RAL)
-* AJC: Alan Chipperfield (Starlink, RAL)
-* {enter_new_authors_here}
-
-* History:
-* 23-MAY-1991 (PMA):
-* Original version.
-* 12-JAN-1996 (AJC):
-* Add cnf_cref and cnf_freef
-* 14-JUN-1996 (AJC):
-* Add cnf_crefa, imprta, exprta
-* crela, impla, expla
-* 18-JUL-1996 (AJC):
-* Add impch and expch
-* 17-MAR-1998 (AJC):
-* Add imprtap and exprtap
-* {enter_changes_here}
-
-* Bugs:
-* {note_any_bugs_here}
-
-*-
-------------------------------------------------------------------------------
-*/
-void cnfInitRTL( int, char** );
-void *cnfCalloc( size_t, size_t );
-void cnfCopyf( const char *source_f, int source_len, char *dest_f,
- int dest_len );
-void *cnfCptr( F77_POINTER_TYPE );
-char *cnfCreat( int length );
-F77_CHARACTER_ARG_TYPE *cnfCref( int length );
-F77_CHARACTER_ARG_TYPE *cnfCrefa( int length, int ndims, const int *dims );
-char *cnfCreib( const char *source_f, int source_len );
-char *cnfCreim( const char *source_f, int source_len );
-F77_LOGICAL_TYPE *cnfCrela( int ndims, const int *dims );
-void cnfExpch( const char *source_c, char *dest_f, int nchars );
-void cnfExpla( const int *source_c, F77_LOGICAL_TYPE *dest_f, int ndims,
- const int *dims );
-void cnfExpn( const char *source_c, int max, char *dest_f, int dest_len );
-void cnfExprt( const char *source_c, char *dest_f, int dest_len );
-void cnfExprta( const char *source_c, int source_len, char *dest_f,
- int dest_len, int ndims, const int *dims );
-void cnfExprtap( char *const *source_c, char *dest_f, int dest_len,
- int ndims, const int *dims );
-F77_POINTER_TYPE cnfFptr( void *cpointer );
-void cnfFree( void * );
-void cnfFreef( F77_CHARACTER_ARG_TYPE *temp );
-void cnfImpb( const char *source_f, int source_len, char *dest_c );
-void cnfImpbn( const char *source_f, int source_len, int max, char *dest_c );
-void cnfImpch( const char *source_f, int nchars, char *dest_c );
-void cnfImpla( const F77_LOGICAL_TYPE *source_f, int *dest_c,
- int ndims, const int *dims );
-void cnfImpn( const char *source_f, int source_len, int max, char *dest_c );
-void cnfImprt( const char *source_f, int source_len, char *dest_c );
-void cnfImprta( const char *source_f, int source_len, char *dest_c,
- int dest_len, int ndims, const int *dims );
-void cnfImprtap( const char *source_f, int source_len, char *const *dest_c,
- int dest_len, int ndims, const int *dims );
-int cnfLenc( const char *source_c );
-int cnfLenf( const char *source_f, int source_len );
-void *cnfMalloc( size_t );
-void *cnfRealloc( void *, size_t );
-int cnfRegp( void * );
-void cnfUregp( void * );
-void cnfLock( void );
-void cnfUnlock( void );
-#endif
-
-#ifndef CNF_OLD_DEFINED
-#define CNF_OLD_DEFINED
-/* Define old names to be new names */
-#define cnf_calloc cnfCalloc
-#define cnf_copyf cnfCopyf
-#define cnf_cptr cnfCptr
-#define cnf_creat cnfCreat
-#define cnf_cref cnfCref
-#define cnf_crefa cnfCrefa
-#define cnf_creib cnfCreib
-#define cnf_creim cnfCreim
-#define cnf_crela cnfCrela
-#define cnf_expch cnfExpch
-#define cnf_expla cnfExpla
-#define cnf_expn cnfExpn
-#define cnf_exprt cnfExprt
-#define cnf_exprta cnfExprta
-#define cnf_exprtap cnfExprtap
-#define cnf_fptr cnfFptr
-#define cnf_free cnfFree
-#define cnf_freef cnfFreef
-#define cnf_impb cnfImpb
-#define cnf_impbn cnfImpbn
-#define cnf_impch cnfImpch
-#define cnf_impla cnfImpla
-#define cnf_impn cnfImpn
-#define cnf_imprt cnfImprt
-#define cnf_imprta cnfImprta
-#define cnf_imprtap cnfImprtap
-#define cnf_lenc cnfLenc
-#define cnf_lenf cnfLenf
-#define cnf_malloc cnfMalloc
-#define cnf_regp cnfRegp
-#define cnf_uregp cnfUregp
-
-#endif /* CNF_MACROS */
diff --git a/ast/object.h b/ast/object.h
deleted file mode 100644
index b2c2d1f..0000000
--- a/ast/object.h
+++ /dev/null
@@ -1,1934 +0,0 @@
-#if !defined( OBJECT_INCLUDED ) /* Include this file only once */
-#define OBJECT_INCLUDED
-/*
-*++
-* Name:
-* object.h
-
-* Type:
-* C include file.
-
-* Purpose:
-* Define the interface to the Object class.
-
-* Invocation:
-* #include "object.h"
-
-* Description:
-* This include file defines the interface to the Object class and
-* provides the type definitions, function prototypes and macros,
-* etc. needed to use this class.
-
-* The Object class is the base class from which all other classes
-* in the AST library are derived. This class provides all the
-* basic Object behaviour and Object manipulation facilities
-* required throughout the library. There is no Object constructor,
-* however, as Objects on their own are not of much use.
-
-* Inheritance:
-* The Object base class does not inherit from any other class.
-
-* Attributes Over-Ridden:
-* None.
-
-* New Attributes Defined:
-* Class (string)
-* This is a read-only attribute containing the name of the
-* class to which an Object belongs.
-* ID (string)
-* An identification string which may be used to identify the
-* Object (e.g.) in debugging output, or when stored in an
-* external medium such as a data file. There is no restriction
-* on the string's contents. The default is an empty string.
-* Ident (string)
-* Like ID, this is an identification string which may be used
-* to identify the Object. Unlike ID, Ident is transferred when an
-* Object is copied.
-* UseDefs (int)
-* Should default values be used for unset attributes?
-* Nobject (integer)
-* This is a read-only attribute which gives the total number of
-* Objects currently in existence in the same class as the
-* Object given. It does not include Objects which belong to
-* derived (more specialised) classes. This value is mainly
-* intended for debugging, as it can be used to show whether
-* Objects which should have been deleted have, in fact, been
-* deleted.
-* ObjSize (int)
-* The in-memory size of the Object in bytes.
-* RefCount (integer)
-* This is a read-only Attribute which gives the "reference
-* count" (the number of active pointers) associated with an
-* Object. It is modified whenever pointers are created or
-* annulled (by astClone or astAnnul/astEnd for example) and
-* includes the initial pointer issued when the Object was
-* created. If the reference count for an Object falls to zero
-* as the result of annulling a pointer to it, then the Object
-* will be deleted.
-
-* Methods Over-Ridden:
-* None.
-
-* New Methods Defined:
-* Public:
-* astAnnul
-* Annul a pointer to an Object.
-* astClear
-* Clear attribute values for an Object.
-* astClone
-* Clone a pointer to an Object.
-* astCopy
-* Copy an Object.
-* astDelete
-* Delete an Object.
-* astExempt
-* Exempt an Object pointer from AST context handling
-* astExport
-* Export an Object pointer to an outer context.
-* astGet<X>, where <X> = C, D, F, I, L
-* Get an attribute value for an Object.
-* astImport
-* Import an Object pointer into the current context.
-* astSame
-* Return true if two pointers refer to the same object.
-* astSet
-* Set attribute values for an Object.
-* astSet<X>, where <X> = C, D, F, I, L
-* Set an attribute value for an Object.
-* astShow
-* Display a textual representation of an Object on standard output.
-* astTest
-* Test if an attribute value is set for an Object.
-* astTune
-* Get or set the value of a global AST tuning parameter.
-*
-* Protected:
-* astAnnulId
-* Annul an external ID for an Object (for use from protected code
-* which must handle external IDs).
-* astClearAttrib
-* Clear the value of a specified attribute for an Object.
-* astClearID
-* Clear the value of the ID attribute for an Object.
-* astClearIdent
-* Clear the value of the Ident attribute for an Object.
-* astCast
-* Return a deep copy of an object, cast into an instance of a
-* parent class.
-* astDump
-* Write an Object to a Channel.
-* astEqual
-* Are two Objects equivalent?
-* astGetAttrib
-* Get the value of a specified attribute for an Object.
-* astGetClass (deprecated synonym astClass)
-* Obtain the value of the Class attribute for an Object.
-* astGetID
-* Obtain the value of the ID attribute for an Object.
-* astGetIdent
-* Obtain the value of the Ident attribute for an Object.
-* astGetNobject
-* Obtain the value of the Nobject attribute for an Object.
-* astGetRefCount
-* Obtain the value of the RefCount attribute for an Object.
-* astSetAttrib
-* Set the value of a specified attribute for an Object.
-* astSetCopy
-* Declare a copy constructor for an Object.
-* astSetDelete
-* Declare a destructor for an Object.
-* astSetDump
-* Declare a dump function for an Object.
-* astSetVtab
-* Chaneg the virtual function table associated with an Object.
-* astSetID
-* Set the value of the ID attribute for an Object.
-* astSetIdent
-* Set the value of the Ident attribute for an Object.
-* astTestAttrib
-* Test if a specified attribute value is set for an Object.
-* astTestID
-* Test whether the ID attribute for an Object is set.
-* astTestIdent
-* Test whether the Ident attribute for an Object is set.
-* astVSet
-* Set values for an Object's attributes.
-
-* Other Class Functions:
-* Public:
-* astBegin
-* Begin a new AST context.
-* astEnd
-* End an AST context.
-* astIsAObject
-* Test class membership.
-* astVersion
-* Returns the AST library version number.
-* astEscapes
-* Remove escape sequences from returned text strings?
-* astP2I
-* Retrieve an int from a pointer.
-* astI2P
-* Pack an int into a pointer.
-*
-* Protected:
-* astCheckObject
-* Validate class membership.
-* astInitObject
-* Initialise an Object.
-* astInitObjectVtab
-* Initialise the virtual function table for the Object class.
-* astLoadObject
-* Load an Object.
-* astMakeId
-* Issue an identifier for an Object.
-* astMakePointer
-* Obtain a true C pointer from an Object identifier.
-
-* Macros:
-* Public:
-* AST__NULL
-* Null Object pointer value.
-* AST__VMAJOR
-* The AST library major version number.
-* AST__VMINOR
-* The AST library minor version number.
-* AST__RELEASE
-* The AST library release number.
-*
-* Protected:
-* astEQUAL
-* Compare two doubles for equality.
-* astMAX
-* Return maximum of two values.
-* astMIN
-* Return minimum of two values.
-* astMAKE_CHECK
-* Implement the astCheck<Class>_ function for a class.
-* astMAKE_CLEAR
-* Implement a method to clear an attribute value for a class.
-* astMAKE_GET
-* Implement a method to get an attribute value for a class.
-* astMAKE_ISA
-* Implement the astIsA<Class>_ function for a class.
-* astMAKE_SET
-* Implement a method to set an attribute value for a class.
-* astMAKE_TEST
-* Implement a method to test if an attribute has been set for a
-* class.
-* astMEMBER
-* Locate a member function.
-
-* Type Definitions:
-* Public:
-* AstObject
-* Object type.
-*
-* Protected:
-* AstObjectVtab
-* Object virtual function table type.
-
-* Feature Test Macros:
-* AST_CHECK_CLASS
-* If the AST_CHECK_CLASS macro is defined, then Object class
-* checking is enabled for all internal function invocations
-* within the AST library. Otherwise, this checking is
-* omitted. This macro should normally be defined as a compiler
-* option during library development and debugging, but left
-* undefined for software releases, so as to improve
-* peformance. Class checking by the AST public interface is not
-* affected by this macro.
-* astCLASS
-* If the astCLASS macro is undefined, only public symbols are
-* made available, otherwise protected symbols (for use in other
-* class implementations) are defined. This macro also affects
-* the reporting of error context information, which is only
-* provided for external calls to the AST library.
-* astFORTRAN77
-* If the astFORTRAN77 macro is defined, reporting of error
-* context information is suppressed. This is necessary when
-* implementing foreign language interfaces to the AST library, as
-* otherwise the file names and line numbers given would refer
-* to the interface implementation rather than the user's own
-* code.
-
-* Copyright:
-* Copyright (C) 1997-2006 Council for the Central Laboratory of the
-* Research Councils
-* Copyright (C) 2010 Science & Technology Facilities Council.
-* All Rights Reserved.
-
-* Licence:
-* This program is free software: you can redistribute it and/or
-* modify it under the terms of the GNU Lesser General Public
-* License as published by the Free Software Foundation, either
-* version 3 of the License, or (at your option) any later
-* version.
-*
-* This program is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU Lesser General Public License for more details.
-*
-* You should have received a copy of the GNU Lesser General
-* License along with this program. If not, see
-* <http://www.gnu.org/licenses/>.
-
-* Authors:
-* RFWS: R.F. Warren-Smith (Starlink)
-* DSB: David S. Berry (Starlink)
-
-* History:
-* 30-JAN-1996 (RFWS):
-* Original version.
-* 19-APR-1996 (RFWS):
-* Added macros for implementing attribute access methods.
-* 3-JUL-1996 (RFWS):
-* Added new definitions to support the external interface.
-* 10-SEP-1996 (RFWS):
-* Added loader and related facilities.
-* 30-MAY-1997 (RFWS):
-* Add the ID attribute.
-* 14-JUL-1997 (RFWS):
-* Add astExempt function.
-* 20-JAN-1998 (RFWS):
-* Make the astClear and astVSet methods virtual.
-* 15-SEP-1999 (RFWS):
-* Made the astAnnulId function accessible to protected code.
-* 3-APR-2001 (DSB):
-* Added Ident attribute.
-* 8-JAN-2003 (DSB):
-* Added protected astInitObjectVtab method.
-* 30-APR-2003 (DSB):
-* Added macros AST__VMAJOR, AST__VMINOR and AST__RELEASE.
-* Added astVersion function.
-* 7-FEB-2004 (DSB):
-* Added astEscapes function.
-* 11-MAR-2005 (DSB):
-* Added UseDefs attribute.
-* 7-FEB-2006 (DSB):
-* Added astTune function.
-* 14-FEB-2006 (DSB):
-* Added ObjSize attribute.
-* 23-FEB-2006 (DSB):
-* Moved AST__TUNULL from this file to memory.h.
-* 10-MAY-2006 (DSB):
-* Added astEQUAL, astMAX and astMIN.
-* 26-MAY-2006 (DSB):
-* Make all system includes unconditional, so that makeh is not
-* confused when creating ast.h.
-* 22-JUN-2007 (DSB):
-* - Make astVSet return a pointer to dynamic memory holding the
-* expanded setting string.
-* - Add ast astSetVtab and astCast.
-* 22-APR-2008 (DSB):
-* Added astSame.
-* 7-APR-2010 (DSB):
-* Added astHasAttribute.
-*--
-*/
-
-/* Include files. */
-/* ============== */
-/* Configuration results. */
-/* ---------------------- */
-#if HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-/* Interface definitions. */
-/* ---------------------- */
-#include "error.h" /* Error reporting facilities */
-#include "version.h" /* Version number macros */
-
-/* C header files. */
-/* --------------- */
-#include <stddef.h>
-#include <stdarg.h>
-#include <float.h>
-#include <stdio.h>
-
-#if defined(THREAD_SAFE)
-#include <pthread.h>
-#endif
-
-/* Macros. */
-/* ======= */
-#if defined(astCLASS) || defined(astFORTRAN77)
-#define STATUS_PTR status
-#else
-#define STATUS_PTR astGetStatusPtr
-#endif
-
-/* Define a dummy __attribute__ macro for use on non-GNU compilers. */
-#ifndef __GNUC__
-# define __attribute__(x) /*NOTHING*/
-#endif
-
-/* Set to "1" (yes) or "0" (no) to indicate if AST was build with threads
- support. */
-#define AST__THREADSAFE 1
-
-#if defined(astCLASS )
-#define AST__GETATTRIB_BUFF_LEN 50 /* Length of string returned by GetAttrib. */
-#define AST__ASTGETC_MAX_STRINGS 50 /* Number of string values to buffer within astGetC */
-
-/* Values supplied to astManageLock */
-#define AST__LOCK 1 /* Lock the object */
-#define AST__UNLOCK 2 /* Unlock the object */
-#define AST__CHECKLOCK 3 /* Check if the object is locked */
-
-/* Values returned by astThread */
-#define AST__UNLOCKED 1 /* Object is unlocked */
-#define AST__RUNNING 2 /* Object is locked by the running thread */
-#define AST__OTHER 3 /* Object is locked by another thread */
-
-#endif
-
-/* Value that indicates that two classes are not in direct line from each
- other. */
-#if defined(astCLASS )
-#define AST__COUSIN -1000000
-#endif
-
-/*
-*+
-* Name:
-* astINVOKE
-
-* Type:
-* Protected macro.
-
-* Purpose:
-* Invoke an AST function.
-
-* Synopsis:
-* #include "object.h"
-* astINVOKE(rettype,function)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an invocation of an AST function, together
-* with any additional actions required to support it. The actual
-* expansion depends on whether the macro is expanded in internal
-* code (astCLASS defined) or external code (astCLASS undefined)
-* and it therefore hides the differences between these two
-* interfaces.
-
-* Parameters:
-* rettype
-* A character to indicate the type of result returned by the function:
-*
-* V
-* The function returns a value (including void or a pointer
-* value, but excluding an Object pointer). astINVOKE will
-* return the value unchanged.
-* O
-* The function returns an Object pointer. astINVOKE will
-* convert it to an Object identifier if necessary.
-* F
-* The function returns a function pointer. astINVOKE will
-* return it unchanged. This is typically used when the
-* function has a variable argument list. In this case the
-* function name is passed to astINVOKE without its argument
-* list and a pointer to the function is returned which can
-* then be supplied with an argument list. This avoids the
-* need to define a macro with a variable number of arguments
-* (which isn't allowed).
-* function
-* A normal invocation of the function returning the required
-* result. In the case of a variable argument list, the
-* argument list should be omitted so that the function is not
-* invoked but a function pointer is returned that may then be
-* used to invoke it.
-
-* Examples:
-* #define astGetNobject(this) \
-* astINVOKE(V,astGetNobject_(astCheckObject(this)))
-* Defines a macro to invoke the astGetNobject_ function which
-* returns an int.
-* #define astClone(this) \
-* astINVOKE(O,astClone_(astCheckObject(this)))
-* Defines a macro to invoke the astClone_ function which
-* returns an Object pointer.
-* #define astSet astINVOKE(F,astSet_)
-* Defines a macro to invoke the astSet_ function which has a
-* variable argument list and returns void. The macro result is
-* a pointer to the astSet_ function. This function must perform
-* its own argument validation, as (e.g) astCheckObject cannot
-* be invoked on its arguments via a macro.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* Define astINVOKE, which records the current file and line number
- (in case of error) using astAt, and then invokes the function
- supplied as an argument of the astRetV_, astRetO_ or astRetF_
- macro.
-
- Suppress reporting of the file and line number from internal code
- and from foreign language interfaces by not using astAt in these
- cases. */
-#if defined(astCLASS) || defined(astFORTRAN77)
-#define astINVOKE(rettype,function) astRet##rettype##_(function)
-#else
-#define astINVOKE(rettype,function) \
-astERROR_INVOKE(astRet##rettype##_(function))
-#endif
-
-/* astRetF_ and astRetV_ currently do nothing. */
-#define astRetF_(x) (x)
-#define astRetV_(x) (x)
-
-/* However, astRetO_ converts a pointer to an ID if necessary. */
-#if defined(astCLASS)
-#define astRetO_(x) ((void *)(x))
-#else
-#define astRetO_(x) ((void *)astMakeId_((AstObject *)(x),STATUS_PTR))
-#endif
-
-/*
-*+
-* Name:
-* astINVOKE_CHECK
-* astINVOKE_ISA
-
-* Type:
-* Protected macros.
-
-* Purpose:
-* Invoke the astCheck<Class>_ and astIsA<Class>_ functions.
-
-* Synopsis:
-* #include "object.h"
-* astINVOKE_CHECK(class,this,force)
-* astINVOKE_ISA(class,this)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* These macros expand to invocations of the standard
-* astCheck<Class>_ and astIsA<Class>_ functions for a class.
-
-* Parameters:
-* class
-* The name (not the type) of the class for which the function
-* is to be invoked.
-* this
-* The "this" argument (the Object pointer) to be passed to the
-* function.
-* force
-* Type checking takes time, and so can be disabled within the
-* protected context in order to save time. Setting "force" to
-* zero causes the astINVOKE_CHECK macro to skip the class check
-* in a protected context (it assumes that AST "knows what it is
-* doing"). Setting "force" to a non-zero value forces the class
-* check even in a protected context.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* For the public interface (and also internally if AST_CHECK_CLASS is
- defined), define astINVOKE_CHECK to invoke the astCheck<Class>
- function. */
-#if !defined(astCLASS) || defined(AST_CHECK_CLASS)
-#define astINVOKE_CHECK(class,this,force) \
-astCheck##class##_((Ast##class *)astEnsurePointer_(this),astGetStatusPtr)
-
-/* For the internal interface, astINVOKE_CHECK omits the
- astCheck<class> function (unless AST_CHECK_CLASS is defined). */
-#else
-
-#define astINVOKE_CHECK(class,this,force) ( (force) ? \
- ( astCheck##class##_((Ast##class *)astEnsurePointer_(this),astGetStatusPtr) ) : \
- ( (Ast##class *) astEnsurePointer_(this) ) )
-
-#endif
-
-/* Define astINVOKE_ISA to invoke the astIsA<Class> function. */
-#if defined(astCLASS) /* Protected */
-#define astINVOKE_ISA(class,this) \
-astIsA##class##_((const Ast##class *)(this),status)
-#else /* Public */
-#define astINVOKE_ISA(class,this) \
-astINVOKE(V,astIsA##class##_((const Ast##class *)astEnsurePointer_(this),astGetStatusPtr))
-#endif
-
-/* The astEnsurePointer_ macro ensures a true C pointer, converting
- from an ID if necessary. */
-#if defined(astCLASS) /* Protected */
-#define astEnsurePointer_(x) ((void *)(x))
-#else /* Public */
-#define astEnsurePointer_(x) ((void *)astCheckLock_(astMakePointer_((AstObject *)(x),STATUS_PTR),STATUS_PTR))
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_CHECK
-
-* Type:
-* Protected macro.
-
-* Purpose:
-* Implement the astCheck<Class>_ function for a class.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_CHECK(class)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of the public astCheck<Class>_
-* function (q.v.) which validates membership of a specified class.
-
-* Parameters:
-* class
-* The name (not the type) of the class whose membership is to be
-* validated.
-
-* Notes:
-* - This macro is provided so that class definitions can easiy
-* implement the astCheck<Class>_ function, which is essentially the same
-* for each class apart for a change of name.
-* - To avoid problems with some compilers, you should not leave any white
-* space around the macro arguments.
-*-
-*/
-
-#ifndef MEM_DEBUG
-
-/* Define the macro. */
-#define astMAKE_CHECK(class) \
-\
-/* Declare the function (see the object.c file for a prologue). */ \
-Ast##class *astCheck##class##_( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return this; \
-\
-/* Check if the object is a class member. */ \
- if ( !astIsA##class( this ) ) { \
-\
-/* If not, but the pointer was valid (which means it identifies an Object \
- of some sort), then report more information about why this Object is \
- unsuitable. */ \
- if ( astOK ) { \
- astError( AST__OBJIN, "Pointer to " #class " required, but pointer " \
- "to %s given.", status, astGetClass( this ) ); \
- } \
- } \
-\
-/* Return the pointer value supplied. */ \
- return this; \
-}
-
-/* Define the macro with memory debugging facilities. */
-#else
-
-#define astMAKE_CHECK(class) \
-\
-/* Declare the function (see the object.c file for a prologue). */ \
-Ast##class *astCheck##class##_( Ast##class *this, int *status ) { \
-\
- char buf[100]; \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return this; \
-\
-/* Check if the object is a class member. */ \
- if ( !astIsA##class( this ) ) { \
-\
-/* If not, but the pointer was valid (which means it identifies an Object \
- of some sort), then report more information about why this Object is \
- unsuitable. */ \
- if ( astOK ) { \
- astError( AST__OBJIN, "Pointer to " #class " required, but pointer " \
- "to %s given.", status, astGetClass( this ) ); \
- }\
-\
- } else { \
-\
-/* Call the astMemoryUse function to report it if the memory block is \
- being watched. */ \
- sprintf( buf, "checked (refcnt: %d)", astGetRefCount_( (AstObject *) this, status ) ); \
- astMemoryUse( this, buf ); \
- } \
-\
-/* Return the pointer value supplied. */ \
- return this; \
-}
-#endif
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_CLEAR
-
-* Purpose:
-* Implement a method to clear an attribute value for a class.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_CLEAR(class,attribute,component,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static void Clear<Attribute>( Ast<Class> *this )
-*
-* and an external interface function of the form:
-*
-* void astClear<Attribute>_( Ast<Class> *this )
-*
-* which implement a method for clearing a specified attribute value for
-* a class.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute to be cleared, as it appears in the function
-* name (e.g. Label in "astClearLabel").
-* component
-* The name of the class structure component that holds the attribute
-* value.
-* assign
-* An expression that evaluates to the value to assign to the component
-* to clear its value.
-
-* Examples:
-* astMAKE_CLEAR(MyStuff,Flag,flag,-1)
-* Implements the astClearFlag method for the MyStuff class which
-* operates by setting the "flag" structure component to -1 to indicate
-* that it has no value.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave any white
-* space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_CLEAR(class,attribute,component,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static void Clear##attribute( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Assign the "clear" value. */ \
- this->component = (assign); \
-} \
-\
-/* External interface. */ \
-/* ------------------- */ \
-void astClear##attribute##_( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Invoke the required method via the virtual function table. */ \
- (**astMEMBER(this,class,Clear##attribute))( this, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_CLEAR1
-
-* Purpose:
-* Implement a method to clear an attribute value for a class, reporting
-* an error if the object has more than one reference.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_CLEAR1(class,attribute,component,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static void Clear<Attribute>( Ast<Class> *this )
-*
-* and an external interface function of the form:
-*
-* void astClear<Attribute>_( Ast<Class> *this )
-*
-* which implement a method for clearing a specified attribute value for
-* a class. An error is reported if the object has a reference count that
-* is greater than one.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute to be cleared, as it appears in the function
-* name (e.g. Label in "astClearLabel").
-* component
-* The name of the class structure component that holds the attribute
-* value.
-* assign
-* An expression that evaluates to the value to assign to the component
-* to clear its value.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave any white
-* space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_CLEAR1(class,attribute,component,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static void Clear##attribute( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Report an error if the object has been cloned (i.e. has a reference \
- count that is greater than one). */ \
- if( astGetRefCount( this ) > 1 ) { \
- astError( AST__IMMUT, "astClear(%s): The " #attribute "attribute of " \
- "the supplied %s cannot be cleared because the %s has " \
- "been cloned (programming error).", status, \
- astGetClass(this), astGetClass(this), astGetClass(this) ); \
-\
-/* Otherwise, assign the "clear" value in the structure component. */ \
- } else { \
- this->component = (assign); \
- } \
-} \
-\
-/* External interface. */ \
-/* ------------------- */ \
-void astClear##attribute##_( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Invoke the required method via the virtual function table. */ \
- (**astMEMBER(this,class,Clear##attribute))( this, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_GET
-
-* Purpose:
-* Implement a method to get an attribute value for a class.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_GET(class,attribute,type,bad_value,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static <Type> Get<Attribute>( Ast<Class> *this )
-*
-* and an external interface function of the form:
-*
-* <Type> astGet<Attribute>_( Ast<Class> *this )
-*
-* which implement a method for getting a specified attribute value for a
-* class.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute whose value is to be obtained, as it
-* appears in the function name (e.g. Label in "astGetLabel").
-* type
-* The C type of the attribute.
-* bad_value
-* A constant value to return if the inherited error status is set, or if
-* the function fails.
-* assign
-* An expression that evaluates to the value to be returned.
-
-* Examples:
-* astMAKE_GET(MyStuff,Flag,int,0,( this->flag == 1 ))
-* Implements the astGetFlag method for the MyStuff class which operates
-* by examining the integer "flag" structure component and comparing it
-* with the value 1 to see if it is set. A value of 0 is returned if the
-* method fails to complete successfully.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave any white
-* space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_GET(class,attribute,type,bad_value,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static type Get##attribute( Ast##class *this, int *status ) { \
- type result; /* Result to be returned */ \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return (bad_value); \
-\
-/* Assign the result value. */ \
- result = (assign); \
-\
-/* Check for errors and clear the result if necessary. */ \
- if ( !astOK ) result = (bad_value); \
-\
-/* Return the result. */ \
- return result; \
-} \
-/* External interface. */ \
-/* ------------------- */ \
-type astGet##attribute##_( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return (bad_value); \
-\
-/* Invoke the required method via the virtual function table. */ \
- return (**astMEMBER(this,class,Get##attribute))( this, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_ISA
-
-* Type:
-* Protected macro.
-
-* Purpose:
-* Implement the astIsA<Class>_ function for a class.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_ISA(class,parent)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of the public
-* astIsA<Class>_ function (q.v.) which checks membership of a
-* specified class.
-
-* Parameters:
-* class
-* The name (not the type) of the class whose membership is to be
-* tested.
-* parent
-* The name of the parent class.
-
-* Notes:
-* - This macro is provided so that class definitions can easiy
-* implement the astIsA<Class>_ function, which is essentially the
-* same for each class apart for a change of name.
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_ISA(class,parent) \
-\
-/* Declare the function (see the object.c file for a prologue). */ \
-int astIsA##class##_( const Ast##class *this, int *status ) { \
-\
-/* Local Variables: */ \
- int isa = 0; /* Is object a member? */ \
-\
-/* To test if the object is correctly constructed, we first test if it is a \
- member of the parent class. This improves the security of the test by \
- checking the object structure from the base Object class downwards \
- (without this, the "magic numbers" that identify classes might be \
- encountered by accident or we might address parts of the Object which \
- don't exist). */ \
- if ( astIsA##parent( this ) ) { \
-\
-/* Obtain the Object's size and check it is adequate for an object of the \
- proposed type (this avoids any attempt to access derived class data that \
- doesn't exist and therefore lies outside the memory allocated for the \
- object). */ \
- if ( ( (AstObject *) this )->size >= sizeof( Ast##class ) ) { \
-\
-/* If OK, see whether the check component in the object's virtual function \
- table matches the expected "magic" value. */ \
- isa = ( *astMEMBER(this,class,id.check) == &class_check ); \
- } \
- } \
-\
-/* Return the result. */ \
- return isa; \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_SET
-
-* Purpose:
-* Implement a method to set an attribute value for a class.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_SET(class,attribute,type,component,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static void Set<Attribute>( Ast<Class> *this, <Type> value )
-*
-* and an external interface function of the form:
-*
-* void astSet<Attribute>_( Ast<Class> *this, <Type> value )
-*
-* which implement a method for setting a specified attribute value for a
-* class.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute to be set, as it appears in the function
-* name (e.g. Label in "astSetLabel").
-* type
-* The C type of the attribute.
-* component
-* The name of the class structure component that holds the attribute
-* value.
-* assign
-* An expression that evaluates to the value to be assigned to the
-* component.
-
-* Examples:
-* astMAKE_SET(MyStuff,Flag,int,flag,( value != 0 ))
-* Implements the astSetFlag method for the MyStuff class which operates
-* by setting the "flag" structure component to 0 or 1 depending on
-* whether the "value" parameter is non-zero or not.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_SET(class,attribute,type,component,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static void Set##attribute( Ast##class *this, type value, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Store the new value in the structure component. */ \
- this->component = (assign); \
-} \
-\
-/* External interface. */ \
-/* ------------------- */ \
-void astSet##attribute##_( Ast##class *this, type value, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Invoke the required method via the virtual function table. */ \
- (**astMEMBER(this,class,Set##attribute))( this, value, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_SET1
-
-* Purpose:
-* Implement a method to set an attribute value for a class, reporting
-* an error if the object has more than one reference.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_SET1(class,attribute,type,component,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static void Set<Attribute>( Ast<Class> *this, <Type> value )
-*
-* and an external interface function of the form:
-*
-* void astSet<Attribute>_( Ast<Class> *this, <Type> value )
-*
-* which implement a method for setting a specified attribute value for a
-* class. An error is reported if the object has a reference count that
-* is greater than one.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute to be set, as it appears in the function
-* name (e.g. Label in "astSetLabel").
-* type
-* The C type of the attribute.
-* component
-* The name of the class structure component that holds the attribute
-* value.
-* assign
-* An expression that evaluates to the value to be assigned to the
-* component.
-
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_SET1(class,attribute,type,component,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static void Set##attribute( Ast##class *this, type value, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Report an error if the object has been cloned (i.e. has a reference \
- count that is greater than one). */ \
- if( astGetRefCount( this ) > 1 ) { \
- astError( AST__IMMUT, "astSet(%s): The " #attribute "attribute of " \
- "the supplied %s cannot be changed because the %s has " \
- "been cloned (programming error).", status, \
- astGetClass(this), astGetClass(this), astGetClass(this) ); \
-\
-/* Otherwise, store the new value in the structure component. */ \
- } else { \
- this->component = (assign); \
- } \
-} \
-\
-/* External interface. */ \
-/* ------------------- */ \
-void astSet##attribute##_( Ast##class *this, type value, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return; \
-\
-/* Invoke the required method via the virtual function table. */ \
- (**astMEMBER(this,class,Set##attribute))( this, value, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMAKE_TEST
-
-* Purpose:
-* Implement a method to test if an attribute has been set for a class.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMAKE_TEST(class,attribute,assign)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro expands to an implementation of a private member function of
-* the form:
-*
-* static int Test<Attribute>( Ast<Class> *this )
-*
-* and an external interface function of the form:
-*
-* int astTest<Attribute>_( Ast<Class> *this )
-*
-* which implement a method for testing if a specified attribute has been
-* set for a class.
-
-* Parameters:
-* class
-* The name (not the type) of the class to which the attribute belongs.
-* attribute
-* The name of the attribute to be tested, as it appears in the function
-* name (e.g. Label in "astTestLabel").
-* assign
-* An expression that evaluates to 0 or 1, to be used as the returned
-* value.
-
-* Examples:
-* astMAKE_TEST(MyStuff,Flag,( this->flag != -1 ))
-* Implements the astTestFlag method for the MyStuff class which operates
-* by testing the "flag" structure component to see if it is set to a
-* value other than -1.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave any white
-* space around the macro arguments.
-*-
-*/
-
-/* Define the macro. */
-#define astMAKE_TEST(class,attribute,assign) \
-\
-/* Private member function. */ \
-/* ------------------------ */ \
-static int Test##attribute( Ast##class *this, int *status ) { \
- int result; /* Value to return */ \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return 0; \
-\
-/* Assign the result value. */ \
- result = (assign); \
-\
-/* Check for errors and clear the result if necessary. */ \
- if ( !astOK ) result = 0; \
-\
-/* Return the result. */ \
- return result; \
-} \
-/* External interface. */ \
-/* ------------------- */ \
-int astTest##attribute##_( Ast##class *this, int *status ) { \
-\
-/* Check the inherited error status. */ \
- if ( !astOK ) return 0; \
-\
-/* Invoke the required method via the virtual function table. */ \
- return (**astMEMBER(this,class,Test##attribute))( this, status ); \
-}
-#endif
-
-#if defined(astCLASS) /* Protected */
-/*
-*+
-* Name:
-* astMEMBER
-
-* Purpose:
-* Locate a member function.
-
-* Type:
-* Protected macro.
-
-* Synopsis:
-* #include "object.h"
-* astMEMBER(this,class,method)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* This macro evaluates to the address where the pointer to a
-* specified Object member function is stored. Typically, this will
-* be used to obtain a pointer to the member function so that it
-* can be invoked. It may also be used to assign a new function
-* pointer so that a derived class can re-define a virtual function
-* and hence over-ride an inherited method.
-
-* Parameters:
-* this
-* Pointer to an Object belonging to the class for which the
-* virtual function is required. This must either be the class
-* that originally defined the method, or one derived from it.
-* class
-* Name of the class that originally defined the method. This
-* may differ from (i.e. be an ancestor of) the class to which
-* "this" belongs.
-* method
-* Name of the method whose member function is to be located.
-
-* Returned Value:
-* The address where the member function pointer is stored (the
-* type of the result is determined by the type of the member
-* function itself).
-
-* Examples:
-* astMEMBER(this,Gnome,astFish)
-* Returns the address where the pointer to the function that
-* implements the astFish method for the "this" object is
-* stored. The Gnome class should be where the astFish method
-* was first defined (i.e. from where it was inherited by
-* "this").
-* (**astMEMBER(this,Gnome,astFish))( this, arg1, arg2 );
-* Invokes the virtual function that implements the astFish
-* method for object "this" and passes it additional arguments
-* "arg2" and "arg2". Again, Gnome should be the class that
-* originally defined the astFish method.
-* *astMEMBER(this,Gnome,astFish) = myFish;
-* Stores a pointer to the myFish function so that it replaces
-* the virtual function that previously implemented the astFish
-* method for the "this" object. Note that all objects in the
-* same class as "this" are affected, but objects in class
-* "class" are not affected (unless it happens to be the class
-* to which "this" belongs).
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* A subsiduary macro that returns a pointer to the vtab of an object,
- cast to an AstObjectVtab. */
-#define astVTAB(this) (((AstObject*)(this))->vtab)
-
-/* Define the macro. This functions by (a) casting the Object pointer
- to type (AstObject *) and locating the Object's virtual function
- table (b) casting the table pointer to the correct type
- (AstClassVtab *) for the class in which the method pointer resides,
- (c) locating the component holding the member function pointer, and
- (d) taking its address. */
-#define astMEMBER(this,class,method) \
-(&((Ast##class##Vtab*)astVTAB(this))->method)
-
-#endif
-
-/*
-*+
-* Name:
-* astPROTO_CHECK
-* astPROTO_ISA
-
-* Type:
-* Protected macros.
-
-* Purpose:
-* Prototype the astCheck<Class>_ and astIsA<Class>_ functions.
-
-* Synopsis:
-* #include "object.h"
-* astPROTO_CHECK(class)
-* astPROTO_ISA(class)
-
-* Class Membership:
-* Defined by the Object class.
-
-* Description:
-* These macros expands to function prototypes for the
-* astCheck<Class>_ and astIsA<Class>_ functions (q.v.) which
-* validate and test for membership of a specified class.
-
-* Parameters:
-* class
-* The name (not the type) of the class whose membership is to
-* be validated.
-
-* Notes:
-* - To avoid problems with some compilers, you should not leave
-* any white space around the macro arguments.
-*-
-*/
-
-/* Define the macros. */
-#define astPROTO_CHECK(class) Ast##class *astCheck##class##_( Ast##class *, int * );
-#define astPROTO_ISA(class) int astIsA##class##_( const Ast##class *, int * );
-
-/* Macros which return the maximum and minimum of two values. */
-#define astMAX(aa,bb) ((aa)>(bb)?(aa):(bb))
-#define astMIN(aa,bb) ((aa)<(bb)?(aa):(bb))
-
-/* Check for equality of floating point values. We cannot compare bad values
- directly because of the danger of floating point exceptions, so bad
- values are dealt with explicitly. */
-#define astEQUALS(aa,bb,tol) (((aa)==AST__BAD)?(((bb)==AST__BAD)?1:0):(((bb)==AST__BAD)?0:(fabs((aa)-(bb))<=(tol)*astMAX((fabs(aa)+fabs(bb))*DBL_EPSILON,DBL_MIN))))
-#define astEQUAL(aa,bb) astEQUALS(aa,bb,1.0E5)
-
-
-/* AST__NULL. */
-/* ---------- */
-/* Define the AST__NULL macro, which evaluates to a null Object
- pointer. */
-#define AST__NULL (astI2P(0))
-
-
-#if defined(astCLASS) /* Protected */
-
-/* Test the validy of an attribute value */
-/* ------------------------------------- */
-/* If the set attribute value is invalid, clear it. These macros should
- be used in a context in which error reporting has been deferred by
- calling astReporting( 0 ). */
-
-#define astCLEAN_ATTRIB(attr) \
- if( astTest##attr(this) ) { \
- astSet##attr( this, astGet##attr( this ) ); \
- if( !astOK ) { \
- astClearStatus; \
- astClear##attr( this ); \
- } \
- }
-
-#define astCLEAN_INDEXED_ATTRIB(attr,index) \
- if( astTest##attr(this,index) ) { \
- astSet##attr( this, index, astGet##attr( this, index ) ); \
- if( !astOK ) { \
- astClearStatus; \
- astClear##attr( this, index ); \
- } \
- }
-
-#endif
-
-
-#if defined(astCLASS) /* Protected */
-#define astSetVtabClassIdentifier(vtab,id_ptr) \
- ((AstObjectVtab *)(vtab))->top_id = (id_ptr)
-#endif
-
-/* Type Definitions. */
-/* ================= */
-
-/* Object structure. */
-/* ----------------- */
-/* This structure contains all information that is unique to each object in
- the class (e.g. its instance variables). */
-typedef struct AstObject {
-
-/* Attributes specific to objects in this class. */
- unsigned long check; /* Check value to identify Objects */
- size_t size; /* Amount of memory used by Object */
- struct AstObjectVtab *vtab; /* Pointer to virtual function table */
- char dynamic; /* Memory allocated dynamically? */
- int ref_count; /* Number of active pointers to the Object */
- char *id; /* Pointer to ID string */
- char *ident; /* Pointer to Ident string */
- char usedefs; /* Use default attribute values? */
- int iref; /* Object index (unique within class) */
- void *proxy; /* A pointer to an external object that
- acts as a foreign language proxy for the
- AST object */
-#if defined(THREAD_SAFE)
- int locker; /* Thread that has locked this Object */
- pthread_mutex_t mutex1; /* Guards access to all elements of the
- Object except for the "locker" and
- "ref_count" components */
- pthread_mutex_t mutex2; /* Guards access to the "locker" and
- "ref_count" components */
- struct AstGlobals *globals; /* Pointer to thread-specific global data */
-#endif
-
-} AstObject;
-
-/* Class identifier structure */
-typedef struct AstClassIdentifier {
- int *check;
- struct AstClassIdentifier *parent;
-} AstClassIdentifier;
-
-/* Virtual function table. */
-/* ----------------------- */
-/* The virtual function table makes a forward reference to the
- AstChannel structure which is not defined until "channel.h" is
- included (below). Hence make a preliminary definition available
- now. */
-struct AstChannel;
-
-/* This table contains all information that is the same for all
- objects in the class (e.g. pointers to its virtual functions). */
-#if defined(astCLASS) /* Protected */
-typedef struct AstObjectVtab {
-
-/* A unique identifier for this class. */
- AstClassIdentifier id;
-
-/* Pointer to the structure that identifies the top-level class described
- by the whole vtab (of which the AstObjectVtab is just the first,
- lowest-level, component). */
- AstClassIdentifier *top_id;
-
-/* Pointer to a dynamically allocated string holding the default
- attribute values to use when creating new objects. These are read from
- environment variables of the form "<CLASSNAME>_OPTIONS". */
- const char *defaults;
-
-/* Properties specific to this class. */
- void ( *CleanAttribs )( AstObject *, int * );
- AstObject *( *Cast )( AstObject *, AstObject *, int * );
- const char *( *GetID )( AstObject *, int * );
- const char *( *GetIdent )( AstObject *, int * );
- const char *(* GetAttrib)( AstObject *, const char *, int * );
- int (* TestAttrib)( AstObject *, const char *, int * );
- int (* TestID)( AstObject *, int * );
- int (* Same)( AstObject *, AstObject *, int * );
- int (* HasAttribute)( AstObject *, const char *, int * );
- int (* TestIdent)( AstObject *, int * );
- void (* Clear)( AstObject *, const char *, int * );
- void (* ClearAttrib)( AstObject *, const char *, int * );
- void (* ClearID)( AstObject *, int * );
- void (* ClearIdent)( AstObject *, int * );
- void (* Dump)( AstObject *, struct AstChannel *, int * );
- int (* Equal)( AstObject *, AstObject *, int * );
- void (* SetAttrib)( AstObject *, const char *, int * );
- void (* SetID)( AstObject *, const char *, int * );
- void (* SetIdent)( AstObject *, const char *, int * );
- void (* Show)( AstObject *, int * );
- void (* VSet)( AstObject *, const char *, char **, va_list, int * );
- void (* EnvSet)( AstObject *, int * );
-
- void *(* GetProxy)( AstObject *, int * );
- void (* SetProxy)( AstObject *, void *, int * );
-
- int (* GetObjSize)( AstObject *, int * );
-
- int (* TestUseDefs)( AstObject *, int * );
- int (* GetUseDefs)( AstObject *, int * );
- void (* SetUseDefs)( AstObject *, int, int * );
- void (* ClearUseDefs)( AstObject *, int * );
-
- const char *class; /* Pointer to class name string */
- void (** delete)( AstObject *, int * ); /* Pointer to array of destructors */
- void (** copy)( const AstObject *, AstObject *, int * ); /* Copy constructors */
- void (** dump)( AstObject *, struct AstChannel *, int * ); /* Dump functions */
- const char **dump_class; /* Dump function class string pointers */
- const char **dump_comment; /* Dump function comment string pointers */
- int ndelete; /* Number of destructors */
- int ncopy; /* Number of copy constructors */
- int ndump; /* Number of dump functions */
- int nobject; /* Number of active objects in the class */
- int nfree; /* No. of entries in "free_list" */
- AstObject **free_list; /* List of pointers for freed Objects */
-
-#if defined(THREAD_SAFE)
- int (* ManageLock)( AstObject *, int, int, AstObject **, int * );
-#endif
-
-} AstObjectVtab;
-#endif
-
-#if defined(THREAD_SAFE) && defined(astCLASS)
-
-/* Define a structure holding all data items that are global within the
- object.c file. */
-
-typedef struct AstObjectGlobals {
- AstObjectVtab Class_Vtab;
- int Class_Init;
- int Retain_Esc;
- int Context_Level;
- int *Active_Handles;
- char GetAttrib_Buff[ AST__GETATTRIB_BUFF_LEN + 1 ];
- char *AstGetC_Strings[ AST__ASTGETC_MAX_STRINGS ];
- int AstGetC_Istr;
- int AstGetC_Init;
- int Nvtab;
- AstObjectVtab **Known_Vtabs;
-} AstObjectGlobals;
-
-#endif
-
-/* More include files. */
-/* =================== */
-/* The interface to the Channel class must be included here (after the
- type definitions for the Object class) because "channel.h" itself
- includes this file ("object.h"), although "object.h" refers to the
- AstChannel structure above. This seems a little strange at first,
- but is simply analogous to making a forward reference to a
- structure type when recursively defining a normal C structure
- (except that here the definitions happen to be in separate include
- files). */
-#include "channel.h"
-
-/* Function prototypes. */
-/* ==================== */
-/* Prototypes for standard class functions. */
-/* ---------------------------------------- */
-astPROTO_CHECK(Object) /* Validate class membership */
-astPROTO_ISA(Object) /* Test class membership */
-
-/* NB. There is no constructor function for this class. */
-
-#if defined(astCLASS) /* Protected */
-
-/* Initialiser. */
-AstObject *astInitObject_( void *, size_t, int, AstObjectVtab *,
- const char *, int * );
-
-/* Vtab Initialiser. */
-void astInitObjectVtab_( AstObjectVtab *, const char *, int * );
-
-/* Loader. */
-AstObject *astLoadObject_( void *, size_t, AstObjectVtab *,
- const char *, AstChannel *channel, int * );
-
-#if defined(THREAD_SAFE)
-void astInitObjectGlobals_( AstObjectGlobals * );
-#endif
-
-#endif
-
-/* Prototypes for other class functions. */
-/* ------------------------------------- */
-#if !defined(astCLASS) /* Public */
-void astBegin_( void );
-void astEnd_( int * );
-#endif
-
-AstObject *astI2P_( int, int * );
-AstObject *astMakeId_( AstObject *, int * );
-AstObject *astMakePointer_( AstObject *, int * );
-AstObject *astMakePointer_NoLockCheck_( AstObject *, int * );
-int astP2I_( AstObject *, int * );
-int astVersion_( int * );
-int astEscapes_( int, int * );
-int astTune_( const char *, int, int * );
-void astTuneC_( const char *, const char *, char *, int, int * );
-
-/* Prototypes for member functions. */
-/* -------------------------------- */
-#if defined(astCLASS) /* Protected */
-AstObject *astAnnul_( AstObject *, int * );
-AstObject *astDelete_( AstObject *, int * );
-void astSet_( void *, const char *, int *, ... );
-
-#else /* Public */
-AstObject *astDeleteId_( AstObject *, int * );
-int astThreadId_( AstObject *, int, int * );
-void astExportId_( AstObject *, int * );
-void astImportId_( AstObject *, int * );
-void astSetId_( void *, const char *, ... )__attribute__((format(printf,2,3)));
-#endif
-
-AstObject *astAnnulId_( AstObject *, int * );
-AstObject *astCheckLock_( AstObject *, int * );
-AstObject *astClone_( AstObject *, int * );
-AstObject *astCopy_( const AstObject *, int * );
-AstObject *astFromString_( const char *, int * );
-char *astToString_( AstObject *, int * );
-const char *astGetC_( AstObject *, const char *, int * );
-double astGetD_( AstObject *, const char *, int * );
-float astGetF_( AstObject *, const char *, int * );
-int astEqual_( AstObject *, AstObject *, int * );
-int astGetI_( AstObject *, const char *, int * );
-int astHasAttribute_( AstObject *, const char *, int * );
-int astSame_( AstObject *, AstObject *, int * );
-int astTest_( AstObject *, const char *, int * );
-long astGetL_( AstObject *, const char *, int * );
-void *astGetProxy_( AstObject *, int * );
-void astClear_( AstObject *, const char *, int * );
-void astExemptId_( AstObject *, int * );
-void astLockId_( AstObject *, int, int * );
-void astSetC_( AstObject *, const char *, const char *, int * );
-void astSetD_( AstObject *, const char *, double, int * );
-void astSetF_( AstObject *, const char *, float, int * );
-void astSetI_( AstObject *, const char *, int, int * );
-void astSetL_( AstObject *, const char *, long, int * );
-void astSetProxy_( AstObject *, void *, int * );
-void astShow_( AstObject *, int * );
-void astUnlockId_( AstObject *, int, int * );
-
-#if defined(astCLASS) /* Protected */
-
-void astCleanAttribs_( AstObject *, int * );
-AstObject *astCast_( AstObject *, AstObject *, int * );
-AstObject *astCastCopy_( AstObject *, AstObject *, int * );
-
-#if defined(THREAD_SAFE)
-int astManageLock_( AstObject *, int, int, AstObject **, int * );
-#endif
-
-int astGetObjSize_( AstObject *, int * );
-
-int astTestUseDefs_( AstObject *, int * );
-int astGetUseDefs_( AstObject *, int * );
-void astSetUseDefs_( AstObject *, int, int * );
-void astClearUseDefs_( AstObject *, int * );
-
-const char *astGetAttrib_( AstObject *, const char *, int * );
-const char *astGetClass_( const AstObject *, int * );
-const char *astGetID_( AstObject *, int * );
-const char *astGetIdent_( AstObject *, int * );
-int astClassCompare_( AstObjectVtab *, AstObjectVtab *, int * );
-int astGetNobject_( const AstObject *, int * );
-int astGetRefCount_( AstObject *, int * );
-int astTestAttrib_( AstObject *, const char *, int * );
-int astTestID_( AstObject *, int * );
-int astTestIdent_( AstObject *, int * );
-void astClearAttrib_( AstObject *, const char *, int * );
-void astClearID_( AstObject *, int * );
-void astClearIdent_( AstObject *, int * );
-void astDump_( AstObject *, AstChannel *, int * );
-void astSetAttrib_( AstObject *, const char *, int * );
-void astSetCopy_( AstObjectVtab *, void (*)( const AstObject *, AstObject *, int * ), int * );
-void astSetDelete_( AstObjectVtab *, void (*)( AstObject *, int * ), int * );
-void astSetDump_( AstObjectVtab *, void (*)( AstObject *, AstChannel *, int * ), const char *, const char *, int * );
-void astSetVtab_( AstObject *, AstObjectVtab *, int * );
-void astSetID_( AstObject *, const char *, int * );
-void astSetIdent_( AstObject *, const char *, int * );
-void astEnvSet_( AstObject *, int * );
-void astVSet_( AstObject *, const char *, char **, va_list, int * );
-
-#endif
-
-
-/* Function interfaces. */
-/* ==================== */
-/* These macros are wrap-ups for the functions defined by this class
- to make them easier to invoke (e.g. to avoid type mis-matches when
- passing pointers to objects from derived classes). */
-
-/* Interfaces to standard class functions. */
-/* --------------------------------------- */
-/* Check class membership. */
-#define astCheckObject(this) astINVOKE_CHECK(Object,this,0)
-#define astVerifyObject(this) astINVOKE_CHECK(Object,this,1)
-
-/* Test class membership. */
-#define astIsAObject(this) astINVOKE_ISA(Object,this)
-
-/* NB. There is no constructor function for this class. */
-
-#if defined(astCLASS) /* Protected */
-
-/* Initialiser. */
-#define astInitObject(mem,size,init,vtab,name) \
-astINVOKE(O,astInitObject_(mem,size,init,vtab,name,STATUS_PTR))
-
-/* Vtab Initialiser. */
-#define astInitObjectVtab(vtab,name) astINVOKE(V,astInitObjectVtab_(vtab,name,STATUS_PTR))
-
-/* Loader. */
-#define astLoadObject(mem,size,vtab,name,channel) \
-astINVOKE(O,astLoadObject_(mem,size,vtab,name,astCheckChannel(channel),STATUS_PTR))
-#endif
-
-/* Interfaces to other class functions. */
-/* ------------------------------------ */
-#if !defined(astCLASS) /* Public */
-#define astBegin astBegin_()
-#define astEnd astINVOKE(V,astEnd_(STATUS_PTR))
-#else /* Protected */
-#define astMakePointer_NoLockCheck(id) ((void *)astMakePointer_NoLockCheck_((AstObject *)(id),STATUS_PTR))
-#endif
-
-#define astVersion astVersion_(STATUS_PTR)
-#define astEscapes(int) astEscapes_(int,STATUS_PTR)
-#define astTune(name,val) astTune_(name,val,STATUS_PTR)
-#define astTuneC(name,value,buff,bufflen) astTuneC_(name,value,buff,bufflen,STATUS_PTR)
-#define astI2P(integer) ((void *)astI2P_(integer,STATUS_PTR))
-#define astMakeId(pointer) ((void *)astMakeId_((AstObject *)(pointer),STATUS_PTR))
-#define astP2I(pointer) astP2I_((AstObject *)(pointer),STATUS_PTR)
-#define astMakePointer(id) ((void *)astCheckLock_(astMakePointer_((AstObject *)(id),STATUS_PTR),STATUS_PTR))
-#define astToString(this) astINVOKE(V,astToString_(astCheckObject(this),STATUS_PTR))
-#define astFromString(string) astINVOKE(O,astFromString_(string,STATUS_PTR))
-
-/* Interfaces to member functions. */
-/* ------------------------------- */
-/* Here we make use of astCheckObject (et al.) to validate Object
- pointers before use. This provides a contextual error report if a
- pointer to the wrong sort of object is supplied. In the case of an
- external caller, it also performs the required conversion from an
- Object identifier to a true C pointer. */
-
-/* These functions require special treatment for external use because
- they handle Object identifiers and their resources explicitly, and
- must therefore be passed identifier values without conversion to C
- pointers. */
-
-#if defined(astCLASS) || defined(astFORTRAN77) /* Protected or Fotran interface */
-#define astAnnulId(this) astINVOKE(O,astAnnulId_((AstObject *)(this),STATUS_PTR))
-#endif
-
-#if defined(astCLASS) /* Protected only */
-#define astAnnul(this) astINVOKE(O,astAnnul_(astCheckObject(this),STATUS_PTR))
-#define astDelete(this) astINVOKE(O,astDelete_(astCheckObject(this),STATUS_PTR))
-#define astSet astINVOKE(F,astSet_)
-
-#else /* Public only */
-#define astAnnul(this) astINVOKE(O,astAnnulId_((AstObject *)(this),STATUS_PTR))
-#define astDelete(this) astINVOKE(O,astDeleteId_((AstObject *)(this),STATUS_PTR))
-#define astExport(this) astINVOKE(V,astExportId_((AstObject *)(this),STATUS_PTR))
-#define astImport(this) astINVOKE(V,astImportId_((AstObject *)(this),STATUS_PTR))
-#define astSet astINVOKE(F,astSetId_)
-#define astThread(this,ptr) astINVOKE(V,astThreadId_((AstObject *)(this),ptr,STATUS_PTR))
-#endif
-
-/* Both.... */
-#define astLock(this,wait) astINVOKE(V,astLockId_((AstObject *)(this),wait,STATUS_PTR))
-#define astUnlock(this,report) astINVOKE(V,astUnlockId_((AstObject *)(this),report,STATUS_PTR))
-#define astEqual(this,that) astINVOKE(V,(((AstObject*)this==(AstObject*)that)||astEqual_(astCheckObject(this),astCheckObject(that),STATUS_PTR)))
-#define astExempt(this) astINVOKE(V,astExemptId_((AstObject *)(this),STATUS_PTR))
-#define astClear(this,attrib) astINVOKE(V,astClear_(astCheckObject(this),attrib,STATUS_PTR))
-#define astClone(this) astINVOKE(O,astClone_(astCheckObject(this),STATUS_PTR))
-#define astCopy(this) astINVOKE(O,astCopy_(astCheckObject(this),STATUS_PTR))
-#define astGetC(this,attrib) astINVOKE(V,astGetC_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetD(this,attrib) astINVOKE(V,astGetD_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetF(this,attrib) astINVOKE(V,astGetF_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetI(this,attrib) \
-astINVOKE(V,astGetI_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetL(this,attrib) \
-astINVOKE(V,astGetL_(astCheckObject(this),attrib,STATUS_PTR))
-#define astSetC(this,attrib,value) \
-astINVOKE(V,astSetC_(astCheckObject(this),attrib,value,STATUS_PTR))
-#define astSetD(this,attrib,value) \
-astINVOKE(V,astSetD_(astCheckObject(this),attrib,value,STATUS_PTR))
-#define astSetF(this,attrib,value) \
-astINVOKE(V,astSetF_(astCheckObject(this),attrib,value,STATUS_PTR))
-#define astSetI(this,attrib,value) \
-astINVOKE(V,astSetI_(astCheckObject(this),attrib,value,STATUS_PTR))
-#define astSetL(this,attrib,value) \
-astINVOKE(V,astSetL_(astCheckObject(this),attrib,value,STATUS_PTR))
-#define astShow(this) \
-astINVOKE(V,astShow_(astCheckObject(this),STATUS_PTR))
-#define astTest(this,attrib) \
-astINVOKE(V,astTest_(astCheckObject(this),attrib,STATUS_PTR))
-#define astSame(this,that) \
-astINVOKE(V,astSame_(astCheckObject(this),astCheckObject(that),STATUS_PTR))
-#define astHasAttribute(this,attrib) \
-astINVOKE(V,astHasAttribute_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetProxy(this) \
-astINVOKE(V,astGetProxy_(astCheckObject(this),STATUS_PTR))
-#define astSetProxy(this,proxy) \
-astINVOKE(V,astSetProxy_(astCheckObject(this),proxy,STATUS_PTR))
-
-
-#if defined(astCLASS) /* Protected */
-
-#if defined(THREAD_SAFE)
-#define astManageLock(this,mode,extra,fail) \
-astINVOKE(V,astManageLock_(astCheckObject(this),mode, extra,fail,STATUS_PTR))
-#else
-#define astManageLock(this,mode,extra,fail)
-#endif
-
-#define astCleanAttribs(this) astINVOKE(V,astCleanAttribs_(astCheckObject(this),STATUS_PTR))
-#define astGetObjSize(this) astINVOKE(V,astGetObjSize_(astCheckObject(this),STATUS_PTR))
-#define astCast(this,obj) astINVOKE(O,astCast_(astCheckObject(this),astCheckObject(obj),STATUS_PTR))
-#define astCastCopy(this,obj) astCastCopy_((AstObject*)this,(AstObject*)obj,STATUS_PTR)
-
-#define astClearUseDefs(this) astINVOKE(V,astClearUseDefs_(astCheckObject(this),STATUS_PTR))
-#define astTestUseDefs(this) astINVOKE(V,astTestUseDefs_(astCheckObject(this),STATUS_PTR))
-#define astGetUseDefs(this) astINVOKE(V,astGetUseDefs_(astCheckObject(this),STATUS_PTR))
-#define astSetUseDefs(this,val) astINVOKE(V,astSetUseDefs_(astCheckObject(this),val,STATUS_PTR))
-
-#define astClearAttrib(this,attrib) \
-astINVOKE(V,astClearAttrib_(astCheckObject(this),attrib,STATUS_PTR))
-#define astClearID(this) astINVOKE(V,astClearID_(astCheckObject(this),STATUS_PTR))
-#define astClearIdent(this) astINVOKE(V,astClearIdent_(astCheckObject(this),STATUS_PTR))
-#define astDump(this,channel) \
-astINVOKE(V,astDump_(astCheckObject(this),astCheckChannel(channel),STATUS_PTR))
-
-#define astGetAttrib(this,attrib) \
-astINVOKE(V,astGetAttrib_(astCheckObject(this),attrib,STATUS_PTR))
-#define astGetClass(this) astINVOKE(V,astGetClass_((const AstObject *)(this),STATUS_PTR))
-#define astGetID(this) astINVOKE(V,astGetID_(astCheckObject(this),STATUS_PTR))
-#define astGetIdent(this) astINVOKE(V,astGetIdent_(astCheckObject(this),STATUS_PTR))
-#define astGetNobject(this) astINVOKE(V,astGetNobject_(astCheckObject(this),STATUS_PTR))
-#define astClassCompare(class1,class2) astClassCompare_(class1,class2,STATUS_PTR)
-#define astGetRefCount(this) astINVOKE(V,astGetRefCount_(astCheckObject(this),STATUS_PTR))
-#define astSetAttrib(this,setting) \
-astINVOKE(V,astSetAttrib_(astCheckObject(this),setting,STATUS_PTR))
-#define astSetCopy(vtab,copy) \
-astINVOKE(V,astSetCopy_((AstObjectVtab *)(vtab),copy,STATUS_PTR))
-#define astSetDelete(vtab,delete) \
-astINVOKE(V,astSetDelete_((AstObjectVtab *)(vtab),delete,STATUS_PTR))
-#define astSetDump(vtab,dump,class,comment) \
-astINVOKE(V,astSetDump_((AstObjectVtab *)(vtab),dump,class,comment,STATUS_PTR))
-#define astSetVtab(object,vtab) \
-astINVOKE(V,astSetVtab_((AstObject *)object,(AstObjectVtab *)(vtab),STATUS_PTR))
-#define astSetID(this,id) astINVOKE(V,astSetID_(astCheckObject(this),id,STATUS_PTR))
-#define astSetIdent(this,id) astINVOKE(V,astSetIdent_(astCheckObject(this),id,STATUS_PTR))
-#define astVSet(this,settings,text,args) \
-astINVOKE(V,astVSet_(astCheckObject(this),settings,text,args,STATUS_PTR))
-#define astEnvSet(this) \
-astINVOKE(V,astEnvSet_(astCheckObject(this),STATUS_PTR))
-#define astTestAttrib(this,attrib) \
-astINVOKE(V,astTestAttrib_(astCheckObject(this),attrib,STATUS_PTR))
-#define astTestID(this) astINVOKE(V,astTestID_(astCheckObject(this),STATUS_PTR))
-#define astTestIdent(this) astINVOKE(V,astTestIdent_(astCheckObject(this),STATUS_PTR))
-
-/* Deprecated synonym. */
-#define astClass(this) astGetClass(this)
-#endif
-
-/* Extra stuff for debuging probnlems with object handles and memory usage */
-#ifdef MEM_DEBUG
-
-void astWatchHandle_( int );
-void astHandleUse_( int, const char *, ... );
-void astHandleAlarm_( const char *, va_list );
-
-#define astWatchHandle astWatchHandle_
-#define astHandleUse astHandleUse_
-#define astHandleAlarm astHandleAlarm_
-
-#else
-
-#define astWatchHandle
-#define astHandleUse
-#define astHandleAlarm
-
-#endif
-
-#endif
-