research/cantera
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

*** empty log message ***

Browse source
This commit is contained in:
Dave Goodwin 2007-04-25 00:08:11 +00:00
parent 6d9a1aa4bd
commit b30a0ee8f1
36 changed files with 1081 additions and 1057 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
Cantera/clib/src/ctfunc.cpp
View file

@ -35,7 +35,22 @@ extern "C" {
func_t* r=0;
int m = lenp;
try {
if (type == FourierFuncType) {
if (type == SinFuncType) {
r = new Sin1(params[0]);
}
else if (type == CosFuncType) {
r = new Cos1(params[0]);
}
else if (type == ExpFuncType) {
r = new Exp1(params[0]);
}
else if (type == PowFuncType) {
if (lenp < 1)
throw CanteraError("func_new",
"exponent for pow must be supplied");
r = new Pow1(params[0]);
}
else if (type == FourierFuncType) {
if (lenp < 2*n + 2)
throw CanteraError("func_new",
"not enough Fourier coefficients");
@ -61,19 +76,28 @@ extern "C" {
r = new Arrhenius1(n, params);
}
else if (type == PeriodicFuncType) {
r = new PeriodicFunc(*_func(n), params[0]);
r = new Periodic1(*_func(n), params[0]);
}
else if (type == SumFuncType) {
r = new Func1Sum(*_func(n), *_func(m));
r = new Sum1(*_func(n), *_func(m));
}
else if (type == DiffFuncType) {
r = new Func1Diff(*_func(n), *_func(m));
r = new Diff1(*_func(n), *_func(m));
}
else if (type == ProdFuncType) {
r = new Func1Product(*_func(n), *_func(m));
r = new Product1(*_func(n), *_func(m));
}
else if (type == RatioFuncType) {
r = new Func1Ratio(*_func(n), *_func(m));
r = new Ratio1(*_func(n), *_func(m));
}
else if (type == CompositeFuncType) {
r = new Composite1(*_func(n), *_func(m));
}
else if (type == TimesConstantFuncType) {
r = new TimesConstant1(*_func(n), params[0]);
}
else if (type == PlusConstantFuncType) {
r = new PlusConstant1(*_func(n), params[0]);
}
else
r = new Func1();
@ -100,4 +124,11 @@ extern "C" {
return _func(i)->eval(t);
}
int DLL_EXPORT func_derivative(int i) {
func_t* r = 0;
r = &_func(i)->derivative();
return Cabinet<func_t>::cabinet()->add(r);
}
}

1
Cantera/clib/src/ctfunc.h
View file

@ -9,6 +9,7 @@ extern "C" {
int DLL_IMPORT func_copy(int i);
int DLL_IMPORT func_assign(int i, int j);
double DLL_IMPORT func_value(int i, double t);
int DLL_IMPORT func_derivative(int i);
}
#endif

2
Cantera/matlab/cantera/@Func/Func.m
View file

@ -62,6 +62,8 @@ else
itype = 30;
elseif strcmp(typ,'ratio')
itype = 40;
elseif strcmp(typ,'composite')
itype = 60;
end
x.f1 = n;
x.f2 = p;

166
Cantera/python/Cantera/Func.py
View file

@ -39,16 +39,25 @@ class Func1:
See: Polynomial, Gaussian, Arrhenius, Fourier, Const,
PeriodicFunction """
self.n = n
self._own = 1
self._func_id = 0
self._typ = typ
self.coeffs = asarray(coeffs,'d')
self._func_id = _cantera.func_new(typ, n, self.coeffs)
def __del__(self):
_cantera.func_del(self._func_id)
if self._func_id and self._own:
_cantera.func_del(self._func_id)
def __call__(self, t):
"""Implements function syntax, so that F(t) is equivalent to
F.value(t)."""
return _cantera.func_value(self._func_id, t)
if type(t) == types.NoneType:
return self
if type(t) == types.InstanceType:
return CompositeFunction(self, t)
else:
return _cantera.func_value(self._func_id, t)
def __add__(self, other):
"""Overloads operator '+'
@ -61,7 +70,6 @@ class Func1:
return SumFunction(self, Const(other))
return SumFunction(self, other)
def __radd__(self, other):
"""Overloads operator '+'
@ -73,29 +81,59 @@ class Func1:
return SumFunction(Const(other),self)
return SumFunction(other, self)
def __sub__(self, other):
"""Overloads operator '-'
Returns a new function self(t) - other(t)"""
# if 'other' is a number, then create a 'Const' functor for
# it.
if type(other) != types.InstanceType:
return DiffFunction(self, Const(other))
return DiffFunction(self, other)
def __rsub__(self, other):
"""Overloads operator '-'
Returns a new function other(t) - self(t)"""
# if 'other' is a number, then create a 'Const' functor for
# it.
if type(other) != types.InstanceType:
return DiffFunction(Const(other), self)
return DiffFunction(other, self)
def __mul__(self, other):
"""Overloads operator '*'
Return a new function self(t)*other(t)"""
Return a new function self(t)*other(t)"""
if type(other) != types.InstanceType:
return ProdFunction(self, Const(other))
return ProdFunction(self, other)
def __rmul__(self, other):
"""Overloads operator '*'
Returns a new function other(t)*self(t)"""
Returns a new function other(t)*self(t)"""
if type(other) != types.InstanceType:
return ProdFunction(Const(other), self)
return ProdFunction(other, self)
def __div__(self, other):
"""Overloads operator '/'
Returns a new function self(t)/other(t)"""
Returns a new function self(t)/other(t)"""
if type(other) != types.InstanceType:
return RatioFunction(self, Const(other))
return RatioFunction(self, other)
def __rdiv__(self, other):
"""Overloads operator '/'
Returns a new function other(t)/self(t)"""
Returns a new function other(t)/self(t)"""
if type(other) != types.InstanceType:
return RatioFunction(Const(other), self)
return RatioFunction(other, self)
def func_id(self):
@ -103,7 +141,19 @@ class Func1:
kernel-level object."""
return self._func_id
class Sin(Func1):
def __init__(self,omega=1.0):
Func1.__init__(self,100,1,omega)
class Cos(Func1):
def __init__(self, omega=1.0):
Func1.__init__(self,102,1,omega)
class Exp(Func1):
def __init__(self,A=1.0):
Func1.__init__(self,104,1,A)
class Pow(Func1):
def __init__(self, n):
Func1.__init__(self,106,1,n)
class Polynomial(Func1):
"""A polynomial.
Instances of class 'Polynomial' evaluate
@ -240,11 +290,25 @@ class PeriodicFunction(Func1):
T - period [s]
"""
Func1.__init__(self, 50, func.func_id(), array([T],'d'))
func._own = 0
# functions that combine two functions
class SumFunction(Func1):
class ComboFunc1(Func1):
def __init__(self, typ, f1, f2):
self._own = 1
self._func_id = 0
self._typ = typ
self.f1 = f1
self.f2 = f2
self.f1._own = 0
self.f2._own = 0
self._func_id = _cantera.func_newcombo(typ, f1.func_id(), f2.func_id())
class SumFunction(ComboFunc1):
"""Sum of two functions.
Instances of class SumFunction evaluate the sum of two supplied functors.
It is not necessary to explicitly create an instance of SumFunction, since
@ -263,12 +327,31 @@ class SumFunction(Func1):
f2 - second functor.
"""
self.f1 = f1
self.f2 = f2
self.n = -1
self._func_id = _cantera.func_newcombo(20, f1.func_id(), f2.func_id())
ComboFunc1.__init__(self, 20, f1, f2)
class ProdFunction(Func1):
class DiffFunction(ComboFunc1):
"""Difference of two functions.
Instances of class DiffFunction evaluate the difference of two supplied
functors. It is not necessary to explicitly create an instance of
DiffFunction, since the subtraction operator of the base class is
overloaded to return a DiffFunction instance.
>>> f1 = Polynomial([2.0, 1.0])
>>> f2 = Polynomial([3.0, -5.0])
>>> f3 = f1 - f2 # functor to evaluate (2t + 1) - (3t - 5)
In this example, object 'f3' is a functor of class'DiffFunction' that
calls f1 and f2 and returns their difference.
"""
def __init__(self, f1, f2):
"""
f1 - first functor.
f2 - second functor.
"""
ComboFunc1.__init__(self, 25, f1, f2)
class ProdFunction(ComboFunc1):
"""Product of two functions. Instances of class ProdFunction
evaluate the product of two supplied functors. It is not
@ -287,20 +370,10 @@ class ProdFunction(Func1):
""" f1 - first functor.
f2 - second functor.
"""
if type(f1) == types.FloatType:
self.f1 = Const(f1)
else:
self.f1 = f1
if type(f2) == types.FloatType:
self.f2 = Const(f2)
else:
self.f2 = f2
self.n = -1
self._func_id = _cantera.func_newcombo(30, self.f1.func_id(), self.f2.func_id())
ComboFunc1.__init__(self, 30, f1, f2)
class RatioFunction(Func1):
class RatioFunction(ComboFunc1):
"""Ratio of two functions.
Instances of class RatioFunction evaluate the ratio of two supplied functors.
It is not necessary to explicitly create an instance of 'RatioFunction', since
@ -318,9 +391,38 @@ class RatioFunction(Func1):
f2 - second functor.
"""
self.f1 = f1
self.f2 = f2
self.n = -1
self._func_id = _cantera.func_newcombo(40, f1.func_id(), f2.func_id())
ComboFunc1.__init__(self, 40, f1, f2)
class CompositeFunction(ComboFunc1):
"""Function of a function.
Instances of class CompositeFunction evaluate f(g(t)) for two supplied
functors f and g. It is not necessary to explicitly create an instance
of 'CompositeFunction', since the () operator of the base class is
overloaded to return a CompositeFunction when called with a functor
argument.
>>> f1 = Polynomial([2.0, 1.0])
>>> f2 = Polynomial([3.0, -5.0])
>>> f3 = f1(f2) # functor to evaluate 2(3t - 5) + 1
In this example, object 'f3' is a functor of class'CompositeFunction'
that calls f1 and f2 and returns f1(f2(t)).
"""
def __init__(self, f1, f2):
"""
f1 - first functor.
f2 - second functor.
"""
ComboFunc1.__init__(self, 60, f1, f2)
class DerivativeFunction(Func1):
def __init__(self, f):
self.f = f
#f._own = 0
self._own = 1
self._func_id = _cantera.func_derivative(f.func_id())
def derivative(f):
return DerivativeFunction(f)

21
Cantera/python/examples/reactors/surf_pfr.py
View file

@ -25,7 +25,7 @@ minute = 60.0
#
#######################################################################
tc = 800.0 # Temperature in Centigrade
tc = 800.0 # Temperature in Celsius
length = 0.3 * cm # Catalyst bed length
area = 1.0 * cm * cm # Catalyst bed area
@ -83,7 +83,7 @@ mass_flow_rate = velocity * rho0 * area
# upstream. Since in a PFR model there is no diffusion, the upstream
# reactors are not affected by any downstream reactors, and therefore
# the problem may be solved by simply marching from the first to last
# reactors, integrating each one to steady state.
# reactor, integrating each one to steady state.
for n in range(NReactors):
@ -112,7 +112,7 @@ for n in range(NReactors):
v = Valve(upstream = r, downstream = downstream, Kv = 3.0e-6)
# The mass flow rate into the reactor will be fixed by using a
# MassFlowController obbject.
# MassFlowController object.
m = MassFlowController(upstream = upstream,
downstream = r, mdot = mass_flow_rate)
@ -126,19 +126,30 @@ for n in range(NReactors):
time = time + dt
sim.advance(time)
# check whether surface coverages are in steady state.
# check whether surface coverages are in steady
# state. This will be the case if the creation and
# destruction rates for a surface (but not gas) species
# are equal.
alldone = 1
# Note: netProduction = creation - destruction. By
# supplying the surface object as an argument, only the
# values for the surface species are returned by these
# methods
sdot = surf.netProductionRates(surf)
cdot = surf.creationRates(surf)
ddot = surf.destructionRates(surf)
for ks in range(nsurf):
ratio = sdot[ks]/(cdot[ks] + ddot[ks])
#print ks, ratio
if ratio < 0.0: ratio = -ratio
if ratio > 1.0e-11 or time < 10*dt:
alldone = 0
if alldone: break
# set the gas object state to that of this reactor, in
# preparation for the simulation of the next reactor
# downstream, where this object will set the inlet conditions
gas = r.contents()
dist = n*rlen * 1.0e3 # distance in mm

11
Cantera/python/src/ctfunc_methods.cpp
View file

@ -25,6 +25,17 @@ py_func_newcombo(PyObject *self, PyObject *args)
return Py_BuildValue("i",nn);
}
static PyObject*
py_func_derivative(PyObject *self, PyObject *args)
{
int type, n, m;
if (!PyArg_ParseTuple(args, "i:func_derivative", &n))
return NULL;
int nn = func_derivative(n);
if (nn < 0) return reportError(nn);
return Py_BuildValue("i",nn);
}
static PyObject*
py_func_del(PyObject *self, PyObject *args)
{

1
Cantera/python/src/methods.h
View file

@ -259,6 +259,7 @@ static PyMethodDef ct_methods[] = {
{"func_new", py_func_new, METH_VARARGS},
{"func_newcombo", py_func_newcombo, METH_VARARGS},
{"func_derivative", py_func_derivative, METH_VARARGS},
{"func_del", py_func_del, METH_VARARGS},
{"func_value", py_func_value, METH_VARARGS},

527
Cantera/src/Func1.h
View file

@ -18,6 +18,10 @@
#include "ct_defs.h"
#include <iostream>
#include <string>
using namespace std;
namespace Cantera {
const int FourierFuncType = 1;
@ -29,6 +33,20 @@ namespace Cantera {
const int ProdFuncType = 30;
const int RatioFuncType = 40;
const int PeriodicFuncType = 50;
const int CompositeFuncType = 60;
const int TimesConstantFuncType = 70;
const int PlusConstantFuncType = 80;
const int SinFuncType = 100;
const int CosFuncType = 102;
const int ExpFuncType = 104;
const int PowFuncType = 106;
const int ConstFuncType = 110;
class Sin1;
class Cos1;
class Exp1;
class Pow1;
class TimesConstant1;
/**
* Base class for 'functor' classes that evaluate a function of
@ -36,16 +54,420 @@ namespace Cantera {
*/
class Func1 {
public:
Func1() {}
Func1() : m_c(0.0), m_f1(0), m_f2(0) {}
virtual ~Func1() {}
virtual int ID() const { return 0; }
virtual Func1& duplicate() { cout << "DUPL ERR: ID = " << ID() << endl;
return *(new Func1);}
/// Calls method eval to evaluate the function
doublereal operator()(doublereal t) { return eval(t); }
doublereal operator()(doublereal t) const { return eval(t); }
/// Evaluate the function.
virtual doublereal eval(doublereal t) { return 0.0; }
virtual doublereal eval(doublereal t) const { return 0.0; }
virtual Func1& derivative() const {
cout << "ERR: ID = " << ID() << endl;
return *(new Func1);
}
bool isIdentical(Func1& other) const {
if ((ID() != other.ID()) || (m_c != other.m_c))
return false;
if (m_f1) {
if (!other.m_f1) return false;
if (!m_f1->isIdentical(*other.m_f1)) return false;
}
if (m_f2) {
if (!other.m_f2) return false;
if (!m_f2->isIdentical(*other.m_f2)) return false;
}
return true;
}
virtual doublereal isProportional(TimesConstant1& other);
virtual doublereal isProportional(Func1& other);
virtual std::string write(std::string arg) const;
doublereal c() const { return m_c; }
Func1& func1() { return *m_f1; }
Func1& func2() { return *m_f2; }
virtual int order() const { return 3; }
Func1& func1_dup() const { return m_f1->duplicate(); }
Func1& func2_dup() const { return m_f2->duplicate(); }
protected:
doublereal m_c;
Func1 *m_f1, *m_f2;
private:
};
Func1& newSumFunction(Func1& f1, Func1& f2);
Func1& newDiffFunction(Func1& f1, Func1& f2);
Func1& newProdFunction(Func1& f1, Func1& f2);
Func1& newRatioFunction(Func1& f1, Func1& f2);
Func1& newCompositeFunction(Func1& f1, Func1& f2);
Func1& newTimesConstFunction(Func1& f1, doublereal c);
Func1& newPlusConstFunction(Func1& f1, doublereal c);
/// sin
class Sin1 : public Func1 {
public:
Sin1(doublereal omega = 1.0) {
m_c = omega;
}
virtual ~Sin1() {}
virtual std::string write(std::string arg) const;
virtual Func1& duplicate() { return *(new Sin1(m_c)); }
virtual int ID() const { return SinFuncType; }
virtual doublereal eval(doublereal t) const {
return sin(m_c*t);
}
virtual Func1& derivative() const;
protected:
};
/// cos
class Cos1 : public Func1 {
public:
Cos1(doublereal omega = 1.0) {
m_c = omega;
}
virtual ~Cos1() {}
virtual std::string write(std::string arg) const;
virtual Func1& duplicate() { return *(new Cos1(m_c)); }
virtual int ID() const { return CosFuncType; }
virtual doublereal eval(doublereal t) const {
return cos(m_c * t);
}
virtual Func1& derivative() const;
protected:
};
/// exp
class Exp1 : public Func1 {
public:
Exp1(doublereal A = 1.0) {m_c = A;}
virtual ~Exp1() {}
virtual std::string write(std::string arg) const;
virtual int ID() const { return ExpFuncType; }
virtual Func1& duplicate() { return *(new Exp1(m_c)); }
virtual doublereal eval(doublereal t) const {
return exp(m_c*t);
}
virtual Func1& derivative() const;
protected:
};
/// pow
class Pow1 : public Func1 {
public:
Pow1(doublereal n) {m_c = n;}
virtual ~Pow1() {}
virtual int ID() const { return PowFuncType; }
virtual Func1& duplicate() { return *(new Pow1(m_c)); }
virtual doublereal eval(doublereal t) const {
return pow(t, m_c);
}
virtual Func1& derivative() const;
protected:
};
/**
* Constant.
*/
class Const1 : public Func1 {
public:
Const1(doublereal A) {
m_c = A;
}
virtual ~Const1() {}
virtual int ID() const { return ConstFuncType; }
virtual doublereal eval(doublereal t) const {
return m_c;
}
virtual Func1& derivative() {
Func1* z = new Const1(0.0);
return *z;
}
protected:
};
/**
* Sum of two functions.
*/
class Sum1 : public Func1 {
public:
Sum1(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Sum1() {
delete m_f1;
delete m_f2;
}
virtual int ID() const { return SumFuncType; }
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) + m_f2->eval(t);
}
virtual Func1& duplicate() {
Func1& f1d = m_f1->duplicate();
Func1& f2d = m_f2->duplicate();
Func1& dup = newSumFunction(f1d, f2d);
return dup;
}
virtual Func1& derivative() {
Func1& d1 = m_f1->derivative();
Func1& d2 = m_f2->derivative();
Func1& d = newSumFunction(d1, d2);
return d;
}
virtual int order() const { return 0; }
virtual std::string write(std::string arg) const;
protected:
};
/**
* Difference of two functions.
*/
class Diff1 : public Func1 {
public:
Diff1(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Diff1() {
delete m_f1;
delete m_f2;
}
virtual int ID() const { return DiffFuncType; }
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) - m_f2->eval(t);
}
virtual Func1& duplicate() {
Func1& f1d = m_f1->duplicate();
Func1& f2d = m_f2->duplicate();
Func1& dup = newDiffFunction(f1d, f2d);
return dup;
}
virtual Func1& derivative() const {
Func1& d = newDiffFunction(m_f1->derivative(), m_f2->derivative());
return d;
}
virtual int order() const { return 0; }
virtual std::string write(std::string arg) const;
protected:
};
/**
* Product of two functions.
*/
class Product1 : public Func1 {
public:
Product1(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Product1() {
cout << "In Product1 destructor, deleting" << m_f1 << " " << m_f2 << endl;
delete m_f1;
delete m_f2;
}
virtual int ID() const { return ProdFuncType; }
virtual Func1& duplicate() {
Func1& f1d = m_f1->duplicate();
Func1& f2d = m_f2->duplicate();
Func1& dup = newProdFunction(f1d, f2d);
return dup;
}
virtual std::string write(std::string arg) const;
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) * m_f2->eval(t);
}
virtual Func1& derivative() const {
Func1& a1 = newProdFunction(m_f1->duplicate(), m_f2->derivative());
Func1& a2 = newProdFunction(m_f2->duplicate(), m_f1->derivative());
Func1& s = newSumFunction(a1, a2);
return s;
}
virtual int order() const { return 1; }
protected:
};
/**
* Product of two functions.
*/
class TimesConstant1 : public Func1 {
public:
TimesConstant1(Func1& f1, doublereal A) {
m_f1 = &f1;
m_c = A;
}
virtual ~TimesConstant1() {
delete m_f1;
}
virtual int ID() const { return TimesConstantFuncType; }
virtual Func1& duplicate() {
Func1& f1 = m_f1->duplicate();
Func1* dup = new TimesConstant1(f1, m_c);
return *dup;
}
virtual doublereal isProportional(TimesConstant1& other) {
if (func1().isIdentical(other.func1()))
return (other.c()/c());
else
return 0.0;
}
virtual doublereal isProportional(Func1& other) {
if (func1().isIdentical(other)) return 1.0/c();
else return 0.0;
}
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) * m_c;
}
virtual Func1& derivative() const {
Func1& f1d = m_f1->derivative();
Func1* d = new TimesConstant1(f1d, m_c);
return *d;
}
virtual std::string write(std::string arg) const;
virtual int order() const { return 0; }
protected:
};
/**
* A function plus a constant.
*/
class PlusConstant1 : public Func1 {
public:
PlusConstant1(Func1& f1, doublereal A) {
m_f1 = &f1;
m_c = A;
}
virtual ~PlusConstant1() {
cout << "PlusConstant1: deleting " << m_f1 << endl;
delete m_f1;
}
virtual int ID() const { return PlusConstantFuncType; }
virtual Func1& duplicate() {
Func1& f1 = m_f1->duplicate();
Func1* dup = new PlusConstant1(f1, m_c);
return *dup;
}
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) + m_c;
}
virtual Func1& derivative() const {
Func1& f1d = m_f1->derivative();
return f1d;
}
virtual std::string write(std::string arg) const;
virtual int order() const { return 0; }
protected:
};
/**
* Ratio of two functions.
*/
class Ratio1 : public Func1 {
public:
Ratio1(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Ratio1() {
cout << "Ratio1: deleting " << m_f1 << " " << m_f2 << endl;
delete m_f1;
delete m_f2;
}
virtual int ID() const { return RatioFuncType; }
virtual doublereal eval(doublereal t) const {
return m_f1->eval(t) / m_f2->eval(t);
}
virtual Func1& duplicate() {
Func1& f1d = m_f1->duplicate();
Func1& f2d = m_f2->duplicate();
Func1& dup = newRatioFunction(f1d, f2d);
return dup;
}
virtual Func1& derivative() const {
Func1& a1 = newProdFunction(m_f1->derivative(), m_f2->duplicate());
Func1& a2 = newProdFunction(m_f1->duplicate(), m_f2->derivative());
Func1& s = newDiffFunction(a1, a2);
Func1& p = newProdFunction(m_f2->duplicate(), m_f2->duplicate());
Func1& r = newRatioFunction(s, p);
return r;
}
virtual std::string write(std::string arg) const;
virtual int order() const { return 1; }
protected:
};
/**
* Composite function.
*/
class Composite1 : public Func1 {
public:
Composite1(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Composite1() {
delete m_f1;
delete m_f2;
}
virtual int ID() const { return CompositeFuncType; }
virtual doublereal eval(doublereal t) const {
return m_f1->eval( m_f2->eval(t) );
}
virtual Func1& duplicate() {
Func1& f1d = m_f1->duplicate();
Func1& f2d = m_f2->duplicate();
Func1& dup = newCompositeFunction(f1d, f2d);
return dup;
}
virtual Func1& derivative() const {
Func1& d1 = m_f1->derivative();
Func1& d3 = newCompositeFunction(d1, m_f2->duplicate());
Func1& d2 = m_f2->derivative();
Func1& p = newProdFunction(d3, d2);
return p;
}
virtual std::string write(std::string arg) const;
virtual int order() const { return 2; }
protected:
};
//
// The functors below are the old-style ones. They still work,
// but can't do derivatives.
//
/**
* A Gaussian.
* \f[
@ -64,7 +486,7 @@ namespace Cantera {
m_tau = fwhm/(2.0*std::sqrt(std::log(2.0)));
}
virtual ~Gaussian() {}
virtual doublereal eval(doublereal t) {
virtual doublereal eval(doublereal t) const {
doublereal x = (t - m_t0)/m_tau;
return m_A*std::exp(-x*x);
}
@ -86,7 +508,7 @@ namespace Cantera {
}
virtual ~Poly1() {}
virtual doublereal eval(doublereal t) {
virtual doublereal eval(doublereal t) const {
int n;
doublereal r = m_c[m_n-1];
for (n = 1; n < m_n; n++) {
@ -124,7 +546,7 @@ namespace Cantera {
}
virtual ~Fourier1() {}
virtual doublereal eval(doublereal t) {
virtual doublereal eval(doublereal t) const {
int n, nn;
doublereal sum = m_a0_2;
for (n = 0; n < m_n; n++) {
@ -165,7 +587,7 @@ namespace Cantera {
}
virtual ~Arrhenius1() {}
virtual doublereal eval(doublereal t) {
virtual doublereal eval(doublereal t) const {
int n;
doublereal sum = 0.0;
for (n = 0; n < m_n; n++) {
@ -183,100 +605,25 @@ namespace Cantera {
* Periodic function. Takes any function and makes it
* periodic with period T.
*/
class PeriodicFunc : public Func1 {
class Periodic1 : public Func1 {
public:
PeriodicFunc(Func1& f, doublereal T) {
Periodic1(Func1& f, doublereal T) {
m_func = &f;
m_period = T;
m_c = T;
}
virtual ~PeriodicFunc() {}
virtual doublereal eval(doublereal t) {
int np = int(t/m_period);
doublereal time = t - np*m_period;
virtual ~Periodic1() { delete m_func; }
virtual doublereal eval(doublereal t) const {
int np = int(t/m_c);
doublereal time = t - np*m_c;
return m_func->eval(time);
}
protected:
Func1* m_func;
doublereal m_period;
private:
};
/**
* Sum of two functions.
*/
class Func1Sum : public Func1 {
public:
Func1Sum(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Func1Sum() {}
virtual doublereal eval(doublereal t) {
return m_f1->eval(t) + m_f2->eval(t);
}
protected:
Func1 *m_f1, *m_f2;
private:
};
/**
* Difference of two functions.
*/
class Func1Diff : public Func1 {
public:
Func1Diff(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Func1Diff() {}
virtual doublereal eval(doublereal t) {
return m_f1->eval(t) - m_f2->eval(t);
}
protected:
Func1 *m_f1, *m_f2;
private:
};
/**
* Product of two functions.
*/
class Func1Product : public Func1 {
public:
Func1Product(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Func1Product() {}
virtual doublereal eval(doublereal t) {
return m_f1->eval(t) * m_f2->eval(t);
}
protected:
Func1 *m_f1, *m_f2;
private:
};
/**
* Ratio of two functions.
*/
class Func1Ratio : public Func1 {
public:
Func1Ratio(Func1& f1, Func1& f2) {
m_f1 = &f1;
m_f2 = &f2;
}
virtual ~Func1Ratio() {}
virtual doublereal eval(doublereal t) {
return m_f1->eval(t) / m_f2->eval(t);
}
protected:
Func1 *m_f1, *m_f2;
private:
};
}
#endif

2
Cantera/src/Makefile.in
View file

@ -39,7 +39,7 @@ SUNDIALS_INC = @sundials_include@
BASE_OBJ = State.o Elements.o Constituents.o stringUtils.o misc.o \
importCTML.o plots.o \
xml.o Phase.o DenseMatrix.o ctml.o funcs.o \
phasereport.o ct2ctml.o
phasereport.o ct2ctml.o Func1.o
BASE_H = State.h Elements.h Constituents.h stringUtils.h global.h \
importCTML.h plots.h xml.h Phase.h DenseMatrix.h ctml.h \

2
Cantera/src/converters/Makefile.in
View file

@ -20,7 +20,7 @@ PIC_FLAG=@PIC@
CXX_FLAGS = @CXXFLAGS@ $(CXX_OPT) $(PIC_FLAG)
OBJS = atomicWeightDB.o CKParser.o CKReader.o Reaction.o ckr_utils.o \
thermoFunctions.o writelog.o ck2ct.o
thermoFunctions.o writelog.o ck2ct.o
# ck2ctml.o
CONV_H = CKReader.h thermoFunctions.h \
Element.h Reaction.h CKParser.h \

4
Cantera/src/oneD/Makefile.in
View file

@ -20,9 +20,9 @@ PIC_FLAG=@PIC@
CXX_FLAGS = @CXXFLAGS@ $(CXX_OPT) $(PIC_FLAG)
CXX_INCLUDES = -I.. @CXX_INCLUDES@
# stirred reactors
OBJS = MultiJac.o MultiNewton.o newton_utils.o OneDim.o\
StFlow.o boundaries1D.o refine.o Sim1D.o Domain1D.o
StFlow.o boundaries1D.o refine.o Sim1D.o Domain1D.o
ONED_H = Inlet1D.h MultiJac.h Sim1D.h StFlow.h \
Surf1D.h Domain1D.h MultiNewton.h OneDim.h \
Resid1D.h Solid1D.h refine.h

3
config.h.in
View file

@ -134,4 +134,7 @@ typedef int ftnlen; // Fortran hidden string length type
// models for electrolyte solutions.
#undef WITH_ELECTROLYTES
#undef WITH_PRIME
#endif

5
configure.in
View file

@ -461,6 +461,11 @@ fi
AC_SUBST(COMPILE_ELECTROLYTES)
AC_SUBST(NEED_CATHERMO)
if test "$WITH_PRIME" = "y"; then
AC_DEFINE(WITH_PRIME)
fi
if test "$ENABLE_KINETICS" = "y"; then
KERNEL=$KERNEL' 'kinetics;
KERNEL_OBJ=$KERNEL_OBJ' $(KINETICS_OBJ) $(HETEROKIN_OBJ)'

3
ext/f2c_math/Makefile.in
View file

@ -73,7 +73,8 @@ xerhlt.o \
xermsg.o \
xerprn.o \
xersve.o \
xgetua.o
xgetua.o \
printstring.o
SRCS = $(OBJS:.o=.cpp)

40
ext/f2c_math/daux.c
View file

@ -1,18 +1,8 @@
/* daux.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* daux.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -59,7 +49,7 @@ static logical c_true = TRUE_;
/* Local variables */
extern integer ixsav_(integer *, integer *, logical *);
static integer lunit, mesflg;
integer lunit, mesflg;
/* Fortran I/O blocks */
static cilist io___3 = { 0, 0, 0, fmt_10, 0 };
@ -189,7 +179,7 @@ L100:
/* DECK XSETF */
/* Subroutine */ int xsetf_(integer *mflag)
{
static integer junk;
integer junk;
extern integer ixsav_(integer *, integer *, logical *);
/* ***BEGIN PROLOGUE XSETF */
@ -231,7 +221,7 @@ L100:
/* DECK XSETUN */
/* Subroutine */ int xsetun_(integer *lun)
{
static integer junk;
integer junk;
extern integer ixsav_(integer *, integer *, logical *);
/* ***BEGIN PROLOGUE XSETUN */
@ -271,15 +261,12 @@ L100:
/* DECK IXSAV */
integer ixsav_(integer *ipar, integer *ivalue, logical *iset)
{
/* Initialized data */
static integer lunit = -1;
static integer lundef = 6;
static integer mesflg = 1;
/* System generated locals */
integer ret_val;
/* Local variables */
integer lunit, lundef, mesflg;
/* ***BEGIN PROLOGUE IXSAV */
/* ***SUBSIDIARY */
/* ***PURPOSE Save and recall error message control parameters. */
@ -327,6 +314,12 @@ integer ixsav_(integer *ipar, integer *ivalue, logical *iset)
/* The following Fortran-77 declaration is to cause the values of the */
/* listed (local) variables to be saved between calls to this routine. */
/* ----------------------------------------------------------------------- */
/* SAVE LUNIT, LUNDEF, MESFLG */
/* dgg mod 2/2007 */
lunit = -1;
lundef = 6;
mesflg = 1;
/* DATA LUNIT/-1/, LUNDEF/6/, MESFLG/1/ */
/* ***FIRST EXECUTABLE STATEMENT IXSAV */
if (*ipar == 1) {
@ -350,6 +343,3 @@ integer ixsav_(integer *ipar, integer *ivalue, logical *iset)
/* ----------------------- End of Function IXSAV ------------------------- */
} /* ixsav_ */
#ifdef _cpluscplus
}
#endif

352
ext/f2c_math/ddaspk.c
View file

@ -1,18 +1,8 @@
/* ddaspk.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* ddaspk.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -140,39 +130,42 @@ static integer c__926 = 926;
e_wsle(void);
/* Local variables */
static doublereal h__;
static integer i__;
static doublereal r__, h0;
static integer le;
static doublereal rh, tn;
static integer ici, idi, lid, ier;
static char msg[80];
static integer lwm, lvt, lwt, nwt, nli0, nni0;
static logical lcfl, lcfn, done;
static doublereal rcfl;
static integer nnid;
static logical lavl;
static integer maxl, iret;
static doublereal hmax;
static integer lphi;
static doublereal hmin;
static integer lyic, lpwk, nstd;
static doublereal rcfn;
static integer ncfl0, ncfn0;
doublereal h__;
integer i__;
doublereal r__, h0;
integer le;
doublereal rh, tn;
integer ici, idi;
static integer lid;
integer ier;
char msg[80];
integer lwm, lvt, lwt, nwt, nli0, nni0;
logical lcfl, lcfn, done;
doublereal rcfl;
integer nnid;
logical lavl;
integer maxl, iret;
doublereal hmax;
integer lphi;
doublereal hmin;
integer lyic, lpwk, nstd;
doublereal rcfn;
integer ncfl0, ncfn0;
extern /* Subroutine */ int dnedd_();
static integer mband;
integer mband;
extern /* Subroutine */ int dnedk_();
static integer lenic, lenid, ncphi, lenpd, lsoff, msave, index, itemp,
leniw, nzflg;
static doublereal atoli;
static integer lypic;
static logical lwarn;
static doublereal avlin;
static integer lenwp, lenrw, mxord, nwarn;
static doublereal rtoli;
static integer lsavr;
integer lenic;
static integer lenid, ncphi;
integer lenpd, lsoff, msave, index, itemp, leniw, nzflg;
doublereal atoli;
integer lypic;
logical lwarn;
doublereal avlin;
integer lenwp, lenrw, mxord, nwarn;
doublereal rtoli;
integer lsavr;
extern doublereal d1mach_(integer *);
static doublereal tdist, tnext, fmaxl;
doublereal tdist, tnext, fmaxl;
extern /* Subroutine */ int ddstp_(doublereal *, doublereal *, doublereal
*, integer *, U_fp, U_fp, U_fp, doublereal *, doublereal *,
doublereal *, integer *, integer *, doublereal *, integer *,
@ -183,7 +176,7 @@ static integer c__926 = 926;
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, U_fp);
static doublereal tstop;
doublereal tstop;
extern /* Subroutine */ int dcnst0_(integer *, doublereal *, integer *,
integer *), ddasic_(doublereal *, doublereal *, doublereal *,
integer *, integer *, integer *, U_fp, U_fp, U_fp, doublereal *,
@ -194,24 +187,24 @@ static integer c__926 = 926;
doublereal *, doublereal *, integer *, integer *, integer *, U_fp)
;
extern /* Subroutine */ int ddasid_(), ddasik_();
static integer icnflg;
static doublereal tscale, epconi;
integer icnflg;
doublereal tscale, epconi;
extern /* Subroutine */ int ddatrp_(doublereal *, doublereal *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
doublereal *);
static doublereal floatn;
doublereal floatn;
static integer nonneg;
extern /* Subroutine */ int ddawts_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *)
;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static integer leniwp;
integer leniwp;
extern /* Subroutine */ int xerrwd_(char *, integer *, integer *, integer
*, integer *, integer *, integer *, integer *, doublereal *,
doublereal *, ftnlen), dinvwt_(integer *, doublereal *, integer *)
;
static doublereal uround, ypnorm;
doublereal uround, ypnorm;
/* Fortran I/O blocks */
static cilist io___49 = { 0, 6, 0, 0, 0 };
@ -3082,11 +3075,11 @@ L760:
integer phi_dim1, phi_offset;
/* Local variables */
static doublereal cj;
static integer nh, mxnh;
doublereal cj;
integer nh, mxnh;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static integer jskip, iernls;
integer jskip, iernls;
/* ***BEGIN PROLOGUE DDASIC */
@ -3286,7 +3279,7 @@ L350:
integer i__1;
/* Local variables */
static integer i__;
integer i__;
/* ***BEGIN PROLOGUE DYYPNW */
@ -3372,25 +3365,25 @@ L350:
double pow_dd(doublereal *, doublereal *);
/* Local variables */
static integer i__, j;
static doublereal r__;
static integer j1;
static doublereal ck;
static integer km1, kp1, kp2, ncf, nef;
static doublereal erk, err, est;
static integer nsp1;
static doublereal hnew, terk, xold;
static integer knew;
static doublereal erkm1, erkm2, erkp1, temp1, temp2;
static integer kdiff;
static doublereal enorm, alpha0, terkm1, terkm2, terkp1, alphas;
integer i__, j;
doublereal r__;
integer j1;
doublereal ck;
integer km1, kp1, kp2, ncf, nef;
doublereal erk, err, est;
integer nsp1;
doublereal hnew, terk, xold;
integer knew;
doublereal erkm1, erkm2, erkp1, temp1, temp2;
integer kdiff;
doublereal enorm, alpha0, terkm1, terkm2, terkp1, alphas;
extern /* Subroutine */ int ddatrp_(doublereal *, doublereal *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
doublereal *);
static doublereal cjlast;
doublereal cjlast;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static integer iernls;
integer iernls;
/* ***BEGIN PROLOGUE DDSTP */
@ -4011,8 +4004,8 @@ L690:
doublereal d__1;
/* Local variables */
static integer i__;
static doublereal rdy, rdymx;
integer i__;
doublereal rdy, rdymx;
/* ***BEGIN PROLOGUE DCNSTR */
@ -4148,7 +4141,7 @@ L690:
integer i__1;
/* Local variables */
static integer i__;
integer i__;
/* ***BEGIN PROLOGUE DCNST0 */
@ -4233,8 +4226,8 @@ L690:
doublereal d__1;
/* Local variables */
static integer i__;
static doublereal atoli, rtoli;
integer i__;
doublereal atoli, rtoli;
/* ***BEGIN PROLOGUE DDAWTS */
@ -4284,7 +4277,7 @@ L10:
integer i__1;
/* Local variables */
static integer i__;
integer i__;
/* ***BEGIN PROLOGUE DINVWT */
@ -4336,10 +4329,10 @@ L30:
integer phi_dim1, phi_offset, i__1, i__2;
/* Local variables */
static doublereal c__, d__;
static integer i__, j;
static doublereal temp1, gamma;
static integer koldp1;
doublereal c__, d__;
integer i__, j;
doublereal temp1, gamma;
integer koldp1;
/* ***BEGIN PROLOGUE DDATRP */
@ -4420,8 +4413,8 @@ doublereal ddwnrm_(integer *neq, doublereal *v, doublereal *rwt, doublereal *
double sqrt(doublereal);
/* Local variables */
static integer i__;
static doublereal sum, vmax;
integer i__;
doublereal sum, vmax;
/* ***BEGIN PROLOGUE DDWNRM */
@ -4481,7 +4474,7 @@ L30:
dumr, doublereal *epcon, doublereal *ratemx, doublereal *stptol,
integer *jfdum, integer *icnflg, integer *icnstr, integer *iernls)
{
static integer nj, ierj, ires, mxnj;
integer nj, ierj, ires, mxnj;
extern /* Subroutine */ int dmatd_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, integer *, S_fp,
@ -4492,7 +4485,7 @@ L30:
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, integer *, integer *,
integer *);
static integer mxnit, iernew;
integer mxnit, iernew;
/* ***BEGIN PROLOGUE DDASID */
@ -4689,9 +4682,9 @@ L380:
ratemx, integer *maxit, doublereal *stptol, integer *icnflg, integer *
icnstr, integer *iernew)
{
static integer m;
static doublereal rlx, rate, fnrm;
static integer iret, ires, lsoff;
integer m;
doublereal rlx, rate, fnrm;
integer iret, ires, lsoff;
extern /* Subroutine */ int dslvd_(integer *, doublereal *, doublereal *,
integer *), dcopy_(integer *, doublereal *, integer *, doublereal
*, integer *), dlinsd_(integer *, doublereal *, doublereal *,
@ -4700,7 +4693,7 @@ L380:
S_fp, integer *, doublereal *, integer *, doublereal *, integer *,
integer *, doublereal *, doublereal *, doublereal *, integer *,
integer *, doublereal *, doublereal *, integer *);
static doublereal oldfnm, delnrm;
doublereal oldfnm, delnrm;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
@ -4901,17 +4894,17 @@ L390:
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer i__;
static doublereal rl;
static char msg[80];
static doublereal tau;
static integer ivar;
static doublereal slpi, f1nrm, ratio;
integer i__;
doublereal rl;
char msg[80];
doublereal tau;
integer ivar;
doublereal slpi, f1nrm, ratio;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static doublereal rlmin, fnrmp;
static integer kprin;
static doublereal ratio1, f1nrmp;
doublereal rlmin, fnrmp;
integer kprin;
doublereal ratio1, f1nrmp;
extern /* Subroutine */ int dfnrmd_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, S_fp, integer *, doublereal *, doublereal *,
@ -5221,25 +5214,25 @@ L200:
doublereal d__1;
/* Local variables */
static integer i__, j, ierj;
integer i__, j, ierj;
extern /* Subroutine */ int dnsd_(doublereal *, doublereal *, doublereal *
, integer *, S_fp, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *
, doublereal *, doublereal *, doublereal *, doublereal *, integer
*, integer *, integer *, integer *, integer *);
static integer idum, ires;
static doublereal temp1, temp2;
integer idum, ires;
doublereal temp1, temp2;
extern /* Subroutine */ int dmatd_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, integer *, S_fp,
integer *, doublereal *, U_fp, doublereal *, integer *);
static doublereal pnorm, delnrm;
static integer iernew;
doublereal pnorm, delnrm;
integer iernew;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static doublereal tolnew;
static integer iertyp;
doublereal tolnew;
integer iertyp;
/* ***BEGIN PROLOGUE DNEDD */
@ -5572,14 +5565,14 @@ L390:
double pow_dd(doublereal *, doublereal *);
/* Local variables */
static integer i__, m;
static doublereal rate;
integer i__, m;
doublereal rate;
extern /* Subroutine */ int dslvd_(integer *, doublereal *, doublereal *,
integer *);
static doublereal delnrm;
doublereal delnrm;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static doublereal oldnrm;
doublereal oldnrm;
/* ***BEGIN PROLOGUE DNSD */
@ -5787,19 +5780,19 @@ L380:
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
/* Local variables */
static integer i__, j, k, l, n, i1, i2, ii, mba;
static doublereal del;
static integer meb1, nrow;
static doublereal squr;
integer i__, j, k, l, n, i1, i2, ii, mba;
doublereal del;
integer meb1, nrow;
doublereal squr;
extern /* Subroutine */ int dgbfa_(doublereal *, integer *, integer *,
integer *, integer *, integer *, integer *), dgefa_(doublereal *,
integer *, integer *, integer *, integer *);
static integer mband, lenpd, isave, msave;
static doublereal ysave;
static integer lipvt, mtype, meband;
static doublereal delinv;
static integer ipsave;
static doublereal ypsave;
integer mband, lenpd, isave, msave;
doublereal ysave;
integer lipvt, mtype, meband;
doublereal delinv;
integer ipsave;
doublereal ypsave;
/* ***BEGIN PROLOGUE DMATD */
@ -6048,7 +6041,7 @@ L550:
integer *, integer *, integer *, doublereal *, integer *), dgesl_(
doublereal *, integer *, integer *, integer *, doublereal *,
integer *);
static integer lipvt, mtype, meband;
integer lipvt, mtype, meband;
/* ***BEGIN PROLOGUE DSLVD */
@ -6124,8 +6117,8 @@ L400:
doublereal *epcon, doublereal *ratemx, doublereal *stptol, integer *
jflg, integer *icnflg, integer *icnstr, integer *iernls)
{
static integer nj, lwp, ires, liwp, mxnj;
static doublereal eplin;
integer nj, lwp, ires, liwp, mxnj;
doublereal eplin;
extern /* Subroutine */ int dnsik_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, S_fp, U_fp, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
@ -6133,10 +6126,10 @@ L400:
, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, integer *, doublereal *,
integer *, integer *, integer *);
static integer ierpj;
integer ierpj;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static integer mxnit, iernew;
integer mxnit, iernew;
/* ***BEGIN PROLOGUE DDASIK */
@ -6342,28 +6335,28 @@ L380:
*eplin, doublereal *epcon, doublereal *ratemx, integer *maxit,
doublereal *stptol, integer *icnflg, integer *icnstr, integer *iernew)
{
static integer m, ier, lwp;
static doublereal rlx, rate;
static integer ires;
static doublereal fnrm, rhok;
static integer iret, liwp;
static doublereal fnrm0;
static integer lsoff;
integer m, ier, lwp;
doublereal rlx, rate;
integer ires;
doublereal fnrm, rhok;
integer iret, liwp;
doublereal fnrm0;
integer lsoff;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static integer iersl;
integer iersl;
extern /* Subroutine */ int dslvk_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, S_fp, integer *, U_fp, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *);
static doublereal oldfnm;
doublereal oldfnm;
extern /* Subroutine */ int dfnrmk_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, S_fp,
integer *, U_fp, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, integer *);
static doublereal delnrm;
doublereal delnrm;
extern /* Subroutine */ int dlinsk_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
@ -6614,18 +6607,18 @@ L390:
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer i__;
static doublereal rl;
static integer ier;
static char msg[80];
static doublereal tau;
static integer ivar;
static doublereal slpi, f1nrm, ratio;
integer i__;
doublereal rl;
integer ier;
char msg[80];
doublereal tau;
integer ivar;
doublereal slpi, f1nrm, ratio;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static doublereal rlmin, fnrmp;
static integer kprin;
static doublereal ratio1, f1nrmp;
doublereal rlmin, fnrmp;
integer kprin;
doublereal ratio1, f1nrmp;
extern /* Subroutine */ int dfnrmk_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, S_fp,
@ -6970,22 +6963,22 @@ L200:
doublereal d__1;
/* Local variables */
static integer i__, j, lwp;
integer i__, j, lwp;
extern /* Subroutine */ int dnsk_(doublereal *, doublereal *, doublereal *
, integer *, S_fp, U_fp, doublereal *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
integer *, integer *, integer *, integer *);
static integer ires, liwp;
static doublereal temp1, temp2, eplin;
static integer ierpj, iersl;
static doublereal delnrm;
static integer iernew;
integer ires, liwp;
doublereal temp1, temp2, eplin;
integer ierpj, iersl;
doublereal delnrm;
integer iernew;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static doublereal tolnew;
static integer iertyp;
doublereal tolnew;
integer iertyp;
/* ***BEGIN PROLOGUE DNEDK */
@ -7326,17 +7319,17 @@ L390:
double pow_dd(doublereal *, doublereal *);
/* Local variables */
static integer i__, m;
static doublereal rate, rhok;
integer i__, m;
doublereal rate, rhok;
extern /* Subroutine */ int dslvk_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, S_fp, integer *, U_fp, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *);
static doublereal delnrm;
doublereal delnrm;
extern doublereal ddwnrm_(integer *, doublereal *, doublereal *,
doublereal *, integer *);
static doublereal oldnrm;
doublereal oldnrm;
/* ***BEGIN PROLOGUE DNSK */
@ -7561,12 +7554,12 @@ L380:
integer i__1, i__2;
/* Local variables */
static integer i__, lq, lr, lv, lz, ldl, nli, nre, kmp, lwk, nps, lwp,
ncfl, lhes, lgmr, maxl, nres, npsl, liwp, iflag;
integer i__, lq, lr, lv, lz, ldl, nli, nre, kmp, lwk, nps, lwp, ncfl,
lhes, lgmr, maxl, nres, npsl, liwp, iflag;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), dcopy_(integer *, doublereal *, integer *, doublereal
*, integer *);
static integer miter, nrmax, nrsts, maxlp1;
integer miter, nrmax, nrsts, maxlp1;
extern /* Subroutine */ int dspigm_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *
, integer *, integer *, doublereal *, doublereal *, S_fp, integer
@ -7739,31 +7732,31 @@ L115:
doublereal d__1;
/* Local variables */
static doublereal c__;
static integer i__, j, k;
static doublereal s;
static integer i2, ll, ip1, ier;
static doublereal tem, rho;
static integer llp1, info;
doublereal c__;
integer i__, j, k;
doublereal s;
integer i2, ll, ip1, ier;
doublereal tem, rho;
integer llp1, info;
extern /* Subroutine */ int datv_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, S_fp, integer *, S_fp, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
integer *, integer *, doublereal *, integer *);
static doublereal prod, rnrm;
doublereal prod, rnrm;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), dhels_(doublereal *, integer *, integer *, doublereal
*, doublereal *), dheqr_(doublereal *, integer *, integer *,
doublereal *, integer *, integer *);
static doublereal dlnrm;
doublereal dlnrm;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), dorth_(doublereal *, doublereal *,
doublereal *, integer *, integer *, integer *, integer *,
doublereal *), daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
static integer maxlm1;
static doublereal snormw;
integer maxlm1;
doublereal snormw;
/* ***BEGIN PROLOGUE DSPIGM */
@ -8167,7 +8160,7 @@ L300:
integer i__1;
/* Local variables */
static integer i__;
integer i__;
/* ***BEGIN PROLOGUE DATV */
@ -8327,15 +8320,15 @@ L300:
double sqrt(doublereal);
/* Local variables */
static integer i__, i0;
static doublereal arg, tem;
integer i__, i0;
doublereal arg, tem;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
static doublereal vnrm;
doublereal vnrm;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
static doublereal sumdsq;
doublereal sumdsq;
/* ***BEGIN PROLOGUE DORTH */
@ -8470,10 +8463,10 @@ L30:
double sqrt(doublereal);
/* Local variables */
static doublereal c__;
static integer i__, j, k;
static doublereal s, t, t1, t2;
static integer iq, km1, kp1, nm1;
doublereal c__;
integer i__, j, k;
doublereal s, t, t1, t2;
integer iq, km1, kp1, nm1;
/* ***BEGIN PROLOGUE DHEQR */
@ -8678,10 +8671,10 @@ L130:
integer a_dim1, a_offset, i__1, i__2;
/* Local variables */
static doublereal c__;
static integer k;
static doublereal s, t, t1, t2;
static integer kb, iq, kp1;
doublereal c__;
integer k;
doublereal s, t, t1, t2;
integer kb, iq, kp1;
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
@ -8778,6 +8771,3 @@ L130:
/* ------END OF SUBROUTINE DHELS------------------------------------------ */
} /* dhels_ */
#ifdef _cpluscplus
}
#endif

25
ext/f2c_math/dgbefa.c
View file

@ -1,18 +1,8 @@
/* dgbefa.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dgbefa.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -26,9 +16,9 @@ static integer c__1 = 1;
integer abd_dim1, abd_offset, i__1, i__2, i__3, i__4;
/* Local variables */
static integer i__, j, k, l, m;
static doublereal t;
static integer i0, j0, j1, lm, mm, ju, jz, kp1, nm1;
integer i__, j, k, l, m;
doublereal t;
integer i0, j0, j1, lm, mm, ju, jz, kp1, nm1;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), daxpy_(integer *, doublereal *, doublereal *, integer
*, doublereal *, integer *);
@ -248,6 +238,3 @@ L130:
return 0;
} /* dgbfa_ */
#ifdef _cpluscplus
}
#endif

25
ext/f2c_math/dgbsl.c
View file

@ -1,18 +1,8 @@
/* dgbsl.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dgbsl.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -26,9 +16,9 @@ static integer c__1 = 1;
integer abd_dim1, abd_offset, i__1, i__2, i__3;
/* Local variables */
static integer k, l, m;
static doublereal t;
static integer kb, la, lb, lm, nm1;
integer k, l, m;
doublereal t;
integer kb, la, lb, lm, nm1;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
@ -201,6 +191,3 @@ L100:
return 0;
} /* dgbsl_ */
#ifdef _cpluscplus
}
#endif

25
ext/f2c_math/dgefa.c
View file

@ -1,18 +1,8 @@
/* dgefa.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dgefa.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -26,9 +16,9 @@ static integer c__1 = 1;
integer a_dim1, a_offset, i__1, i__2, i__3;
/* Local variables */
static integer j, k, l;
static doublereal t;
static integer kp1, nm1;
integer j, k, l;
doublereal t;
integer kp1, nm1;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), daxpy_(integer *, doublereal *, doublereal *, integer
*, doublereal *, integer *);
@ -159,6 +149,3 @@ L70:
return 0;
} /* dgefa_ */
#ifdef _cpluscplus
}
#endif

25
ext/f2c_math/dgesl.c
View file

@ -1,18 +1,8 @@
/* dgesl.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dgesl.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -26,9 +16,9 @@ static integer c__1 = 1;
integer a_dim1, a_offset, i__1, i__2;
/* Local variables */
static integer k, l;
static doublereal t;
static integer kb, nm1;
integer k, l;
doublereal t;
integer kb, nm1;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
@ -178,6 +168,3 @@ L100:
return 0;
} /* dgesl_ */
#ifdef _cpluscplus
}
#endif

57
ext/f2c_math/dp1vlu.c
View file

@ -1,18 +1,8 @@
/* dp1vlu.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dp1vlu.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -30,6 +20,7 @@ static integer c__5 = 5;
address a__1[5];
integer i__1, i__2, i__3[5];
char ch__1[150];
icilist ici__1;
/* Builtin functions */
integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
@ -37,23 +28,18 @@ static integer c__5 = 5;
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static integer i__, n, k1, k2, k3, k4;
static doublereal cc;
static integer ic, kc, in, k1i, lm1, lp1;
static doublereal dif;
static integer k3p1, k4p1, ndo;
static doublereal val;
static integer ilo, iup, ndp1, inp1, k3pn, k4pn, nord;
static char xern1[8], xern2[8];
static integer maxord;
integer i__, n, k1, k2, k3, k4;
doublereal cc;
integer ic, kc, in, k1i, lm1, lp1;
doublereal dif;
integer k3p1, k4p1, ndo;
doublereal val;
integer ilo, iup, ndp1, inp1, k3pn, k4pn, nord;
char xern1[8], xern2[8];
integer maxord;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* Fortran I/O blocks */
static icilist io___28 = { 0, xern1, 0, "(I8)", 8, 1 };
static icilist io___30 = { 0, xern2, 0, "(I8)", 8, 1 };
/* ***BEGIN PROLOGUE DP1VLU */
/* ***PURPOSE Use the coefficients generated by DPOLFT to evaluate the */
/* polynomial fit of degree L, along with the first NDER of */
@ -225,10 +211,20 @@ L10:
return 0;
L11:
s_wsfi(&io___28);
ici__1.icierr = 0;
ici__1.icirnum = 1;
ici__1.icirlen = 8;
ici__1.iciunit = xern1;
ici__1.icifmt = "(I8)";
s_wsfi(&ici__1);
do_fio(&c__1, (char *)&(*l), (ftnlen)sizeof(integer));
e_wsfi();
s_wsfi(&io___30);
ici__1.icierr = 0;
ici__1.icirnum = 1;
ici__1.icirlen = 8;
ici__1.iciunit = xern2;
ici__1.icifmt = "(I8)";
s_wsfi(&ici__1);
do_fio(&c__1, (char *)&nord, (ftnlen)sizeof(integer));
e_wsfi();
/* Writing concatenation */
@ -250,6 +246,3 @@ L12:
return 0;
} /* dp1vlu_ */
#ifdef _cpluscplus
}
#endif

27
ext/f2c_math/dpcoef.c
View file

@ -1,18 +1,8 @@
/* dpcoef.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dpcoef.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* DECK DPCOEF */
@ -23,10 +13,10 @@ extern "C" {
integer i__1;
/* Local variables */
static integer i__, ll, nr;
static doublereal fac;
static integer new__, llp1, llp2;
static doublereal save;
integer i__, ll, nr;
doublereal fac;
integer new__, llp1, llp2;
doublereal save;
extern /* Subroutine */ int dp1vlu_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *);
@ -122,6 +112,3 @@ L4:
return 0;
} /* dpcoef_ */
#ifdef _cpluscplus
}
#endif

71
ext/f2c_math/dpolft.c
View file

@ -1,18 +1,8 @@
/* dpolft.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* dpolft.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -25,12 +15,6 @@ static integer c__1 = 1;
doublereal *w, integer *maxdeg, integer *ndeg, doublereal *eps,
doublereal *r__, integer *ierr, doublereal *a)
{
/* Initialized data */
static doublereal co[12] /* was [4][3] */ = { -13.08685,-2.4648165,
-3.3846535,-1.2973162,-3.3381146,-1.7812271,-3.2578406,-1.6589279,
-1.6282703,-1.3152745,-3.2640179,-1.9829776 };
/* System generated locals */
integer i__1;
doublereal d__1;
@ -39,22 +23,22 @@ static integer c__1 = 1;
double sqrt(doublereal);
/* Local variables */
static doublereal f;
static integer i__, j, m, k1, k2, k3, k4, k5;
static doublereal w1, w11, xm, yp;
static integer jp1;
static doublereal den, sig;
static integer k1pj, k2pj, k3pi, k4pi, k5pi, mop1;
static doublereal degf;
static integer nder;
static doublereal sigj;
static integer jpas, ksig;
static doublereal temp, etst, temd1, temd2;
static integer idegf, nfail;
static doublereal fcrit, sigjm1;
doublereal f;
integer i__, j, m, k1, k2, k3, k4, k5;
doublereal w1, co[12] /* was [4][3] */, w11, xm, yp;
integer jp1;
doublereal den, sig;
integer k1pj, k2pj, k3pi, k4pi, k5pi, mop1;
doublereal degf;
integer nder;
doublereal sigj;
integer jpas, ksig;
doublereal temp, etst, temd1, temd2;
integer idegf, nfail;
doublereal fcrit, sigjm1;
extern /* Subroutine */ int dp1vlu_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *);
static doublereal sigpas;
doublereal sigpas;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
@ -181,6 +165,18 @@ static integer c__1 = 1;
/* 920501 Reformatted the REFERENCES section. (WRB) */
/* 920527 Corrected erroneous statements in DESCRIPTION. (WRB) */
/* ***END PROLOGUE DPOLFT */
/* SAVE CO */
/* DATA CO(1,1), CO(2,1), CO(3,1), CO(4,1), CO(1,2), CO(2,2), */
/* 1 CO(3,2), CO(4,2), CO(1,3), CO(2,3), CO(3,3), */
/* 2 CO(4,3)/-13.086850D0,-2.4648165D0,-3.3846535D0,-1.2973162D0, */
/* 3 -3.3381146D0,-1.7812271D0,-3.2578406D0,-1.6589279D0, */
/* 4 -1.6282703D0,-1.3152745D0,-3.2640179D0,-1.9829776D0/ */
/* ***FIRST EXECUTABLE STATEMENT DPOLFT */
/* write(*,*) 'DPOLFT n = ',n */
/* do ii = 1,n */
/* write(*,*) x(ii), y(ii), w(ii) */
/* end do */
/* write(*,*) ' maxdeg, eps = ',maxdeg,eps */
/* Parameter adjustments */
--a;
--r__;
@ -189,12 +185,6 @@ static integer c__1 = 1;
--x;
/* Function Body */
/* ***FIRST EXECUTABLE STATEMENT DPOLFT */
/* write(*,*) 'DPOLFT n = ',n */
/* do ii = 1,n */
/* write(*,*) x(ii), y(ii), w(ii) */
/* end do */
/* write(*,*) ' maxdeg, eps = ',maxdeg,eps */
m = abs(*n);
if (m == 0) {
goto L30;
@ -534,6 +524,3 @@ L37:
return 0;
} /* dpolft_ */
#ifdef _cpluscplus
}
#endif

87
ext/f2c_math/fdump.c
View file

@ -1,18 +1,8 @@
/* fdump.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* fdump.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* DECK FDUMP */
@ -47,75 +37,4 @@ extern "C" {
/* ***FIRST EXECUTABLE STATEMENT FDUMP */
return 0;
} /* fdump_ */
/* integer isamax_(integer *n, real *sx, integer *incx) */
/* { */
/* /\* System generated locals *\/ */
/* integer ret_val, i__1; */
/* real r__1; */
/* /\* Local variables *\/ */
/* static integer i__, ix; */
/* static real smax; */
/* /\* finds the index of element having max. absolute value. *\/ */
/* /\* jack dongarra, linpack, 3/11/78. *\/ */
/* /\* modified 3/93 to return if incx .le. 0. *\/ */
/* /\* Parameter adjustments *\/ */
/* --sx; */
/* /\* Function Body *\/ */
/* ret_val = 0; */
/* if (*n < 1 || *incx <= 0) { */
/* return ret_val; */
/* } */
/* ret_val = 1; */
/* if (*n == 1) { */
/* return ret_val; */
/* } */
/* if (*incx == 1) { */
/* goto L20; */
/* } */
/* /\* code for increment not equal to 1 *\/ */
/* ix = 1; */
/* smax = dabs(sx[1]); */
/* ix += *incx; */
/* i__1 = *n; */
/* for (i__ = 2; i__ <= i__1; ++i__) { */
/* if ((r__1 = sx[ix], dabs(r__1)) <= smax) { */
/* goto L5; */
/* } */
/* ret_val = i__; */
/* smax = (r__1 = sx[ix], dabs(r__1)); */
/* L5: */
/* ix += *incx; */
/* /\* L10: *\/ */
/* } */
/* return ret_val; */
/* /\* code for increment equal to 1 *\/ */
/* L20: */
/* smax = dabs(sx[1]); */
/* i__1 = *n; */
/* for (i__ = 2; i__ <= i__1; ++i__) { */
/* if ((r__1 = sx[i__], dabs(r__1)) <= smax) { */
/* goto L30; */
/* } */
/* ret_val = i__; */
/* smax = (r__1 = sx[i__], dabs(r__1)); */
/* L30: */
/* ; */
/* } */
/* return ret_val; */
/* } /\* isamax_ *\/ */
#ifdef _cpluscplus
}
#endif

23
ext/f2c_math/idamax.c
View file

@ -1,18 +1,8 @@
/* idamax.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* idamax.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
integer idamax_(integer *n, doublereal *dx, integer *incx)
@ -22,8 +12,8 @@ integer idamax_(integer *n, doublereal *dx, integer *incx)
doublereal d__1;
/* Local variables */
static integer i__, ix;
static doublereal dmax__;
integer i__, ix;
doublereal dmax__;
/* finds the index of element having max. absolute value. */
@ -82,6 +72,3 @@ L30:
return ret_val;
} /* idamax_ */
#ifdef _cpluscplus
}
#endif

20
ext/f2c_math/j4save.c
View file

@ -1,18 +1,8 @@
/* j4save.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* j4save.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* DECK J4SAVE */
@ -77,6 +67,7 @@ integer j4save_(integer *iwhich, integer *ivalue, logical *iset)
/* 910411 Added KEYWORDS section. (WRB) */
/* 920501 Reformatted the REFERENCES section. (WRB) */
/* ***END PROLOGUE J4SAVE */
/* SAVE IPARAM */
/* ***FIRST EXECUTABLE STATEMENT J4SAVE */
ret_val = iparam[(0 + (0 + (*iwhich - 1 << 2))) / 4];
if (*iset) {
@ -85,6 +76,3 @@ integer j4save_(integer *iwhich, integer *ivalue, logical *iset)
return ret_val;
} /* j4save_ */
#ifdef _cpluscplus
}
#endif

75
ext/f2c_math/pcoef.c
View file

@ -1,18 +1,8 @@
/* pcoef.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* pcoef.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -26,10 +16,10 @@ static integer c__1 = 1;
integer i__1;
/* Local variables */
static integer i__, ll, nr;
static real fac;
static integer new__, llp1, llp2;
static real save;
integer i__, ll, nr;
real fac;
integer new__, llp1, llp2;
real save;
extern /* Subroutine */ int pvalue_(integer *, integer *, real *, real *,
real *, real *);
@ -181,25 +171,25 @@ L4:
double d_sign(doublereal *, doublereal *);
/* Local variables */
static integer j, k, l, m;
static doublereal s, t;
static integer kb, la;
static doublereal ek;
static integer lm, mm, is, ju;
static doublereal sm, wk;
static integer lz, kp1;
static doublereal wkm;
integer j, k, l, m;
doublereal s, t;
integer kb, la;
doublereal ek;
integer lm, mm, is, ju;
doublereal sm, wk;
integer lz, kp1;
doublereal wkm;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
static integer info;
integer info;
extern /* Subroutine */ int dgbfa_(doublereal *, integer *, integer *,
integer *, integer *, integer *, integer *), dscal_(integer *,
doublereal *, doublereal *, integer *);
extern doublereal dasum_(integer *, doublereal *, integer *);
static doublereal anorm;
doublereal anorm;
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
static doublereal ynorm;
doublereal ynorm;
/* dgbco factors a double precision band matrix by gaussian */
@ -546,23 +536,23 @@ L150:
double d_sign(doublereal *, doublereal *);
/* Local variables */
static integer j, k, l;
static doublereal s, t;
static integer kb;
static doublereal ek, sm, wk;
static integer kp1;
static doublereal wkm;
integer j, k, l;
doublereal s, t;
integer kb;
doublereal ek, sm, wk;
integer kp1;
doublereal wkm;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
static integer info;
integer info;
extern /* Subroutine */ int dgefa_(doublereal *, integer *, integer *,
integer *, integer *), dscal_(integer *, doublereal *, doublereal
*, integer *);
extern doublereal dasum_(integer *, doublereal *, integer *);
static doublereal anorm;
doublereal anorm;
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
static doublereal ynorm;
doublereal ynorm;
/* dgeco factors a double precision matrix by gaussian elimination */
@ -823,10 +813,10 @@ L150:
integer a_dim1, a_offset, i__1, i__2;
/* Local variables */
static integer i__, j, k, l;
static doublereal t;
static integer kb, kp1, nm1;
static doublereal ten;
integer i__, j, k, l;
doublereal t;
integer kb, kp1, nm1;
doublereal ten;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), dswap_(integer *, doublereal *, integer *, doublereal
*, integer *), daxpy_(integer *, doublereal *, doublereal *,
@ -1001,6 +991,3 @@ L150:
return 0;
} /* dgedi_ */
#ifdef _cpluscplus
}
#endif

203
ext/f2c_math/polfit.c
View file

@ -1,35 +1,14 @@
/* polfit.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* polfit.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
static integer c__2 = 2;
static integer c__1 = 1;
/* DECK POLFIT */
/* Subroutine */ int polfit_(integer *n, real *x, real *y, real *w, integer *
maxdeg, integer *ndeg, real *eps, real *r__, integer *ierr, real *a)
{
/* Initialized data */
static real co[12] /* was [4][3] */ = { -13.08685f,-2.4648165f,
-3.3846535f,-1.2973162f,-3.3381146f,-1.7812271f,-3.2578406f,
-1.6589279f,-1.6282703f,-1.3152745f,-3.2640179f,-1.9829776f };
/* System generated locals */
integer i__1;
real r__1;
@ -38,23 +17,19 @@ static integer c__1 = 1;
double sqrt(doublereal);
/* Local variables */
static real f;
static integer i__, j, m, k1, k2, k3, k4, k5;
static real w1, w11, xm, yp;
static integer jp1;
static real den, sig;
static integer k1pj, k2pj, k4pi, k5pi, k3pi, mop1;
static real degf;
static integer nder;
static real sigj;
static integer ksig, jpas;
static real temp, etst;
static doublereal temd1, temd2;
static integer idegf, nfail;
static real fcrit, sigjm1, sigpas;
integer i__, j, m, k1, k2, k3, k4, k5;
real w1, w11, xm, yp;
integer jp1;
real sig;
integer k1pj, k2pj, k4pi, k3pi, k5pi, mop1, nder;
real sigj;
integer jpas;
real temp, etst;
doublereal temd1, temd2;
integer nfail;
real sigjm1, sigpas;
extern /* Subroutine */ int pvalue_(integer *, integer *, real *, real *,
real *, real *), xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
real *, real *);
/* ***BEGIN PROLOGUE POLFIT */
/* ***PURPOSE Fit discrete data in a least squares sense by polynomials */
@ -177,6 +152,14 @@ static integer c__1 = 1;
/* 920501 Reformatted the REFERENCES section. (WRB) */
/* 920527 Corrected erroneous statements in DESCRIPTION. (WRB) */
/* ***END PROLOGUE POLFIT */
/* DIMENSION CO(4,3) */
/* SAVE CO */
/* DATA CO(1,1), CO(2,1), CO(3,1), CO(4,1), CO(1,2), CO(2,2), */
/* 1 CO(3,2), CO(4,2), CO(1,3), CO(2,3), CO(3,3), */
/* 2 CO(4,3)/-13.086850,-2.4648165,-3.3846535,-1.2973162, */
/* 3 -3.3381146,-1.7812271,-3.2578406,-1.6589279, */
/* 4 -1.6282703,-1.3152745,-3.2640179,-1.9829776/ */
/* ***FIRST EXECUTABLE STATEMENT POLFIT */
/* Parameter adjustments */
--a;
--r__;
@ -185,7 +168,6 @@ static integer c__1 = 1;
--x;
/* Function Body */
/* ***FIRST EXECUTABLE STATEMENT POLFIT */
m = abs(*n);
if (m == 0) {
goto L30;
@ -201,121 +183,6 @@ static integer c__1 = 1;
if (*eps < 0.f && m == mop1) {
goto L30;
}
xm = (real) m;
etst = *eps * *eps * xm;
if (w[1] < 0.f) {
goto L2;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
if (w[i__] <= 0.f) {
goto L30;
}
/* L1: */
}
goto L4;
L2:
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L3: */
w[i__] = 1.f;
}
L4:
if (*eps >= 0.f) {
goto L8;
}
/* DETERMINE SIGNIFICANCE LEVEL INDEX TO BE USED IN STATISTICAL TEST FOR */
/* CHOOSING DEGREE OF POLYNOMIAL FIT */
if (*eps > -.55f) {
goto L5;
}
idegf = m - *maxdeg - 1;
ksig = 1;
if (idegf < 10) {
ksig = 2;
}
if (idegf < 5) {
ksig = 3;
}
goto L8;
L5:
ksig = 1;
if (*eps < -.03f) {
ksig = 2;
}
if (*eps < -.07f) {
ksig = 3;
}
/* INITIALIZE INDEXES AND COEFFICIENTS FOR FITTING */
L8:
k1 = *maxdeg + 1;
k2 = k1 + *maxdeg;
k3 = k2 + *maxdeg + 2;
k4 = k3 + m;
k5 = k4 + m;
i__1 = k4;
for (i__ = 2; i__ <= i__1; ++i__) {
/* L9: */
a[i__] = 0.f;
}
w11 = 0.f;
if (*n < 0) {
goto L11;
}
/* UNCONSTRAINED CASE */
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
k4pi = k4 + i__;
a[k4pi] = 1.f;
/* L10: */
w11 += w[i__];
}
goto L13;
/* CONSTRAINED CASE */
L11:
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
k4pi = k4 + i__;
/* L12: */
/* Computing 2nd power */
r__1 = a[k4pi];
w11 += w[i__] * (r__1 * r__1);
}
/* COMPUTE FIT OF DEGREE ZERO */
L13:
temd1 = 0.;
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
k4pi = k4 + i__;
temd1 += (doublereal) w[i__] * (doublereal) y[i__] * (doublereal) a[
k4pi];
/* L14: */
}
temd1 /= (doublereal) w11;
a[k2 + 1] = temd1;
sigj = 0.f;
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
k4pi = k4 + i__;
k5pi = k5 + i__;
temd2 = temd1 * (doublereal) a[k4pi];
r__[i__] = temd2;
a[k5pi] = temd2 - (doublereal) r__[i__];
/* L15: */
/* Computing 2nd power */
r__1 = y[i__] - r__[i__] - a[k5pi];
sigj += w[i__] * (r__1 * r__1);
}
j = 0;
/* SEE IF POLYNOMIAL OF DEGREE 0 SATISFIES THE DEGREE SELECTION CRITERION */
@ -426,15 +293,12 @@ L23:
if (sigj == 0.f) {
goto L29;
}
degf = (real) (m - j - 1);
den = (co[(ksig << 2) - 1] * degf + 1.f) * degf;
fcrit = ((co[(ksig << 2) - 2] * degf + co[(ksig << 2) - 3]) * degf + co[(
ksig << 2) - 4]) / den;
fcrit *= fcrit;
f = (sigjm1 - sigj) * degf / sigj;
if (f < fcrit) {
goto L25;
}
/* DEGF = M - J - 1 */
/* DEN = (CO(4,KSIG)*DEGF + 1.0)*DEGF */
/* FCRIT = (((CO(3,KSIG)*DEGF) + CO(2,KSIG))*DEGF + CO(1,KSIG))/DEN */
/* FCRIT = FCRIT*FCRIT */
/* F = (SIGJM1 - SIGJ)*DEGF/SIGJ */
/* IF (F .LT. FCRIT) GO TO 25 */
/* POLYNOMIAL OF DEGREE J SATISFIES F TEST */
@ -450,7 +314,7 @@ L24:
/* POLYNOMIAL OF DEGREE J FAILS F TEST. IF THERE HAVE BEEN THREE */
/* SUCCESSIVE FAILURES, A STATISTICALLY BEST DEGREE HAS BEEN FOUND. */
L25:
/* L25: */
++nfail;
if (nfail >= 3) {
goto L29;
@ -494,8 +358,8 @@ L29:
goto L33;
L30:
*ierr = 2;
xermsg_("SLATEC", "POLFIT", "INVALID INPUT PARAMETER.", &c__2, &c__1, (
ftnlen)6, (ftnlen)6, (ftnlen)24);
/* CALL XERMSG ('SLATEC', 'POLFIT', 'INVALID INPUT PARAMETER.', 2, */
/* + 1) */
goto L37;
L31:
*ierr = 3;
@ -528,6 +392,3 @@ L37:
return 0;
} /* polfit_ */
#ifdef _cpluscplus
}
#endif

88
ext/f2c_math/pvalue.c
View file

@ -1,58 +1,25 @@
/* pvalue.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* pvalue.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
static integer c__1 = 1;
static integer c__8 = 8;
static integer c__2 = 2;
static integer c__5 = 5;
/* DECK PVALUE */
/* Subroutine */ int pvalue_(integer *l, integer *nder, real *x, real *yfit,
real *yp, real *a)
{
/* System generated locals */
address a__1[5];
integer i__1, i__2, i__3[5];
char ch__1[150];
/* Builtin functions */
integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
;
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer i__1, i__2;
/* Local variables */
static integer i__, n, k1, k2, k3, k4;
static real cc;
static integer ic, kc, in, k1i, lm1, lp1;
static real dif;
static integer k3p1, k4p1, ndo;
static real val;
static integer ilo, iup, ndp1, inp1, k3pn, k4pn, nord;
static char xern1[8], xern2[8];
static integer maxord;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* Fortran I/O blocks */
static icilist io___28 = { 0, xern1, 0, "(I8)", 8, 1 };
static icilist io___30 = { 0, xern2, 0, "(I8)", 8, 1 };
integer i__, n, k1, k2, k3, k4;
real cc;
integer ic, kc, in, k1i, lm1, lp1;
real dif;
integer k3p1, k4p1, ndo;
real val;
integer ilo, iup, ndp1, inp1, k3pn, k4pn, nord, maxord;
/* ***BEGIN PROLOGUE PVALUE */
/* ***PURPOSE Use the coefficients generated by POLFIT to evaluate the */
@ -225,31 +192,20 @@ L10:
return 0;
L11:
s_wsfi(&io___28);
do_fio(&c__1, (char *)&(*l), (ftnlen)sizeof(integer));
e_wsfi();
s_wsfi(&io___30);
do_fio(&c__1, (char *)&nord, (ftnlen)sizeof(integer));
e_wsfi();
/* Writing concatenation */
i__3[0] = 40, a__1[0] = "THE ORDER OF POLYNOMIAL EVALUATION, L = ";
i__3[1] = 8, a__1[1] = xern1;
i__3[2] = 49, a__1[2] = " REQUESTED EXCEEDS THE HIGHEST ORDER FIT, NORD "
"= ";
i__3[3] = 8, a__1[3] = xern2;
i__3[4] = 45, a__1[4] = ", COMPUTED BY POLFIT -- EXECUTION TERMINATED.";
s_cat(ch__1, a__1, i__3, &c__5, (ftnlen)150);
xermsg_("SLATEC", "PVALUE", ch__1, &c__8, &c__2, (ftnlen)6, (ftnlen)6, (
ftnlen)150);
return 0;
/* WRITE (XERN1, '(I8)') L */
/* WRITE (XERN2, '(I8)') NORD */
/* CALL XERMSG ('SLATEC', 'PVALUE', */
/* * 'THE ORDER OF POLYNOMIAL EVALUATION, L = ' // XERN1 // */
/* * ' REQUESTED EXCEEDS THE HIGHEST ORDER FIT, NORD = ' // XERN2 // */
/* * ', COMPUTED BY POLFIT -- EXECUTION TERMINATED.', 8, 2) */
/* RETURN */
L12:
xermsg_("SLATEC", "PVALUE", "INVALID INPUT PARAMETER. ORDER OF POLYNOMI"
"AL EVALUATION REQUESTED IS NEGATIVE -- EXECUTION TERMINATED.", &
c__2, &c__2, (ftnlen)6, (ftnlen)6, (ftnlen)103);
return 0;
/* CALL XERMSG ('SLATEC', 'PVALUE', */
/* + 'INVALID INPUT PARAMETER. ORDER OF POLYNOMIAL EVALUATION ' // */
/* + 'REQUESTED IS NEGATIVE -- EXECUTION TERMINATED.', 2, 2) */
/* RETURN */
} /* pvalue_ */
#ifdef _cpluscplus
}
#endif

19
ext/f2c_math/xercnt.c
View file

@ -1,18 +1,8 @@
/* xercnt.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xercnt.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* DECK XERCNT */
@ -78,6 +68,3 @@ extern "C" {
return 0;
} /* xercnt_ */
#ifdef _cpluscplus
}
#endif

19
ext/f2c_math/xerhlt.c
View file

@ -1,18 +1,8 @@
/* xerhlt.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xerhlt.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -73,6 +63,3 @@ static integer c__1 = 1;
return 0;
} /* xerhlt_ */
#ifdef _cpluscplus
}
#endif

49
ext/f2c_math/xermsg.c
View file

@ -1,18 +1,8 @@
/* xermsg.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xermsg.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -35,6 +25,7 @@ static logical c_true = TRUE_;
address a__1[2];
integer i__1, i__2, i__3[2];
char ch__1[87];
icilist ici__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
@ -43,28 +34,24 @@ static logical c_true = TRUE_;
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static integer i__, lerr;
static char temp[72];
integer i__, lerr;
char temp[72];
extern /* Subroutine */ int fdump_(void);
static char xlibr[8];
static integer ltemp, kount;
static char xsubr[8];
char xlibr[8];
integer ltemp, kount;
char xsubr[8];
extern integer j4save_(integer *, integer *, logical *);
static integer llevel, maxmes;
static char lfirst[20];
integer llevel, maxmes;
char lfirst[20];
extern /* Subroutine */ int xercnt_(char *, char *, char *, integer *,
integer *, integer *, ftnlen, ftnlen, ftnlen);
static integer lkntrl, kdummy;
integer lkntrl, kdummy;
extern /* Subroutine */ int xerhlt_(char *, ftnlen);
static integer mkntrl;
integer mkntrl;
extern /* Subroutine */ int xersve_(char *, char *, char *, integer *,
integer *, integer *, integer *, ftnlen, ftnlen, ftnlen), xerprn_(
char *, integer *, char *, integer *, ftnlen, ftnlen);
/* Fortran I/O blocks */
static icilist io___14 = { 0, temp, 0, "('ERROR NUMBER = ', I8)", 72, 1 };
/* ***BEGIN PROLOGUE XERMSG */
/* ***PURPOSE Process error messages for SLATEC and other libraries. */
/* ***LIBRARY SLATEC (XERROR) */
@ -413,7 +400,12 @@ static logical c_true = TRUE_;
/* TRACEBACK. */
if (lkntrl > 0) {
s_wsfi(&io___14);
ici__1.icierr = 0;
ici__1.icirnum = 1;
ici__1.icirlen = 72;
ici__1.iciunit = temp;
ici__1.icifmt = "('ERROR NUMBER = ', I8)";
s_wsfi(&ici__1);
do_fio(&c__1, (char *)&(*nerr), (ftnlen)sizeof(integer));
e_wsfi();
for (i__ = 16; i__ <= 22; ++i__) {
@ -470,6 +462,3 @@ L30:
return 0;
} /* xermsg_ */
#ifdef _cpluscplus
}
#endif

61
ext/f2c_math/xerprn.c
View file

@ -1,24 +1,13 @@
/* xerprn.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xerprn.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
static integer c__4 = 4;
static integer c__1 = 1;
/* DECK XERPRN */
/* Subroutine */ int xerprn_(char *prefix, integer *npref, char *messg,
@ -30,23 +19,18 @@ static integer c__1 = 1;
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Local variables */
static integer i__, n, iu[5];
static char cbuff[148];
static integer lpref, nextc, lwrap, nunit;
integer i__, n, iu[5];
extern /* Subroutine */ int printstring_(char *, ftnlen);
char cbuff[148];
integer lpref, nextc, lwrap, nunit;
extern integer i1mach_(integer *);
static integer lpiece, idelta, lenmsg;
integer lpiece, idelta, lenmsg;
extern /* Subroutine */ int xgetua_(integer *, integer *);
/* Fortran I/O blocks */
static cilist io___9 = { 0, 0, 0, "(A)", 0 };
static cilist io___13 = { 0, 0, 0, "(A)", 0 };
/* ***BEGIN PROLOGUE XERPRN */
/* ***SUBSIDIARY */
/* ***PURPOSE Print error messages processed by XERMSG. */
@ -177,14 +161,10 @@ L30:
if (lenmsg == 0) {
i__1 = lpref;
s_copy(cbuff + i__1, " ", lpref + 1 - i__1, (ftnlen)1);
i__1 = nunit;
for (i__ = 1; i__ <= i__1; ++i__) {
io___9.ciunit = iu[i__ - 1];
s_wsfe(&io___9);
do_fio(&c__1, cbuff, lpref + 1);
e_wsfe();
/* L40: */
}
printstring_(cbuff, (ftnlen)148);
/* DO 40 I=1,NUNIT */
/* WRITE(IU(I), '(A)') CBUFF(1:LPREF+1) */
/* 40 CONTINUE */
return 0;
}
@ -296,14 +276,10 @@ L58:
/* PRINT */
i__1 = nunit;
for (i__ = 1; i__ <= i__1; ++i__) {
io___13.ciunit = iu[i__ - 1];
s_wsfe(&io___13);
do_fio(&c__1, cbuff, lpref + lpiece);
e_wsfe();
/* L60: */
}
printstring_(cbuff, (ftnlen)148);
/* DO 60 I=1,NUNIT */
/* WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE) */
/* 60 CONTINUE */
if (nextc <= lenmsg) {
goto L50;
@ -311,6 +287,3 @@ L58:
return 0;
} /* xerprn_ */
#ifdef _cpluscplus
}
#endif

26
ext/f2c_math/xersve.c
View file

@ -1,18 +1,8 @@
/* xersve.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xersve.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -48,9 +38,10 @@ static integer c__1 = 1;
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer i__;
static char lib[8], mes[20], sub[8];
static integer lun[5], iunit, kunit, nunit, kount[10];
integer i__;
char lib[8], mes[20], sub[8];
integer lun[5], iunit, kunit, nunit;
static integer kount[10];
extern integer i1mach_(integer *);
static char libtab[8*10], mestab[20*10];
static integer nertab[10], levtab[10];
@ -234,6 +225,3 @@ static integer c__1 = 1;
} /* xersve_ */
#ifdef _cpluscplus
}
#endif

21
ext/f2c_math/xgetua.c
View file

@ -1,18 +1,8 @@
/* xgetua.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
/* xgetua.f -- translated by f2c (version 20030320).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef _cpluscplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
@ -28,7 +18,7 @@ static logical c_false = FALSE_;
integer i__1;
/* Local variables */
static integer i__, index;
integer i__, index;
extern integer j4save_(integer *, integer *, logical *);
/* ***BEGIN PROLOGUE XGETUA */
@ -88,6 +78,3 @@ static logical c_false = FALSE_;
return 0;
} /* xgetua_ */
#ifdef _cpluscplus
}
#endif

9
preconfig
View file

@ -132,7 +132,7 @@ BUILD_F90_INTERFACE=${BUILD_F90_INTERFACE:="default"}
# The Fortran 90/95 compiler. If set to "default", the script will
# look for a Fortran 90/95 compiler on your system by the name of
# "f95", "gfortran", or "g95".
F90=${F90:="default"}
F90=${F90:="gfortran"}
# Compiler option flags for the Fortran 90/95 compiler. If you are
# using the Absoft or the NAG compiler, additional options specific to
@ -199,6 +199,10 @@ WITH_IDEAL_SOLUTIONS=${WITH_IDEAL_SOLUTIONS:="y"}
# models for electrolyte solutions
WITH_ELECTROLYTES=${WITH_ELECTROLYTES:="y"}
# Enable generating phase models from PrIMe models. For more
# information about PrIME, see http://www.primekinetics.org
# WARNING: Support for PrIMe is experimental!
WITH_PRIME=${WITH_PRIME:="n"}
######################################################################
# if set to 'y', the ck2cti program that converts Chemkin input files
@ -327,7 +331,7 @@ LCXX_END_LIBS=${LCXX_END_LIBS:="-lm"}
PIC=${PIC:=-fPIC}
# the compiler option to create a shared library from object files
SHARED=${SHARED:="-shared"}
SHARED=${SHARED:="-dynamic"}
#-------------------------------------------------------------------
@ -479,6 +483,7 @@ export WITH_STOICH_SUBSTANCE
export WITH_PURE_FLUIDS
export WITH_IDEAL_SOLUTIONS
export WITH_ELECTROLYTES
export WITH_PRIME
#cd config
chmod +x ./configure