diff --git a/Cantera/clib/src/ctfunc.cpp b/Cantera/clib/src/ctfunc.cpp index 0c788701a..7cf0feb14 100755 --- a/Cantera/clib/src/ctfunc.cpp +++ b/Cantera/clib/src/ctfunc.cpp @@ -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::cabinet()->add(r); + } + + } diff --git a/Cantera/clib/src/ctfunc.h b/Cantera/clib/src/ctfunc.h index fba972550..630d5b40e 100755 --- a/Cantera/clib/src/ctfunc.h +++ b/Cantera/clib/src/ctfunc.h @@ -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 diff --git a/Cantera/matlab/cantera/@Func/Func.m b/Cantera/matlab/cantera/@Func/Func.m index cda486e9d..b892f9ff7 100644 --- a/Cantera/matlab/cantera/@Func/Func.m +++ b/Cantera/matlab/cantera/@Func/Func.m @@ -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; diff --git a/Cantera/python/Cantera/Func.py b/Cantera/python/Cantera/Func.py index a4cc297b6..0f950997c 100644 --- a/Cantera/python/Cantera/Func.py +++ b/Cantera/python/Cantera/Func.py @@ -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) + + + diff --git a/Cantera/python/examples/reactors/surf_pfr.py b/Cantera/python/examples/reactors/surf_pfr.py index 6a0529c29..680233634 100644 --- a/Cantera/python/examples/reactors/surf_pfr.py +++ b/Cantera/python/examples/reactors/surf_pfr.py @@ -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 diff --git a/Cantera/python/src/ctfunc_methods.cpp b/Cantera/python/src/ctfunc_methods.cpp index 1d2186f81..26d331f75 100644 --- a/Cantera/python/src/ctfunc_methods.cpp +++ b/Cantera/python/src/ctfunc_methods.cpp @@ -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) { diff --git a/Cantera/python/src/methods.h b/Cantera/python/src/methods.h index c25bdd0e8..1aaa25819 100644 --- a/Cantera/python/src/methods.h +++ b/Cantera/python/src/methods.h @@ -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}, diff --git a/Cantera/src/Func1.h b/Cantera/src/Func1.h index 47fdbf5ba..f18528e18 100644 --- a/Cantera/src/Func1.h +++ b/Cantera/src/Func1.h @@ -18,6 +18,10 @@ #include "ct_defs.h" +#include +#include +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 diff --git a/Cantera/src/Makefile.in b/Cantera/src/Makefile.in index db8c90e4c..9c114af71 100755 --- a/Cantera/src/Makefile.in +++ b/Cantera/src/Makefile.in @@ -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 \ diff --git a/Cantera/src/converters/Makefile.in b/Cantera/src/converters/Makefile.in index 7586962fa..7ab6bf102 100644 --- a/Cantera/src/converters/Makefile.in +++ b/Cantera/src/converters/Makefile.in @@ -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 \ diff --git a/Cantera/src/oneD/Makefile.in b/Cantera/src/oneD/Makefile.in index 580c7395f..934076110 100644 --- a/Cantera/src/oneD/Makefile.in +++ b/Cantera/src/oneD/Makefile.in @@ -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 diff --git a/config.h.in b/config.h.in index 94cb604e4..75ca1cf1a 100755 --- a/config.h.in +++ b/config.h.in @@ -134,4 +134,7 @@ typedef int ftnlen; // Fortran hidden string length type // models for electrolyte solutions. #undef WITH_ELECTROLYTES +#undef WITH_PRIME + + #endif diff --git a/configure.in b/configure.in index 8ca4cba18..48efb453d 100755 --- a/configure.in +++ b/configure.in @@ -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)' diff --git a/ext/f2c_math/Makefile.in b/ext/f2c_math/Makefile.in index 862297d8d..fcaea3f10 100644 --- a/ext/f2c_math/Makefile.in +++ b/ext/f2c_math/Makefile.in @@ -73,7 +73,8 @@ xerhlt.o \ xermsg.o \ xerprn.o \ xersve.o \ -xgetua.o +xgetua.o \ +printstring.o SRCS = $(OBJS:.o=.cpp) diff --git a/ext/f2c_math/daux.c b/ext/f2c_math/daux.c index 251c3748d..3af7c6312 100644 --- a/ext/f2c_math/daux.c +++ b/ext/f2c_math/daux.c @@ -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 diff --git a/ext/f2c_math/ddaspk.c b/ext/f2c_math/ddaspk.c index adf7ee8e4..44ffb2319 100644 --- a/ext/f2c_math/ddaspk.c +++ b/ext/f2c_math/ddaspk.c @@ -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 diff --git a/ext/f2c_math/dgbefa.c b/ext/f2c_math/dgbefa.c index 377c589ca..f98c570b9 100644 --- a/ext/f2c_math/dgbefa.c +++ b/ext/f2c_math/dgbefa.c @@ -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 diff --git a/ext/f2c_math/dgbsl.c b/ext/f2c_math/dgbsl.c index e6c787475..bcafc9fb8 100644 --- a/ext/f2c_math/dgbsl.c +++ b/ext/f2c_math/dgbsl.c @@ -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 diff --git a/ext/f2c_math/dgefa.c b/ext/f2c_math/dgefa.c index 67457052e..42e9094a5 100644 --- a/ext/f2c_math/dgefa.c +++ b/ext/f2c_math/dgefa.c @@ -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 diff --git a/ext/f2c_math/dgesl.c b/ext/f2c_math/dgesl.c index 56a562734..8f3a43e92 100644 --- a/ext/f2c_math/dgesl.c +++ b/ext/f2c_math/dgesl.c @@ -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 diff --git a/ext/f2c_math/dp1vlu.c b/ext/f2c_math/dp1vlu.c index 95e906608..894219901 100644 --- a/ext/f2c_math/dp1vlu.c +++ b/ext/f2c_math/dp1vlu.c @@ -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 diff --git a/ext/f2c_math/dpcoef.c b/ext/f2c_math/dpcoef.c index d2a28d2a4..5c3b9a818 100644 --- a/ext/f2c_math/dpcoef.c +++ b/ext/f2c_math/dpcoef.c @@ -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 diff --git a/ext/f2c_math/dpolft.c b/ext/f2c_math/dpolft.c index bf956fa00..5bc670187 100644 --- a/ext/f2c_math/dpolft.c +++ b/ext/f2c_math/dpolft.c @@ -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 diff --git a/ext/f2c_math/fdump.c b/ext/f2c_math/fdump.c index 6c23186b8..2438c6698 100644 --- a/ext/f2c_math/fdump.c +++ b/ext/f2c_math/fdump.c @@ -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 diff --git a/ext/f2c_math/idamax.c b/ext/f2c_math/idamax.c index 2615da8d4..c64ea8427 100644 --- a/ext/f2c_math/idamax.c +++ b/ext/f2c_math/idamax.c @@ -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 diff --git a/ext/f2c_math/j4save.c b/ext/f2c_math/j4save.c index 828b3a4bd..733e9e848 100644 --- a/ext/f2c_math/j4save.c +++ b/ext/f2c_math/j4save.c @@ -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 diff --git a/ext/f2c_math/pcoef.c b/ext/f2c_math/pcoef.c index a27f3b27f..08494b831 100644 --- a/ext/f2c_math/pcoef.c +++ b/ext/f2c_math/pcoef.c @@ -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 diff --git a/ext/f2c_math/polfit.c b/ext/f2c_math/polfit.c index fe6fb0b18..5b2e16653 100644 --- a/ext/f2c_math/polfit.c +++ b/ext/f2c_math/polfit.c @@ -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 diff --git a/ext/f2c_math/pvalue.c b/ext/f2c_math/pvalue.c index 033d5f619..1afe90937 100644 --- a/ext/f2c_math/pvalue.c +++ b/ext/f2c_math/pvalue.c @@ -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 diff --git a/ext/f2c_math/xercnt.c b/ext/f2c_math/xercnt.c index 6c3774de4..488d6074e 100644 --- a/ext/f2c_math/xercnt.c +++ b/ext/f2c_math/xercnt.c @@ -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 diff --git a/ext/f2c_math/xerhlt.c b/ext/f2c_math/xerhlt.c index e7373a096..6d1875aab 100644 --- a/ext/f2c_math/xerhlt.c +++ b/ext/f2c_math/xerhlt.c @@ -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 diff --git a/ext/f2c_math/xermsg.c b/ext/f2c_math/xermsg.c index 34cdc40ff..b1eac2ab1 100644 --- a/ext/f2c_math/xermsg.c +++ b/ext/f2c_math/xermsg.c @@ -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 diff --git a/ext/f2c_math/xerprn.c b/ext/f2c_math/xerprn.c index b0bc973c7..433dcd84d 100644 --- a/ext/f2c_math/xerprn.c +++ b/ext/f2c_math/xerprn.c @@ -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 diff --git a/ext/f2c_math/xersve.c b/ext/f2c_math/xersve.c index 7b54dcc5a..3c93c4161 100644 --- a/ext/f2c_math/xersve.c +++ b/ext/f2c_math/xersve.c @@ -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 diff --git a/ext/f2c_math/xgetua.c b/ext/f2c_math/xgetua.c index 4c2bf1282..a39f2c5d8 100644 --- a/ext/f2c_math/xgetua.c +++ b/ext/f2c_math/xgetua.c @@ -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 diff --git a/preconfig b/preconfig index 7583d1934..ce7785a4f 100755 --- a/preconfig +++ b/preconfig @@ -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