# HG changeset patch # User jwe # Date 744772906 0 # Node ID 9a4c07481e61808de3d65d3672d86fb1c382556d # Parent c0190df9885d0fe6f4e9021793ff393435ba403e [project @ 1993-08-08 01:20:23 by jwe] Initial revision diff -r c0190df9885d -r 9a4c07481e61 liboctave/Bounds.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Bounds.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,220 @@ +// Bounds.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "Bounds.h" + +// error handling + +void +Bounds::error (const char* msg) +{ + cerr << "Fatal bounds error. " << msg << "\n"; + exit(1); +} + +Bounds::Bounds (void) +{ + nb = 0; +} + +Bounds::Bounds (int n) +{ + nb = n; + lb.resize (nb); + ub.resize (nb); + lb.fill (0.0); + ub.fill (0.0); +} + +Bounds::Bounds (const ColumnVector l, const ColumnVector u) +{ + if (l.capacity () != u.capacity ()) + error ("inconsistent sizes for lower and upper bounds"); + + nb = l.capacity (); + lb = l; + ub = u; +} + +Bounds::Bounds (const Bounds& a) +{ + nb = a.size (); + lb = a.lower_bounds (); + ub = a.upper_bounds (); +} + +Bounds& +Bounds::operator = (const Bounds& a) +{ + nb = a.size (); + lb = a.lower_bounds (); + ub = a.upper_bounds (); + + return *this; +} + +Bounds& +Bounds::resize (int n) +{ + nb = n; + lb.resize (nb); + ub.resize (nb); + + return *this; +} + +double +Bounds::lower_bound (int index) const +{ + return lb.elem (index); +} + +double +Bounds::upper_bound (int index) const +{ + return ub.elem (index); +} + +ColumnVector +Bounds::lower_bounds (void) const +{ + return lb; +} + +ColumnVector +Bounds::upper_bounds (void) const +{ + return ub; +} + +int +Bounds::size (void) const +{ + return nb; +} + +Bounds& +Bounds::set_bound (int index, double low, double high) +{ + lb.elem (index) = low; + ub.elem (index) = high; + + return *this; +} + +Bounds& +Bounds::set_bounds (double low, double high) +{ + lb.fill (low); + ub.fill (high); + + return *this; +} + +Bounds& +Bounds::set_bounds (const ColumnVector l, const ColumnVector u) +{ + if (l.capacity () != u.capacity ()) + error ("inconsistent sizes for lower and upper bounds"); + + nb = l.capacity (); + lb = l; + ub = u; + + return *this; +} + +Bounds& +Bounds::set_lower_bound (int index, double low) +{ + lb.elem (index) = low; + + return *this; +} + +Bounds& +Bounds::set_upper_bound (int index, double high) +{ + ub.elem (index) = high; + + return *this; +} + +Bounds& +Bounds::set_lower_bounds (double low) +{ + lb.fill (low); + + return *this; +} + +Bounds& +Bounds::set_upper_bounds (double high) +{ + ub.fill (high); + + return *this; +} + +Bounds& +Bounds::set_lower_bounds (const ColumnVector l) +{ + if (nb != l.capacity ()) + error ("inconsistent size for lower bounds"); + + lb = l; + + return *this; +} + +Bounds& +Bounds::set_upper_bounds (const ColumnVector u) +{ + if (nb != u.capacity ()) + error ("inconsistent size for upper bounds"); + + ub = u; + + return *this; +} + +ostream& +operator << (ostream& os, const Bounds& b) +{ + for (int i = 0; i < b.size (); i++) + os << b.lower_bound (i) << " " << b.upper_bound (i) << "\n"; + + return os; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Bounds.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Bounds.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,95 @@ +// Bounds.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_Bounds_h) +#define _Bounds_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class Bounds +{ +public: + + Bounds (void); + Bounds (int n); + Bounds (const Vector lb, const Vector ub); + Bounds (const Bounds& a); + + Bounds& operator = (const Bounds& a); + + Bounds& resize (int n); + + double lower_bound (int index) const; + double upper_bound (int index) const; + + Vector lower_bounds (void) const; + Vector upper_bounds (void) const; + + int size (void) const; + + Bounds& set_bound (int index, double low, double high); + + Bounds& set_bounds (double low, double high); + Bounds& set_bounds (const Vector lb, const Vector ub); + + Bounds& set_lower_bound (int index, double low); + Bounds& set_upper_bound (int index, double high); + + Bounds& set_lower_bounds (double low); + Bounds& set_upper_bounds (double high); + + Bounds& set_lower_bounds (const Vector lb); + Bounds& set_upper_bounds (const Vector ub); + + friend ostream& operator << (ostream& os, const Bounds& b); + +protected: + + Vector lb; + Vector ub; + + int nb; + +private: + + void error (const char *msg); + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/ColVector.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/ColVector.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,1214 @@ +// ColumnVector manipulations. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +// I\'m not sure how this is supposed to work if the .h file declares +// several classes, each of which is defined in a separate file... +// +// #ifdef __GNUG__ +// #pragma implementation "Matrix.h" +// #endif + +#include "Matrix.h" +#include "mx-inlines.cc" + +/* + * Column Vector class. + */ + +ColumnVector::ColumnVector (int n) +{ + if (n < 0) + FAIL; + + len = n; + if (n > 0) + data = new double [len]; + else + data = (double *) NULL; +} + +ColumnVector::ColumnVector (int n, double val) +{ + if (n < 0) + FAIL; + + len = n; + if (n > 0) + { + data = new double [len]; + copy (data, len, val); + } + else + data = (double *) NULL; +} + +ColumnVector::ColumnVector (const ColumnVector& a) +{ + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +ColumnVector::ColumnVector (double a) +{ + len = 1; + data = new double [1]; + data[0] = a; +} + +ColumnVector& +ColumnVector::operator = (const ColumnVector& a) +{ + if (this != &a) + { + delete [] data; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; + } + return *this; +} + +ColumnVector& +ColumnVector::resize (int n) +{ + if (n < 0) + FAIL; + + double *new_data = (double *) NULL; + if (n > 0) + { + new_data = new double [n]; + int min_len = len < n ? len : n; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + len = n; + data = new_data; + + return *this; +} + +ColumnVector& +ColumnVector::resize (int n, double val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +int +ColumnVector::operator == (const ColumnVector& a) const +{ + if (len != a.len) + return 0; + return equal (data, a.data, len); +} + +int +ColumnVector::operator != (const ColumnVector& a) const +{ + if (len != a.len) + return 1; + return !equal (data, a.data, len); +} + +ColumnVector& +ColumnVector::insert (const ColumnVector& a, int r) +{ + if (r < 0 || r + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[r+i] = a.data[i]; + + return *this; +} + +ColumnVector& +ColumnVector::fill (double val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +ColumnVector& +ColumnVector::fill (double val, int r1, int r2) +{ + if (r1 < 0 || r2 < 0 || r1 >= len || r2 >= len) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + + for (int i = r1; i <= r2; i++) + data[i] = val; + + return *this; +} + +ColumnVector +ColumnVector::stack (const ColumnVector& a) const +{ + int nr_insert = len; + ColumnVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nr_insert); + return retval; +} + +RowVector +ColumnVector::transpose (void) const +{ + return RowVector (dup (data, len), len); +} + +// resize is the destructive equivalent for this one + +ColumnVector +ColumnVector::extract (int r1, int r2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + + int new_r = r2 - r1 + 1; + + ColumnVector result (new_r); + + for (int i = 0; i < new_r; i++) + result.data[i] = elem (r1+i); + + return result; +} + +// column vector by scalar -> column vector operations + +ColumnVector +ColumnVector::operator + (double s) const +{ + return ColumnVector (add (data, len, s), len); +} + +ColumnVector +ColumnVector::operator - (double s) const +{ + return ColumnVector (subtract (data, len, s), len); +} + +ColumnVector +ColumnVector::operator * (double s) const +{ + return ColumnVector (multiply (data, len, s), len); +} + +ColumnVector +ColumnVector::operator / (double s) const +{ + return ColumnVector (divide (data, len, s), len); +} + +// scalar by column vector -> column vector operations + +ColumnVector +operator + (double s, const ColumnVector& a) +{ + return ColumnVector (add (a.data, a.len, s), a.len); +} + +ColumnVector +operator - (double s, const ColumnVector& a) +{ + return ColumnVector (subtract (s, a.data, a.len), a.len); +} + +ColumnVector +operator * (double s, const ColumnVector& a) +{ + return ColumnVector (multiply (a.data, a.len, s), a.len); +} + +ColumnVector +operator / (double s, const ColumnVector& a) +{ + return ColumnVector (divide (s, a.data, a.len), a.len); +} + +ComplexColumnVector +ColumnVector::operator + (Complex s) const +{ + return ComplexColumnVector (add (data, len, s), len); +} + +ComplexColumnVector +ColumnVector::operator - (Complex s) const +{ + return ComplexColumnVector (subtract (data, len, s), len); +} + +ComplexColumnVector +ColumnVector::operator * (Complex s) const +{ + return ComplexColumnVector (multiply (data, len, s), len); +} + +ComplexColumnVector +ColumnVector::operator / (Complex s) const +{ + return ComplexColumnVector (divide (data, len, s), len); +} + +// column vector by row vector -> matrix operations + +Matrix +ColumnVector::operator * (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return Matrix (len, len, 0.0); + + char transa = 'N'; + char transb = 'N'; + double alpha = 1.0; + double beta = 0.0; + int anr = 1; + int anc = a.len; + + double *c = new double [len * a.len]; + + F77_FCN (dgemm) (&transa, &transb, &len, &anc, &anr, &alpha, data, + &len, a.data, &anr, &beta, c, &len, 1L, 1L); + + return Matrix (c, len, a.len); +} + +ComplexMatrix +ColumnVector::operator * (const ComplexRowVector& a) const +{ + ComplexColumnVector tmp (*this); + return tmp * a; +} + +// column vector by column vector -> column vector operations + +ColumnVector +ColumnVector::operator + (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ColumnVector (0); + + return ColumnVector (add (data, a.data, len), len); +} + +ColumnVector +ColumnVector::operator - (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ColumnVector (0); + + return ColumnVector (subtract (data, a.data, len), len); +} + +ComplexColumnVector +ColumnVector::operator + (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (add (data, a.data, len), len); +} + +ComplexColumnVector +ColumnVector::operator - (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (subtract (data, a.data, len), len); +} + +ColumnVector +ColumnVector::product (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ColumnVector (0); + + return ColumnVector (multiply (data, a.data, len), len); +} + +ColumnVector +ColumnVector::quotient (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ColumnVector (0); + + return ColumnVector (divide (data, a.data, len), len); +} + +ComplexColumnVector +ColumnVector::product (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (multiply (data, a.data, len), len); +} + +ComplexColumnVector +ColumnVector::quotient (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (divide (data, a.data, len), len); +} + +ColumnVector& +ColumnVector::operator += (const ColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ColumnVector& +ColumnVector::operator -= (const ColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// unary operations + +ColumnVector +ColumnVector::operator - (void) const +{ + if (len == 0) + return ColumnVector (0); + + return ColumnVector (negate (data, len), len); +} + +ColumnVector +map (d_d_Mapper f, const ColumnVector& a) +{ + ColumnVector b (a); + b.map (f); + return b; +} + +void +ColumnVector::map (d_d_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +double +ColumnVector::min (void) const +{ + if (len == 0) + return 0.0; + + double res = data[0]; + + for (int i = 1; i < len; i++) + if (data[i] < res) + res = data[i]; + + return res; +} + +double +ColumnVector::max (void) const +{ + if (len == 0) + return 0.0; + + double res = data[0]; + + for (int i = 1; i < len; i++) + if (data[i] > res) + res = data[i]; + + return res; +} + +ostream& +operator << (ostream& os, const ColumnVector& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.len; i++) + os << /* setw (field_width) << */ a.data[i] << "\n"; + return os; +} + +/* + * Complex Column Vector class + */ + +ComplexColumnVector::ComplexColumnVector (int n) +{ + if (n < 0) + FAIL; + + len = n; + if (n > 0) + data = new Complex [len]; + else + data = (Complex *) NULL; +} + +ComplexColumnVector::ComplexColumnVector (int n, double val) +{ + if (n < 0) + FAIL; + + len = n; + if (n > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexColumnVector::ComplexColumnVector (int n, Complex val) +{ + if (n < 0) + FAIL; + + len = n; + if (n > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexColumnVector::ComplexColumnVector (const ColumnVector& a) +{ + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexColumnVector::ComplexColumnVector (const ComplexColumnVector& a) +{ + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexColumnVector::ComplexColumnVector (double a) +{ + len = 1; + data = new Complex [1]; + data[0] = a; +} + +ComplexColumnVector::ComplexColumnVector (Complex a) +{ + len = 1; + data = new Complex [1]; + data[0] = Complex (a); +} + +ComplexColumnVector& +ComplexColumnVector::operator = (const ColumnVector& a) +{ + delete [] data; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::operator = (const ComplexColumnVector& a) +{ + if (this != &a) + { + delete [] data; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + } + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::resize (int n) +{ + if (n < 0) + FAIL; + + Complex *new_data = (Complex *) NULL; + if (n > 0) + { + new_data = new Complex [n]; + int min_len = len < n ? len : n; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + len = n; + data = new_data; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::resize (int n, double val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::resize (int n, Complex val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +int +ComplexColumnVector::operator == (const ComplexColumnVector& a) const +{ + if (len != a.len) + return 0; + return equal (data, a.data, len); +} + +int +ComplexColumnVector::operator != (const ComplexColumnVector& a) const +{ + if (len != a.len) + return 0; + return !equal (data, a.data, len); +} + +// destructive insert/delete/reorder operations + +ComplexColumnVector& +ComplexColumnVector::insert (const ColumnVector& a, int r) +{ + if (r < 0 || r + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[r+i] = a.data[i]; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::insert (const ComplexColumnVector& a, int r) +{ + if (r < 0 || r + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[r+i] = a.data[i]; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::fill (double val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::fill (Complex val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::fill (double val, int r1, int r2) +{ + if (r1 < 0 || r2 < 0 || r1 >= len || r2 >= len) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + + for (int i = r1; i <= r2; i++) + data[i] = val; + + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::fill (Complex val, int r1, int r2) +{ + if (r1 < 0 || r2 < 0 || r1 >= len || r2 >= len) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + + for (int i = r1; i <= r2; i++) + data[i] = val; + + return *this; +} + +ComplexColumnVector +ComplexColumnVector::stack (const ColumnVector& a) const +{ + int nr_insert = len; + ComplexColumnVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nr_insert); + return retval; +} + +ComplexColumnVector +ComplexColumnVector::stack (const ComplexColumnVector& a) const +{ + int nr_insert = len; + ComplexColumnVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nr_insert); + return retval; +} + +ComplexRowVector +ComplexColumnVector::hermitian (void) const +{ + return ComplexRowVector (conj_dup (data, len), len); +} + +ComplexRowVector +ComplexColumnVector::transpose (void) const +{ + return ComplexRowVector (dup (data, len), len); +} + +ColumnVector +real (const ComplexColumnVector& a) +{ + ColumnVector retval; + if (a.len > 0) + retval = ColumnVector (real_dup (a.data, a.len), a.len); + return retval; +} + +ColumnVector +imag (const ComplexColumnVector& a) +{ + ColumnVector retval; + if (a.len > 0) + retval = ColumnVector (imag_dup (a.data, a.len), a.len); + return retval; +} + +ComplexColumnVector +conj (const ComplexColumnVector& a) +{ + ComplexColumnVector retval; + if (a.len > 0) + retval = ComplexColumnVector (conj_dup (a.data, a.len), a.len); + return retval; +} + +// resize is the destructive equivalent for this one + +ComplexColumnVector +ComplexColumnVector::extract (int r1, int r2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + + int new_r = r2 - r1 + 1; + + ComplexColumnVector result (new_r); + + for (int i = 0; i < new_r; i++) + result.data[i] = elem (r1+i); + + return result; +} + +// column vector by scalar -> column vector operations + +ComplexColumnVector +ComplexColumnVector::operator + (double s) const +{ + return ComplexColumnVector (add (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator - (double s) const +{ + return ComplexColumnVector (subtract (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator * (double s) const +{ + return ComplexColumnVector (multiply (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator / (double s) const +{ + return ComplexColumnVector (divide (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator + (Complex s) const +{ + return ComplexColumnVector (add (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator - (Complex s) const +{ + return ComplexColumnVector (subtract (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator * (Complex s) const +{ + return ComplexColumnVector (multiply (data, len, s), len); +} + +ComplexColumnVector +ComplexColumnVector::operator / (Complex s) const +{ + return ComplexColumnVector (divide (data, len, s), len); +} + +// scalar by column vector -> column vector operations + +ComplexColumnVector +operator + (double s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (add (a.data, a.len, s), a.len); +} + +ComplexColumnVector +operator - (double s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (subtract (s, a.data, a.len), a.len); +} + +ComplexColumnVector +operator * (double s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (multiply (a.data, a.len, s), a.len); +} + +ComplexColumnVector +operator / (double s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (divide (s, a.data, a.len), a.len); +} + +ComplexColumnVector +operator + (Complex s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (add (a.data, a.len, s), a.len); +} + +ComplexColumnVector +operator - (Complex s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (subtract (s, a.data, a.len), a.len); +} + +ComplexColumnVector +operator * (Complex s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (multiply (a.data, a.len, s), a.len); +} + +ComplexColumnVector +operator / (Complex s, const ComplexColumnVector& a) +{ + return ComplexColumnVector (divide (s, a.data, a.len), a.len); +} + +// column vector by row vector -> matrix operations + +ComplexMatrix +ComplexColumnVector::operator * (const RowVector& a) const +{ + ComplexRowVector tmp (a); + return *this * tmp; +} + +ComplexMatrix +ComplexColumnVector::operator * (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexMatrix (len, len, 0.0); + + char transa = 'N'; + char transb = 'N'; + Complex alpha (1.0); + Complex beta (0.0); + int anr = 1; + int anc = a.len; + + Complex *c = new Complex [len * a.len]; + + F77_FCN (zgemm) (&transa, &transb, &len, &anc, &anr, &alpha, data, + &len, a.data, &anr, &beta, c, &len, 1L, 1L); + + return ComplexMatrix (c, len, a.len); +} + +// column vector by column vector -> column vector operations + +ComplexColumnVector +ComplexColumnVector::operator + (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (add (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::operator - (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (subtract (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::operator + (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (add (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::operator - (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (subtract (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::product (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (multiply (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::quotient (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (divide (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::product (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (multiply (data, a.data, len), len); +} + +ComplexColumnVector +ComplexColumnVector::quotient (const ComplexColumnVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (divide (data, a.data, len), len); +} + +ComplexColumnVector& +ComplexColumnVector::operator += (const ColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::operator -= (const ColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::operator += (const ComplexColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexColumnVector& +ComplexColumnVector::operator -= (const ComplexColumnVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// unary operations + +ComplexColumnVector +ComplexColumnVector::operator - (void) const +{ + if (len == 0) + return ComplexColumnVector (0); + + return ComplexColumnVector (negate (data, len), len); +} + +ComplexColumnVector +map (c_c_Mapper f, const ComplexColumnVector& a) +{ + ComplexColumnVector b (a); + b.map (f); + return b; +} + +ColumnVector +map (d_c_Mapper f, const ComplexColumnVector& a) +{ + ColumnVector b (a.len); + for (int i = 0; i < a.len; i++) + b.elem (i) = f (a.elem (i)); + return b; +} + +void +ComplexColumnVector::map (c_c_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +Complex +ComplexColumnVector::min (void) const +{ + if (len == 0) + return 0.0; + + Complex res = data[0]; + double absres = abs (res); + + for (int i = 1; i < len; i++) + if (abs (data[i]) < absres) + { + res = data[i]; + absres = abs (res); + } + + return res; +} + +Complex +ComplexColumnVector::max (void) const +{ + if (len == 0) + return 0.0; + + Complex res = data[0]; + double absres = abs (res); + + for (int i = 1; i < len; i++) + if (abs (data[i]) > absres) + { + res = data[i]; + absres = abs (res); + } + + return res; +} + +// i/o + +ostream& +operator << (ostream& os, const ComplexColumnVector& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.len; i++) + os << /* setw (field_width) << */ a.data[i] << "\n"; + return os; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/CollocWt.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/CollocWt.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,339 @@ +// CollocWt.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "CollocWt.h" +#include "f77-uscore.h" + +extern "C" +{ + int F77_FCN (jcobi) (int*, int*, int*, int*, double*, double*, + double*, double*, double*, double*); + + int F77_FCN (dfopr) (int*, int*, int*, int*, int*, int*, + double*, double*, double*, double*, double*); +} + +// Error handling. + +void +CollocWt::error (const char* msg) +{ + cerr << "Fatal CollocWt error. " << msg << "\n"; + exit(1); +} + +CollocWt::CollocWt (void) +{ + n = 0; + inc_left = 0; + inc_right = 0; + lb = 0.0; + rb = 1.0; + + Alpha = 0.0; + Beta = 0.0; + + initialized = 0; +} + +CollocWt::CollocWt (int nc, int il, int ir) +{ + n = nc; + inc_left = il; + inc_right = ir; + lb = 0.0; + rb = 1.0; + + Alpha = 0.0; + Beta = 0.0; + + initialized = 0; +} + +CollocWt::CollocWt (int nc, int ir, int il, double l, double r) +{ + n = nc; + inc_left = il; + inc_right = ir; + lb = l; + rb = r; + + Alpha = 0.0; + Beta = 0.0; + + initialized = 0; +} + +CollocWt::CollocWt (int nc, double a, double b, int il, int ir) +{ + n = nc; + inc_left = il; + inc_right = ir; + lb = 0.0; + rb = 1.0; + + Alpha = a; + Beta = b; + + initialized = 0; +} + +CollocWt::CollocWt (int nc, double a, double b, int ir, int il, + double l, double r) +{ + n = nc; + inc_left = il; + inc_right = ir; + lb = l; + rb = r; + + Alpha = a; + Beta = b; + + initialized = 0; +} + +CollocWt::CollocWt (const CollocWt& a) +{ + n = a.n; + inc_left = a.inc_left; + inc_right = a.inc_right; + lb = a.lb; + rb = a.rb; + r = a.r; + q = a.q; + A = a.A; + B = a.B; + + nt = n + inc_left + inc_right; + + initialized = a.initialized; +} + +CollocWt& +CollocWt::operator = (const CollocWt& a) +{ + n = a.n; + inc_left = a.inc_left; + inc_right = a.inc_right; + lb = a.lb; + rb = a.rb; + r = a.r; + q = a.q; + A = a.A; + B = a.B; + + nt = a.nt; + + initialized = a.initialized; + + return *this; +} + +CollocWt& +CollocWt::resize (int ncol) +{ + n = ncol; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::add_left (void) +{ + inc_left = 1; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::delete_left (void) +{ + inc_left = 0; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::set_left (double val) +{ + if (val >= rb) + error ("left bound greater than right bound"); + + lb = val; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::add_right (void) +{ + inc_right = 1; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::delete_right (void) +{ + inc_right = 0; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::set_right (double val) +{ + if (val <= lb) + error ("right bound less than left bound"); + + rb = val; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::set_alpha (double val) +{ + Alpha = val; + initialized = 0; + return *this; +} + +CollocWt& +CollocWt::set_beta (double val) +{ + Beta = val; + initialized = 0; + return *this; +} + +void +CollocWt::init (void) +{ +// Check for possible errors. + + double wid = rb - lb; + if (wid <= 0.0) + error ("width less than or equal to zero"); + + nt = n + inc_left + inc_right; + if (nt < 0) + error ("total number of collocation points less than zero"); + else if (nt == 0) + return; + + double *dif1 = new double [nt]; + double *dif2 = new double [nt]; + double *dif3 = new double [nt]; + double *vect = new double [nt]; + + r.resize (nt); + q.resize (nt); + A.resize (nt, nt); + B.resize (nt, nt); + + double *pr = r.fortran_vec (); + +// Compute roots. + + F77_FCN (jcobi) (&nt, &n, &inc_left, &inc_right, &Alpha, &Beta, + dif1, dif2, dif3, pr); + + int id; + int i, j; + +// First derivative weights. + + id = 1; + for (i = 1; i <= nt; i++) + { + F77_FCN (dfopr) (&nt, &n, &inc_left, &inc_right, &i, &id, dif1, + dif2, dif3, pr, vect); + + for (j = 0; j < nt; j++) + A (i-1, j) = vect[j]; + } + +// Second derivative weights. + + id = 2; + for (i = 1; i <= nt; i++) + { + F77_FCN (dfopr) (&nt, &n, &inc_left, &inc_right, &i, &id, dif1, + dif2, dif3, pr, vect); + + for (j = 0; j < nt; j++) + B (i-1, j) = vect[j]; + } + +// Gaussian quadrature weights. + + id = 3; + double *pq = q.fortran_vec (); + F77_FCN (dfopr) (&nt, &n, &inc_left, &inc_right, &i, &id, dif1, + dif2, dif3, pr, pq); + + delete dif1; + delete dif2; + delete dif3; + delete vect; + + initialized = 1; +} + +ostream& +operator << (ostream& os, const CollocWt& a) +{ + if (a.left_included ()) + os << "left boundary is included\n"; + else + os << "left boundary is not included\n"; + + if (a.right_included ()) + os << "right boundary is included\n"; + else + os << "right boundary is not included\n"; + + os << "\n"; + + os << a.Alpha << " " << a.Beta << "\n\n" + << a.r << "\n\n" + << a.q << "\n\n" + << a.A << "\n" + << a.B << "\n"; + + return os; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/CollocWt.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/CollocWt.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,151 @@ +// CollocWt.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_CollocWt_h) +#define _CollocWt_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class CollocWt +{ +public: + + CollocWt (void); + CollocWt (int ncol, int include_left, int include_right); + CollocWt (int ncol, int include_left, int include_right, double left, + double right); + CollocWt (int ncol, double alpha, double beta, int include_left, + int include_right); + CollocWt (int ncol, double alpha, double beta, int include_left, + int include_right, double left, double right); + + CollocWt (const CollocWt&); + + CollocWt& operator = (const CollocWt&); + + CollocWt& resize (int ncol); + + CollocWt& add_left (void); + CollocWt& delete_left (void); + CollocWt& set_left (double val); + + CollocWt& add_right (void); + CollocWt& delete_right (void); + CollocWt& set_right (double val); + + CollocWt& set_alpha (double val); + CollocWt& set_beta (double val); + + int ncol (void) const; + int left_included (void) const; + int right_included (void) const; + + double left (void) const; + double right (void) const; + double width (void) const; + + double alpha (void) const; + double beta (void) const; + + Vector roots (void); + Vector quad (void); + Vector quad_weights (void); + + Matrix first (void); + Matrix second (void); + + friend ostream& operator << (ostream&, const CollocWt&); + +protected: + + int n; + int nt; + + int inc_left; + int inc_right; + + double lb; + double rb; + + double Alpha; + double Beta; + + Vector r; + Vector q; + + Matrix A; + Matrix B; + + int initialized; + + void init (void); + + void error (const char *msg); +}; + +inline int +CollocWt::ncol (void) const +{ + return n; +} + +inline int CollocWt::left_included (void) const { return inc_left; } +inline int CollocWt::right_included (void) const { return inc_right; } +inline double CollocWt::left (void) const { return lb; } +inline double CollocWt::right (void) const { return rb; } +inline double CollocWt::width (void) const { return rb - lb; } +inline double CollocWt::alpha (void) const { return Alpha; } +inline double CollocWt::beta (void) const { return Beta; } + +inline Vector CollocWt::roots (void) + { if (!initialized) init (); return r; } + +inline Vector CollocWt::quad (void) + { if (!initialized) init (); return q; } + +inline Vector CollocWt::quad_weights (void) + { return quad (); } + +inline Matrix CollocWt::first (void) + { if (!initialized) init (); return A; } + +inline Matrix CollocWt::second (void) + { if (!initialized) init (); return B; } + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/DAE.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/DAE.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,93 @@ +// DAE.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_DAE_h) +#define _DAE_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "ODE.h" +#include "DAEFunc.h" +#include "Matrix.h" +#include "f77-uscore.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class DAE : public ODE, public DAEFunc +{ +public: + + DAE (void); + + DAE (int); + + DAE (Vector& x, double time, DAEFunc& f); + + DAE (Vector& x, Vector& xdot, double time, DAEFunc& f); + + ~DAE (void); + + Vector deriv (void); + + virtual void initialize (Vector& x, double t); + virtual void initialize (Vector& x, Vector& xdot, double t); + + Vector integrate (double t); + + Matrix integrate (const Vector& tout, Matrix& xdot_out); + Matrix integrate (const Vector& tout, Matrix& xdot_out, + const Vector& tcrit); + +protected: + +/* + * Some of this is probably too closely related to DASSL, but hey, + * this is just a first attempt... + */ + + Vector xdot; + +private: + + int restart; + int liw; + int lrw; + int idid; + int *info; + int *iwork; + double *rwork; + + friend int ddassl_j (double *time, double *state, double *deriv, + double *pd, double *cj, double *rpar, int *ipar); + + friend int ddassl_f (double *time, double *state, double *deriv, + double *delta, int *ires, double *rpar, int *ipar); + +}; + +#endif diff -r c0190df9885d -r 9a4c07481e61 liboctave/DAEFunc.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/DAEFunc.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,89 @@ +// DAEFunc.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "DAEFunc.h" + +DAEFunc::DAEFunc (void) +{ + fun = NULL; + jac = NULL; +} + +DAEFunc::DAEFunc (DAERHSFunc f) +{ + fun = f; + jac = NULL; +} + +DAEFunc::DAEFunc (DAERHSFunc f, DAEJacFunc j) +{ + fun = f; + jac = j; +} + +DAEFunc::DAEFunc (const DAEFunc& a) +{ + fun = a.fun; + jac = a.jac; +} + +DAEFunc& +DAEFunc::operator = (const DAEFunc& a) +{ + fun = a.fun; + jac = a.jac; + + return *this; +} + +DAERHSFunc +DAEFunc::function (void) const +{ + return fun; +} + +DAEFunc& +DAEFunc::set_function (DAERHSFunc f) +{ + fun = f; + return *this; +} + +DAEJacFunc +DAEFunc::jacobian_function (void) const +{ + return jac; +} + +DAEFunc& +DAEFunc::set_jacobian_function (DAEJacFunc j) +{ + jac = j; + return *this; +} + diff -r c0190df9885d -r 9a4c07481e61 liboctave/DAEFunc.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/DAEFunc.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,79 @@ +// DAEFunc.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_DAEFunc_h) +#define _DAEFunc_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +#ifndef _DAEFunc_typedefs +#define _DAEFunc_typedefs 1 + +typedef struct DAEJac +{ + Matrix *dfdxdot; + Matrix *dfdx; +}; + +typedef Vector (*DAERHSFunc) (const Vector& x, const Vector& xdot, double); +typedef DAEJac (*DAEJacFunc) (const Vector& x, const Vector& xdot, double); + +#endif + +class DAEFunc +{ +public: + + DAEFunc (void); + DAEFunc (DAERHSFunc f); + DAEFunc (DAERHSFunc f, DAEJacFunc j); + + DAEFunc (const DAEFunc& a); + + DAEFunc& operator = (const DAEFunc& a); + + DAERHSFunc function (void) const; + + DAEFunc& set_function (DAERHSFunc f); + + DAEJacFunc jacobian_function (void) const; + + DAEFunc& set_jacobian_function (DAEJacFunc f); + +protected: + + DAERHSFunc fun; + + DAEJacFunc jac; +}; + +#endif diff -r c0190df9885d -r 9a4c07481e61 liboctave/DASSL.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/DASSL.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,457 @@ +// DAE.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "DAE.h" + +extern "C" +{ + int F77_FCN (ddassl) (int (*)(), const int*, double*, double*, + double*, double*, const int*, const double*, + const double*, int*, double*, const int*, + int*, const int*, const double*, const int*, + int (*)()); +} + +static DAERHSFunc user_fun; +static DAEJacFunc user_jac; +static int nn; + +DAE::DAE (void) +{ + n = 0; + t = 0.0; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + DAEFunc::set_function (NULL); + DAEFunc::set_jacobian_function (NULL); + + liw = 0; + lrw = 0; + + info = new int [15]; + iwork = (int *) NULL; + rwork = (double *) NULL; + + for (int i = 0; i < 15; i++) + info [i] = 0; +} + +DAE::DAE (int size) +{ + n = size; + t = 0.0; + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + DAEFunc::set_function (NULL); + DAEFunc::set_jacobian_function (NULL); + + liw = 20 + n; + lrw = 40 + 9*n + n*n; + + info = new int [15]; + iwork = new int [liw]; + rwork = new double [lrw]; + + for (int i = 0; i < 15; i++) + info [i] = 0; +} + +DAE::DAE (Vector& state, double time, DAEFunc& f) +{ + n = state.capacity (); + t = time; + x = state; + xdot.resize (n, 0.0); + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + DAEFunc::set_function (f.function ()); + DAEFunc::set_jacobian_function (f.jacobian_function ()); + + liw = 20 + n; + lrw = 40 + 9*n + n*n; + + info = new int [15]; + iwork = new int [liw]; + rwork = new double [lrw]; + + for (int i = 0; i < 15; i++) + info [i] = 0; +} + +DAE::DAE (Vector& state, Vector& deriv, double time, DAEFunc& f) +{ + if (deriv.capacity () != state.capacity ()) + { + cerr << "x, xdot size mismatch in DAE constructor"; + exit (1); + } + + n = state.capacity (); + t = time; + xdot = deriv; + x = state; + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + DAEFunc::set_function (f.function ()); + DAEFunc::set_jacobian_function (f.jacobian_function ()); + + liw = 20 + n; + lrw = 40 + 9*n + n*n; + + info = new int [15]; + iwork = new int [liw]; + rwork = new double [lrw]; + + for (int i = 0; i < 15; i++) + info [i] = 0; +} + +DAE::~DAE (void) +{ + delete info; + delete rwork; + delete iwork; +} + +Vector +DAE::deriv (void) +{ + return xdot; +} + +void +DAE::initialize (Vector& state, double time) +{ + restart = 1; + x = state; + int nx = x.capacity (); + xdot.resize (nx, 0.0); + t = time; +} + +void +DAE::initialize (Vector& state, Vector& deriv, double time) +{ + restart = 1; + xdot = deriv; + x = state; + t = time; +} + +int +ddassl_f (double *time, double *state, double *deriv, double *delta, + int *ires, double *rpar, int *ipar) +{ + Vector tmp_deriv (nn); + Vector tmp_state (nn); + Vector tmp_delta (nn); + + for (int i = 0; i < nn; i++) + { + tmp_deriv.elem (i) = deriv [i]; + tmp_state.elem (i) = state [i]; + } + + tmp_delta = user_fun (tmp_state, tmp_deriv, *time); + + for (i = 0; i < nn; i++) + delta [i] = tmp_delta.elem (i); + + return 0; +} + +int +ddassl_j (double *time, double *state, double *deriv, double *pd, + double *cj, double *rpar, int *ipar) +{ + Vector tmp_state (nn); + Vector tmp_deriv (nn); + +// XXX FIXME XXX + + Matrix tmp_dfdxdot (nn, nn); + Matrix tmp_dfdx (nn, nn); + + DAEJac tmp_jac; + tmp_jac.dfdxdot = &tmp_dfdxdot; + tmp_jac.dfdx = &tmp_dfdx; + + tmp_jac = user_jac (tmp_state, tmp_deriv, *time); + + // Fix up the matrix of partial derivatives for dassl. + + tmp_dfdx = tmp_dfdx + (*cj * tmp_dfdxdot); + + for (int j = 0; j < nn; j++) + for (int i = 0; i < nn; i++) + pd [nn * j + i] = tmp_dfdx.elem (i, j); + + return 0; +} + +Vector +DAE::integrate (double tout) +{ + if (DAEFunc::jac == NULL) + iwork [4] = 0; + else + iwork [4] = 1; + + double *px = x.fortran_vec (); + double *pxdot = xdot.fortran_vec (); + + nn = n; + user_fun = DAEFunc::fun; + user_jac = DAEFunc::jac; + + if (stop_time_set) + { + info [3] = 1; + rwork [0] = stop_time; + } + else + info [3] = 0; + + double dummy; + int idummy; + + if (restart) + { + restart = 0; + info[0] = 0; + } + + again: + + F77_FCN (ddassl) (ddassl_f, &n, &t, px, pxdot, &tout, info, + &relative_tolerance, &absolute_tolerance, &idid, + rwork, &lrw, iwork, &liw, &dummy, &idummy, + ddassl_j); + + switch (idid) + { + case 1: // A step was successfully taken in the + // intermediate-output mode. The code has not yet reached + // TOUT. + break; + case 2: // The integration to TSTOP was successfully completed + // (T=TSTOP) by stepping exactly to TSTOP. + break; + case 3: // The integration to TOUT was successfully completed + // (T=TOUT) by stepping past TOUT. Y(*) is obtained by + // interpolation. YPRIME(*) is obtained by interpolation. + break; + case -1: // A large amount of work has been expended. (About 500 steps). + break; + case -2: // The error tolerances are too stringent. + break; + case -3: // The local error test cannot be satisfied because you + // specified a zero component in ATOL and the + // corresponding computed solution component is zero. + // Thus, a pure relative error test is impossible for + // this component. + break; + case -6: // DDASSL had repeated error test failures on the last + // attempted step. + break; + case -7: // The corrector could not converge. + break; + case -8: // The matrix of partial derivatives is singular. + break; + case -9: // The corrector could not converge. There were repeated + // error test failures in this step. + break; + case -10: // The corrector could not converge because IRES was + // equal to minus one. + break; + case -11: // IRES equal to -2 was encountered and control is being + // returned to the calling program. + break; + case -12: // DDASSL failed to compute the initial YPRIME. + break; + case -33: // The code has encountered trouble from which it cannot + // recover. A message is printed explaining the trouble + // and control is returned to the calling program. For + // example, this occurs when invalid input is detected. + break; + default: + // Error? + break; + } + + t = tout; + + return x; +} + +Matrix +DAE::integrate (const Vector& tout, Matrix& xdot_out) +{ + Matrix retval; + int n_out = tout.capacity (); + + if (n_out > 0 && n > 0) + { + retval.resize (n_out, n); + xdot_out.resize (n_out, n); + + for (int i = 0; i < n; i++) + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } + + for (int j = 1; j < n_out; j++) + { + ColumnVector x_next = integrate (tout.elem (j)); + for (i = 0; i < n; i++) + { + retval.elem (j, i) = x_next.elem (i); + xdot_out.elem (j, i) = xdot.elem (i); + } + } + } + + return retval; +} + +Matrix +DAE::integrate (const Vector& tout, Matrix& xdot_out, const Vector& tcrit) +{ + Matrix retval; + int n_out = tout.capacity (); + + if (n_out > 0 && n > 0) + { + retval.resize (n_out, n); + xdot_out.resize (n_out, n); + + for (int i = 0; i < n; i++) + { + retval.elem (0, i) = x.elem (i); + xdot_out.elem (0, i) = xdot.elem (i); + } + + int n_crit = tcrit.capacity (); + + if (n_crit > 0) + { + int i_crit = 0; + int i_out = 1; + double next_crit = tcrit.elem (0); + double next_out; + while (i_out < n_out) + { + int do_restart = 0; + + next_out = tout.elem (i_out); + if (i_crit < n_crit) + next_crit = tcrit.elem (i_crit); + + int save_output; + double t_out; + + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + i_crit++; + do_restart = 1; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = 0; + i_crit++; + do_restart = 1; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = 1; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + } + + ColumnVector x_next = integrate (t_out); + + if (save_output) + { + for (i = 0; i < n; i++) + { + retval.elem (i_out-1, i) = x_next.elem (i); + xdot_out.elem (i_out-1, i) = xdot.elem (i); + } + } + + if (do_restart) + force_restart (); + } + } + else + retval = integrate (tout); + } + + return retval; +} diff -r c0190df9885d -r 9a4c07481e61 liboctave/DiagMatrix.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/DiagMatrix.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,2074 @@ +// DiagMatrix manipulations. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +// I\'m not sure how this is supposed to work if the .h file declares +// several classes, each of which is defined in a separate file... +// +// #ifdef __GNUG__ +// #pragma implementation "Matrix.h" +// #endif + +#include "Matrix.h" +#include "mx-inlines.cc" + +/* + * Diagonal Matrix class. + */ + +DiagMatrix::DiagMatrix (int n) +{ + if (n < 0) + FAIL; + + nr = n; + nc = n; + len = n; + if (len > 0) + data = new double [len]; + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (int n, double val) +{ + if (n < 0) + FAIL; + + nr = n; + nc = n; + len = n; + if (len > 0) + { + data = new double [len]; + copy (data, len, val); + } + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = r < c ? r : c; + if (len > 0) + data = new double [len]; + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = r < c ? r : c; + if (len > 0) + { + data = new double [len]; + copy (data, len, val); + } + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (const RowVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (const ColumnVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (const DiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +DiagMatrix::DiagMatrix (double a) +{ + nr = 1; + nc = 1; + len = 1; + data = new double [1]; + data[0] = a; +} + +DiagMatrix& +DiagMatrix::operator = (const DiagMatrix& a) +{ + if (this != &a) + { + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; + } + return *this; +} + +DiagMatrix& +DiagMatrix::resize (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r < c ? r : c; + double *new_data = (double *) NULL; + if (new_len > 0) + { + new_data = new double [new_len]; + + int min_len = new_len < len ? new_len : len; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +DiagMatrix& +DiagMatrix::resize (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r < c ? r : c; + double *new_data = (double *) NULL; + if (new_len > 0) + { + new_data = new double [new_len]; + + int min_len = new_len < len ? new_len : len; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + + for (i = min_len; i < new_len; i++) + new_data[i] = val; + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +int +DiagMatrix::operator == (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 0; + + return equal (data, a.data, len); +} + +int +DiagMatrix::operator != (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 1; + + return !equal (data, a.data, len); +} + +DiagMatrix& +DiagMatrix::fill (double val) +{ + copy (data, len, val); + return *this; +} + +DiagMatrix& +DiagMatrix::fill (double val, int beg, int end) +{ + if (beg < 0 || end >= len || end < beg) + FAIL; + + if (end > beg) + copy (data+beg, beg-end, val); + return *this; +} + +DiagMatrix& +DiagMatrix::fill (const ColumnVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +DiagMatrix& +DiagMatrix::fill (const RowVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +DiagMatrix& +DiagMatrix::fill (const ColumnVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +DiagMatrix& +DiagMatrix::fill (const RowVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +DiagMatrix +DiagMatrix::transpose (void) const +{ + return DiagMatrix (dup (data, len), nc, nr); +} + +Matrix +DiagMatrix::extract (int r1, int c1, int r2, int c2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_r = r2 - r1 + 1; + int new_c = c2 - c1 + 1; + + Matrix result (new_r, new_c); + + for (int j = 0; j < new_c; j++) + for (int i = 0; i < new_r; i++) + result.data[new_r*j+i] = elem (r1+i, c1+j); + + return result; +} + +// extract row or column i. + +RowVector +DiagMatrix::row (int i) const +{ + if (i < 0 || i >= nr) + FAIL; + + RowVector retval (nc, 0.0); + if (nr < nc || + (nr > nc && i < nc)) + retval.data [i] = data[i]; + + return retval; +} + +RowVector +DiagMatrix::row (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return row (0); + else if (c == 'l' || c == 'L') + return row (nr - 1); + else + FAIL; +} + +ColumnVector +DiagMatrix::column (int i) const +{ + if (i < 0 || i >= nc) + FAIL; + + ColumnVector retval (nr, 0.0); + if (nr > nc || + (nr < nc && i < nr)) + retval.data [i] = data[i]; + + return retval; +} + +ColumnVector +DiagMatrix::column (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return column (0); + else if (c == 'l' || c == 'L') + return column (nc - 1); + else + FAIL; +} + +DiagMatrix +DiagMatrix::inverse (int &info) const +{ + if (nr != nc) + FAIL; + + info = 0; + double *tmp_data = dup (data, len); + for (int i = 0; i < len; i++) + { + if (data[i] == 0.0) + { + info = -1; + copy (tmp_data, data, len); // Restore contents. + break; + } + else + { + tmp_data[i] = 1.0 / data[i]; + } + } + + return DiagMatrix (tmp_data, nr, nc); +} + +DiagMatrix +DiagMatrix::inverse (void) const +{ + int info; + return inverse (info); +} + +// diagonal matrix by scalar -> matrix operations + +Matrix +DiagMatrix::operator + (double s) const +{ + Matrix tmp (nr, nc, s); + return *this + tmp; +} + +Matrix +DiagMatrix::operator - (double s) const +{ + Matrix tmp (nr, nc, -s); + return *this + tmp; +} + +ComplexMatrix +DiagMatrix::operator + (Complex s) const +{ + ComplexMatrix tmp (nr, nc, s); + return *this + tmp; +} + +ComplexMatrix +DiagMatrix::operator - (Complex s) const +{ + ComplexMatrix tmp (nr, nc, -s); + return *this + tmp; +} + +// diagonal matrix by scalar -> diagonal matrix operations + +DiagMatrix +DiagMatrix::operator * (double s) const +{ + return DiagMatrix (multiply (data, len, s), nr, nc); +} + +DiagMatrix +DiagMatrix::operator / (double s) const +{ + return DiagMatrix (divide (data, len, s), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::operator * (Complex s) const +{ + return ComplexDiagMatrix (multiply (data, len, s), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::operator / (Complex s) const +{ + return ComplexDiagMatrix (divide (data, len, s), nr, nc); +} + +// scalar by diagonal matrix -> matrix operations + +Matrix +operator + (double s, const DiagMatrix& a) +{ + return a + s; +} + +Matrix +operator - (double s, const DiagMatrix& a) +{ + return -a + s; +} + +// scalar by diagonal matrix -> diagonal matrix operations + +DiagMatrix +operator * (double s, const DiagMatrix& a) +{ + return DiagMatrix (multiply (a.data, a.len, s), a.nr, a.nc); +} + +DiagMatrix +operator / (double s, const DiagMatrix& a) +{ + return DiagMatrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +// diagonal matrix by column vector -> column vector operations + +ColumnVector +DiagMatrix::operator * (const ColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nc == 0 || nr == 0) + return ColumnVector (0); + + ColumnVector result (nr); + + for (int i = 0; i < a.len; i++) + result.data[i] = a.data[i] * data[i]; + + for (i = a.len; i < nr; i++) + result.data[i] = 0.0; + + return result; +} + +ComplexColumnVector +DiagMatrix::operator * (const ComplexColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexColumnVector (0); + + ComplexColumnVector result (nr); + + for (int i = 0; i < a.len; i++) + result.data[i] = a.data[i] * data[i]; + + for (i = a.len; i < nr; i++) + result.data[i] = 0.0; + + return result; +} + +// diagonal matrix by diagonal matrix -> diagonal matrix operations + +DiagMatrix +DiagMatrix::operator + (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return DiagMatrix (nr, nc); + + return DiagMatrix (add (data, a.data, len), nr , nc); +} + +DiagMatrix +DiagMatrix::operator - (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return DiagMatrix (nr, nc); + + return DiagMatrix (subtract (data, a.data, len), nr, nc); +} + +DiagMatrix +DiagMatrix::operator * (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return DiagMatrix (nr, nc); + + return DiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::operator + (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (add (data, a.data, len), nr , nc); +} + +ComplexDiagMatrix +DiagMatrix::operator - (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::operator * (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +DiagMatrix +DiagMatrix::product (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return DiagMatrix (nr, nc); + + return DiagMatrix (multiply (data, a.data, len), nr, nc); +} + +DiagMatrix +DiagMatrix::quotient (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return DiagMatrix (nr, nc); + + return DiagMatrix (divide (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::product (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +DiagMatrix::quotient (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (divide (data, a.data, len), nr, nc); +} + +DiagMatrix& +DiagMatrix::operator += (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nc == 0 || nr == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +DiagMatrix& +DiagMatrix::operator -= (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + + subtract2 (data, a.data, len); + return *this; +} + +// diagonal matrix by matrix -> matrix operations + +Matrix +DiagMatrix::operator + (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + Matrix result (a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +Matrix +DiagMatrix::operator - (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + Matrix result (-a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +Matrix +DiagMatrix::operator * (const Matrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return Matrix (nr, a.nc, 0.0); + + Matrix c (nr, a.nc); + + for (int i = 0; i < len; i++) + { + if (data[i] == 1.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = a.elem (i, j); + } + else if (data[i] == 0.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = 0.0; + } + else + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = data[i] * a.elem (i, j); + } + } + + if (nr > nc) + { + for (int j = 0; j < a.nc; j++) + for (int i = a.nr; i < nr; i++) + c.elem (i, j) = 0.0; + } + + return c; +} + +ComplexMatrix +DiagMatrix::operator + (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +DiagMatrix::operator - (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (-a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +DiagMatrix::operator * (const ComplexMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, nc, 0.0); + + ComplexMatrix c (nr, a.nc); + + for (int i = 0; i < len; i++) + { + if (data[i] == 1.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = a.elem (i, j); + } + else if (data[i] == 0.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = 0.0; + } + else + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = data[i] * a.elem (i, j); + } + } + + if (nr > nc) + { + for (int j = 0; j < a.nc; j++) + for (int i = a.nr; i < nr; i++) + c.elem (i, j) = 0.0; + } + + return c; +} + +// unary operations + +DiagMatrix +DiagMatrix::operator - (void) const +{ + return DiagMatrix (negate (data, len), nr, nc); +} + +ColumnVector +DiagMatrix::diag (void) const +{ + return diag (0); +} + +// Could be optimized... + +ColumnVector +DiagMatrix::diag (int k) const +{ + int nnr = nr; + int nnc = nc; + if (k > 0) + nnc -= k; + else if (k < 0) + nnr += k; + + ColumnVector d; + + if (nnr > 0 && nnc > 0) + { + int ndiag = (nnr < nnc) ? nnr : nnc; + + d.resize (ndiag); + + if (k > 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i+k); + } + else if ( k < 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i-k, i); + } + else + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i); + } + } + else + cerr << "diag: requested diagonal out of range\n"; + + return d; +} + +ostream& +operator << (ostream& os, const DiagMatrix& a) +{ + double ZERO = 0.0; +// int field_width = os.precision () + 7; + for (int i = 0; i < a.nr; i++) + { + for (int j = 0; j < a.nc; j++) + { + if (i == j) + os << /* setw (field_width) << */ a.data[i]; + else + os << /* setw (field_width) << */ ZERO; + } + os << "\n"; + } + return os; +} + +/* + * Complex Diagonal Matrix class + */ + +ComplexDiagMatrix::ComplexDiagMatrix (int n) +{ + if (n < 0) + FAIL; + + nr = n; + nc = n; + len = n; + if (len > 0) + data = new Complex [len]; + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (int n, double val) +{ + if (n < 0) + FAIL; + + nr = n; + nc = n; + len = n; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (int n, Complex val) +{ + if (n < 0) + FAIL; + + nr = n; + nc = n; + len = n; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = r < c ? r : c; + if (len > 0) + data = new Complex [len]; + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = r < c ? r : c; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (int r, int c, Complex val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = r < c ? r : c; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const RowVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const ComplexRowVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const ColumnVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const ComplexColumnVector& a) +{ + nr = a.len; + nc = nr; + len = nr; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const DiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (const ComplexDiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexDiagMatrix::ComplexDiagMatrix (double a) +{ + nr = 1; + nc = 1; + len = 1; + data = new Complex [1]; + data[0] = a; +} + +ComplexDiagMatrix::ComplexDiagMatrix (Complex a) +{ + nr = 1; + nc = 1; + len = 1; + data = new Complex [1]; + data[0] = Complex (a); +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator = (const DiagMatrix& a) +{ + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator = (const ComplexDiagMatrix& a) +{ + if (this != &a) + { + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + } + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::resize (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r < c ? r : c; + Complex *new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + + int min_len = new_len < len ? new_len : len; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::resize (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r < c ? r : c; + Complex *new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + + int min_len = new_len < len ? new_len : len; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + + for (i = min_len; i < new_len; i++) + new_data[i] = val; + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::resize (int r, int c, Complex val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r < c ? r : c; + Complex *new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + + int min_len = new_len < len ? new_len : len; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + + for (i = min_len; i < new_len; i++) + new_data[i] = val; + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +int +ComplexDiagMatrix::operator == (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 0; + + return equal (data, a.data, len); +} + +int +ComplexDiagMatrix::operator != (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 1; + + return !equal (data, a.data, len); +} + +ComplexDiagMatrix +ComplexDiagMatrix::hermitian (void) const +{ + return ComplexDiagMatrix (conj_dup (data, len), nc, nr); +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (double val) +{ + copy (data, len, val); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (Complex val) +{ + copy (data, len, val); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (double val, int beg, int end) +{ + if (beg < 0 || end >= len || end < beg) + FAIL; + + if (end > beg) + copy (data+beg, beg-end, val); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (Complex val, int beg, int end) +{ + if (beg < 0 || end >= len || end < beg) + FAIL; + + if (end > beg) + copy (data+beg, beg-end, val); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ColumnVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ComplexColumnVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const RowVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ComplexRowVector& a) +{ + if (a.len != len) + FAIL; + + copy (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ColumnVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ComplexColumnVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const RowVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::fill (const ComplexRowVector& a, int beg) +{ + if (beg < 0 || beg + a.len >= len) + FAIL; + + copy (data+beg, a.data, a.len); + return *this; +} + +ComplexDiagMatrix +ComplexDiagMatrix::transpose (void) const +{ + return ComplexDiagMatrix (dup (data, len), nc, nr); +} + +DiagMatrix +real (const ComplexDiagMatrix& a) +{ + DiagMatrix retval; + if (a.len > 0) + retval = DiagMatrix (real_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +DiagMatrix +imag (const ComplexDiagMatrix& a) +{ + DiagMatrix retval; + if (a.len > 0) + retval = DiagMatrix (imag_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +ComplexDiagMatrix +conj (const ComplexDiagMatrix& a) +{ + ComplexDiagMatrix retval; + if (a.len > 0) + retval = ComplexDiagMatrix (conj_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +// resize is the destructive analog for this one + +ComplexMatrix +ComplexDiagMatrix::extract (int r1, int c1, int r2, int c2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_r = r2 - r1 + 1; + int new_c = c2 - c1 + 1; + + ComplexMatrix result (new_r, new_c); + + for (int j = 0; j < new_c; j++) + for (int i = 0; i < new_r; i++) + result.data[new_r*j+i] = elem (r1+i, c1+j); + + return result; +} + +// extract row or column i. + +ComplexRowVector +ComplexDiagMatrix::row (int i) const +{ + if (i < 0 || i >= nr) + FAIL; + + ComplexRowVector retval (nc, 0.0); + if (nr < nc || + (nr > nc && i < nc)) + retval.data [i] = data[i]; + + return retval; +} + +ComplexRowVector +ComplexDiagMatrix::row (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return row (0); + else if (c == 'l' || c == 'L') + return row (nr - 1); + else + FAIL; +} + +ComplexColumnVector +ComplexDiagMatrix::column (int i) const +{ + if (i < 0 || i >= nc) + FAIL; + + ComplexColumnVector retval (nr, 0.0); + if (nr > nc || + (nr < nc && i < nr)) + retval.data [i] = data[i]; + + return retval; +} + +ComplexColumnVector +ComplexDiagMatrix::column (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return column (0); + else if (c == 'l' || c == 'L') + return column (nc - 1); + else + FAIL; +} + +ComplexDiagMatrix +ComplexDiagMatrix::inverse (int& info) const +{ + if (nr != nc) + FAIL; + + info = 0; + for (int i = 0; i < len; i++) + { + if (data[i] == 0.0) + { + info = -1; + return *this; + } + else + data[i] = 1.0 / data[i]; + } + + return *this; +} + +ComplexDiagMatrix +ComplexDiagMatrix::inverse (void) const +{ + int info; + return inverse (info); +} + +// diagonal matrix by scalar -> matrix operations + +ComplexMatrix +ComplexDiagMatrix::operator + (double s) const +{ + ComplexMatrix tmp (nr, nc, s); + return *this + tmp; +} + +ComplexMatrix +ComplexDiagMatrix::operator - (double s) const +{ + ComplexMatrix tmp (nr, nc, -s); + return *this + tmp; +} + +ComplexMatrix +ComplexDiagMatrix::operator + (Complex s) const +{ + ComplexMatrix tmp (nr, nc, s); + return *this + tmp; +} + +ComplexMatrix +ComplexDiagMatrix::operator - (Complex s) const +{ + ComplexMatrix tmp (nr, nc, -s); + return *this + tmp; +} + +// diagonal matrix by scalar -> diagonal matrix operations + +ComplexDiagMatrix +ComplexDiagMatrix::operator * (double s) const +{ + return ComplexDiagMatrix (multiply (data, len, s), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator / (double s) const +{ + return ComplexDiagMatrix (divide (data, len, s), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator * (Complex s) const +{ + return ComplexDiagMatrix (multiply (data, len, s), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator / (Complex s) const +{ + return ComplexDiagMatrix (divide (data, len, s), nr, nc); +} + +// scalar by diagonal matrix -> matrix operations + +ComplexMatrix +operator + (double s, const ComplexDiagMatrix& a) +{ + return a + s; +} + +ComplexMatrix +operator - (double s, const ComplexDiagMatrix& a) +{ + return -a + s; +} + +ComplexMatrix +operator + (Complex s, const ComplexDiagMatrix& a) +{ + return a + s; +} + +ComplexMatrix +operator - (Complex s, const ComplexDiagMatrix& a) +{ + return -a + s; +} + +// scalar by diagonal matrix -> diagonal matrix operations + +ComplexDiagMatrix +operator * (double s, const ComplexDiagMatrix& a) +{ + return ComplexDiagMatrix (multiply (a.data, a.len, s), a.nr, a.nc); +} + +ComplexDiagMatrix + operator / (double s, const ComplexDiagMatrix& a) +{ + return ComplexDiagMatrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +ComplexDiagMatrix + operator * (Complex s, const ComplexDiagMatrix& a) +{ + return ComplexDiagMatrix (multiply (a.data, a.len, s), a.nr, a.nc); +} + +ComplexDiagMatrix +operator / (Complex s, const ComplexDiagMatrix& a) +{ + return ComplexDiagMatrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +// diagonal matrix by column vector -> column vector operations + +ComplexColumnVector +ComplexDiagMatrix::operator * (const ColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexColumnVector (0); + + ComplexColumnVector result (nr); + + for (int i = 0; i < a.len; i++) + result.data[i] = a.data[i] * data[i]; + + for (i = a.len; i < nr; i++) + result.data[i] = 0.0; + + return result; +} + +ComplexColumnVector +ComplexDiagMatrix::operator * (const ComplexColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexColumnVector (0); + + ComplexColumnVector result (nr); + + for (int i = 0; i < a.len; i++) + result.data[i] = a.data[i] * data[i]; + + for (i = a.len; i < nr; i++) + result.data[i] = 0.0; + + return result; +} + +// diagonal matrix by diagonal matrix -> diagonal matrix operations + +ComplexDiagMatrix +ComplexDiagMatrix::operator + (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (add (data, a.data, len), nr , nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator - (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator * (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator + (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (add (data, a.data, len), nr , nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator - (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::operator * (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::product (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::quotient (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (divide (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::product (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix +ComplexDiagMatrix::quotient (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexDiagMatrix (nr, nc); + + return ComplexDiagMatrix (divide (data, a.data, len), nr, nc); +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator += (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator -= (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator += (const ComplexDiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexDiagMatrix& +ComplexDiagMatrix::operator -= (const ComplexDiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// diagonal matrix by matrix -> matrix operations + +ComplexMatrix +ComplexDiagMatrix::operator + (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +ComplexDiagMatrix::operator - (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (-a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +ComplexDiagMatrix::operator * (const Matrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, a.nc, 0.0); + + ComplexMatrix c (nr, a.nc); + + for (int i = 0; i < len; i++) + { + if (data[i] == 1.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = a.elem (i, j); + } + else if (data[i] == 0.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = 0.0; + } + else + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = data[i] * a.elem (i, j); + } + } + + if (nr > nc) + { + for (int j = 0; j < a.nc; j++) + for (int i = a.nr; i < nr; i++) + c.elem (i, j) = 0.0; + } + + return c; +} + +ComplexMatrix +ComplexDiagMatrix::operator + (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +ComplexDiagMatrix::operator - (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (-a); + for (int i = 0; i < len; i++) + result.elem (i, i) += data[i]; + + return result; +} + +ComplexMatrix +ComplexDiagMatrix::operator * (const ComplexMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, a.nc, 0.0); + + ComplexMatrix c (nr, a.nc); + + for (int i = 0; i < len; i++) + { + if (data[i] == 1.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = a.elem (i, j); + } + else if (data[i] == 0.0) + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = 0.0; + } + else + { + for (int j = 0; j < a.nc; j++) + c.elem (i, j) = data[i] * a.elem (i, j); + } + } + + if (nr > nc) + { + for (int j = 0; j < a.nc; j++) + for (int i = a.nr; i < nr; i++) + c.elem (i, j) = 0.0; + } + + return c; +} + +// unary operations + +ComplexDiagMatrix +ComplexDiagMatrix::operator - (void) const +{ + return ComplexDiagMatrix (negate (data, len), nr, nc); +} + +ComplexColumnVector +ComplexDiagMatrix::diag (void) const +{ + return diag (0); +} + +// Could be optimized... + +ComplexColumnVector +ComplexDiagMatrix::diag (int k) const +{ + int nnr = nr; + int nnc = nc; + if (k > 0) + nnc -= k; + else if (k < 0) + nnr += k; + + ComplexColumnVector d; + + if (nnr > 0 && nnc > 0) + { + int ndiag = (nnr < nnc) ? nnr : nnc; + + d.resize (ndiag); + + if (k > 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i+k); + } + else if ( k < 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i-k, i); + } + else + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i); + } + } + else + cerr << "diag: requested diagonal out of range\n"; + + return d; +} + +// i/o + +ostream& +operator << (ostream& os, const ComplexDiagMatrix& a) +{ + Complex ZERO (0.0); +// int field_width = os.precision () + 7; + for (int i = 0; i < a.nr; i++) + { + for (int j = 0; j < a.nc; j++) + { + if (i == j) + os << /* setw (field_width) << */ a.data[i]; + else + os << /* setw (field_width) << */ ZERO; + } + os << "\n"; + } + return os; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/FEGrid.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/FEGrid.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,118 @@ +// FEGrid.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "FEGrid.h" + +// error handling + +void +FEGrid::error (const char* msg) const +{ + cerr << "Fatal FEGrid error. " << msg << "\n"; + exit(1); +} + +void +FEGrid::nel_error (void) const +{ + error ("number of elements less than 1"); +} + +// Constructors + +FEGrid::FEGrid (int nel, double width) +{ + if (nel < 1) + nel_error (); + + elem.resize (nel+1); + + for (int i = 0; i <= nel; i++) + elem.elem (i) = i * width; +} + +FEGrid::FEGrid (int nel, double left, double right) +{ + if (nel < 1) + nel_error (); + + elem.resize (nel+1); + + double width = (right - left) / (double) nel; + + for (int i = 0; i <= nel; i++) + elem.elem (i) = i * width + left; + + check_grid (); +} + +int +FEGrid::element (double x) const +{ + if (! in_bounds (x)) + error ("value not within grid boundaries"); + + int nel = elem.capacity () - 1; + for (int i = 1; i <= nel; i++) + { + if (x >= elem.elem (i-1) && x <= elem.elem (i)) + return i; + } + return -1; + +} + +void +FEGrid::check_grid (void) const +{ + int nel = elem.capacity () - 1; + if (nel < 1) + nel_error (); + + for (int i = 1; i <= nel; i++) + { + if (elem.elem (i-1) > elem.elem (i)) + error ("element boundaries not in ascending order"); + + if (elem.elem (i-1) == elem.elem (i)) + error ("zero width element"); + } +} + +ostream& +operator << (ostream& s, const FEGrid& g) +{ + s << g.element_boundaries (); + return s; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/FEGrid.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/FEGrid.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,93 @@ +// FEGrid.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_FEGrid_h) +#define _FEGrid_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class FEGrid +{ +public: + + FEGrid (void); + FEGrid (const Vector& elbnds); + FEGrid (int nel, double width); + FEGrid (int nel, double left, double right); + + int in_bounds (double x) const; + + int element (double x) const; + + double left (void) const; + double right (void) const; + + Vector element_boundaries (void) const; + + friend ostream& operator << (ostream&, const FEGrid&); + +protected: + + Vector elem; + +private: + + void error (const char* msg) const; + void nel_error (void) const; + + void check_grid (void) const; +}; + +inline FEGrid::FEGrid (void) {} + +inline FEGrid::FEGrid (const Vector& elbnds) + { elem = elbnds; check_grid (); } + +inline int FEGrid::in_bounds (double x) const + { return (x >= left () && x <= right ()); } + +inline double FEGrid::left (void) const + { return elem.elem (0); } + +inline double FEGrid::right (void) const + { return elem.elem (elem.capacity () - 1); } + +inline Vector FEGrid::element_boundaries (void) const + { return elem; } + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/FSQP.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/FSQP.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,42 @@ +// FSQP.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifndef FSQP_MISSING + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "FSQP.h" +#include "f77-uscore.h" + +#endif /* FSQP_MISSING */ + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/FSQP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/FSQP.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,54 @@ +// FSQP.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifndef FSQP_MISSING + +#if !defined (_FSQP_h) +#define _FSQP_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "NLP.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class FSQP : public NLP +{ + public: + private: +}; + +#endif + +#endif /* FSQP_MISSING */ + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LP.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LP.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,70 @@ +// LP.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "LP.h" + +LP::LP (void) {} + +LP::LP (const Vector& c_arg) : c (c_arg) { } + +LP::LP (const Vector& c_arg, const Bounds& b) : c (c_arg), bnds (b) { } + +LP::LP (const Vector& c_arg, const LinConst& l) : c (c_arg), lc (l) { } + +LP::LP (const Vector& c_arg, const Bounds& b, const LinConst& l) + : c (c_arg), bnds (b), lc (l) { } + +Vector +LP::minimize (void) +{ + double objf; + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +LP::minimize (double& objf) +{ + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +LP::minimize (double& objf, int& inform) +{ + Vector lambda; + return minimize (objf, inform, lambda); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LP.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,68 @@ +// LP.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_LP_h) +#define _LP_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "Bounds.h" +#include "LinConst.h" +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class LP +{ + public: + + LP (void); + LP (const Vector& c); + LP (const Vector& c, const Bounds& b); + LP (const Vector& c, const Bounds& b, const LinConst& lc); + LP (const Vector& c, const LinConst& lc); + + virtual Vector minimize (void); + virtual Vector minimize (double& objf); + virtual Vector minimize (double& objf, int& inform); + virtual Vector minimize (double& objf, int& inform, Vector& lambda) = 0; + + protected: + + Vector c; + Bounds bnds; + LinConst lc; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LPsolve.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LPsolve.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,49 @@ +// LPsolve.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "LPsolve.h" +#include "f77-uscore.h" + +Vector +LPsolve::minimize (double& objf, int& inform, Vector& lambda) +{ +} + +void +LPsolve::set_default_options (void) +{ +// Maybe this isn't needed? +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LPsolve.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LPsolve.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,70 @@ +// LPsolve.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_LPsolve_h) +#define _LPsolve_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "LP.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class LPsolve : public LP +{ + public: + + LPsolve (void) : LP () + { set_default_options (); } + + LPsolve (const Vector& c) : LP (c) + { set_default_options (); } + + LPsolve (const Vector& c, const Bounds& b) : LP (c, b) + { set_default_options (); } + + LPsolve (const Vector& c, const Bounds& b, const LinConst& lc) + : LP (c, b, lc) { set_default_options (); } + + LPsolve (const Vector& c, const LinConst& lc) : LP (c, lc) + { set_default_options (); } + + virtual Vector minimize (double& objf, int& inform, Vector& lambda); + + private: + + void set_default_options (void); +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LSODE.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LSODE.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,461 @@ +// ODE.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "ODE.h" +#include "f77-uscore.h" + +extern "C" +{ + int F77_FCN (lsode) (int (*)(), int *, double *, double *, double *, + int *, double *, double *, int *, int *, int *, + double *, int *, int *, int *, int (*)(), int *); +} + +static ColumnVector (*user_fun) (ColumnVector&, double); +static Matrix (*user_jac) (ColumnVector&, double); +static ColumnVector *tmp_x; + +ODE::ODE (void) +{ + n = 0; + t = 0.0; + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + istate = 1; + itol = 1; + itask = 1; + iopt = 0; + + liw = 20 + n; + lrw = 22 + n * (9 + n); + + iwork = new int [liw]; + rwork = new double [lrw]; + for (int i = 4; i < 9; i++) + { + iwork[i] = 0; + rwork[i] = 0.0; + } + + fun = NULL; + jac = NULL; +} + +ODE::ODE (int size) +{ + n = size; + t = 0.0; + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + istate = 1; + itol = 1; + itask = 1; + iopt = 0; + + liw = 20 + n; + lrw = 22 + n * (9 + n); + + iwork = new int [liw]; + rwork = new double [lrw]; + for (int i = 4; i < 9; i++) + { + iwork[i] = 0; + rwork[i] = 0.0; + } + + fun = NULL; + jac = NULL; +} + +ODE::ODE (const ColumnVector& state, double time, const ODEFunc& f) +{ + n = state.capacity (); + t = time; + x = state; + + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + + stop_time_set = 0; + stop_time = 0.0; + + restart = 1; + + istate = 1; + itol = 1; + itask = 1; + iopt = 0; + + liw = 20 + n; + lrw = 22 + n * (9 + n); + + iwork = new int [liw]; + rwork = new double [lrw]; + for (int i = 4; i < 9; i++) + { + iwork[i] = 0; + rwork[i] = 0.0; + } + + fun = f.function (); + jac = f.jacobian_function (); +} + +ODE::~ODE (void) +{ + delete [] rwork; + delete [] iwork; +} + +int +lsode_f (int *neq, double *time, double *state, double *deriv) +{ + int nn = *neq; + ColumnVector tmp_deriv (nn); + + /* + * NOTE: this won't work if LSODE passes copies of the state vector. + * In that case we have to create a temporary vector object + * and copy. + */ + tmp_deriv = (*user_fun) (*tmp_x, *time); + + for (int i = 0; i < nn; i++) + deriv [i] = tmp_deriv.elem (i); + + return 0; +} + +int +lsode_j (int *neq, double *time, double *state, int *ml, int *mu, + double *pd, int *nrowpd) +{ + int nn = *neq; + Matrix tmp_jac (nn, nn); + + /* + * NOTE: this won't work if LSODE passes copies of the state vector. + * In that case we have to create a temporary vector object + * and copy. + */ + tmp_jac = (*user_jac) (*tmp_x, *time); + + for (int j = 0; j < nn; j++) + for (int i = 0; i < nn; i++) + pd [*nrowpd * j + i] = tmp_jac (i, j); + + return 0; +} + +ColumnVector +ODE::integrate (double tout) +{ + if (jac == NULL) + method_flag = 22; + else + method_flag = 21; + + double *xp = x.fortran_vec (); + +// NOTE: this won't work if LSODE passes copies of the state vector. +// In that case we have to create a temporary vector object +// and copy. + + tmp_x = &x; + user_fun = fun; + user_jac = jac; + +// Try 5000 steps before giving up. + + iwork[5] = 5000; + int working_too_hard = 0; + + if (stop_time_set) + { + iopt = 1; + itask = 4; + rwork [0] = stop_time; + } + else + { + iopt = 0; + itask = 1; + } + + if (restart) + { + restart = 0; + istate = 1; + } + + again: + + (void) F77_FCN (lsode) (lsode_f, &n, xp, &t, &tout, &itol, + &relative_tolerance, &absolute_tolerance, + &itask, &istate, &iopt, rwork, &lrw, iwork, + &liw, lsode_j, &method_flag); + + switch (istate) + { + case -6: // error weight became zero during problem. (solution + // component i vanished, and atol or atol(i) = 0.) + break; + case -5: // repeated convergence failures (perhaps bad jacobian + // supplied or wrong choice of mf or tolerances). + break; + case -4: // repeated error test failures (check all inputs). + break; + case -3: // illegal input detected (see printed message). + break; + case -2: // excess accuracy requested (tolerances too small). + break; + case -1: // excess work done on this call (perhaps wrong mf). + working_too_hard++; + if (working_too_hard > 20) + { + cerr << "Shut 'er down Slim! She's a suckin' mud!\n"; + exit (1); + } + else + { + istate = 2; + goto again; + } + break; + case 2: // lsode was successful + break; + default: + // Error? + break; + } + + t = tout; + + return x; +} + +void +ODE::integrate (int nsteps, double tstep, ostream& s) +{ + int time_to_quit = 0; + double tout = t; + + s << t << " " << x << "\n"; + + for (int i = 0; i < nsteps; i++) + { + tout += tstep; + if (stop_time_set && tout > stop_time) + { + tout = stop_time; + time_to_quit = 1; + } + + x = integrate (tout); + + s << t << " " << x << "\n"; + + if (time_to_quit) + return; + } +} + +Matrix +ODE::integrate (const ColumnVector& tout) +{ + Matrix retval; + int n_out = tout.capacity (); + + if (n_out > 0 && n > 0) + { + retval.resize (n_out, n); + + for (int i = 0; i < n; i++) + retval.elem (0, i) = x.elem (i); + + for (int j = 1; j < n_out; j++) + { + ColumnVector x_next = integrate (tout.elem (j)); + for (i = 0; i < n; i++) + retval.elem (j, i) = x_next.elem (i); + } + } + + return retval; +} + +Matrix +ODE::integrate (const ColumnVector& tout, const ColumnVector& tcrit) +{ + Matrix retval; + int n_out = tout.capacity (); + + if (n_out > 0 && n > 0) + { + retval.resize (n_out, n); + + for (int i = 0; i < n; i++) + retval.elem (0, i) = x.elem (i); + + int n_crit = tcrit.capacity (); + + if (n_crit > 0) + { + int i_crit = 0; + int i_out = 1; + double next_crit = tcrit.elem (0); + double next_out; + while (i_out < n_out) + { + int do_restart = 0; + + next_out = tout.elem (i_out); + if (i_crit < n_crit) + next_crit = tcrit.elem (i_crit); + + int save_output; + double t_out; + + if (next_crit == next_out) + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + i_crit++; + do_restart = 1; + } + else if (next_crit < next_out) + { + if (i_crit < n_crit) + { + set_stop_time (next_crit); + t_out = next_crit; + save_output = 0; + i_crit++; + do_restart = 1; + } + else + { + clear_stop_time (); + t_out = next_out; + save_output = 1; + i_out++; + } + } + else + { + set_stop_time (next_crit); + t_out = next_out; + save_output = 1; + i_out++; + } + + ColumnVector x_next = integrate (t_out); + + if (save_output) + { + for (i = 0; i < n; i++) + retval.elem (i_out-1, i) = x_next.elem (i); + } + + if (do_restart) + force_restart (); + } + } + else + retval = integrate (tout); + } + + return retval; +} + +int +ODE::size (void) const +{ + return n; +} + +ColumnVector +ODE::state (void) const +{ + return x; +} + +double ODE::time (void) const +{ + return t; +} + +void +ODE::force_restart (void) +{ + restart = 1; +} + +void +ODE::initialize (const ColumnVector& state, double time) +{ + restart = 1; + x = state; + t = time; +} + +void +ODE::set_stop_time (double time) +{ + stop_time_set = 1; + stop_time = time; +} + +void +ODE::clear_stop_time (void) +{ + stop_time_set = 0; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LinConst.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LinConst.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,177 @@ +// LinConst.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "LinConst.h" + +// error handling + +void +LinConst::error (const char* msg) +{ + cerr << "Fatal LinConst error. " << msg << "\n"; + exit(1); +} + +LinConst::LinConst (const Matrix& a_eq, const Vector& b_eq, + const Matrix& a_ineq, const Vector& b_ineq) +{ +// Need some checks here. + + int nc_eq = b_eq.capacity (); + int nc_ineq = b_ineq.capacity (); + nb = nc_eq + nc_ineq; + + lb.resize (nb); + ub.resize (nb); + + lb.insert (b_eq, 0); + lb.insert (-b_ineq, nc_eq); + + ub.insert (b_eq, 0); + ub.fill (DBL_MAX, nc_eq, nb-1); + + int nx = a_eq.columns (); + + A.resize (nb, nx); + + A.insert (a_eq, 0, 0); + A.insert (a_ineq, nc_eq, 0); +} + +LinConst& +LinConst::resize (int nc, int n) +{ + nb = nc; + lb.resize (nb); + A.resize (nb, n); + ub.resize (nb); + + return *this; +} + +Matrix +LinConst::eq_constraint_matrix (void) const +{ + int anr = A.rows (); + int anc = A.columns (); + Matrix retval (anr, anc); + int count = 0; + for (int i = 0; i < anr; i++) + { + if (lb.elem (i) == ub.elem (i)) + { + retval.insert (A.extract (i, 0, i, anc-1), count, 0); + count++; + } + } + retval.resize (count, anc); + return retval; +} + +Matrix +LinConst::ineq_constraint_matrix (void) const +{ + int anr = A.rows (); + int anc = A.columns (); + Matrix retval (2*anr, anc); + int count = 0; + for (int i = 0; i < anr; i++) + { + if (lb.elem (i) != ub.elem (i)) + { + Matrix tmp = A.extract (i, 0, i, anc-1); + retval.insert (tmp, count, 0); + count++; + if (ub.elem (i) < DBL_MAX) + { + retval.insert (-tmp, count, 0); + count++; + } + } + } + retval.resize (count, anc); + return retval; +} + +Vector +LinConst::eq_constraint_vector (void) const +{ + Vector retval (nb); + int count = 0; + for (int i = 0; i < nb; i++) + { + if (lb.elem (i) == ub.elem (i)) + { + retval.elem (count) = lb.elem (i); + count++; + } + } + retval.resize (count); + return retval; +} + +Vector +LinConst::ineq_constraint_vector (void) const +{ + Vector retval (2*nb); + int count = 0; + for (int i = 0; i < nb; i++) + { + if (lb.elem (i) != ub.elem (i)) + { + retval.elem (count) = -lb.elem (i); + count++; + if (ub.elem (i) < DBL_MAX) + { + retval.elem (count) = ub.elem (i); + count++; + } + } + } + retval.resize (count); + return retval; +} + +ostream& +operator << (ostream& os, const LinConst& c) +{ + for (int i = 0; i < c.size (); i++) + os << c.lower_bound (i) << " " << c.upper_bound (i) << "\n"; + + os << "\n"; + os << c.constraint_matrix (); + + return os; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/LinConst.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/LinConst.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,134 @@ +// LinConst.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_LinConst_h) +#define _LinConst_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" +#include "Bounds.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class LinConst : public Bounds +{ +public: + + LinConst (void); + LinConst (int nclin, int nx); + + LinConst (int nclin_eq, int nclin_ineq, int nx); + + LinConst (const Vector& lb, const Matrix& A, const Vector& ub); + + LinConst (const Matrix& A_eq, const Vector& b_eq, + const Matrix& A_ineq, const Vector& b_ineq); + + LinConst (const LinConst& a); + + LinConst& operator = (const LinConst& a); + + LinConst& resize (int nclin, int n); + + Matrix constraint_matrix (void) const; + + LinConst& set_constraint_matrix (const Matrix& A); + + Matrix eq_constraint_matrix (void) const; + Matrix ineq_constraint_matrix (void) const; + + Vector eq_constraint_vector (void) const; + Vector ineq_constraint_vector (void) const; + + friend ostream& operator << (ostream& os, const LinConst& b); + +protected: + + Matrix A; + +private: + + void error (const char *msg); + +}; + +inline LinConst::LinConst (void) : Bounds () {} + +inline LinConst::LinConst (int nc, int n) : Bounds (nc), A (nb, n) {} + +inline LinConst::LinConst (int eq, int ineq, int n) + : Bounds (eq+ineq), A (nb, n) {} + +inline LinConst::LinConst (const Vector& l, const Matrix& amat, + const Vector& u) + : Bounds (l, u), A (amat) +{ + if (nb != amat.rows ()) + error ("inconsistent sizes for constraint matrix and bounds vectors"); +} + +inline LinConst::LinConst (const LinConst& a) + : Bounds (a.lb, a.ub), A (a.constraint_matrix ()) {} + +inline LinConst& +LinConst::operator = (const LinConst& a) +{ + nb = a.nb; + lb = a.lb; + A = a.A; + ub = a.ub; + + return *this; +} + +inline Matrix +LinConst::constraint_matrix (void) const +{ + return A; +} + +inline LinConst& +LinConst::set_constraint_matrix (const Matrix& amat) +{ + if (lb.capacity () != amat.rows ()) + error ("inconsistent size for new linear constraint matrix"); + + A = amat; + + return *this; +} + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Makedeps.in --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Makedeps.in Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,24 @@ +# Makefile dependencies for liboctave.a + +../liboctave.a(Matrix.o): Matrix.h + +../liboctave.a(FEGrid.o): FEGrid.h Matrix.h + +../liboctave.a(NLFunc.o): NLFunc.h Matrix.h + +../liboctave.a(NLEqn.o): NLEqn.h NLFunc.h Matrix.h + +../liboctave.a(NLP.o): Objective.h Bounds.h LinConst.h NLConst.h \ + Matrix.h NLFunc.h + +../liboctave.a(ODE.o): ODE.h ODEFunc.h Matrix.h + +../liboctave.a(ODEFunc.o): ODEFunc.h Matrix.h + +../liboctave.a(Objective.o): Objective.h Matrix.h + +../liboctave.a(Bounds.o): Bounds.h Matrix.h + +../liboctave.a(LinConst.o): LinConst.h Bounds.h Matrix.h + +../liboctave.a(NLConst.o): NLConst.h LinConst.h Bounds.h NLFunc.h Matrix.h diff -r c0190df9885d -r 9a4c07481e61 liboctave/Makefile.in --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Makefile.in Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,108 @@ +# +# Makefile for octave's liboctave directory +# +# John W. Eaton +# jwe@che.utexas.edu +# Department of Chemical Engineering +# The University of Texas at Austin + +TOPDIR = .. + +srcdir = @srcdir@ +VPATH = @srcdir@ + +include $(TOPDIR)/Makeconf + +# Here is a rule for generating dependencies for .cc files: + +%.d: %.cc + rm -f $@ + if test "$(srcdir)" = "." ; then \ + $(CXX) -MM $(CPPFLAGS) $(ALL_CXXFLAGS) $< | \ + sed -e 's/$*\.o/& $@/g' > $@.tmp && \ + mv $@.tmp $@ ; \ + else \ + $(CXX) -MM $(CPPFLAGS) $(ALL_CXXFLAGS) $< | \ + sed -e 's/$*\.o/& $@/g' -e 's,$(srcdir)/,,g' > $@.tmp && \ + mv $@.tmp $@ ; \ + fi + +INCLUDES = Bounds.h CollocWt.h DAE.h DAEFunc.h FEGrid.h FSQP.h \ + LinConst.h LP.h LPsolve.h Matrix.h NLConst.h NLEqn.h \ + NLFunc.h NLP.h NPSOL.h ODE.h ODEFunc.h Objective.h QLD.h \ + QP.h QPSOL.h Quad.h Range.h f77-uscore.h sun-utils.h + +SOURCES = Bounds.cc ColVector.cc CollocWt.cc DAE.cc DAEFunc.cc \ + DiagMatrix.cc FEGrid.cc FSQP.cc LinConst.cc LP.cc LPsolve.cc \ + Matrix-ext.cc Matrix.cc NLConst.cc NLEqn.cc NLFunc.cc NPSOL.cc \ + Objective.cc ODE.cc ODEFunc.cc QLD.cc QP.cc QPSOL.cc Quad.cc \ + Range.cc RowVector.cc sun-utils.cc + +EXTRAS = mx-inlines.cc + +DISTFILES = Makefile.in $(SOURCES) $(INCLUDES) $(EXTRAS) + +MAKEDEPS = $(patsubst %.cc, %.d, $(SOURCES)) + +OBJECTS = $(patsubst %.cc, %.o, $(SOURCES)) + +LIBOCTAVE_DEPEND := $(patsubst %, ../liboctave.a(%), $(OBJECTS)) + +all: ../liboctave.a +.PHONY: all + +../liboctave.a: $(OBJECTS) + $(AR) $(ARFLAGS) ../liboctave.a $(OBJECTS) + $(RANLIB) ../liboctave.a + +check: all +.PHONY: check + +install: all + if test -d $(libdir) ; then true ; else $(TOPDIR)/mkpath $(libdir) ; fi + rm -f $(libdir)/liboctave.a + $(INSTALL_DATA) ../liboctave.a $(libdir)/liboctave.a + $(RANLIB) $(libdir)/liboctave.a + if test -d $(includedir) ; then true ; \ + else $(TOPDIR)/mkpath $(includedir) ; fi + for f in $(INCLUDES) ; do \ + rm -f $(includedir)/$$f ; \ + $(INSTALL_DATA) $(srcdir)/$$f $(includedir)/$$f ; \ + done +.PHONY: install + +uninstall: + rm -f $(libdir)/liboctave.a + for f in $(INCLUDES) ; do rm -f $(includedir)/$$f ; done +.PHONY: uninstall + +tags: $(SOURCES) + ctags $(SOURCES) + +TAGS: $(SOURCES) + etags $(SOURCES) + +clean: + rm -f *.a *.o +.PHONY: clean + +mostlyclean: clean +.PHONY: mostlyclean + +distclean: clean + rm -f Makefile ../liboctave.a $(TMPSRC) $(TMPINC) *.d +.PHONY: distclean + +realclean: distclean + rm -f tags TAGS *.d +.PHONY: realclean + +local-dist: + ln $(DISTFILES) ../`cat ../.fname`/liboctave +.PHONY: local-dist + +dist: + ln $(DISTFILES) ../`cat ../.fname`/liboctave +.PHONY: dist + +include $(MAKEDEPS) diff -r c0190df9885d -r 9a4c07481e61 liboctave/Matrix-ext.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Matrix-ext.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,751 @@ +// Extra Matrix manipulations. -*- C++ -*- +/* + +Copyright (C) 1992 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "Matrix.h" +#include "mx-inlines.cc" + +/* + * HESS stuff + */ + +int +HESS::init (const Matrix& a) +{ + if (a.nr != a.nc) + FAIL; + + char jobbal = 'S'; + char side = 'R'; + + int n = a.nc; + int lwork = 32 * n; + int info; + int ilo; + int ihi; + + double *h = dup(a.data, a.len); + + double *tau = new double [n+1]; + double *scale = new double [n]; + double *z = new double [n*n]; + double *work = new double [lwork]; + + F77_FCN (dgebal) (&jobbal, &n, h, &n, &ilo, &ihi, scale, &info, + 1L, 1L); + + F77_FCN (dgehrd) (&n, &ilo, &ihi, h, &n, tau, work, &lwork, &info, + 1L, 1L); + + copy(z,h,n*n); + + F77_FCN (dorghr) (&n, &ilo, &ihi, z, &n, tau, work, &lwork, &info, + 1L, 1L); + + F77_FCN (dgebak) (&jobbal, &side, &n, &ilo, &ihi, scale, &n, z, &n, + &info, 1L, 1L); + +// We need to clear out all of the area below the sub-diagonal which was used +// to store the unitary matrix. + + hess_mat = Matrix(h,n,n); + unitary_hess_mat = Matrix(z,n,n); + +// If someone thinks of a more graceful way of doing this (or faster for +// that matter :-)), please let me know! + + if (n > 2) + for (int j = 0; j < a.nc; j++) + for (int i = j+2; i < a.nr; i++) + hess_mat.elem(i,j) = 0; + + delete [] tau; + delete [] work; + delete [] scale; + + return info; +} + + +int +ComplexHESS::init (const ComplexMatrix& a) +{ + if (a.nr != a.nc) + FAIL; + + char job = 'S'; + char side = 'R'; + + int n = a.nc; + int lwork = 32 * n; + int info; + int ilo; + int ihi; + + Complex *h = dup(a.data,a.len); + + double *scale = new double [n]; + Complex *tau = new Complex [n-1]; + Complex *work = new Complex [lwork]; + Complex *z = new Complex [n*n]; + + F77_FCN (zgebal) (&job, &n, h, &n, &ilo, &ihi, scale, &info, 1L, 1L); + + F77_FCN (zgehrd) (&n, &ilo, &ihi, h, &n, tau, work, &lwork, &info, 1L, + 1L); + + copy(z,h,n*n); + + F77_FCN (zunghr) (&n, &ilo, &ihi, z, &n, tau, work, &lwork, &info, 1L, + 1L); + + F77_FCN (zgebak) (&job, &side, &n, &ilo, &ihi, scale, &n, z, &n, &info, + 1L, 1L); + + hess_mat = ComplexMatrix (h,n,n); + unitary_hess_mat = ComplexMatrix (z,n,n); + +// If someone thinks of a more graceful way of doing this (or faster for +// that matter :-)), please let me know! + + if (n > 2) + for (int j = 0; j < a.nc; j++) + for (int i = j+2; i < a.nr; i++) + hess_mat.elem(i,j) = 0; + + delete [] work; + delete [] tau; + delete [] scale; + + return info; +} + +/* + * SCHUR stuff + */ + +static int +select_ana (double *a, double *b) +{ + return (*a < 0.0); +} + +static int +select_dig (double *a, double *b) +{ + return (hypot (*a, *b) < 1.0); +} + +// GAG. +extern "C" { static int (*dummy_select)(); } + +int +SCHUR::init (const Matrix& a, const char *ord) +{ + if (a.nr != a.nc) + FAIL; + + char jobvs = 'V'; + char sort; + + if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') + sort = 'S'; + else + sort = 'N'; + + char sense = 'N'; + + int n = a.nc; + int lwork = 8 * n; + int liwork = 1; + int info; + int sdim; + double rconde; + double rcondv; + + double *s = dup(a.data,a.len); + + double *wr = new double [n]; + double *wi = new double [n]; + double *q = new double [n*n]; + double *work = new double [lwork]; + +// These are not referenced for the non-ordered Schur routine. + + int *iwork = (int *) NULL; + int *bwork = (int *) NULL; + if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') + { + iwork = new int [liwork]; + bwork = new int [n]; + } + + if (*ord == 'A' || *ord == 'a') + { + F77_FCN (dgeesx) (&jobvs, &sort, select_ana, &sense, &n, s, &n, + &sdim, wr, wi, q, &n, &rconde, &rcondv, work, + &lwork, iwork, &liwork, bwork, &info, 1L, 1L); + } + else if (*ord == 'D' || *ord == 'd') + { + F77_FCN (dgeesx) (&jobvs, &sort, select_dig, &sense, &n, s, &n, + &sdim, wr, wi, q, &n, &rconde, &rcondv, work, + &lwork, iwork, &liwork, bwork, &info, 1L, 1L); + + } + else + { + F77_FCN (dgeesx) (&jobvs, &sort, dummy_select, &sense, &n, s, + &n, &sdim, wr, wi, q, &n, &rconde, &rcondv, + work, &lwork, iwork, &liwork, bwork, &info, + 1L, 1L); + } + + + schur_mat = Matrix (s, n, n); + unitary_mat = Matrix (q, n, n); + + delete [] wr; + delete [] wi; + delete [] work; + delete [] iwork; + delete [] bwork; + + return info; +} + +static int +complex_select_ana (Complex *a) +{ + return (real (*a) < 0.0); +} + +static int +complex_select_dig (Complex *a) +{ + return (abs (*a) < 1.0); +} + +int +ComplexSCHUR::init (const ComplexMatrix& a, const char *ord) +{ + if (a.nr != a.nc) + FAIL; + + char jobvs = 'V'; + char sort; + if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') + sort = 'S'; + else + sort = 'N'; + + char sense = 'N'; + + int n = a.nc; + int lwork = 8 * n; + int info; + int sdim; + double rconde; + double rcondv; + + double *rwork = new double [n]; + +// bwork is not referenced for non-ordered Schur. + + int *bwork = (int *) NULL; + if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') + bwork = new int [n]; + + Complex *s = dup(a.data,a.len); + + Complex *work = new Complex [lwork]; + Complex *q = new Complex [n*n]; + Complex *w = new Complex [n]; + + if (*ord == 'A' || *ord == 'a') + { + F77_FCN (zgeesx) (&jobvs, &sort, complex_select_ana, &sense, + &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, + work, &lwork, rwork, bwork, &info, 1L, 1L); + } + else if (*ord == 'D' || *ord == 'd') + { + F77_FCN (zgeesx) (&jobvs, &sort, complex_select_dig, &sense, + &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, + work, &lwork, rwork, bwork, &info, 1L, 1L); + } + else + { + F77_FCN (zgeesx) (&jobvs, &sort, dummy_select, &sense, &n, s, + &n, &sdim, w, q, &n, &rconde, &rcondv, work, + &lwork, rwork, bwork, &info, 1L, 1L); + } + + schur_mat = ComplexMatrix (s,n,n); + unitary_mat = ComplexMatrix (q,n,n); + + delete [] w; + delete [] work; + delete [] rwork; + delete [] bwork; + + return info; +} + +ostream& +operator << (ostream& os, const SCHUR& a) +{ + os << a.schur_matrix () << "\n"; + os << a.unitary_matrix () << "\n"; + + return os; +} + +/* + * SVD stuff + */ + +int +SVD::init (const Matrix& a) +{ + int info; + + int m = a.nr; + int n = a.nc; + + char jobu = 'A'; + char jobv = 'A'; + + double *tmp_data = dup (a.data, a.len); + + int min_mn = m < n ? m : n; + int max_mn = m > n ? m : n; + + double *u = new double[m*m]; + double *s_vec = new double[min_mn]; + double *vt = new double[n*n]; + + int tmp1 = 3*min_mn + max_mn; + int tmp2 = 5*min_mn - 4; + int lwork = tmp1 > tmp2 ? tmp1 : tmp2; + double *work = new double[lwork]; + + F77_FCN (dgesvd) (&jobu, &jobv, &m, &n, tmp_data, &m, s_vec, u, &m, + vt, &n, work, &lwork, &info, 1L, 1L); + + left_sm = Matrix (u, m, m); + sigma = DiagMatrix (s_vec, m, n); + Matrix vt_m (vt, n, n); + right_sm = Matrix (vt_m.transpose ()); + + delete [] tmp_data; + delete [] work; + + return info; +} + +ostream& +operator << (ostream& os, const SVD& a) +{ + os << a.left_singular_matrix () << "\n"; + os << a.singular_values () << "\n"; + os << a.right_singular_matrix () << "\n"; + + return os; +} + +int +ComplexSVD::init (const ComplexMatrix& a) +{ + int info; + + int m = a.nr; + int n = a.nc; + + char jobu = 'A'; + char jobv = 'A'; + + Complex *tmp_data = dup (a.data, a.len); + + int min_mn = m < n ? m : n; + int max_mn = m > n ? m : n; + + Complex *u = new Complex[m*m]; + double *s_vec = new double[min_mn]; + Complex *vt = new Complex[n*n]; + + int lwork = 2*min_mn + max_mn; + Complex *work = new Complex[lwork]; + + int lrwork = 5*max_mn; + double *rwork = new double[lrwork]; + + F77_FCN (zgesvd) (&jobu, &jobv, &m, &n, tmp_data, &m, s_vec, u, &m, + vt, &n, work, &lwork, rwork, &info, 1L, 1L); + + left_sm = ComplexMatrix (u, m, m); + sigma = DiagMatrix (s_vec, m, n); + ComplexMatrix vt_m (vt, n, n); + right_sm = ComplexMatrix (vt_m.hermitian ()); + + delete [] tmp_data; + delete [] work; + + return info; +} + +/* + * EIG stuff. + */ + +int +EIG::init (const Matrix& a) +{ + if (a.nr != a.nc) + FAIL; + + int n = a.nr; + + int info; + + char jobvl = 'N'; + char jobvr = 'V'; + + double *tmp_data = dup (a.data, a.len); + double *wr = new double[n]; + double *wi = new double[n]; + Matrix vr (n, n); + double *pvr = vr.fortran_vec (); + int lwork = 8*n; + double *work = new double[lwork]; + + double dummy; + int idummy = 1; + + F77_FCN (dgeev) (&jobvl, &jobvr, &n, tmp_data, &n, wr, wi, &dummy, + &idummy, pvr, &n, work, &lwork, &info, 1L, 1L); + + lambda.resize (n); + v.resize (n, n); + + for (int j = 0; j < n; j++) + { + if (wi[j] == 0.0) + { + lambda.elem (j) = Complex (wr[j]); + for (int i = 0; i < n; i++) + v.elem (i, j) = vr.elem (i, j); + } + else + { + if (j+1 >= n) + FAIL; + + for (int i = 0; i < n; i++) + { + lambda.elem (j) = Complex (wr[j], wi[j]); + lambda.elem (j+1) = Complex (wr[j+1], wi[j+1]); + double real_part = vr.elem (i, j); + double imag_part = vr.elem (i, j+1); + v.elem (i, j) = Complex (real_part, imag_part); + v.elem (i, j+1) = Complex (real_part, -imag_part); + } + j++; + } + } + + delete [] tmp_data; + delete [] wr; + delete [] wi; + delete [] work; + + return info; +} + +int +EIG::init (const ComplexMatrix& a) +{ + + if (a.nr != a.nc) + FAIL; + + int n = a.nr; + + int info; + + char jobvl = 'N'; + char jobvr = 'V'; + + lambda.resize (n); + v.resize (n, n); + + Complex *pw = lambda.fortran_vec (); + Complex *pvr = v.fortran_vec (); + + Complex *tmp_data = dup (a.data, a.len); + + int lwork = 8*n; + Complex *work = new Complex[lwork]; + double *rwork = new double[4*n]; + + Complex dummy; + int idummy = 1; + + F77_FCN (zgeev) (&jobvl, &jobvr, &n, tmp_data, &n, pw, &dummy, + &idummy, pvr, &n, work, &lwork, rwork, &info, 1L, + 1L); + + delete [] tmp_data; + delete [] work; + delete [] rwork; + + return info; +} + +/* + * LU stuff. + */ + +LU::LU (const Matrix& a) +{ + if (a.nr == 0 || a.nc == 0 || a.nr != a.nc) + FAIL; + + int n = a.nr; + + int *ipvt = new int [n]; + int *pvt = new int [n]; + double *tmp_data = dup (a.data, a.len); + int info = 0; + int zero = 0; + double b; + + F77_FCN (dgesv) (&n, &zero, tmp_data, &n, ipvt, &b, &n, &info); + + Matrix A_fact (tmp_data, n, n); + + int i; + + for (i = 0; i < n; i++) + { + ipvt[i] -= 1; + pvt[i] = i; + } + + for (i = 0; i < n - 1; i++) + { + int k = ipvt[i]; + if (k != i) + { + int tmp = pvt[k]; + pvt[k] = pvt[i]; + pvt[i] = tmp; + } + } + + l.resize (n, n, 0.0); + u.resize (n, n, 0.0); + p.resize (n, n, 0.0); + + for (i = 0; i < n; i++) + { + p.elem (i, pvt[i]) = 1.0; + + int j; + + l.elem (i, i) = 1.0; + for (j = 0; j < i; j++) + l.elem (i, j) = A_fact.elem (i, j); + + for (j = i; j < n; j++) + u.elem (i, j) = A_fact.elem (i, j); + } + + delete [] ipvt; + delete [] pvt; +} + +ComplexLU::ComplexLU (const ComplexMatrix& a) +{ + if (a.nr == 0 || a.nc == 0 || a.nr != a.nc) + FAIL; + + int n = a.nr; + + int *ipvt = new int [n]; + int *pvt = new int [n]; + Complex *tmp_data = dup (a.data, a.len); + int info = 0; + int zero = 0; + Complex b; + + F77_FCN (zgesv) (&n, &zero, tmp_data, &n, ipvt, &b, &n, &info); + + ComplexMatrix A_fact (tmp_data, n, n); + + int i; + + for (i = 0; i < n; i++) + { + ipvt[i] -= 1; + pvt[i] = i; + } + + for (i = 0; i < n - 1; i++) + { + int k = ipvt[i]; + if (k != i) + { + int tmp = pvt[k]; + pvt[k] = pvt[i]; + pvt[i] = tmp; + } + } + + l.resize (n, n, 0.0); + u.resize (n, n, 0.0); + p.resize (n, n, 0.0); + + for (i = 0; i < n; i++) + { + p.elem (i, pvt[i]) = 1.0; + + int j; + + l.elem (i, i) = 1.0; + for (j = 0; j < i; j++) + l.elem (i, j) = A_fact.elem (i, j); + + for (j = i; j < n; j++) + u.elem (i, j) = A_fact.elem (i, j); + } + + delete [] ipvt; + delete [] pvt; +} + +/* + * QR stuff. + */ + +QR::QR (const Matrix& a) +{ + int m = a.nr; + int n = a.nc; + + if (m == 0 || n == 0) + FAIL; + + double *tmp_data; + int min_mn = m < n ? m : n; + double *tau = new double[min_mn]; + int lwork = 32*n; + double *work = new double[lwork]; + int info = 0; + + if (m > n) + { + tmp_data = new double [m*m]; + copy (tmp_data, a.data, a.len); + } + else + tmp_data = dup (a.data, a.len); + + F77_FCN (dgeqrf) (&m, &n, tmp_data, &m, tau, work, &lwork, &info); + + delete [] work; + + r.resize (m, n, 0.0); + for (int j = 0; j < n; j++) + { + int limit = j < min_mn-1 ? j : min_mn-1; + for (int i = 0; i <= limit; i++) + r.elem (i, j) = tmp_data[m*j+i]; + } + + lwork = 32*m; + work = new double[lwork]; + + F77_FCN (dorgqr) (&m, &m, &min_mn, tmp_data, &m, tau, work, &lwork, &info); + + q = Matrix (tmp_data, m, m); + + delete [] tau; + delete [] work; +} + +ComplexQR::ComplexQR (const ComplexMatrix& a) +{ + int m = a.nr; + int n = a.nc; + + if (m == 0 || n == 0) + FAIL; + + Complex *tmp_data; + int min_mn = m < n ? m : n; + Complex *tau = new Complex[min_mn]; + int lwork = 32*n; + Complex *work = new Complex[lwork]; + int info = 0; + + if (m > n) + { + tmp_data = new Complex [m*m]; + copy (tmp_data, a.data, a.len); + } + else + tmp_data = dup (a.data, a.len); + + F77_FCN (zgeqrf) (&m, &n, tmp_data, &m, tau, work, &lwork, &info); + + delete [] work; + + r.resize (m, n, 0.0); + for (int j = 0; j < n; j++) + { + int limit = j < min_mn-1 ? j : min_mn-1; + for (int i = 0; i <= limit; i++) + r.elem (i, j) = tmp_data[m*j+i]; + } + + lwork = 32*m; + work = new Complex[lwork]; + + F77_FCN (zungqr) (&m, &m, &min_mn, tmp_data, &m, tau, work, &lwork, &info); + + q = ComplexMatrix (tmp_data, m, m); + + delete [] tau; + delete [] work; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Matrix.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Matrix.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,4253 @@ +// Matrix manipulations. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +// I\'m not sure how this is supposed to work if the .h file declares +// several classes, each of which is defined in a separate file... +// +// #ifdef __GNUG__ +// #pragma implementation +// #endif + +#include "Matrix.h" +#include "mx-inlines.cc" + +/* + * Matrix class. + */ + +Matrix::Matrix (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = nr * nc; + if (len > 0) + data = new double [len]; + else + data = (double *) NULL; +} + +Matrix::Matrix (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = nr * nc; + if (len > 0) + { + data = new double [len]; + copy (data, len, val); + } + else + data = (double *) NULL; +} + +Matrix::Matrix (const Matrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +Matrix::Matrix (const DiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = nr * nc; + if (len > 0) + { + data = new double [len]; + copy (data, len, 0.0); + for (int i = 0; i < a.len; i++) + data[nr*i+i] = a.data[i]; + } + else + data = (double *) NULL; +} + +Matrix::Matrix (double a) +{ + nr = 1; + nc = 1; + len = 1; + data = new double [1]; + data[0] = a; +} + +Matrix& +Matrix::operator = (const Matrix& a) +{ + if (this != &a) + { + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; + } + return *this; +} + +Matrix& +Matrix::resize (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r * c; + double* new_data = (double *) NULL; + if (new_len > 0) + { + new_data = new double [new_len]; + + int min_r = nr < r ? nr : r; + int min_c = nc < c ? nc : c; + + for (int j = 0; j < min_c; j++) + for (int i = 0; i < min_r; i++) + new_data[r*j+i] = elem (i, j); + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +Matrix& +Matrix::resize (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r * c; + double *new_data = (double *) NULL; + if (new_len > 0) + { + new_data = new double [new_len]; + +// There may be faster or cleaner ways to do this. + + if (r > nr || c > nc) + copy (new_data, new_len, val); + + int min_r = nr < r ? nr : r; + int min_c = nc < c ? nc : c; + + for (int j = 0; j < min_c; j++) + for (int i = 0; i < min_r; i++) + new_data[r*j+i] = elem (i, j); + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +int +Matrix::operator == (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 0; + + return equal (data, a.data, len); +} + +int +Matrix::operator != (const Matrix& a) const +{ + return !(*this == a); +} + +Matrix& +Matrix::insert (const Matrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int j = 0; j < a.nc; j++) + for (int i = 0; i < a.nr; i++) + elem (r+i, c+j) = a.elem (i, j); + + return *this; +} + +Matrix& +Matrix::insert (const RowVector& a, int r, int c) +{ + if (r < 0 || r >= nr || c < 0 || c + a.len - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r, c+i) = a.data[i]; + + return *this; +} + +Matrix& +Matrix::insert (const ColumnVector& a, int r, int c) +{ + if (r < 0 || r + a.len - 1 > nr || c < 0 || c >= nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c) = a.data[i]; + + return *this; +} + +Matrix& +Matrix::insert (const DiagMatrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c+i) = a.data[i]; + + return *this; +} + +Matrix& +Matrix::fill (double val) +{ + if (nr > 0 && nc > 0) + copy (data, len, val); + return *this; +} + +Matrix& +Matrix::fill (double val, int r1, int c1, int r2, int c2) +{ + if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 + || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int j = c1; j <= c2; j++) + for (int i = r1; i <= r2; i++) + elem (i, j) = val; + + return *this; +} + +Matrix +Matrix::append (const Matrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + Matrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval;; +} + +Matrix +Matrix::append (const RowVector& a) const +{ + if (nr != 1) + FAIL; + + int nc_insert = nc; + Matrix retval (nr, nc + a.len); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +Matrix +Matrix::append (const ColumnVector& a) const +{ + if (nr != a.len) + FAIL; + + int nc_insert = nc; + Matrix retval (nr, nc + 1); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +Matrix +Matrix::append (const DiagMatrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + Matrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +Matrix +Matrix::stack (const Matrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + Matrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +Matrix +Matrix::stack (const RowVector& a) const +{ + if (nc != a.len) + FAIL; + + int nr_insert = nr; + Matrix retval (nr + 1, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +Matrix +Matrix::stack (const ColumnVector& a) const +{ + if (nc != 1) + FAIL; + + int nr_insert = nr; + Matrix retval (nr + a.len, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +Matrix +Matrix::stack (const DiagMatrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + Matrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +Matrix +Matrix::transpose (void) const +{ + Matrix result; + if (len > 0) + { + result.resize (nc, nr); + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result.data[nc*i+j] = data[nr*j+i]; + } + return result; +} + +Matrix +Matrix::extract (int r1, int c1, int r2, int c2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_r = r2 - r1 + 1; + int new_c = c2 - c1 + 1; + + Matrix result (new_r, new_c); + + for (int j = 0; j < new_c; j++) + for (int i = 0; i < new_r; i++) + result.data[new_r*j+i] = elem (r1+i, c1+j); + + return result; +} + +// extract row or column i. + +RowVector +Matrix::row (int i) const +{ + if (i < 0 || i >= nr) + FAIL; + + RowVector retval (nc); + for (int j = 0; j < nc; j++) + retval.elem (j) = elem (i, j); + + return retval; +} + +RowVector +Matrix::row (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return row (0); + else if (c == 'l' || c == 'L') + return row (nr - 1); + else + FAIL; +} + +ColumnVector +Matrix::column (int i) const +{ + if (i < 0 || i >= nc) + FAIL; + + ColumnVector retval (nr); + for (int j = 0; j < nr; j++) + retval.elem (j) = elem (j, i); + + return retval; +} + +ColumnVector +Matrix::column (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return column (0); + else if (c == 'l' || c == 'L') + return column (nc - 1); + else + FAIL; +} + +Matrix +Matrix::inverse (int& info, double& rcond) const +{ + if (nr != nc) + FAIL; + + info = 0; + + int *ipvt = new int [nr]; + double *z = new double [nr]; + double *tmp_data = dup (data, len); + + F77_FCN (dgeco) (tmp_data, &nr, &nc, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -1; + copy (tmp_data, data, len); // Restore matrix contents. + } + else + { + int job = 1; + double dummy; + + F77_FCN (dgedi) (tmp_data, &nr, &nc, ipvt, &dummy, z, &job); + } + + delete [] ipvt; + delete [] z; + + return Matrix (tmp_data, nr, nc); +} + +Matrix +Matrix::inverse (int& info) const +{ + double rcond; + return inverse (info, rcond); +} + +Matrix +Matrix::inverse (void) const +{ + int info; + double rcond; + return inverse (info, rcond); +} + +ComplexMatrix +Matrix::fourier (void) const +{ + int npts, nsamples; + if (nr == 1 || nc == 1) + { + npts = nr > nc ? nr : nc; + nsamples = 1; + } + else + { + npts = nr; + nsamples = nc; + } + + int nn = 4*npts+15; + Complex *wsave = new Complex [nn]; + Complex *tmp_data = make_complex (data, len); + + F77_FCN (cffti) (&npts, wsave); + + for (int j = 0; j < nsamples; j++) + F77_FCN (cfftf) (&npts, &tmp_data[npts*j], wsave); + + delete [] wsave; + + return ComplexMatrix (tmp_data, nr, nc); +} + +ComplexMatrix +Matrix::ifourier (void) const +{ + int npts, nsamples; + if (nr == 1 || nc == 1) + { + npts = nr > nc ? nr : nc; + nsamples = 1; + } + else + { + npts = nr; + nsamples = nc; + } + + int nn = 4*npts+15; + Complex *wsave = new Complex [nn]; + Complex *tmp_data = make_complex (data, len); + + F77_FCN (cffti) (&npts, wsave); + + for (int j = 0; j < nsamples; j++) + F77_FCN (cfftb) (&npts, &tmp_data[npts*j], wsave); + + for (j = 0; j < npts*nsamples; j++) + tmp_data[j] = tmp_data[j] / (double) npts; + + delete [] wsave; + + return ComplexMatrix (tmp_data, nr, nc); +} + +DET +Matrix::determinant (void) const +{ + int info; + double rcond; + return determinant (info, rcond); +} + +DET +Matrix::determinant (int& info) const +{ + double rcond; + return determinant (info, rcond); +} + +DET +Matrix::determinant (int& info, double& rcond) const +{ + DET retval; + + if (nr == 0 || nc == 0) + { + double d[2]; + d[0] = 1.0; + d[1] = 0.0; + return DET (d); + } + + info = 0; + int *ipvt = new int [nr]; + + double *z = new double [nr]; + double *tmp_data = dup (data, len); + + F77_FCN (dgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -1; + } + else + { + int job = 10; + double d[2]; + F77_FCN (dgedi) (tmp_data, &nr, &nr, ipvt, d, z, &job); + retval = DET (d); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +Matrix +Matrix::solve (const Matrix& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +Matrix +Matrix::solve (const Matrix& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +Matrix +Matrix::solve (const Matrix& b, int& info, double& rcond) const +{ + Matrix retval; + + if (nr == 0 || nc == 0 || nr != nc || nr != b.nr) + FAIL; + + info = 0; + int *ipvt = new int [nr]; + + double *z = new double [nr]; + double *tmp_data = dup (data, len); + + F77_FCN (dgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -2; + } + else + { + int job = 0; + + double *result = dup (b.data, b.len); + + for (int j = 0; j < b.nc; j++) + F77_FCN (dgesl) (tmp_data, &nr, &nr, ipvt, &result[nr*j], &job); + + retval = Matrix (result, b.nr, b.nc); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +ComplexMatrix +Matrix::solve (const ComplexMatrix& b) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b); +} + +ComplexMatrix +Matrix::solve (const ComplexMatrix& b, int& info) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b, info); +} + +ComplexMatrix +Matrix::solve (const ComplexMatrix& b, int& info, double& rcond) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b, info, rcond); +} + +ColumnVector +Matrix::solve (const ColumnVector& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +ColumnVector +Matrix::solve (const ColumnVector& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +ColumnVector +Matrix::solve (const ColumnVector& b, int& info, double& rcond) const +{ + ColumnVector retval; + + if (nr == 0 || nc == 0 || nr != nc || nr != b.len) + FAIL; + + info = 0; + int *ipvt = new int [nr]; + + double *z = new double [nr]; + double *tmp_data = dup (data, len); + + F77_FCN (dgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -2; + } + else + { + int job = 0; + + double *result = dup (b.data, b.len); + + F77_FCN (dgesl) (tmp_data, &nr, &nr, ipvt, result, &job); + + retval = ColumnVector (result, b.len); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +ComplexColumnVector +Matrix::solve (const ComplexColumnVector& b) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b); +} + +ComplexColumnVector +Matrix::solve (const ComplexColumnVector& b, int& info) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b, info); +} + +ComplexColumnVector +Matrix::solve (const ComplexColumnVector& b, int& info, double& rcond) const +{ + ComplexMatrix tmp (*this); + return tmp.solve (b, info, rcond); +} + +Matrix +Matrix::lssolve (const Matrix& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +Matrix +Matrix::lssolve (const Matrix& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +Matrix +Matrix::lssolve (const Matrix& b, int& info, int& rank) const +{ + int nrhs = b.nc; + + int m = nr; + int n = nc; + + if (m == 0 || n == 0 || m != b.nr) + FAIL; + + double *tmp_data = dup (data, len); + + int nrr = m > n ? m : n; + Matrix result (nrr, nrhs); + + int i, j; + for (j = 0; j < nrhs; j++) + for (i = 0; i < m; i++) + result.elem (i, j) = b.elem (i, j); + + double *presult = result.fortran_vec (); + + int len_s = m < n ? m : n; + double *s = new double [len_s]; + double rcond = -1.0; + int lwork; + if (m < n) + lwork = 3*m + (2*m > nrhs ? (2*m > n ? 2*m : n) : (nrhs > n ? nrhs : n)); + else + lwork = 3*n + (2*n > nrhs ? (2*n > m ? 2*n : m) : (nrhs > m ? nrhs : m)); + + double *work = new double [lwork]; + + F77_FCN (dgelss) (&m, &n, &nrhs, tmp_data, &m, presult, &nrr, s, + &rcond, &rank, work, &lwork, &info); + + Matrix retval (n, nrhs); + for (j = 0; j < nrhs; j++) + for (i = 0; i < n; i++) + retval.elem (i, j) = result.elem (i, j); + + delete [] tmp_data; + delete [] s; + delete [] work; + + return retval; +} + +ComplexMatrix +Matrix::lssolve (const ComplexMatrix& b) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b); +} + +ComplexMatrix +Matrix::lssolve (const ComplexMatrix& b, int& info) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b, info); +} + +ComplexMatrix +Matrix::lssolve (const ComplexMatrix& b, int& info, int& rank) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b, info, rank); +} + +ColumnVector +Matrix::lssolve (const ColumnVector& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +ColumnVector +Matrix::lssolve (const ColumnVector& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +ColumnVector +Matrix::lssolve (const ColumnVector& b, int& info, int& rank) const +{ + int nrhs = 1; + + int m = nr; + int n = nc; + + if (m == 0 || n == 0 || m != b.len) + FAIL; + + double *tmp_data = dup (data, len); + + int nrr = m > n ? m : n; + ColumnVector result (nrr); + + int i; + for (i = 0; i < m; i++) + result.elem (i) = b.elem (i); + + double *presult = result.fortran_vec (); + + int len_s = m < n ? m : n; + double *s = new double [len_s]; + double rcond = -1.0; + int lwork; + if (m < n) + lwork = 3*m + (2*m > nrhs ? (2*m > n ? 2*m : n) : (nrhs > n ? nrhs : n)); + else + lwork = 3*n + (2*n > nrhs ? (2*n > m ? 2*n : m) : (nrhs > m ? nrhs : m)); + + double *work = new double [lwork]; + + F77_FCN (dgelss) (&m, &n, &nrhs, tmp_data, &m, presult, &nrr, s, + &rcond, &rank, work, &lwork, &info); + + ColumnVector retval (n); + for (i = 0; i < n; i++) + retval.elem (i) = result.elem (i); + + delete [] tmp_data; + delete [] s; + delete [] work; + + return retval; +} + +ComplexColumnVector +Matrix::lssolve (const ComplexColumnVector& b) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b); +} + +ComplexColumnVector +Matrix::lssolve (const ComplexColumnVector& b, int& info) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b, info); +} + +ComplexColumnVector +Matrix::lssolve (const ComplexColumnVector& b, int& info, int& rank) const +{ + ComplexMatrix tmp (*this); + return tmp.lssolve (b, info, rank); +} + +// matrix by scalar -> matrix operations. + +Matrix +Matrix::operator + (double s) const +{ + return Matrix (add (data, len, s), nr, nc); +} + +Matrix +Matrix::operator - (double s) const +{ + return Matrix (subtract (data, len, s), nr, nc); +} + +Matrix +Matrix::operator * (double s) const +{ + return Matrix (multiply (data, len, s), nr, nc); +} + +Matrix +Matrix::operator / (double s) const +{ + return Matrix (divide (data, len, s), nr, nc); +} + +ComplexMatrix +Matrix::operator + (Complex s) const +{ + return ComplexMatrix (add (data, len, s), nr, nc); +} + +ComplexMatrix +Matrix::operator - (Complex s) const +{ + return ComplexMatrix (subtract (data, len, s), nr, nc); +} + +ComplexMatrix +Matrix::operator * (Complex s) const +{ + return ComplexMatrix (multiply (data, len, s), nr, nc); +} + +ComplexMatrix +Matrix::operator / (Complex s) const +{ + return ComplexMatrix (divide (data, len, s), nr, nc); +} + +// scalar by matrix -> matrix operations + +Matrix +operator + (double s, const Matrix& a) +{ + return Matrix (add (a.data, a.len, s), a.nr, a.nc); +} + +Matrix +operator - (double s, const Matrix& a) +{ + return Matrix (subtract (s, a.data, a.len), a.nr, a.nc); +} + +Matrix +operator * (double s, const Matrix& a) +{ + return Matrix (multiply (a.data, a.len, s), a.nr, a.nc); +} + +Matrix +operator / (double s, const Matrix& a) +{ + return Matrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +// matrix by column vector -> column vector operations + +ColumnVector +Matrix::operator * (const ColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nr == 0 || nc == 0) + return ColumnVector (0); + + char trans = 'N'; + int ld = nr; + double alpha = 1.0; + double beta = 0.0; + int i_one = 1; + + double *y = new double [a.len]; + + F77_FCN (dgemv) (&trans, &nr, &nc, &alpha, data, &ld, a.data, + &i_one, &beta, y, &i_one, 1L); + + return ColumnVector (y, a.len); +} + +ComplexColumnVector +Matrix::operator * (const ComplexColumnVector& a) const +{ + ComplexMatrix tmp (*this); + return tmp * a; +} + +// matrix by diagonal matrix -> matrix operations + +Matrix +Matrix::operator + (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + Matrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) += a.data[i]; + + return result; +} + +Matrix +Matrix::operator - (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + Matrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) -= a.data[i]; + + return result; +} + +Matrix +Matrix::operator * (const DiagMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return Matrix (nr, a.nc, 0.0); + + double *c = new double [nr*a.nc]; + double *ctmp = (double *) NULL; + + for (int j = 0; j < a.len; j++) + { + int idx = j * nr; + ctmp = c + idx; + if (a.data[j] == 1.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = elem (i, j); + } + else if (a.data[j] == 0.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = 0.0; + } + else + { + for (int i = 0; i < nr; i++) + ctmp[i] = a.data[j] * elem (i, j); + } + } + + if (a.nr < a.nc) + { + for (int i = nr * nc; i < nr * a.nc; i++) + ctmp[i] = 0.0; + } + + return Matrix (c, nr, a.nc); +} + +ComplexMatrix +Matrix::operator + (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) += a.data[i]; + + return result; +} + +ComplexMatrix +Matrix::operator - (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) -= a.data[i]; + + return result; +} + +ComplexMatrix +Matrix::operator * (const ComplexDiagMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, a.nc, 0.0); + + Complex *c = new Complex [nr*a.nc]; + Complex *ctmp = (Complex *) NULL; + + for (int j = 0; j < a.len; j++) + { + int idx = j * nr; + ctmp = c + idx; + if (a.data[j] == 1.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = elem (i, j); + } + else if (a.data[j] == 0.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = 0.0; + } + else + { + for (int i = 0; i < nr; i++) + ctmp[i] = a.data[j] * elem (i, j); + } + } + + if (a.nr < a.nc) + { + for (int i = nr * nc; i < nr * a.nc; i++) + ctmp[i] = 0.0; + } + + return ComplexMatrix (c, nr, a.nc); +} + +Matrix& +Matrix::operator += (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) += a.data[i]; + + return *this; +} + +Matrix& +Matrix::operator -= (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) -= a.data[i]; + + return *this; +} + +// matrix by matrix -> matrix operations + +Matrix +Matrix::operator + (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + return Matrix (add (data, a.data, len), nr, nc); +} + +Matrix +Matrix::operator - (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + return Matrix (subtract (data, a.data, len), nr, nc); +} + +Matrix +Matrix::operator * (const Matrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return Matrix (nr, a.nc, 0.0); + + char trans = 'N'; + char transa = 'N'; + + int ld = nr; + int lda = a.nr; + + double alpha = 1.0; + double beta = 0.0; + int anc = a.nc; + + double *c = new double [nr*a.nc]; + + F77_FCN (dgemm) (&trans, &transa, &nr, &anc, &nc, &alpha, data, &ld, + a.data, &lda, &beta, c, &nr, 1L, 1L); + + return Matrix (c, nr, a.nc); +} + +ComplexMatrix +Matrix::operator + (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + return ComplexMatrix (add (data, a.data, len), nr, nc); +} + +ComplexMatrix +Matrix::operator - (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexMatrix +Matrix::operator * (const ComplexMatrix& a) const +{ + ComplexMatrix tmp (*this); + return tmp * a; +} + +Matrix +Matrix::product (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + return Matrix (multiply (data, a.data, len), nr, nc); +} + +Matrix +Matrix::quotient (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return Matrix (nr, nc); + + return Matrix (divide (data, a.data, len), nr, nc); +} + +ComplexMatrix +Matrix::product (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexMatrix +Matrix::quotient (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (divide (data, a.data, len), nr, nc); +} + +Matrix& +Matrix::operator += (const Matrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +Matrix& +Matrix::operator -= (const Matrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// other operations. + +Matrix +map (d_d_Mapper f, const Matrix& a) +{ + Matrix b (a); + b.map (f); + return b; +} + +void +Matrix::map (d_d_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +// XXX FIXME XXX Do these really belong here? They should maybe be +// cleaned up a bit, no? What about corresponding functions for the +// Vectors? + +Matrix +Matrix::all (void) const +{ + Matrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int j = 0; j < nc; j++) + { + if (elem (0, j) == 0.0) + { + retval.elem (0, 0) = 0.0; + break; + } + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, 0) == 0.0) + { + retval.elem (0, 0) = 0.0; + break; + } + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 1.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, j) == 0.0) + { + retval.elem (0, j) = 0.0; + break; + } + } + } + } + } + return retval; +} + +Matrix +Matrix::any (void) const +{ + Matrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + { + if (elem (0, j) != 0.0) + { + retval.elem (0, 0) = 1.0; + break; + } + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, 0) != 0.0) + { + retval.elem (0, 0) = 1.0; + break; + } + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, j) != 0.0) + { + retval.elem (0, j) = 1.0; + break; + } + } + } + } + } + return retval; +} + +Matrix +Matrix::cumprod (void) const +{ + Matrix retval; + if (nr == 1) + { + retval.resize (1, nc); + if (nc > 0) + { + double prod = elem (0, 0); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = prod; + if (j < nc - 1) + prod *= elem (0, j+1); + } + } + } + else if (nc == 1) + { + retval.resize (nr, 1); + if (nr > 0) + { + double prod = elem (0, 0); + for (int i = 0; i < nr; i++) + { + retval.elem (i, 0) = prod; + if (i < nr - 1) + prod *= elem (i+1, 0); + } + } + } + else + { + retval.resize (nr, nc); + if (nr > 0 && nc > 0) + { + for (int j = 0; j < nc; j++) + { + double prod = elem (0, j); + for (int i = 0; i < nr; i++) + { + retval.elem (i, j) = prod; + if (i < nr - 1) + prod *= elem (i+1, j); + } + } + } + } + return retval; +} + +Matrix +Matrix::cumsum (void) const +{ + Matrix retval; + if (nr == 1) + { + retval.resize (1, nc); + if (nc > 0) + { + double sum = elem (0, 0); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = sum; + if (j < nc - 1) + sum += elem (0, j+1); + } + } + } + else if (nc == 1) + { + retval.resize (nr, 1); + if (nr > 0) + { + double sum = elem (0, 0); + for (int i = 0; i < nr; i++) + { + retval.elem (i, 0) = sum; + if (i < nr - 1) + sum += elem (i+1, 0); + } + } + } + else + { + retval.resize (nr, nc); + if (nr > 0 && nc > 0) + { + for (int j = 0; j < nc; j++) + { + double sum = elem (0, j); + for (int i = 0; i < nr; i++) + { + retval.elem (i, j) = sum; + if (i < nr - 1) + sum += elem (i+1, j); + } + } + } + } + return retval; +} + +Matrix +Matrix::prod (void) const +{ + Matrix retval; + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int j = 0; j < nc; j++) + retval.elem (0, 0) *= elem (0, j); + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int i = 0; i < nr; i++) + retval.elem (0, 0) *= elem (i, 0); + } + else + { + if (nc == 0) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + } + else + retval.resize (1, nc); + + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 1.0; + for (int i = 0; i < nr; i++) + retval.elem (0, j) *= elem (i, j); + } + } + return retval; +} + +Matrix +Matrix::sum (void) const +{ + Matrix retval; + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + retval.elem (0, 0) += elem (0, j); + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + retval.elem (0, 0) += elem (i, 0); + } + else + { + if (nc == 0) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + } + else + retval.resize (1, nc); + + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + retval.elem (0, j) += elem (i, j); + } + } + return retval; +} + +Matrix +Matrix::sumsq (void) const +{ + Matrix retval; + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + { + double d = elem (0, j); + retval.elem (0, 0) += d * d; + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + { + double d = elem (i, 0); + retval.elem (0, 0) += d * d; + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + { + double d = elem (i, j); + retval.elem (0, j) += d * d; + } + } + } + return retval; +} + +ColumnVector +Matrix::diag (void) const +{ + return diag (0); +} + +ColumnVector +Matrix::diag (int k) const +{ + int nnr = nr; + int nnc = nc; + if (k > 0) + nnc -= k; + else if (k < 0) + nnr += k; + + ColumnVector d; + + if (nnr > 0 && nnc > 0) + { + int ndiag = (nnr < nnc) ? nnr : nnc; + + d.resize (ndiag); + + if (k > 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i+k); + } + else if ( k < 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i-k, i); + } + else + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i); + } + } + else + cerr << "diag: requested diagonal out of range\n"; + + return d; +} + +// unary operations + +Matrix +Matrix::operator - (void) const +{ + return Matrix (negate (data, len), nr, nc); +} + +Matrix +Matrix::operator ! (void) const +{ + Matrix b (nr, nc); + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + b.elem (i, j) = ! elem (i, j); + + return b; +} + +ColumnVector +Matrix::row_min (void) const +{ + ColumnVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nr); + + for (int i = 0; i < nr; i++) + { + double res = elem (i, 0); + for (int j = 1; j < nc; j++) + if (elem (i, j) < res) + res = elem (i, j); + result.elem (i) = res; + } + } + + return result; +} + +ColumnVector +Matrix::row_max (void) const +{ + ColumnVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nr); + + for (int i = 0; i < nr; i++) + { + double res = elem (i, 0); + for (int j = 1; j < nc; j++) + if (elem (i, j) > res) + res = elem (i, j); + result.elem (i) = res; + } + } + + return result; +} + +RowVector +Matrix::column_min (void) const +{ + RowVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nc); + + for (int j = 0; j < nc; j++) + { + double res = elem (0, j); + for (int i = 1; i < nr; i++) + if (elem (i, j) < res) + res = elem (i, j); + result.elem (j) = res; + } + } + + return result; +} + +RowVector +Matrix::column_max (void) const +{ + RowVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nc); + + for (int j = 0; j < nc; j++) + { + double res = elem (0, j); + for (int i = 1; i < nr; i++) + if (elem (i, j) > res) + res = elem (i, j); + result.elem (j) = res; + } + } + + return result; +} + +ostream& +operator << (ostream& os, const Matrix& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.nr; i++) + { + for (int j = 0; j < a.nc; j++) + os << " " /* setw (field_width) */ << a.elem (i, j); + os << "\n"; + } + return os; +} + +istream& +operator >> (istream& is, Matrix& a) +{ + int nr = a.rows (); + int nc = a.columns (); + + if (nr < 1 || nc < 1) + is.clear (ios::badbit); + else + { + double tmp; + for (int i = 0; i < nr; i++) + for (int j = 0; j < nc; j++) + { + is >> tmp; + if (is) + a.elem (i, j) = tmp; + else + break; + } + } + + return is; +} + +/* + * Complex Matrix class + */ + +ComplexMatrix::ComplexMatrix (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = nr * nc; + if (len > 0) + data = new Complex [len]; + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = nr * nc; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (int r, int c, Complex val) +{ + if (r < 0 || c < 0) + FAIL; + + nr = r; + nc = c; + len = nr * nc; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (const Matrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (const ComplexMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (const DiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = nr * nc; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, 0.0); + for (int i = 0; i < a.len; i++) + data[nr*i+i] = a.data[i]; + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (const ComplexDiagMatrix& a) +{ + nr = a.nr; + nc = a.nc; + len = nr * nc; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, 0.0); + for (int i = 0; i < a.len; i++) + data[nr*i+i] = a.data[i]; + } + else + data = (Complex *) NULL; +} + +ComplexMatrix::ComplexMatrix (double a) +{ + nr = 1; + nc = 1; + len = 1; + data = new Complex [1]; + data[0] = a; +} + +ComplexMatrix::ComplexMatrix (Complex a) +{ + nr = 1; + nc = 1; + len = 1; + data = new Complex [1]; + data[0] = Complex (a); +} + +ComplexMatrix& +ComplexMatrix::operator = (const Matrix& a) +{ + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator = (const ComplexMatrix& a) +{ + if (this != &a) + { + delete [] data; + nr = a.nr; + nc = a.nc; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + } + return *this; +} + +ComplexMatrix& +ComplexMatrix::resize (int r, int c) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r * c; + Complex* new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + + int min_r = nr < r ? nr : r; + int min_c = nc < c ? nc : c; + + for (int j = 0; j < min_c; j++) + for (int i = 0; i < min_r; i++) + new_data[r*j+i] = elem (i, j); + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::resize (int r, int c, double val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r * c; + Complex *new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + +// There may be faster or cleaner ways to do this. + + if (r > nr || c > nc) + copy (new_data, new_len, val); + + int min_r = nr < r ? nr : r; + int min_c = nc < c ? nc : c; + + for (int j = 0; j < min_c; j++) + for (int i = 0; i < min_r; i++) + new_data[r*j+i] = elem (i, j); + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::resize (int r, int c, Complex val) +{ + if (r < 0 || c < 0) + FAIL; + + int new_len = r * c; + Complex *new_data = (Complex *) NULL; + if (new_len > 0) + { + new_data = new Complex [new_len]; + +// There may be faster or cleaner ways to do this. + + if (r > nr || c > nc) + copy (new_data, new_len, val); + + int min_r = nr < r ? nr : r; + int min_c = nc < c ? nc : c; + + for (int j = 0; j < min_c; j++) + for (int i = 0; i < min_r; i++) + new_data[r*j+i] = elem (i, j); + } + + delete [] data; + nr = r; + nc = c; + len = new_len; + data = new_data; + + return *this; +} + +int +ComplexMatrix::operator == (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + return 0; + + return equal (data, a.data, len); +} + +int +ComplexMatrix::operator != (const ComplexMatrix& a) const +{ + return !(*this == a); +} + +// destructive insert/delete/reorder operations + +ComplexMatrix& +ComplexMatrix::insert (const Matrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int j = 0; j < a.nc; j++) + for (int i = 0; i < a.nr; i++) + elem (r+i, c+j) = a.elem (i, j); + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const RowVector& a, int r, int c) +{ + if (r < 0 || r >= nr || c < 0 || c + a.len - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r, c+i) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const ColumnVector& a, int r, int c) +{ + if (r < 0 || r + a.len - 1 > nr || c < 0 || c >= nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const DiagMatrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c+i) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const ComplexMatrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int j = 0; j < a.nc; j++) + for (int i = 0; i < a.nr; i++) + elem (r+i, c+j) = a.elem (i, j); + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const ComplexRowVector& a, int r, int c) +{ + if (r < 0 || r >= nr || c < 0 || c + a.len - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r, c+i) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const ComplexColumnVector& a, int r, int c) +{ + if (r < 0 || r + a.len - 1 > nr || c < 0 || c >= nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::insert (const ComplexDiagMatrix& a, int r, int c) +{ + if (r < 0 || r + a.nr - 1 > nr || c < 0 || c + a.nc - 1 > nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (r+i, c+i) = a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::fill (double val) +{ + if (nr > 0 && nc > 0) + copy (data, len, val); + return *this; +} + +ComplexMatrix& +ComplexMatrix::fill (Complex val) +{ + if (nr > 0 && nc > 0) + copy (data, len, val); + return *this; +} + +ComplexMatrix& +ComplexMatrix::fill (double val, int r1, int c1, int r2, int c2) +{ + if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 + || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int j = c1; j <= c2; j++) + for (int i = r1; i <= r2; i++) + elem (i, j) = val; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::fill (Complex val, int r1, int c1, int r2, int c2) +{ + if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 + || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) + FAIL; + + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int j = c1; j <= c2; j++) + for (int i = r1; i <= r2; i++) + elem (i, j) = val; + + return *this; +} + +ComplexMatrix +ComplexMatrix::append (const Matrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const RowVector& a) const +{ + if (nr != 1) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.len); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const ColumnVector& a) const +{ + if (nr != a.len) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + 1); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const DiagMatrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const ComplexMatrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const ComplexRowVector& a) const +{ + if (nr != 1) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.len); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const ComplexColumnVector& a) const +{ + if (nr != a.len) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + 1); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::append (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr) + FAIL; + + int nc_insert = nc; + ComplexMatrix retval (nr, nc + a.nc); + retval.insert (*this, 0, 0); + retval.insert (a, 0, nc_insert); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const Matrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const RowVector& a) const +{ + if (nc != a.len) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + 1, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const ColumnVector& a) const +{ + if (nc != 1) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.len, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const DiagMatrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const ComplexMatrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const ComplexRowVector& a) const +{ + if (nc != a.len) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + 1, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const ComplexColumnVector& a) const +{ + if (nc != 1) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.len, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::stack (const ComplexDiagMatrix& a) const +{ + if (nc != a.nc) + FAIL; + + int nr_insert = nr; + ComplexMatrix retval (nr + a.nr, nc); + retval.insert (*this, 0, 0); + retval.insert (a, nr_insert, 0); + return retval; +} + +ComplexMatrix +ComplexMatrix::hermitian (void) const +{ + ComplexMatrix result; + if (len > 0) + { + result.resize (nc, nr); + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result.data[nc*i+j] = conj (data[nr*j+i]); + } + return result; +} + +ComplexMatrix +ComplexMatrix::transpose (void) const +{ + ComplexMatrix result; + if (len > 0) + { + result.resize (nc, nr); + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result.data[nc*i+j] = data[nr*j+i]; + } + return result; +} + +Matrix +real (const ComplexMatrix& a) +{ + Matrix retval; + if (a.len > 0) + retval = Matrix (real_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +Matrix +imag (const ComplexMatrix& a) +{ + Matrix retval; + if (a.len > 0) + retval = Matrix (imag_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +ComplexMatrix +conj (const ComplexMatrix& a) +{ + ComplexMatrix retval; + if (a.len > 0) + retval = ComplexMatrix (conj_dup (a.data, a.len), a.nr, a.nc); + return retval; +} + +// resize is the destructive equivalent for this one + +ComplexMatrix +ComplexMatrix::extract (int r1, int c1, int r2, int c2) const +{ + if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; } + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_r = r2 - r1 + 1; + int new_c = c2 - c1 + 1; + + ComplexMatrix result (new_r, new_c); + + for (int j = 0; j < new_c; j++) + for (int i = 0; i < new_r; i++) + result.data[new_r*j+i] = elem (r1+i, c1+j); + + return result; +} + +// extract row or column i. + +ComplexRowVector +ComplexMatrix::row (int i) const +{ + if (i < 0 || i >= nr) + FAIL; + + ComplexRowVector retval (nc); + for (int j = 0; j < nc; j++) + retval.elem (j) = elem (i, j); + + return retval; +} + +ComplexRowVector +ComplexMatrix::row (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return row (0); + else if (c == 'l' || c == 'L') + return row (nr - 1); + else + FAIL; +} + +ComplexColumnVector +ComplexMatrix::column (int i) const +{ + if (i < 0 || i >= nc) + FAIL; + + ComplexColumnVector retval (nr); + for (int j = 0; j < nr; j++) + retval.elem (j) = elem (j, i); + + return retval; +} + +ComplexColumnVector +ComplexMatrix::column (char *s) const +{ + if (s == (char *) NULL) + FAIL; + + char c = *s; + if (c == 'f' || c == 'F') + return column (0); + else if (c == 'l' || c == 'L') + return column (nc - 1); + else + FAIL; +} + +ComplexMatrix +ComplexMatrix::inverse (int& info, double& rcond) const +{ + if (nr != nc) + FAIL; + + info = 0; + + int *ipvt = new int [nr]; + Complex *z = new Complex [nr]; + Complex *tmp_data = dup (data, len); + + F77_FCN (zgeco) (tmp_data, &nr, &nc, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -1; + copy (tmp_data, data, len); // Restore contents. + } + else + { + int job = 1; + Complex dummy; + + F77_FCN (zgedi) (tmp_data, &nr, &nc, ipvt, &dummy, z, &job); + } + + delete [] ipvt; + delete [] z; + + return ComplexMatrix (tmp_data, nr, nc); +} + +ComplexMatrix +ComplexMatrix::inverse (int& info) const +{ + double rcond; + return inverse (info, rcond); +} + +ComplexMatrix +ComplexMatrix::inverse (void) const +{ + int info; + double rcond; + return inverse (info, rcond); +} + +ComplexMatrix +ComplexMatrix::fourier (void) const +{ + int npts, nsamples; + if (nr == 1 || nc == 1) + { + npts = nr > nc ? nr : nc; + nsamples = 1; + } + else + { + npts = nr; + nsamples = nc; + } + + int nn = 4*npts+15; + Complex *wsave = new Complex [nn]; + Complex *tmp_data = dup (data, len); + + F77_FCN (cffti) (&npts, wsave); + + for (int j = 0; j < nsamples; j++) + F77_FCN (cfftf) (&npts, &tmp_data[npts*j], wsave); + + delete [] wsave; + + return ComplexMatrix (tmp_data, nr, nc); +} + +ComplexMatrix +ComplexMatrix::ifourier (void) const +{ + int npts, nsamples; + if (nr == 1 || nc == 1) + { + npts = nr > nc ? nr : nc; + nsamples = 1; + } + else + { + npts = nr; + nsamples = nc; + } + + int nn = 4*npts+15; + Complex *wsave = new Complex [nn]; + Complex *tmp_data = dup (data, len); + + F77_FCN (cffti) (&npts, wsave); + + for (int j = 0; j < nsamples; j++) + F77_FCN (cfftb) (&npts, &tmp_data[npts*j], wsave); + + for (j = 0; j < npts*nsamples; j++) + tmp_data[j] = tmp_data[j] / (double) npts; + + delete [] wsave; + + return ComplexMatrix (tmp_data, nr, nc); +} + +ComplexDET +ComplexMatrix::determinant (void) const +{ + int info; + double rcond; + return determinant (info, rcond); +} + +ComplexDET +ComplexMatrix::determinant (int& info) const +{ + double rcond; + return determinant (info, rcond); +} + +ComplexDET +ComplexMatrix::determinant (int& info, double& rcond) const +{ + ComplexDET retval; + + if (nr == 0 || nc == 0) + { + Complex d[2]; + d[0] = 1.0; + d[1] = 0.0; + return ComplexDET (d); + } + + info = 0; + int *ipvt = new int [nr]; + + Complex *z = new Complex [nr]; + Complex *tmp_data = dup (data, len); + + F77_FCN (zgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -1; + } + else + { + int job = 10; + Complex d[2]; + F77_FCN (zgedi) (tmp_data, &nr, &nr, ipvt, d, z, &job); + retval = ComplexDET (d); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +ComplexMatrix +ComplexMatrix::solve (const Matrix& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +ComplexMatrix +ComplexMatrix::solve (const Matrix& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +ComplexMatrix +ComplexMatrix::solve (const Matrix& b, int& info, double& rcond) const +{ + ComplexMatrix tmp (b); + return solve (tmp, info, rcond); +} + +ComplexMatrix +ComplexMatrix::solve (const ComplexMatrix& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +ComplexMatrix +ComplexMatrix::solve (const ComplexMatrix& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +ComplexMatrix +ComplexMatrix::solve (const ComplexMatrix& b, int& info, double& rcond) const +{ + ComplexMatrix retval; + + if (nr == 0 || nc == 0 || nr != nc || nr != b.nr) + FAIL; + + info = 0; + int *ipvt = new int [nr]; + + Complex *z = new Complex [nr]; + Complex *tmp_data = dup (data, len); + + F77_FCN (zgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -2; + } + else + { + int job = 0; + + Complex *result = dup (b.data, b.len); + + for (int j = 0; j < b.nc; j++) + F77_FCN (zgesl) (tmp_data, &nr, &nr, ipvt, &result[nr*j], &job); + + retval = ComplexMatrix (result, b.nr, b.nc); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +ComplexColumnVector +ComplexMatrix::solve (const ColumnVector& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +ComplexColumnVector +ComplexMatrix::solve (const ColumnVector& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +ComplexColumnVector +ComplexMatrix::solve (const ColumnVector& b, int& info, double& rcond) const +{ + ComplexColumnVector tmp (b); + return solve (tmp, info, rcond); +} + +ComplexColumnVector +ComplexMatrix::solve (const ComplexColumnVector& b) const +{ + int info; + double rcond; + return solve (b, info, rcond); +} + +ComplexColumnVector +ComplexMatrix::solve (const ComplexColumnVector& b, int& info) const +{ + double rcond; + return solve (b, info, rcond); +} + +ComplexColumnVector +ComplexMatrix::solve (const ComplexColumnVector& b, int& info, + double& rcond) const +{ + ComplexColumnVector retval; + + if (nr == 0 || nc == 0 || nr != nc || nr != b.len) + FAIL; + + info = 0; + int *ipvt = new int [nr]; + + Complex *z = new Complex [nr]; + Complex *tmp_data = dup (data, len); + + F77_FCN (zgeco) (tmp_data, &nr, &nr, ipvt, &rcond, z); + + if (rcond + 1.0 == 1.0) + { + info = -2; + } + else + { + int job = 0; + + Complex *result = dup (b.data, b.len); + + F77_FCN (zgesl) (tmp_data, &nr, &nr, ipvt, result, &job); + + retval = ComplexColumnVector (result, b.len); + } + + delete [] tmp_data; + delete [] ipvt; + delete [] z; + + return retval; +} + +ComplexMatrix +ComplexMatrix::lssolve (const Matrix& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +ComplexMatrix +ComplexMatrix::lssolve (const Matrix& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +ComplexMatrix +ComplexMatrix::lssolve (const Matrix& b, int& info, int& rank) const +{ + ComplexMatrix tmp (b); + return lssolve (tmp, info, rank); +} + +ComplexMatrix +ComplexMatrix::lssolve (const ComplexMatrix& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +ComplexMatrix +ComplexMatrix::lssolve (const ComplexMatrix& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +ComplexMatrix +ComplexMatrix::lssolve (const ComplexMatrix& b, int& info, int& rank) const +{ + int nrhs = b.nc; + + int m = nr; + int n = nc; + + if (m == 0 || n == 0 || m != b.nr) + FAIL; + + Complex *tmp_data = dup (data, len); + + int nrr = m > n ? m : n; + ComplexMatrix result (nrr, nrhs); + + int i, j; + for (j = 0; j < nrhs; j++) + for (i = 0; i < m; i++) + result.elem (i, j) = b.elem (i, j); + + Complex *presult = result.fortran_vec (); + + int len_s = m < n ? m : n; + double *s = new double [len_s]; + double rcond = -1.0; + int lwork; + if (m < n) + lwork = 2*m + (nrhs > n ? nrhs : n); + else + lwork = 2*n + (nrhs > m ? nrhs : m); + + Complex *work = new Complex [lwork]; + + int lrwork = (5 * (m < n ? m : n)) - 4; + lrwork = lrwork > 1 ? lrwork : 1; + double *rwork = new double [lrwork]; + + F77_FCN (zgelss) (&m, &n, &nrhs, tmp_data, &m, presult, &nrr, s, + &rcond, &rank, work, &lwork, rwork, &info); + + ComplexMatrix retval (n, nrhs); + for (j = 0; j < nrhs; j++) + for (i = 0; i < n; i++) + retval.elem (i, j) = result.elem (i, j); + + delete [] tmp_data; + delete [] s; + delete [] work; + delete [] rwork; + + return retval; +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ColumnVector& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ColumnVector& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ColumnVector& b, int& info, int& rank) const +{ + ComplexColumnVector tmp (b); + return lssolve (tmp, info, rank); +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ComplexColumnVector& b) const +{ + int info; + int rank; + return lssolve (b, info, rank); +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ComplexColumnVector& b, int& info) const +{ + int rank; + return lssolve (b, info, rank); +} + +ComplexColumnVector +ComplexMatrix::lssolve (const ComplexColumnVector& b, int& info, + int& rank) const +{ + int nrhs = 1; + + int m = nr; + int n = nc; + + if (m == 0 || n == 0 || m != b.len) + FAIL; + + Complex *tmp_data = dup (data, len); + + int nrr = m > n ? m : n; + ComplexColumnVector result (nrr); + + int i; + for (i = 0; i < m; i++) + result.elem (i) = b.elem (i); + + Complex *presult = result.fortran_vec (); + + int len_s = m < n ? m : n; + double *s = new double [len_s]; + double rcond = -1.0; + int lwork; + if (m < n) + lwork = 2*m + (nrhs > n ? nrhs : n); + else + lwork = 2*n + (nrhs > m ? nrhs : m); + + Complex *work = new Complex [lwork]; + + int lrwork = (5 * (m < n ? m : n)) - 4; + lrwork = lrwork > 1 ? lrwork : 1; + double *rwork = new double [lrwork]; + + F77_FCN (zgelss) (&m, &n, &nrhs, tmp_data, &m, presult, &nrr, s, + &rcond, &rank, work, &lwork, rwork, &info); + + ComplexColumnVector retval (n); + for (i = 0; i < n; i++) + retval.elem (i) = result.elem (i); + + delete [] tmp_data; + delete [] s; + delete [] work; + delete [] rwork; + + return retval; +} + +// matrix by scalar -> matrix operations + +ComplexMatrix +ComplexMatrix::operator + (double s) const +{ + return ComplexMatrix (add (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator - (double s) const +{ + return ComplexMatrix (subtract (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator * (double s) const +{ + return ComplexMatrix (multiply (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator / (double s) const +{ + return ComplexMatrix (divide (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator + (Complex s) const +{ + return ComplexMatrix (add (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator - (Complex s) const +{ + return ComplexMatrix (subtract (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator * (Complex s) const +{ + return ComplexMatrix (multiply (data, len, s), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator / (Complex s) const +{ + return ComplexMatrix (divide (data, len, s), nr, nc); +} + +// scalar by matrix -> matrix operations + +ComplexMatrix +operator + (double s, const ComplexMatrix& a) +{ + return ComplexMatrix (add (a.data, a.len, s), a.nr, a.nc); +} + +ComplexMatrix +operator - (double s, const ComplexMatrix& a) +{ + return ComplexMatrix (subtract (s, a.data, a.len), a.nr, a.nc); +} + +ComplexMatrix +operator * (double s, const ComplexMatrix& a) +{ + return ComplexMatrix (multiply (a.data, a.len, s), a.nr, a.nc); +} + +ComplexMatrix +operator / (double s, const ComplexMatrix& a) +{ + return ComplexMatrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +ComplexMatrix +operator + (Complex s, const ComplexMatrix& a) +{ + return ComplexMatrix (add (s, a.data, a.len), a.nr, a.nc); +} + +ComplexMatrix +operator - (Complex s, const ComplexMatrix& a) +{ + return ComplexMatrix (subtract (s, a.data, a.len), a.nr, a.nc); +} + +ComplexMatrix +operator * (Complex s, const ComplexMatrix& a) +{ + return ComplexMatrix (multiply (s, a.data, a.len), a.nr, a.nc); +} + +ComplexMatrix +operator / (Complex s, const ComplexMatrix& a) +{ + return ComplexMatrix (divide (s, a.data, a.len), a.nr, a.nc); +} + +// matrix by column vector -> column vector operations + +ComplexColumnVector +ComplexMatrix::operator * (const ColumnVector& a) const +{ + ComplexColumnVector tmp (a); + return *this * tmp; +} + +ComplexColumnVector +ComplexMatrix::operator * (const ComplexColumnVector& a) const +{ + if (nc != a.len) + FAIL; + + if (nc == 0 || nr == 0) + return ComplexColumnVector (0); + + char trans = 'N'; + int ld = nr; + Complex alpha (1.0); + Complex beta (0.0); + int i_one = 1; + + Complex *y = new Complex [a.len]; + + F77_FCN (zgemv) (&trans, &nr, &nc, &alpha, data, &ld, a.data, + &i_one, &beta, y, &i_one, 1L); + + return ComplexColumnVector (y, a.len); +} + +// matrix by diagonal matrix -> matrix operations + +ComplexMatrix +ComplexMatrix::operator + (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) += a.data[i]; + + return result; +} + +ComplexMatrix +ComplexMatrix::operator - (const DiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) -= a.data[i]; + + return result; +} + +ComplexMatrix +ComplexMatrix::operator * (const DiagMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, nc, 0.0); + + Complex *c = new Complex [nr*a.nc]; + Complex *ctmp = (Complex *) NULL; + + for (int j = 0; j < a.len; j++) + { + int idx = j * nr; + ctmp = c + idx; + if (a.data[j] == 1.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = elem (i, j); + } + else if (a.data[j] == 0.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = 0.0; + } + else + { + for (int i = 0; i < nr; i++) + ctmp[i] = a.data[j] * elem (i, j); + } + } + + if (a.nr < a.nc) + { + for (int i = nr * nc; i < nr * a.nc; i++) + ctmp[i] = 0.0; + } + + return ComplexMatrix (c, nr, a.nc); +} + +ComplexMatrix +ComplexMatrix::operator + (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) += a.data[i]; + + return result; +} + +ComplexMatrix +ComplexMatrix::operator - (const ComplexDiagMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + ComplexMatrix result (*this); + for (int i = 0; i < a.len; i++) + result.elem (i, i) -= a.data[i]; + + return result; +} + +ComplexMatrix +ComplexMatrix::operator * (const ComplexDiagMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, nc, 0.0); + + Complex *c = new Complex [nr*a.nc]; + Complex *ctmp = (Complex *) NULL; + + for (int j = 0; j < a.len; j++) + { + int idx = j * nr; + ctmp = c + idx; + if (a.data[j] == 1.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = elem (i, j); + } + else if (a.data[j] == 0.0) + { + for (int i = 0; i < nr; i++) + ctmp[i] = 0.0; + } + else + { + for (int i = 0; i < nr; i++) + ctmp[i] = a.data[j] * elem (i, j); + } + } + + if (a.nr < a.nc) + { + for (int i = nr * nc; i < nr * a.nc; i++) + ctmp[i] = 0.0; + } + + return ComplexMatrix (c, nr, a.nc); +} + +ComplexMatrix& +ComplexMatrix::operator += (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) += a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator -= (const DiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) -= a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator += (const ComplexDiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) += a.data[i]; + + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator -= (const ComplexDiagMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + for (int i = 0; i < a.len; i++) + elem (i, i) -= a.data[i]; + + return *this; +} + +// matrix by matrix -> matrix operations + +ComplexMatrix +ComplexMatrix::operator + (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (add (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator - (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator * (const Matrix& a) const +{ + ComplexMatrix tmp (a); + return *this * tmp; +} + +ComplexMatrix +ComplexMatrix::operator + (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (add (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator - (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (subtract (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::operator * (const ComplexMatrix& a) const +{ + if (nc != a.nr) + FAIL; + + if (nr == 0 || nc == 0 || a.nc == 0) + return ComplexMatrix (nr, nc, 0.0); + + char trans = 'N'; + char transa = 'N'; + + int ld = nr; + int lda = a.nr; + + Complex alpha (1.0); + Complex beta (0.0); + int anc = a.nc; + + Complex *c = new Complex [nr*a.nc]; + + F77_FCN (zgemm) (&trans, &transa, &nr, &anc, &nc, &alpha, data, &ld, + a.data, &lda, &beta, c, &nr, 1L, 1L); + + return ComplexMatrix (c, nr, a.nc); +} + +ComplexMatrix +ComplexMatrix::product (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::quotient (const Matrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (divide (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::product (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (multiply (data, a.data, len), nr, nc); +} + +ComplexMatrix +ComplexMatrix::quotient (const ComplexMatrix& a) const +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return ComplexMatrix (nr, nc); + + return ComplexMatrix (divide (data, a.data, len), nr, nc); +} + +ComplexMatrix& +ComplexMatrix::operator += (const Matrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator -= (const Matrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator += (const ComplexMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexMatrix& +ComplexMatrix::operator -= (const ComplexMatrix& a) +{ + if (nr != a.nr || nc != a.nc) + FAIL; + + if (nr == 0 || nc == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// unary operations + +ComplexMatrix +ComplexMatrix::operator - (void) const +{ + return ComplexMatrix (negate (data, len), nr, nc); +} + +Matrix +ComplexMatrix::operator ! (void) const +{ + return Matrix (not (data, len), nr, nc); +} + +// other operations + +ComplexMatrix +map (c_c_Mapper f, const ComplexMatrix& a) +{ + ComplexMatrix b (a); + b.map (f); + return b; +} + +Matrix +map (d_c_Mapper f, const ComplexMatrix& a) +{ + Matrix b (a.nr, a.nc); + for (int j = 0; j < a.nc; j++) + for (int i = 0; i < a.nr; i++) + b.elem (i, j) = f (a.elem (i, j)); + return b; +} + +void +ComplexMatrix::map (c_c_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +Matrix +ComplexMatrix::all (void) const +{ + Matrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int j = 0; j < nc; j++) + { + if (elem (0, j) == 0.0) + { + retval.elem (0, 0) = 0.0; + break; + } + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, 0) == 0.0) + { + retval.elem (0, 0) = 0.0; + break; + } + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 1.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, j) == 0.0) + { + retval.elem (0, j) = 0.0; + break; + } + } + } + } + } + return retval; +} + +Matrix +ComplexMatrix::any (void) const +{ + Matrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + { + if (elem (0, j) != 0.0) + { + retval.elem (0, 0) = 1.0; + break; + } + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, 0) != 0.0) + { + retval.elem (0, 0) = 1.0; + break; + } + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + { + if (elem (i, j) != 0.0) + { + retval.elem (0, j) = 1.0; + break; + } + } + } + } + } + return retval; +} + +ComplexMatrix +ComplexMatrix::cumprod (void) const +{ + ComplexMatrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, nc); + Complex prod = elem (0, 0); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = prod; + if (j < nc - 1) + prod *= elem (0, j+1); + } + } + else if (nc == 1) + { + retval.resize (nr, 1); + Complex prod = elem (0, 0); + for (int i = 0; i < nr; i++) + { + retval.elem (i, 0) = prod; + if (i < nr - 1) + prod *= elem (i+1, 0); + } + } + else + { + retval.resize (nr, nc); + for (int j = 0; j < nc; j++) + { + Complex prod = elem (0, j); + for (int i = 0; i < nr; i++) + { + retval.elem (i, j) = prod; + if (i < nr - 1) + prod *= elem (i+1, j); + } + } + } + } + return retval; +} + +ComplexMatrix +ComplexMatrix::cumsum (void) const +{ + ComplexMatrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, nc); + Complex sum = elem (0, 0); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = sum; + if (j < nc - 1) + sum += elem (0, j+1); + } + } + else if (nc == 1) + { + retval.resize (nr, 1); + Complex sum = elem (0, 0); + for (int i = 0; i < nr; i++) + { + retval.elem (i, 0) = sum; + if (i < nr - 1) + sum += elem (i+1, 0); + } + } + else + { + retval.resize (nr, nc); + for (int j = 0; j < nc; j++) + { + Complex sum = elem (0, j); + for (int i = 0; i < nr; i++) + { + retval.elem (i, j) = sum; + if (i < nr - 1) + sum += elem (i+1, j); + } + } + } + } + return retval; +} + +ComplexMatrix +ComplexMatrix::prod (void) const +{ + ComplexMatrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int j = 0; j < nc; j++) + retval.elem (0, 0) *= elem (0, j); + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 1.0; + for (int i = 0; i < nr; i++) + retval.elem (0, 0) *= elem (i, 0); + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 1.0; + for (int i = 0; i < nr; i++) + retval.elem (0, j) *= elem (i, j); + } + } + } + return retval; +} + +ComplexMatrix +ComplexMatrix::sum (void) const +{ + ComplexMatrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + retval.elem (0, 0) += elem (0, j); + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + retval.elem (0, 0) += elem (i, 0); + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + retval.elem (0, j) += elem (i, j); + } + } + } + return retval; +} + +ComplexMatrix +ComplexMatrix::sumsq (void) const +{ + ComplexMatrix retval; + if (nr > 0 && nc > 0) + { + if (nr == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int j = 0; j < nc; j++) + { + Complex d = elem (0, j); + retval.elem (0, 0) += d * d; + } + } + else if (nc == 1) + { + retval.resize (1, 1); + retval.elem (0, 0) = 0.0; + for (int i = 0; i < nr; i++) + { + Complex d = elem (i, 0); + retval.elem (0, 0) += d * d; + } + } + else + { + retval.resize (1, nc); + for (int j = 0; j < nc; j++) + { + retval.elem (0, j) = 0.0; + for (int i = 0; i < nr; i++) + { + Complex d = elem (i, j); + retval.elem (0, j) += d * d; + } + } + } + } + return retval; +} + +ComplexColumnVector +ComplexMatrix::diag (void) const +{ + return diag (0); +} + +ComplexColumnVector +ComplexMatrix::diag (int k) const +{ + int nnr = nr; + int nnc = nc; + if (k > 0) + nnc -= k; + else if (k < 0) + nnr += k; + + ComplexColumnVector d; + + if (nnr > 0 && nnc > 0) + { + int ndiag = (nnr < nnc) ? nnr : nnc; + + d.resize (ndiag); + + if (k > 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i+k); + } + else if ( k < 0) + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i-k, i); + } + else + { + for (int i = 0; i < ndiag; i++) + d.elem (i) = elem (i, i); + } + } + else + cerr << "diag: requested diagonal out of range\n"; + + return d; +} + +ComplexColumnVector +ComplexMatrix::row_min (void) const +{ + ComplexColumnVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nr); + + for (int i = 0; i < nr; i++) + { + Complex res = elem (i, 0); + double absres = abs (res); + for (int j = 1; j < nc; j++) + if (abs (elem (i, j)) < absres) + { + res = elem (i, j); + absres = abs (res); + } + result.elem (i) = res; + } + } + + return result; +} + +ComplexColumnVector +ComplexMatrix::row_max (void) const +{ + ComplexColumnVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nr); + + for (int i = 0; i < nr; i++) + { + Complex res = elem (i, 0); + double absres = abs (res); + for (int j = 1; j < nc; j++) + if (abs (elem (i, j)) > absres) + { + res = elem (i, j); + absres = abs (res); + } + result.elem (i) = res; + } + } + + return result; +} + +ComplexRowVector +ComplexMatrix::column_min (void) const +{ + ComplexRowVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nc); + + for (int j = 0; j < nc; j++) + { + Complex res = elem (0, j); + double absres = abs (res); + for (int i = 1; i < nr; i++) + if (abs (elem (i, j)) < absres) + { + res = elem (i, j); + absres = abs (res); + } + result.elem (j) = res; + } + } + + return result; +} + +ComplexRowVector +ComplexMatrix::column_max (void) const +{ + ComplexRowVector result; + + if (nr > 0 && nc > 0) + { + result.resize (nc); + + for (int j = 0; j < nc; j++) + { + Complex res = elem (0, j); + double absres = abs (res); + for (int i = 1; i < nr; i++) + if (abs (elem (i, j)) > absres) + { + res = elem (i, j); + absres = abs (res); + } + result.elem (j) = res; + } + } + + return result; +} + +// i/o + +ostream& +operator << (ostream& os, const ComplexMatrix& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.nr; i++) + { + for (int j = 0; j < a.nc; j++) + os << " " /* setw (field_width) */ << a.elem (i, j); + os << "\n"; + } + return os; +} + +istream& +operator >> (istream& is, ComplexMatrix& a) +{ + int nr = a.rows (); + int nc = a.columns (); + + if (nr < 1 || nc < 1) + is.clear (ios::badbit); + else + { + Complex tmp; + for (int i = 0; i < nr; i++) + for (int j = 0; j < nc; j++) + { + is >> tmp; + if (is) + a.elem (i, j) = tmp; + else + break; + } + } + + return is; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Matrix.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Matrix.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,2606 @@ +// Matrix manipulations. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + +Should probably say something here about why these classes are not +represented by some sort of inheritance tree... + +*/ + +#if !defined (_Matrix_h) +#define _Matrix_h 1 + +// I\'m not sure how this is supposed to work if the .h file declares +// several classes, each of which is defined in a separate file... +// +// #ifdef __GNUG__ +// #pragma interface +// #endif + +#include +#include +#include +#include +#include +#include +// #include // We don\'t use this yet. +#include + +#define FAIL assert(0) /* XXX FIXME XXX */ + +#ifndef MAPPER_FCN_TYPEDEFS +#define MAPPER_FCN_TYPEDEFS 1 + +typedef double (*d_d_Mapper)(double); +typedef double (*d_c_Mapper)(const Complex&); +typedef Complex (*c_c_Mapper)(const Complex&); + +#endif + +#include "f77-uscore.h" + +// Fortran functions we call. + +extern "C" +{ + int F77_FCN (dgemm) (const char*, const char*, const int*, + const int*, const int*, const double*, + const double*, const int*, const double*, + const int*, const double*, double*, const int*, + long, long); + + int F77_FCN (dgemv) (const char*, const int*, const int*, + const double*, const double*, const int*, + const double*, const int*, const double*, + double*, const int*, long); + + int F77_FCN (dgeco) (double*, const int*, const int*, int*, double*, + double*); + + int F77_FCN (dgesv) (const int*, const int*, double*, const int*, + int*, double*, const int*, int*); + + int F77_FCN (dgeqrf) (const int*, const int*, double*, const int*, + double*, double*, const int*, int*); + + int F77_FCN (dorgqr) (const int*, const int*, const int*, double*, + const int*, double*, double*, const int*, int*); + + int F77_FCN (dgesl) (const double*, const int*, const int*, + const int*, double*, const int*); + + int F77_FCN (dgedi) (double*, const int*, const int*, const int*, + double*, double*, const int*); + + double F77_FCN (ddot) (const int*, const double*, const int*, + const double*, const int*); + + int F77_FCN (dgeev) (const char*, const char*, const int*, double*, + const int*, double*, double*, double*, + const int*, double*, const int*, double*, + const int*, int*, long, long); + + int F77_FCN (dgeesx) (const char*, const char*, int (*)(), const char*, + const int*, double*, const int*, int*, double*, + double*, double*, const int*, double*, double*, + double*, const int*, int*, const int*, int*, + int*, long, long); + + int F77_FCN (dhseqr) (const char*, const char*, const int*, + const int*, const int*, double*, + const int*, double*, double*, + double*, const int*, double*, const int*, + int*, long, long); + + int F77_FCN (dgebal) (const char*, const int*, double*, + const int*, int*, int*, double*, + int*, long, long); + + int F77_FCN (dgebak) (const char*, const char*, const int*, const int*, + const int*, double*, const int*, double*, const int*, + int*, long, long); + + int F77_FCN (dgehrd) (const int*, const int*, const int*, + double*, const int*, double*, double*, + const int*, int*, long, long); + + int F77_FCN (dorghr) (const int*, const int*, const int*, + double*, const int*, double*, double*, + const int*, int*, long, long); + + int F77_FCN (dgesvd) (const char*, const char*, const int*, + const int*, double*, const int*, double*, + double*, const int*, double*, const int*, + double*, const int*, int*, long, long); + + int F77_FCN (dgelss) (const int*, const int*, const int*, double*, + const int*, double*, const int*, double*, + const double*, int*, double*, const int*, + int*); + +/* + * f2c translates complex*16 as + * + * typedef struct { doublereal re, im; } doublecomplex; + * + * and Complex.h from libg++ uses + * + * protected: + * double re; + * double im; + * + * as the only data members, so this should work (fingers crossed that + * things don't change). + */ + + int F77_FCN (zgemm) (const char*, const char*, const int*, + const int*, const int*, const Complex*, + const Complex*, const int*, const Complex*, + const int*, const Complex*, Complex*, const int*, + long, long); + + int F77_FCN (zgemv) (const char*, const int*, const int*, + const Complex*, const Complex*, const int*, + const Complex*, const int*, const Complex*, + Complex*, const int*, long); + + int F77_FCN (zgeco) (Complex*, const int*, const int*, int*, + double*, Complex*); + + int F77_FCN (zgesv) (const int*, const int*, Complex*, const int*, + int*, Complex*, const int*, int*); + + int F77_FCN (zgeqrf) (const int*, const int*, Complex*, const int*, + Complex*, Complex*, const int*, int*); + + int F77_FCN (zgeesx) (const char*, const char*, int (*)(), const char*, + const int*, Complex*, const int*, int*, + Complex*, Complex*, const int*, double*, double*, + Complex*, const int*, double*, int*, int*, + long, long); + + int F77_FCN (zhseqr) (const char*, const char*, const int*, + const int*, const int*, Complex*, const int*, + Complex*, Complex*, const int*, Complex*, + const int*, int*, long, long); + + int F77_FCN (zgebal) (const char*, const int*, Complex*, const int*, + int*, int*, double*, int*, long, long); + + int F77_FCN (zgebak) (const char*, const char*, const int*, const int*, + const int*, double*, const int*, Complex*, + const int*, int*, long, long); + + int F77_FCN (zgehrd) (const int*, const int*, const int*, Complex*, + const int*, Complex*, Complex*, const int*, + int*, long, long); + + int F77_FCN (zunghr) (const int*, const int*, const int*, Complex*, + const int*, Complex*, Complex*, const int*, + int*, long, long); + + int F77_FCN (zungqr) (const int*, const int*, const int*, Complex*, + const int*, Complex*, Complex*, const int*, int*); + + int F77_FCN (zgedi) (Complex*, const int*, const int*, int*, + Complex*, Complex*, const int*); + + int F77_FCN (zgesl) (Complex*, const int*, const int*, int*, + Complex*, const int*); + + int F77_FCN (zgeev) (const char*, const char*, const int*, Complex*, + const int*, Complex*, Complex*, const int*, + Complex*, const int*, Complex*, const int*, + double*, int*, long, long); + + int F77_FCN (zgesvd) (const char*, const char*, const int*, + const int*, Complex*, const int*, double*, + Complex*, const int*, Complex*, const int*, + Complex*, const int*, double*, int*, long, long); + + int F77_FCN (zgelss) (const int*, const int*, const int*, Complex*, + const int*, Complex*, const int*, double*, + const double*, int*, Complex*, const int*, + double*, int*); + +// Note that the original complex fft routines were not written for +// double complex arguments. They have been modified by adding an +// implicit double precision (a-h,o-z) statement at the beginning of +// each subroutine. + + int F77_FCN (cffti) (const int*, Complex*); + + int F77_FCN (cfftf) (const int*, Complex*, Complex*); + + int F77_FCN (cfftb) (const int*, Complex*, Complex*); + +} + +// Classes we declare. + +class Matrix; +class ColumnVector; +class RowVector; +class DiagMatrix; +class ComplexMatrix; +class ComplexColumnVector; +class ComplexRowVector; +class ComplexDiagMatrix; +class DET; +class ComplexDET; +class EIG; +class HESS; +class ComplexHESS; +class SCHUR; +class ComplexSCHUR; +class SVD; +class ComplexSVD; +class LU; +class ComplexLU; +class QR; +class ComplexQR; + +/* + * Matrix class + */ + +class Matrix +{ +friend class RowVector; +friend class DiagMatrix; +friend class ComplexMatrix; +friend class ComplexDiagMatrix; +friend class EIG; +friend class HESS; +friend class SCHUR; +friend class SVD; +friend class LU; +friend class QR; + +public: + Matrix (void); + Matrix (int r, int c); + Matrix (int r, int c, double val); + Matrix (const Matrix& a); + Matrix (const DiagMatrix& a); + Matrix (double a); + ~Matrix (void); + +#if defined (MDEBUG) + void *operator new (size_t size) + { + Matrix *p = ::new Matrix; + cerr << "Matrix::new(): " << p << "\n"; + return p; + } + + void operator delete (void *p, size_t size) + { + cerr << "Matrix::delete(): " << p << "\n"; + ::delete p; + } +#endif + + Matrix& operator = (const Matrix& a); + + int rows (void) const; + int cols (void) const; + int columns (void) const; + + double& elem (int r, int c); + double& checkelem (int r, int c); + double& operator () (int r, int c); + + double elem (int r, int c) const; // const access + double checkelem (int r, int c) const; + double operator () (int r, int c) const; + + Matrix& resize (int r, int c); + Matrix& resize (int r, int c, double val); + + int operator == (const Matrix& a) const; + int operator != (const Matrix& a) const; + +// destructive insert/delete/reorder operations + + Matrix& insert (const Matrix& a, int r, int c); + Matrix& insert (const RowVector& a, int r, int c); + Matrix& insert (const ColumnVector& a, int r, int c); + Matrix& insert (const DiagMatrix& a, int r, int c); + + Matrix& fill (double val); + Matrix& fill (double val, int r1, int c1, int r2, int c2); + + Matrix append (const Matrix& a) const; + Matrix append (const RowVector& a) const; + Matrix append (const ColumnVector& a) const; + Matrix append (const DiagMatrix& a) const; + + Matrix stack (const Matrix& a) const; + Matrix stack (const RowVector& a) const; + Matrix stack (const ColumnVector& a) const; + Matrix stack (const DiagMatrix& a) const; + + Matrix transpose (void) const; + +// resize is the destructive equivalent for this one + + Matrix extract (int r1, int c1, int r2, int c2) const; + +// extract row or column i. + + RowVector row (int i) const; + RowVector row (char *s) const; + + ColumnVector column (int i) const; + ColumnVector column (char *s) const; + + Matrix inverse (int& info, double& rcond) const; + Matrix inverse (int& info) const; + Matrix inverse (void) const; + + ComplexMatrix fourier (void) const; + ComplexMatrix ifourier (void) const; + + DET determinant (void) const; + DET determinant (int& info) const; + DET determinant (int& info, double& rcond) const; + + Matrix solve (const Matrix& b) const; + Matrix solve (const Matrix& b, int& info) const; + Matrix solve (const Matrix& b, int& info, double& rcond) const; + + ComplexMatrix solve (const ComplexMatrix& b) const; + ComplexMatrix solve (const ComplexMatrix& b, int& info) const; + ComplexMatrix solve (const ComplexMatrix& b, int& info, double& rcond) const; + + ColumnVector solve (const ColumnVector& b) const; + ColumnVector solve (const ColumnVector& b, int& info) const; + ColumnVector solve (const ColumnVector& b, int& info, double& rcond) const; + + ComplexColumnVector solve (const ComplexColumnVector& b) const; + ComplexColumnVector solve (const ComplexColumnVector& b, int& info) const; + ComplexColumnVector solve (const ComplexColumnVector& b, int& info, + double& rcond) const; + + Matrix lssolve (const Matrix& b) const; + Matrix lssolve (const Matrix& b, int& info) const; + Matrix lssolve (const Matrix& b, int& info, int& rank) const; + + ComplexMatrix lssolve (const ComplexMatrix& b) const; + ComplexMatrix lssolve (const ComplexMatrix& b, int& info) const; + ComplexMatrix lssolve (const ComplexMatrix& b, int& info, + int& rank) const; + + ColumnVector lssolve (const ColumnVector& b) const; + ColumnVector lssolve (const ColumnVector& b, int& info) const; + ColumnVector lssolve (const ColumnVector& b, int& info, int& rank) const; + + ComplexColumnVector lssolve (const ComplexColumnVector& b) const; + ComplexColumnVector lssolve (const ComplexColumnVector& b, int& info) const; + ComplexColumnVector lssolve (const ComplexColumnVector& b, int& info, + int& rank) const; + +// matrix by scalar -> matrix operations + + Matrix operator + (double s) const; + Matrix operator - (double s) const; + Matrix operator * (double s) const; + Matrix operator / (double s) const; + + ComplexMatrix operator + (Complex s) const; + ComplexMatrix operator - (Complex s) const; + ComplexMatrix operator * (Complex s) const; + ComplexMatrix operator / (Complex s) const; + +// scalar by matrix -> matrix operations + + friend Matrix operator + (double s, const Matrix& a); + friend Matrix operator - (double s, const Matrix& a); + friend Matrix operator * (double s, const Matrix& a); + friend Matrix operator / (double s, const Matrix& a); + +// matrix by column vector -> column vector operations + + ColumnVector operator * (const ColumnVector& a) const; + + ComplexColumnVector operator * (const ComplexColumnVector& a) const; + +// matrix by diagonal matrix -> matrix operations + + Matrix operator + (const DiagMatrix& a) const; + Matrix operator - (const DiagMatrix& a) const; + Matrix operator * (const DiagMatrix& a) const; + + ComplexMatrix operator + (const ComplexDiagMatrix& a) const; + ComplexMatrix operator - (const ComplexDiagMatrix& a) const; + ComplexMatrix operator * (const ComplexDiagMatrix& a) const; + + Matrix& operator += (const DiagMatrix& a); + Matrix& operator -= (const DiagMatrix& a); + +// matrix by matrix -> matrix operations + + Matrix operator + (const Matrix& a) const; + Matrix operator - (const Matrix& a) const; + Matrix operator * (const Matrix& a) const; + + ComplexMatrix operator + (const ComplexMatrix& a) const; + ComplexMatrix operator - (const ComplexMatrix& a) const; + ComplexMatrix operator * (const ComplexMatrix& a) const; + + Matrix product (const Matrix& a) const; // element by element + Matrix quotient (const Matrix& a) const; // element by element + + ComplexMatrix product (const ComplexMatrix& a) const; // element by element + ComplexMatrix quotient (const ComplexMatrix& a) const; // element by element + + Matrix& operator += (const Matrix& a); + Matrix& operator -= (const Matrix& a); + +// unary operations + + Matrix operator - (void) const; + Matrix operator ! (void) const; + +// other operations + + friend Matrix map (d_d_Mapper f, const Matrix& a); + void map (d_d_Mapper f); + + Matrix all (void) const; + Matrix any (void) const; + + Matrix cumprod (void) const; + Matrix cumsum (void) const; + Matrix prod (void) const; + Matrix sum (void) const; + Matrix sumsq (void) const; + + ColumnVector diag (void) const; + ColumnVector diag (int k) const; + + ColumnVector row_min (void) const; + ColumnVector row_max (void) const; + + RowVector column_min (void) const; + RowVector column_max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const Matrix& a); + friend istream& operator >> (istream& is, Matrix& a); + +// conversions + + double *fortran_vec (void); + +private: + int nr; + int nc; + int len; + double *data; + + Matrix (double *d, int r, int c); +}; + +inline Matrix::Matrix (void) { nr = 0; nc = 0; len = 0; data = 0; } + +inline Matrix::Matrix (double *d, int r, int c) + { nr = r; nc = c; len = nr*nc; data = d; } + +inline Matrix::~Matrix (void) { delete [] data; data = 0; } + +inline int Matrix::rows (void) const { return nr; } +inline int Matrix::cols (void) const { return nc; } +inline int Matrix::columns (void) const { return nc; } + +inline double& Matrix::elem (int r, int c) { return data[nr*c+r]; } + +inline double& Matrix::checkelem (int r, int c) +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline double& Matrix::operator () (int r, int c) + { return checkelem (r, c); } + +inline double Matrix::elem (int r, int c) const { return data[nr*c+r]; } + +inline double Matrix::checkelem (int r, int c) const +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline double Matrix::operator () (int r, int c) const + { return checkelem (r, c); } + +inline double *Matrix::fortran_vec (void) { return data; } + +/* + * Column Vector class + */ + +class ColumnVector +{ +friend class Matrix; +friend class RowVector; +friend class DiagMatrix; +friend class ComplexMatrix; +friend class ComplexColumnVector; +friend class ComplexDiagMatrix; + +public: + ColumnVector (void); + ColumnVector (int n); + ColumnVector (int n, double val); + ColumnVector (const ColumnVector& a); + ColumnVector (double a); + ~ColumnVector (void); + + ColumnVector& operator = (const ColumnVector& a); + + int capacity (void) const; + int length (void) const; + + double& elem (int n); + double& checkelem (int n); + double& operator () (int n); + + double elem (int n) const; // const access + double checkelem (int n) const; + double operator () (int n) const; + + ColumnVector& resize (int n); + ColumnVector& resize (int n, double val); + + int operator == (const ColumnVector& a) const; + int operator != (const ColumnVector& a) const; + +// destructive insert/delete/reorder operations + + ColumnVector& insert (const ColumnVector& a, int r); + + ColumnVector& fill (double val); + ColumnVector& fill (double val, int r1, int r2); + + ColumnVector stack (const ColumnVector& a) const; + + RowVector transpose (void) const; + +// resize is the destructive equivalent for this one + + ColumnVector extract (int r1, int r2) const; + +// column vector by scalar -> column vector operations + + ColumnVector operator + (double s) const; + ColumnVector operator - (double s) const; + ColumnVector operator * (double s) const; + ColumnVector operator / (double s) const; + + ComplexColumnVector operator + (Complex s) const; + ComplexColumnVector operator - (Complex s) const; + ComplexColumnVector operator * (Complex s) const; + ComplexColumnVector operator / (Complex s) const; + +// scalar by column vector -> column vector operations + + friend ColumnVector operator + (double s, const ColumnVector& a); + friend ColumnVector operator - (double s, const ColumnVector& a); + friend ColumnVector operator * (double s, const ColumnVector& a); + friend ColumnVector operator / (double s, const ColumnVector& a); + +// column vector by row vector -> matrix operations + + Matrix operator * (const RowVector& a) const; + + ComplexMatrix operator * (const ComplexRowVector& a) const; + +// column vector by column vector -> column vector operations + + ColumnVector operator + (const ColumnVector& a) const; + ColumnVector operator - (const ColumnVector& a) const; + + ComplexColumnVector operator + (const ComplexColumnVector& a) const; + ComplexColumnVector operator - (const ComplexColumnVector& a) const; + + ColumnVector product (const ColumnVector& a) const; // element by element + ColumnVector quotient (const ColumnVector& a) const; // element by element + + ComplexColumnVector product (const ComplexColumnVector& a) const; + ComplexColumnVector quotient (const ComplexColumnVector& a) const; + + ColumnVector& operator += (const ColumnVector& a); + ColumnVector& operator -= (const ColumnVector& a); + +// unary operations + + ColumnVector operator - (void) const; + + friend ColumnVector map (d_d_Mapper f, const ColumnVector& a); + void map (d_d_Mapper f); + + double min (void) const; + double max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const ColumnVector& a); + +// conversions + + double *fortran_vec (void); + +private: + int len; + double *data; + + ColumnVector (double *d, int l); +}; + +inline ColumnVector::ColumnVector (void) { len = 0; data = 0; } +inline ColumnVector::ColumnVector (double *d, int l) { len = l; data = d; } +inline ColumnVector::~ColumnVector (void) { delete [] data; data = 0; } + +inline int ColumnVector::capacity (void) const { return len; } +inline int ColumnVector::length (void) const { return len; } + +inline double& ColumnVector::elem (int n) { return data[n]; } + +inline double& +ColumnVector::checkelem (int n) +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline double& ColumnVector::operator () (int n) { return checkelem (n); } + +inline double ColumnVector::elem (int n) const { return data[n]; } + +inline double +ColumnVector::checkelem (int n) const +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline double ColumnVector::operator () (int n) const { return checkelem (n); } + +inline double *ColumnVector::fortran_vec (void) { return data; } + +/* + * Row Vector class + */ + +class RowVector +{ +friend class Matrix; +friend class DiagMatrix; +friend class ColumnVector; +friend class ComplexMatrix; +friend class ComplexRowVector; +friend class ComplexDiagMatrix; + +public: + RowVector (void); + RowVector (int n); + RowVector (int n, double val); + RowVector (const RowVector& a); + RowVector (double a); + ~RowVector (void); + + RowVector& operator = (const RowVector& a); + + int capacity (void) const; + int length (void) const; + + double& elem (int n); + double& checkelem (int n); + double& operator () (int n); + + double elem (int n) const; // const access + double checkelem (int n) const; + double operator () (int n) const; + + RowVector& resize (int n); + RowVector& resize (int n, double val); + + int operator == (const RowVector& a) const; + int operator != (const RowVector& a) const; + +// destructive insert/delete/reorder operations + + RowVector& insert (const RowVector& a, int c); + + RowVector& fill (double val); + RowVector& fill (double val, int c1, int c2); + + RowVector append (const RowVector& a) const; + + ColumnVector transpose (void) const; + +// resize is the destructive equivalent for this one + + RowVector extract (int c1, int c2) const; + +// row vector by scalar -> row vector operations + + RowVector operator + (double s) const; + RowVector operator - (double s) const; + RowVector operator * (double s) const; + RowVector operator / (double s) const; + + ComplexRowVector operator + (Complex s) const; + ComplexRowVector operator - (Complex s) const; + ComplexRowVector operator * (Complex s) const; + ComplexRowVector operator / (Complex s) const; + +// scalar by row vector -> row vector operations + + friend RowVector operator + (double s, const RowVector& a); + friend RowVector operator - (double s, const RowVector& a); + friend RowVector operator * (double s, const RowVector& a); + friend RowVector operator / (double s, const RowVector& a); + +// row vector by column vector -> scalar + + double operator * (const ColumnVector& a) const; + + Complex operator * (const ComplexColumnVector& a) const; + +// row vector by matrix -> row vector + + RowVector operator * (const Matrix& a) const; + + ComplexRowVector operator * (const ComplexMatrix& a) const; + +// row vector by row vector -> row vector operations + + RowVector operator + (const RowVector& a) const; + RowVector operator - (const RowVector& a) const; + + ComplexRowVector operator + (const ComplexRowVector& a) const; + ComplexRowVector operator - (const ComplexRowVector& a) const; + + RowVector product (const RowVector& a) const; // element by element + RowVector quotient (const RowVector& a) const; // element by element + + ComplexRowVector product (const ComplexRowVector& a) const; // el by el + ComplexRowVector quotient (const ComplexRowVector& a) const; // el by el + + RowVector& operator += (const RowVector& a); + RowVector& operator -= (const RowVector& a); + +// unary operations + + RowVector operator - (void) const; + + friend RowVector map (d_d_Mapper f, const RowVector& a); + void map (d_d_Mapper f); + + double min (void) const; + double max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const RowVector& a); + +// conversions + + double *fortran_vec (void); + +private: + int len; + double *data; + + RowVector (double *d, int l); +}; + +inline RowVector::RowVector (void) { len = 0; data = 0; } +inline RowVector::RowVector (double *d, int l) { len = l; data = d; } +inline RowVector::~RowVector (void) { delete [] data; data = 0; } + +inline int RowVector::capacity (void) const { return len; } +inline int RowVector::length (void) const { return len; } + +inline double& RowVector::elem (int n) { return data[n]; } + +inline double& +RowVector::checkelem (int n) +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline double& RowVector::operator () (int n) { return checkelem (n); } + +inline double RowVector::elem (int n) const { return data[n]; } + +inline double +RowVector::checkelem (int n) const +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline double RowVector::operator () (int n) const { return checkelem (n); } + +inline double *RowVector::fortran_vec (void) { return data; } + +/* + * Diagonal Matrix class + */ + +class DiagMatrix +{ +friend class Matrix; +friend class ComplexMatrix; +friend class ComplexDiagMatrix; + +public: + DiagMatrix (void); + DiagMatrix (int n); + DiagMatrix (int n, double val); + DiagMatrix (int r, int c); + DiagMatrix (int r, int c, double val); + DiagMatrix (const RowVector& a); + DiagMatrix (const ColumnVector& a); + DiagMatrix (const DiagMatrix& a); + DiagMatrix (double a); + ~DiagMatrix (void); + + DiagMatrix& operator = (const DiagMatrix& a); + + int rows (void) const; + int cols (void) const; + int columns (void) const; + + double& elem (int r, int c); + double& checkelem (int r, int c); + double& operator () (int r, int c); + + double elem (int r, int c) const; // const access + double checkelem (int r, int c) const; + double operator () (int r, int c) const; + + DiagMatrix& resize (int r, int c); + DiagMatrix& resize (int r, int c, double val); + + int operator == (const DiagMatrix& a) const; + int operator != (const DiagMatrix& a) const; + + DiagMatrix& fill (double val); + DiagMatrix& fill (double val, int beg, int end); + DiagMatrix& fill (const ColumnVector& a); + DiagMatrix& fill (const RowVector& a); + DiagMatrix& fill (const ColumnVector& a, int beg); + DiagMatrix& fill (const RowVector& a, int beg); + + DiagMatrix transpose (void) const; + +// resize is the destructive analog for this one + + Matrix extract (int r1, int c1, int r2, int c2) const; + +// extract row or column i. + + RowVector row (int i) const; + RowVector row (char *s) const; + + ColumnVector column (int i) const; + ColumnVector column (char *s) const; + + DiagMatrix inverse (int& info) const; + DiagMatrix inverse (void) const; + +// diagonal matrix by scalar -> matrix operations + + Matrix operator + (double s) const; + Matrix operator - (double s) const; + + ComplexMatrix operator + (Complex s) const; + ComplexMatrix operator - (Complex s) const; + +// diagonal matrix by scalar -> diagonal matrix operations + + DiagMatrix operator * (double s) const; + DiagMatrix operator / (double s) const; + + ComplexDiagMatrix operator * (Complex s) const; + ComplexDiagMatrix operator / (Complex s) const; + +// scalar by diagonal matrix -> matrix operations + + friend Matrix operator + (double s, const DiagMatrix& a); + friend Matrix operator - (double s, const DiagMatrix& a); + +// scalar by diagonal matrix -> diagonal matrix operations + + friend DiagMatrix operator * (double s, const DiagMatrix& a); + friend DiagMatrix operator / (double s, const DiagMatrix& a); + +// diagonal matrix by column vector -> column vector operations + + ColumnVector operator * (const ColumnVector& a) const; + + ComplexColumnVector operator * (const ComplexColumnVector& a) const; + +// diagonal matrix by diagonal matrix -> diagonal matrix operations + + DiagMatrix operator + (const DiagMatrix& a) const; + DiagMatrix operator - (const DiagMatrix& a) const; + DiagMatrix operator * (const DiagMatrix& a) const; + + ComplexDiagMatrix operator + (const ComplexDiagMatrix& a) const; + ComplexDiagMatrix operator - (const ComplexDiagMatrix& a) const; + ComplexDiagMatrix operator * (const ComplexDiagMatrix& a) const; + + DiagMatrix product (const DiagMatrix& a) const; // element by element + DiagMatrix quotient (const DiagMatrix& a) const; // element by element + + ComplexDiagMatrix product (const ComplexDiagMatrix& a) const; // el by el + ComplexDiagMatrix quotient (const ComplexDiagMatrix& a) const; // el by el + + DiagMatrix& operator += (const DiagMatrix& a); + DiagMatrix& operator -= (const DiagMatrix& a); + +// diagonal matrix by matrix -> matrix operations + + Matrix operator + (const Matrix& a) const; + Matrix operator - (const Matrix& a) const; + Matrix operator * (const Matrix& a) const; + + ComplexMatrix operator + (const ComplexMatrix& a) const; + ComplexMatrix operator - (const ComplexMatrix& a) const; + ComplexMatrix operator * (const ComplexMatrix& a) const; + +// unary operations + + DiagMatrix operator - (void) const; + + ColumnVector diag (void) const; + ColumnVector diag (int k) const; + +// i/o + + friend ostream& operator << (ostream& os, const DiagMatrix& a); + +private: + int nr; + int nc; + int len; + double *data; + + DiagMatrix (double *d, int nr, int nc); +}; + +inline DiagMatrix::DiagMatrix (void) + { nr = 0; nc = 0; len = 0; data = 0; } + +inline DiagMatrix::DiagMatrix (double *d, int r, int c) + { nr = r; nc = c; len = nr < nc ? nr : nc; data = d; } + +inline DiagMatrix::~DiagMatrix (void) { delete [] data; data = 0; } + +inline int DiagMatrix::rows (void) const { return len; } +inline int DiagMatrix::cols (void) const { return len; } +inline int DiagMatrix::columns (void) const { return len; } + +// Would be nice to be able to avoid compiler warning and make this +// fail on assignment. +inline double& DiagMatrix::elem (int r, int c) + { return (r == c) ? data[r] : 0; } + +inline double& DiagMatrix::checkelem (int r, int c) +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline double& DiagMatrix::operator () (int r, int c) + { return checkelem (r, c); } + +inline double DiagMatrix::elem (int r, int c) const + { return (r == c) ? data[r] : 0; } + +inline double DiagMatrix::checkelem (int r, int c) const +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline double DiagMatrix::operator () (int r, int c) const + { return checkelem (r, c); } + +/* + * Complex Matrix class + */ + +class ComplexMatrix +{ +friend class Matrix; +friend class DiagMatrix; +friend class ComplexRowVector; +friend class ComplexDiagMatrix; +friend class EIG; +friend class ComplexHESS; +friend class ComplexSVD; +friend class ComplexSCHUR; +friend class ComplexLU; +friend class ComplexQR; + +public: + ComplexMatrix (void); + ComplexMatrix (int r, int c); + ComplexMatrix (int r, int c, double val); + ComplexMatrix (int r, int c, Complex val); + ComplexMatrix (const Matrix& a); + ComplexMatrix (const ComplexMatrix& a); + ComplexMatrix (const DiagMatrix& a); + ComplexMatrix (const ComplexDiagMatrix& a); + ComplexMatrix (double a); + ComplexMatrix (Complex a); + ~ComplexMatrix (void); + + ComplexMatrix& operator = (const Matrix& a); + ComplexMatrix& operator = (const ComplexMatrix& a); + + int rows (void) const; + int cols (void) const; + int columns (void) const; + + Complex& elem (int r, int c); + Complex& checkelem (int r, int c); + Complex& operator () (int r, int c); + + Complex elem (int r, int c) const; // const access + Complex checkelem (int r, int c) const; + Complex operator () (int r, int c) const; + + ComplexMatrix& resize (int r, int c); + ComplexMatrix& resize (int r, int c, double val); + ComplexMatrix& resize (int r, int c, Complex val); + + int operator == (const ComplexMatrix& a) const; + int operator != (const ComplexMatrix& a) const; + +// destructive insert/delete/reorder operations + + ComplexMatrix& insert (const Matrix& a, int r, int c); + ComplexMatrix& insert (const RowVector& a, int r, int c); + ComplexMatrix& insert (const ColumnVector& a, int r, int c); + ComplexMatrix& insert (const DiagMatrix& a, int r, int c); + + ComplexMatrix& insert (const ComplexMatrix& a, int r, int c); + ComplexMatrix& insert (const ComplexRowVector& a, int r, int c); + ComplexMatrix& insert (const ComplexColumnVector& a, int r, int c); + ComplexMatrix& insert (const ComplexDiagMatrix& a, int r, int c); + + ComplexMatrix& fill (double val); + ComplexMatrix& fill (Complex val); + ComplexMatrix& fill (double val, int r1, int c1, int r2, int c2); + ComplexMatrix& fill (Complex val, int r1, int c1, int r2, int c2); + + ComplexMatrix append (const Matrix& a) const; + ComplexMatrix append (const RowVector& a) const; + ComplexMatrix append (const ColumnVector& a) const; + ComplexMatrix append (const DiagMatrix& a) const; + + ComplexMatrix append (const ComplexMatrix& a) const; + ComplexMatrix append (const ComplexRowVector& a) const; + ComplexMatrix append (const ComplexColumnVector& a) const; + ComplexMatrix append (const ComplexDiagMatrix& a) const; + + ComplexMatrix stack (const Matrix& a) const; + ComplexMatrix stack (const RowVector& a) const; + ComplexMatrix stack (const ColumnVector& a) const; + ComplexMatrix stack (const DiagMatrix& a) const; + + ComplexMatrix stack (const ComplexMatrix& a) const; + ComplexMatrix stack (const ComplexRowVector& a) const; + ComplexMatrix stack (const ComplexColumnVector& a) const; + ComplexMatrix stack (const ComplexDiagMatrix& a) const; + + ComplexMatrix hermitian (void) const; // complex conjugate transpose + ComplexMatrix transpose (void) const; + + friend Matrix real (const ComplexMatrix& a); + friend Matrix imag (const ComplexMatrix& a); + friend ComplexMatrix conj (const ComplexMatrix& a); + +// resize is the destructive equivalent for this one + + ComplexMatrix extract (int r1, int c1, int r2, int c2) const; + +// extract row or column i. + + ComplexRowVector row (int i) const; + ComplexRowVector row (char *s) const; + + ComplexColumnVector column (int i) const; + ComplexColumnVector column (char *s) const; + + ComplexMatrix inverse (int& info, double& rcond) const; + ComplexMatrix inverse (int& info) const; + ComplexMatrix inverse (void) const; + + ComplexMatrix fourier (void) const; + ComplexMatrix ifourier (void) const; + + ComplexDET determinant (void) const; + ComplexDET determinant (int& info) const; + ComplexDET determinant (int& info, double& rcond) const; + + ComplexMatrix solve (const Matrix& b) const; + ComplexMatrix solve (const Matrix& b, int& info) const; + ComplexMatrix solve (const Matrix& b, int& info, double& rcond) const; + + ComplexMatrix solve (const ComplexMatrix& b) const; + ComplexMatrix solve (const ComplexMatrix& b, int& info) const; + ComplexMatrix solve (const ComplexMatrix& b, int& info, double& rcond) const; + + ComplexColumnVector solve (const ColumnVector& b) const; + ComplexColumnVector solve (const ColumnVector& b, int& info) const; + ComplexColumnVector solve (const ColumnVector& b, int& info, + double& rcond) const; + + ComplexColumnVector solve (const ComplexColumnVector& b) const; + ComplexColumnVector solve (const ComplexColumnVector& b, int& info) const; + ComplexColumnVector solve (const ComplexColumnVector& b, int& info, + double& rcond) const; + + ComplexMatrix lssolve (const Matrix& b) const; + ComplexMatrix lssolve (const Matrix& b, int& info) const; + ComplexMatrix lssolve (const Matrix& b, int& info, int& rank) const; + + ComplexMatrix lssolve (const ComplexMatrix& b) const; + ComplexMatrix lssolve (const ComplexMatrix& b, int& info) const; + ComplexMatrix lssolve (const ComplexMatrix& b, int& info, + int& rank) const; + + ComplexColumnVector lssolve (const ColumnVector& b) const; + ComplexColumnVector lssolve (const ColumnVector& b, int& info) const; + ComplexColumnVector lssolve (const ColumnVector& b, int& info, + int& rank) const; + + ComplexColumnVector lssolve (const ComplexColumnVector& b) const; + ComplexColumnVector lssolve (const ComplexColumnVector& b, int& info) const; + ComplexColumnVector lssolve (const ComplexColumnVector& b, int& info, + int& rank) const; + +// matrix by scalar -> matrix operations + + ComplexMatrix operator + (double s) const; + ComplexMatrix operator - (double s) const; + ComplexMatrix operator * (double s) const; + ComplexMatrix operator / (double s) const; + + ComplexMatrix operator + (Complex s) const; + ComplexMatrix operator - (Complex s) const; + ComplexMatrix operator * (Complex s) const; + ComplexMatrix operator / (Complex s) const; + +// scalar by matrix -> matrix operations + + friend ComplexMatrix operator + (double s, const ComplexMatrix& a); + friend ComplexMatrix operator - (double s, const ComplexMatrix& a); + friend ComplexMatrix operator * (double s, const ComplexMatrix& a); + friend ComplexMatrix operator / (double s, const ComplexMatrix& a); + + friend ComplexMatrix operator + (Complex s, const ComplexMatrix& a); + friend ComplexMatrix operator - (Complex s, const ComplexMatrix& a); + friend ComplexMatrix operator * (Complex s, const ComplexMatrix& a); + friend ComplexMatrix operator / (Complex s, const ComplexMatrix& a); + +// matrix by column vector -> column vector operations + + ComplexColumnVector operator * (const ColumnVector& a) const; + + ComplexColumnVector operator * (const ComplexColumnVector& a) const; + +// matrix by diagonal matrix -> matrix operations + + ComplexMatrix operator + (const DiagMatrix& a) const; + ComplexMatrix operator - (const DiagMatrix& a) const; + ComplexMatrix operator * (const DiagMatrix& a) const; + + ComplexMatrix operator + (const ComplexDiagMatrix& a) const; + ComplexMatrix operator - (const ComplexDiagMatrix& a) const; + ComplexMatrix operator * (const ComplexDiagMatrix& a) const; + + ComplexMatrix& operator += (const DiagMatrix& a); + ComplexMatrix& operator -= (const DiagMatrix& a); + + ComplexMatrix& operator += (const ComplexDiagMatrix& a); + ComplexMatrix& operator -= (const ComplexDiagMatrix& a); + +// matrix by matrix -> matrix operations + + ComplexMatrix operator + (const Matrix& a) const; + ComplexMatrix operator - (const Matrix& a) const; + ComplexMatrix operator * (const Matrix& a) const; + + ComplexMatrix operator + (const ComplexMatrix& a) const; + ComplexMatrix operator - (const ComplexMatrix& a) const; + ComplexMatrix operator * (const ComplexMatrix& a) const; + + ComplexMatrix product (const Matrix& a) const; // element by element + ComplexMatrix quotient (const Matrix& a) const; // element by element + + ComplexMatrix product (const ComplexMatrix& a) const; // element by element + ComplexMatrix quotient (const ComplexMatrix& a) const; // element by element + + ComplexMatrix& operator += (const Matrix& a); + ComplexMatrix& operator -= (const Matrix& a); + + ComplexMatrix& operator += (const ComplexMatrix& a); + ComplexMatrix& operator -= (const ComplexMatrix& a); + +// unary operations + + ComplexMatrix operator - (void) const; + Matrix operator ! (void) const; + +// other operations + + friend ComplexMatrix map (c_c_Mapper f, const ComplexMatrix& a); + friend Matrix map (d_c_Mapper f, const ComplexMatrix& a); + void map (c_c_Mapper f); + + Matrix all (void) const; + Matrix any (void) const; + + ComplexMatrix cumprod (void) const; + ComplexMatrix cumsum (void) const; + ComplexMatrix prod (void) const; + ComplexMatrix sum (void) const; + ComplexMatrix sumsq (void) const; + + ComplexColumnVector diag (void) const; + ComplexColumnVector diag (int k) const; + + ComplexColumnVector row_min (void) const; + ComplexColumnVector row_max (void) const; + + ComplexRowVector column_min (void) const; + ComplexRowVector column_max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const ComplexMatrix& a); + friend istream& operator >> (istream& is, ComplexMatrix& a); + +// conversions + + Complex *fortran_vec (void); + +private: + int nr; + int nc; + int len; + Complex *data; + + ComplexMatrix (Complex *d, int r, int c); +}; + +inline ComplexMatrix::ComplexMatrix (void) + { nr = 0; nc = 0; len = 0; data = 0; } + +inline ComplexMatrix::ComplexMatrix (Complex *d, int r, int c) + { nr = r; nc = c; len = nr*nc; data = d; } + +inline ComplexMatrix::~ComplexMatrix (void) { delete [] data; data = 0; } + +inline int ComplexMatrix::rows (void) const { return nr; } +inline int ComplexMatrix::cols (void) const { return nc; } +inline int ComplexMatrix::columns (void) const { return nc; } + +inline Complex& ComplexMatrix::elem (int r, int c) { return data[nr*c+r]; } + +inline Complex& ComplexMatrix::checkelem (int r, int c) +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline Complex& ComplexMatrix::operator () (int r, int c) + { return checkelem (r, c); } + +inline Complex ComplexMatrix::elem (int r, int c) const + { return data[nr*c+r]; } + +inline Complex ComplexMatrix::checkelem (int r, int c) const +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline Complex ComplexMatrix::operator () (int r, int c) const + { return checkelem (r, c); } + +inline Complex *ComplexMatrix::fortran_vec (void) { return data; } + +/* + * Complex Column Vector class + */ + +class ComplexColumnVector +{ +friend class DiagMatrix; +friend class ComplexMatrix; +friend class ColumnVector; +friend class ComplexDiagMatrix; + +public: + ComplexColumnVector (void); + ComplexColumnVector (int n); + ComplexColumnVector (int n, double val); + ComplexColumnVector (int n, Complex val); + ComplexColumnVector (const ColumnVector& a); + ComplexColumnVector (const ComplexColumnVector& a); + ComplexColumnVector (double a); + ComplexColumnVector (Complex a); + ~ComplexColumnVector (void); + + ComplexColumnVector& operator = (const ColumnVector& a); + ComplexColumnVector& operator = (const ComplexColumnVector& a); + + int capacity (void) const; + int length (void) const; + + Complex& elem (int n); + Complex& checkelem (int n); + Complex& operator () (int n); + + Complex elem (int n) const; // const access + Complex checkelem (int n) const; + Complex operator () (int n) const; + + ComplexColumnVector& resize (int n); + ComplexColumnVector& resize (int n, double val); + ComplexColumnVector& resize (int n, Complex val); + + int operator == (const ComplexColumnVector& a) const; + int operator != (const ComplexColumnVector& a) const; + +// destructive insert/delete/reorder operations + + ComplexColumnVector& insert (const ColumnVector& a, int r); + ComplexColumnVector& insert (const ComplexColumnVector& a, int r); + + ComplexColumnVector& fill (double val); + ComplexColumnVector& fill (Complex val); + ComplexColumnVector& fill (double val, int r1, int r2); + ComplexColumnVector& fill (Complex val, int r1, int r2); + + ComplexColumnVector stack (const ColumnVector& a) const; + ComplexColumnVector stack (const ComplexColumnVector& a) const; + + ComplexRowVector hermitian (void) const; // complex conjugate transpose. + ComplexRowVector transpose (void) const; + + friend ColumnVector real (const ComplexColumnVector& a); + friend ColumnVector imag (const ComplexColumnVector& a); + friend ComplexColumnVector conj (const ComplexColumnVector& a); + +// resize is the destructive equivalent for this one + + ComplexColumnVector extract (int r1, int r2) const; + +// column vector by scalar -> column vector operations + + ComplexColumnVector operator + (double s) const; + ComplexColumnVector operator - (double s) const; + ComplexColumnVector operator * (double s) const; + ComplexColumnVector operator / (double s) const; + + ComplexColumnVector operator + (Complex s) const; + ComplexColumnVector operator - (Complex s) const; + ComplexColumnVector operator * (Complex s) const; + ComplexColumnVector operator / (Complex s) const; + +// scalar by column vector -> column vector operations + + friend ComplexColumnVector operator + (double s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator - (double s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator * (double s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator / (double s, + const ComplexColumnVector& a); + + friend ComplexColumnVector operator + (Complex s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator - (Complex s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator * (Complex s, + const ComplexColumnVector& a); + friend ComplexColumnVector operator / (Complex s, + const ComplexColumnVector& a); + +// column vector by row vector -> matrix operations + + ComplexMatrix operator * (const RowVector& a) const; + + ComplexMatrix operator * (const ComplexRowVector& a) const; + +// column vector by column vector -> column vector operations + + ComplexColumnVector operator + (const ColumnVector& a) const; + ComplexColumnVector operator - (const ColumnVector& a) const; + + ComplexColumnVector operator + (const ComplexColumnVector& a) const; + ComplexColumnVector operator - (const ComplexColumnVector& a) const; + + ComplexColumnVector product (const ColumnVector& a) const; // el by el + ComplexColumnVector quotient (const ColumnVector& a) const; // el by el + + ComplexColumnVector product (const ComplexColumnVector& a) const; + ComplexColumnVector quotient (const ComplexColumnVector& a) const; + + ComplexColumnVector& operator += (const ColumnVector& a); + ComplexColumnVector& operator -= (const ColumnVector& a); + + ComplexColumnVector& operator += (const ComplexColumnVector& a); + ComplexColumnVector& operator -= (const ComplexColumnVector& a); + +// unary operations + + ComplexColumnVector operator - (void) const; + + friend ComplexColumnVector map (c_c_Mapper f, const ComplexColumnVector& a); + friend ColumnVector map (d_c_Mapper f, const ComplexColumnVector& a); + void map (c_c_Mapper f); + + Complex min (void) const; + Complex max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const ComplexColumnVector& a); + +// conversions + + Complex *fortran_vec (void); + +private: + int len; + Complex *data; + + ComplexColumnVector (Complex *d, int l); +}; + +inline ComplexColumnVector::ComplexColumnVector (void) { len = 0; data = 0; } +inline ComplexColumnVector::ComplexColumnVector (Complex *d, int l) + { len = l; data = d; } +inline ComplexColumnVector::~ComplexColumnVector (void) + { delete [] data; data = 0; } + +inline int ComplexColumnVector::capacity (void) const { return len; } +inline int ComplexColumnVector::length (void) const { return len; } + +inline Complex& ComplexColumnVector::elem (int n) { return data[n]; } + +inline Complex& +ComplexColumnVector::checkelem (int n) +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline Complex& ComplexColumnVector::operator () (int n) + { return checkelem (n); } + +inline Complex ComplexColumnVector::elem (int n) const { return data[n]; } + +inline Complex +ComplexColumnVector::checkelem (int n) const +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline Complex ComplexColumnVector::operator () (int n) const + { return checkelem (n); } + +inline Complex *ComplexColumnVector::fortran_vec (void) { return data; } + +/* + * Complex Row Vector class + */ + +class ComplexRowVector +{ +friend class RowVector; +friend class ComplexMatrix; +friend class ComplexColumnVector; +friend class ComplexDiagMatrix; + +public: + ComplexRowVector (void); + ComplexRowVector (int n); + ComplexRowVector (int n, double val); + ComplexRowVector (int n, Complex val); + ComplexRowVector (const RowVector& a); + ComplexRowVector (const ComplexRowVector& a); + ComplexRowVector (double a); + ComplexRowVector (Complex a); + ~ComplexRowVector (void); + + ComplexRowVector& operator = (const RowVector& a); + ComplexRowVector& operator = (const ComplexRowVector& a); + + int capacity (void) const; + int length (void) const; + + Complex& checkelem (int n); + Complex& elem (int n); + Complex& operator () (int n); + + Complex checkelem (int n) const; // const access + Complex elem (int n) const; + Complex operator () (int n) const; + + ComplexRowVector& resize (int n); + ComplexRowVector& resize (int n, double val); + ComplexRowVector& resize (int n, Complex val); + + int operator == (const ComplexRowVector& a) const; + int operator != (const ComplexRowVector& a) const; + +// destructive insert/delete/reorder operations + + ComplexRowVector& insert (const RowVector& a, int c); + ComplexRowVector& insert (const ComplexRowVector& a, int c); + + ComplexRowVector& fill (double val); + ComplexRowVector& fill (Complex val); + ComplexRowVector& fill (double val, int c1, int c2); + ComplexRowVector& fill (Complex val, int c1, int c2); + + ComplexRowVector append (const RowVector& a) const; + ComplexRowVector append (const ComplexRowVector& a) const; + + ComplexColumnVector hermitian (void) const; // complex conjugate transpose. + ComplexColumnVector transpose (void) const; + + friend RowVector real (const ComplexRowVector& a); + friend RowVector imag (const ComplexRowVector& a); + friend ComplexRowVector conj (const ComplexRowVector& a); + +// resize is the destructive equivalent for this one + + ComplexRowVector extract (int c1, int c2) const; + +// row vector by scalar -> row vector operations + + ComplexRowVector operator + (double s) const; + ComplexRowVector operator - (double s) const; + ComplexRowVector operator * (double s) const; + ComplexRowVector operator / (double s) const; + + ComplexRowVector operator + (Complex s) const; + ComplexRowVector operator - (Complex s) const; + ComplexRowVector operator * (Complex s) const; + ComplexRowVector operator / (Complex s) const; + +// scalar by row vector -> row vector operations + + friend ComplexRowVector operator + (double s, const ComplexRowVector& a); + friend ComplexRowVector operator - (double s, const ComplexRowVector& a); + friend ComplexRowVector operator * (double s, const ComplexRowVector& a); + friend ComplexRowVector operator / (double s, const ComplexRowVector& a); + + friend ComplexRowVector operator + (Complex s, const ComplexRowVector& a); + friend ComplexRowVector operator - (Complex s, const ComplexRowVector& a); + friend ComplexRowVector operator * (Complex s, const ComplexRowVector& a); + friend ComplexRowVector operator / (Complex s, const ComplexRowVector& a); + +// row vector by column vector -> scalar + + Complex operator * (const ColumnVector& a) const; + + Complex operator * (const ComplexColumnVector& a) const; + +// row vector by matrix -> row vector + + ComplexRowVector operator * (const Matrix& a) const; + + ComplexRowVector operator * (const ComplexMatrix& a) const; + +// row vector by row vector -> row vector operations + + ComplexRowVector operator + (const RowVector& a) const; + ComplexRowVector operator - (const RowVector& a) const; + + ComplexRowVector operator + (const ComplexRowVector& a) const; + ComplexRowVector operator - (const ComplexRowVector& a) const; + + ComplexRowVector product (const RowVector& a) const; // element by element + ComplexRowVector quotient (const RowVector& a) const; // element by element + + ComplexRowVector product (const ComplexRowVector& a) const; // el by el + ComplexRowVector quotient (const ComplexRowVector& a) const; // el by el + + ComplexRowVector& operator += (const RowVector& a); + ComplexRowVector& operator -= (const RowVector& a); + + ComplexRowVector& operator += (const ComplexRowVector& a); + ComplexRowVector& operator -= (const ComplexRowVector& a); + +// unary operations + + ComplexRowVector operator - (void) const; + + friend ComplexRowVector map (c_c_Mapper f, const ComplexRowVector& a); + friend RowVector map (d_c_Mapper f, const ComplexRowVector& a); + void map (c_c_Mapper f); + + Complex min (void) const; + Complex max (void) const; + +// i/o + + friend ostream& operator << (ostream& os, const ComplexRowVector& a); + +// conversions + + Complex *fortran_vec (void); + +private: + int len; + Complex *data; + + ComplexRowVector (Complex *d, int l); +}; + +inline ComplexRowVector::ComplexRowVector (void) { len = 0; data = 0; } +inline ComplexRowVector::ComplexRowVector (Complex *d, int l) + { len = l; data = d; } +inline ComplexRowVector::~ComplexRowVector (void) { delete [] data; data = 0; } + +inline int ComplexRowVector::capacity (void) const { return len; } +inline int ComplexRowVector::length (void) const { return len; } + +inline Complex& ComplexRowVector::elem (int n) { return data[n]; } + +inline Complex& +ComplexRowVector::checkelem (int n) +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline Complex& ComplexRowVector::operator () (int n) { return checkelem (n); } + +inline Complex ComplexRowVector::elem (int n) const { return data[n]; } + +inline Complex +ComplexRowVector::checkelem (int n) const +{ +#ifndef NO_RANGE_CHECK + if (n < 0 || n >= len) + FAIL; +#endif + + return elem (n); +} + +inline Complex ComplexRowVector::operator () (int n) const + { return checkelem (n); } + +inline Complex *ComplexRowVector::fortran_vec (void) { return data; } + +/* + * Complex Diagonal Matrix class + */ + +class ComplexDiagMatrix +{ +friend class Matrix; +friend class DiagMatrix; +friend class ComplexMatrix; + +public: + ComplexDiagMatrix (void); + ComplexDiagMatrix (int n); + ComplexDiagMatrix (int n, double val); + ComplexDiagMatrix (int n, Complex val); + ComplexDiagMatrix (int r, int c); + ComplexDiagMatrix (int r, int c, double val); + ComplexDiagMatrix (int r, int c, Complex val); + ComplexDiagMatrix (const RowVector& a); + ComplexDiagMatrix (const ComplexRowVector& a); + ComplexDiagMatrix (const ColumnVector& a); + ComplexDiagMatrix (const ComplexColumnVector& a); + ComplexDiagMatrix (const DiagMatrix& a); + ComplexDiagMatrix (const ComplexDiagMatrix& a); + ComplexDiagMatrix (double a); + ComplexDiagMatrix (Complex a); + ~ComplexDiagMatrix (void); + + ComplexDiagMatrix& operator = (const DiagMatrix& a); + ComplexDiagMatrix& operator = (const ComplexDiagMatrix& a); + + int rows (void) const; + int cols (void) const; + int columns (void) const; + + Complex& checkelem (int r, int c); + Complex& elem (int r, int c); + Complex& operator () (int r, int c); + + Complex checkelem (int r, int c) const; // const access + Complex elem (int r, int c) const; + Complex operator () (int r, int c) const; + + ComplexDiagMatrix& resize (int r, int c); + ComplexDiagMatrix& resize (int r, int c, double val); + ComplexDiagMatrix& resize (int r, int c, Complex val); + + int operator == (const ComplexDiagMatrix& a) const; + int operator != (const ComplexDiagMatrix& a) const; + + ComplexDiagMatrix& fill (double val); + ComplexDiagMatrix& fill (Complex val); + ComplexDiagMatrix& fill (double val, int beg, int end); + ComplexDiagMatrix& fill (Complex val, int beg, int end); + ComplexDiagMatrix& fill (const ColumnVector& a); + ComplexDiagMatrix& fill (const ComplexColumnVector& a); + ComplexDiagMatrix& fill (const RowVector& a); + ComplexDiagMatrix& fill (const ComplexRowVector& a); + ComplexDiagMatrix& fill (const ColumnVector& a, int beg); + ComplexDiagMatrix& fill (const ComplexColumnVector& a, int beg); + ComplexDiagMatrix& fill (const RowVector& a, int beg); + ComplexDiagMatrix& fill (const ComplexRowVector& a, int beg); + + ComplexDiagMatrix hermitian (void) const; // complex conjugate transpose + ComplexDiagMatrix transpose (void) const; + + friend DiagMatrix real (const ComplexDiagMatrix& a); + friend DiagMatrix imag (const ComplexDiagMatrix& a); + friend ComplexDiagMatrix conj (const ComplexDiagMatrix& a); + +// resize is the destructive analog for this one + + ComplexMatrix extract (int r1, int c1, int r2, int c2) const; + +// extract row or column i. + + ComplexRowVector row (int i) const; + ComplexRowVector row (char *s) const; + + ComplexColumnVector column (int i) const; + ComplexColumnVector column (char *s) const; + + ComplexDiagMatrix inverse (int& info) const; + ComplexDiagMatrix inverse (void) const; + +// diagonal matrix by scalar -> matrix operations + + ComplexMatrix operator + (double s) const; + ComplexMatrix operator - (double s) const; + + ComplexMatrix operator + (Complex s) const; + ComplexMatrix operator - (Complex s) const; + +// diagonal matrix by scalar -> diagonal matrix operations + + ComplexDiagMatrix operator * (double s) const; + ComplexDiagMatrix operator / (double s) const; + + ComplexDiagMatrix operator * (Complex s) const; + ComplexDiagMatrix operator / (Complex s) const; + +// scalar by diagonal matrix -> matrix operations + + friend ComplexMatrix operator + (double s, const ComplexDiagMatrix& a); + friend ComplexMatrix operator - (double s, const ComplexDiagMatrix& a); + + friend ComplexMatrix operator + (Complex s, const ComplexDiagMatrix& a); + friend ComplexMatrix operator - (Complex s, const ComplexDiagMatrix& a); + +// scalar by diagonal matrix -> diagonal matrix operations + + friend ComplexDiagMatrix operator * (double s, const ComplexDiagMatrix& a); + friend ComplexDiagMatrix operator / (double s, const ComplexDiagMatrix& a); + + friend ComplexDiagMatrix operator * (Complex s, const ComplexDiagMatrix& a); + friend ComplexDiagMatrix operator / (Complex s, const ComplexDiagMatrix& a); + +// diagonal matrix by column vector -> column vector operations + + ComplexColumnVector operator * (const ColumnVector& a) const; + + ComplexColumnVector operator * (const ComplexColumnVector& a) const; + +// diagonal matrix by diagonal matrix -> diagonal matrix operations + + ComplexDiagMatrix operator + (const DiagMatrix& a) const; + ComplexDiagMatrix operator - (const DiagMatrix& a) const; + ComplexDiagMatrix operator * (const DiagMatrix& a) const; + + ComplexDiagMatrix operator + (const ComplexDiagMatrix& a) const; + ComplexDiagMatrix operator - (const ComplexDiagMatrix& a) const; + ComplexDiagMatrix operator * (const ComplexDiagMatrix& a) const; + + ComplexDiagMatrix product (const DiagMatrix& a) const; // element by element + ComplexDiagMatrix quotient (const DiagMatrix& a) const; // element by element + + ComplexDiagMatrix product (const ComplexDiagMatrix& a) const; // el by el + ComplexDiagMatrix quotient (const ComplexDiagMatrix& a) const; // el by el + + ComplexDiagMatrix& operator += (const DiagMatrix& a); + ComplexDiagMatrix& operator -= (const DiagMatrix& a); + + ComplexDiagMatrix& operator += (const ComplexDiagMatrix& a); + ComplexDiagMatrix& operator -= (const ComplexDiagMatrix& a); + +// diagonal matrix by matrix -> matrix operations + + ComplexMatrix operator + (const Matrix& a) const; + ComplexMatrix operator - (const Matrix& a) const; + ComplexMatrix operator * (const Matrix& a) const; + + ComplexMatrix operator + (const ComplexMatrix& a) const; + ComplexMatrix operator - (const ComplexMatrix& a) const; + ComplexMatrix operator * (const ComplexMatrix& a) const; + +// unary operations + + ComplexDiagMatrix operator - (void) const; + + ComplexColumnVector diag (void) const; + ComplexColumnVector diag (int k) const; + +// i/o + + friend ostream& operator << (ostream& os, const ComplexDiagMatrix& a); + +private: + int nr; + int nc; + int len; + Complex *data; + + ComplexDiagMatrix (Complex *d, int nr, int nc); +}; + +inline ComplexDiagMatrix::ComplexDiagMatrix (void) + { nr = 0; nc = 0; len = 0; data = 0; } + +inline ComplexDiagMatrix::ComplexDiagMatrix (Complex *d, int r, int c) + { nr = r; nc = c; len = nr < nc ? nr : nc; data = d; } + +inline ComplexDiagMatrix::~ComplexDiagMatrix (void) + { delete [] data; data = 0; } + +inline int ComplexDiagMatrix::rows (void) const { return len; } +inline int ComplexDiagMatrix::cols (void) const { return len; } +inline int ComplexDiagMatrix::columns (void) const { return len; } + +// Would be nice to be able to avoid compiler warning and make this +// fail on assignment. +inline Complex& ComplexDiagMatrix::elem (int r, int c) + { Complex czero (0.0, 0.0); return (r == c) ? data[r] : czero; } + +inline Complex& ComplexDiagMatrix::checkelem (int r, int c) +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline Complex& ComplexDiagMatrix::operator () (int r, int c) + { return checkelem (r, c); } + +inline Complex ComplexDiagMatrix::elem (int r, int c) const + { Complex czero (0.0, 0.0); return (r == c) ? data[r] : czero; } + +inline Complex ComplexDiagMatrix::checkelem (int r, int c) const +{ +#ifndef NO_RANGE_CHECK + if (r < 0 || r >= nr || c < 0 || c >= nc) + FAIL; +#endif + + return elem (r, c); +} + +inline Complex ComplexDiagMatrix::operator () (int r, int c) const + { return checkelem (r, c); } + +/* + * Result of a Determinant calculation. + */ + +class DET +{ +public: + DET (void) {} + + DET (const DET& a); + + DET& operator = (const DET& a); + + int value_will_overflow (void) const; + int value_will_underflow (void) const; + double coefficient (void) const; + int exponent (void) const; + double value (void) const; + + friend ostream& operator << (ostream& os, const DET& a); + +private: + DET (const double *d); + + double det [2]; +}; + +inline DET::DET (const DET& a) { det[0] = a.det[0]; det[1] = a.det[1]; } + +inline DET& DET::operator = (const DET& a) + { det[0] = a.det[0]; det[1] = a.det[1]; return *this; } + +inline int DET::value_will_overflow (void) const + { return det[2] + 1 > log10 (MAXDOUBLE) ? 1 : 0; } + +inline int DET::value_will_underflow (void) const + { return det[2] - 1 < log10 (MINDOUBLE) ? 1 : 0; } + +inline double DET::coefficient (void) const { return det[0]; } +inline int DET::exponent (void) const { return (int) det[1]; } +inline double DET::value (void) const { return det[0] * pow (10.0, det[1]); } + +inline DET::DET (const double *d) { det[0] = d[0]; det[1] = d[1]; } + +/* + * Result of a Determinant calculation. + */ + +class ComplexDET +{ +public: + ComplexDET (void) {} + + ComplexDET (const ComplexDET& a); + + ComplexDET& operator = (const ComplexDET& a); + + int value_will_overflow (void) const; + int value_will_underflow (void) const; + Complex coefficient (void) const; + int exponent (void) const; + Complex value (void) const; + + friend ostream& operator << (ostream& os, const ComplexDET& a); + +private: + ComplexDET (const Complex *d); + + Complex det [2]; +}; + +inline ComplexDET::ComplexDET (const ComplexDET& a) + { det[0] = a.det[0]; det[1] = a.det[1]; } + +inline ComplexDET& ComplexDET::operator = (const ComplexDET& a) + { det[0] = a.det[0]; det[1] = a.det[1]; return *this; } + +inline int ComplexDET::value_will_overflow (void) const + { return real (det[2]) + 1 > log10 (MAXDOUBLE) ? 1 : 0; } + +inline int ComplexDET::value_will_underflow (void) const + { return real (det[2]) - 1 < log10 (MINDOUBLE) ? 1 : 0; } + +inline Complex ComplexDET::coefficient (void) const { return det[0]; } + +inline int ComplexDET::exponent (void) const { return (int) real (det[1]); } + +inline Complex ComplexDET::value (void) const + { return det[0] * pow (10.0, real (det[1])); } + +inline ComplexDET::ComplexDET (const Complex *d) + { det[0] = d[0]; det[1] = d[1]; } + +/* + * Result of a Hessenbug Decomposition + */ + +class HESS +{ +friend class Matrix; + +public: + HESS (void) {} + + HESS (const Matrix& a); + HESS (const Matrix&a, int& info); + + HESS (const HESS& a); + + HESS& operator = (const HESS& a); + Matrix hess_matrix (void) const; + Matrix unitary_hess_matrix (void) const; + friend ostream& operator << (ostream& os, const HESS& a); + +private: + int init (const Matrix& a); + + Matrix hess_mat; + Matrix unitary_hess_mat; +}; + +inline HESS::HESS (const Matrix& a) {init (a); } +inline HESS::HESS (const Matrix& a, int& info) { info = init(a); } +inline HESS::HESS (const HESS& a) +{ + hess_mat = a.hess_mat; + unitary_hess_mat = a.unitary_hess_mat; +} +inline HESS& +HESS::operator = (const HESS& a) +{ + hess_mat = a.hess_mat; + unitary_hess_mat = a.unitary_hess_mat; + + return *this; +} +inline Matrix HESS::hess_matrix (void) const { return hess_mat; } +inline Matrix HESS::unitary_hess_matrix (void) const {return unitary_hess_mat;} + +/* + * Result of a Hessenburg Decomposition + */ + +class ComplexHESS +{ +friend class ComplexMatrix; + +public: + ComplexHESS (void) {} + ComplexHESS (const ComplexMatrix& a); + ComplexHESS (const ComplexMatrix& a, int& info); + ComplexHESS (const ComplexHESS& a); + ComplexHESS& operator = (const ComplexHESS& a); + ComplexMatrix hess_matrix (void) const; + ComplexMatrix unitary_hess_matrix (void) const; + + friend ostream& operator << (ostream& os, const ComplexHESS& a); + +private: + int init (const ComplexMatrix& a); + + ComplexMatrix hess_mat; + ComplexMatrix unitary_hess_mat; +}; + +inline ComplexHESS::ComplexHESS (const ComplexMatrix& a) { init(a); } +inline ComplexHESS::ComplexHESS (const ComplexMatrix& a, int& info) + { info = init(a); } + +inline ComplexHESS::ComplexHESS (const ComplexHESS& a) +{ + hess_mat = a.hess_mat; + unitary_hess_mat = a.unitary_hess_mat; +} + +inline ComplexHESS& +ComplexHESS::operator = (const ComplexHESS& a) +{ + hess_mat = a.hess_mat; + unitary_hess_mat = a.unitary_hess_mat; + + return *this; +} + +inline ComplexMatrix ComplexHESS::hess_matrix (void) const + { return hess_mat; } + +inline ComplexMatrix ComplexHESS::unitary_hess_matrix (void) const + { return unitary_hess_mat; } + +/* + * Result of a Schur Decomposition + */ + +class SCHUR +{ +friend class Matrix; + +public: + SCHUR (void) {} + + SCHUR (const Matrix& a, const char *ord); + SCHUR (const Matrix& a, const char *ord, int& info); + + SCHUR (const SCHUR& a, const char *ord); + + SCHUR& operator = (const SCHUR& a, const char *ord); + + Matrix schur_matrix (void) const; + Matrix unitary_matrix (void) const; + + friend ostream& operator << (ostream& os, const SCHUR& a); + +private: + int init (const Matrix& a, const char *ord); + + Matrix schur_mat; + Matrix unitary_mat; +}; + +inline SCHUR::SCHUR (const Matrix& a, const char *ord) { init (a, ord); } + +inline SCHUR::SCHUR (const Matrix& a, const char *ord, int& info) + { info = init (a, ord); } + +inline SCHUR::SCHUR (const SCHUR& a, const char *ord) +{ + schur_mat = a.schur_mat; + unitary_mat = a.unitary_mat; +} + +inline SCHUR& +SCHUR::operator = (const SCHUR& a, const char *ord) +{ + schur_mat = a.schur_mat; + unitary_mat = a.unitary_mat; + + return *this; +} + +inline Matrix SCHUR::schur_matrix (void) const { return schur_mat; } +inline Matrix SCHUR::unitary_matrix (void) const { return unitary_mat; } + +/* + * Result of a Schur Decomposition + */ + +class ComplexSCHUR +{ +friend class ComplexMatrix; + +public: + ComplexSCHUR (void) {} + + ComplexSCHUR (const ComplexMatrix& a, const char *ord); + ComplexSCHUR (const ComplexMatrix& a, const char *ord, int& info); + + ComplexSCHUR (const ComplexSCHUR& a, const char *ord); + + ComplexSCHUR& operator = (const ComplexSCHUR& a, const char *ord); + + ComplexMatrix schur_matrix (void) const; + ComplexMatrix unitary_matrix (void) const; + + friend ostream& operator << (ostream& os, const ComplexSCHUR& a); + +private: + int init (const ComplexMatrix& a, const char *ord); + + ComplexMatrix schur_mat; + ComplexMatrix unitary_mat; +}; + +inline ComplexSCHUR::ComplexSCHUR (const ComplexMatrix& a, const char *ord) + { init (a,ord); } + +inline ComplexSCHUR::ComplexSCHUR (const ComplexMatrix& a, const char *ord, + int& info) + { info = init (a,ord); } + +inline ComplexSCHUR::ComplexSCHUR (const ComplexSCHUR& a, const char *ord) +{ + schur_mat = a.schur_mat; + unitary_mat = a.unitary_mat; +} + +inline ComplexSCHUR& +ComplexSCHUR::operator = (const ComplexSCHUR& a, const char *ord) +{ + schur_mat = a.schur_mat; + unitary_mat = a.unitary_mat; + + return *this; +} +inline ComplexMatrix ComplexSCHUR::schur_matrix (void) const + { return schur_mat; } + +inline ComplexMatrix ComplexSCHUR::unitary_matrix (void) const + { return unitary_mat; } + + +/* + * Result of a Singular Value Decomposition. + */ + +class SVD +{ +friend class Matrix; + +public: + SVD (void) {} + + SVD (const Matrix& a); + SVD (const Matrix& a, int& info); + + SVD (const SVD& a); + + SVD& operator = (const SVD& a); + + DiagMatrix singular_values (void) const; + Matrix left_singular_matrix (void) const; + Matrix right_singular_matrix (void) const; + + friend ostream& operator << (ostream& os, const SVD& a); + +private: + int init (const Matrix& a); + + DiagMatrix sigma; + Matrix left_sm; + Matrix right_sm; +}; + +inline SVD::SVD (const Matrix& a) { init (a); } + +inline SVD::SVD (const Matrix& a, int& info) { info = init (a); } + +inline SVD::SVD (const SVD& a) +{ + sigma = a.sigma; + left_sm = a.left_sm; + right_sm = a.right_sm; +} + +inline SVD& +SVD::operator = (const SVD& a) +{ + sigma = a.sigma; + left_sm = a.left_sm; + right_sm = a.right_sm; + + return *this; +} + +inline DiagMatrix SVD::singular_values (void) const { return sigma; } +inline Matrix SVD::left_singular_matrix (void) const { return left_sm; } +inline Matrix SVD::right_singular_matrix (void) const { return right_sm; } + +/* + * Result of a Singular Value Decomposition. + */ + +class ComplexSVD +{ +friend class ComplexMatrix; + +public: + ComplexSVD (void) {} + + ComplexSVD (const ComplexMatrix& a); + ComplexSVD (const ComplexMatrix& a, int& info); + + ComplexSVD (const ComplexSVD& a); + + ComplexSVD& operator = (const ComplexSVD& a); + + DiagMatrix singular_values (void) const; + ComplexMatrix left_singular_matrix (void) const; + ComplexMatrix right_singular_matrix (void) const; + + friend ostream& operator << (ostream& os, const ComplexSVD& a); + +private: + int init (const ComplexMatrix& a); + + DiagMatrix sigma; + ComplexMatrix left_sm; + ComplexMatrix right_sm; +}; + +inline ComplexSVD::ComplexSVD (const ComplexMatrix& a) { init (a); } +inline ComplexSVD::ComplexSVD (const ComplexMatrix& a, int& info) + { info = init (a); } + +inline ComplexSVD::ComplexSVD (const ComplexSVD& a) +{ + sigma = a.sigma; + left_sm = a.left_sm; + right_sm = a.right_sm; +} + +inline ComplexSVD& +ComplexSVD::operator = (const ComplexSVD& a) +{ + sigma = a.sigma; + left_sm = a.left_sm; + right_sm = a.right_sm; + + return *this; +} + +inline DiagMatrix ComplexSVD::singular_values (void) const + { return sigma; } + +inline ComplexMatrix ComplexSVD::left_singular_matrix (void) const + { return left_sm; } + +inline ComplexMatrix ComplexSVD::right_singular_matrix (void) const + { return right_sm; } + +/* + * Result of an Eigenvalue computation. + */ + +class EIG +{ +friend class Matrix; +friend class ComplexMatrix; + +public: + EIG (void) {} + + EIG (const Matrix& a); + EIG (const Matrix& a, int& info); + + EIG (const ComplexMatrix& a); + EIG (const ComplexMatrix& a, int& info); + + EIG (const EIG& a); + + EIG& operator = (const EIG& a); + + ComplexColumnVector eigenvalues (void) const; + ComplexMatrix eigenvectors (void) const; + + friend ostream& operator << (ostream& os, const EIG& a); + +private: + int init (const Matrix& a); + int init (const ComplexMatrix& a); + + ComplexColumnVector lambda; + ComplexMatrix v; +}; + +inline EIG::EIG (const Matrix& a) { init (a); } +inline EIG::EIG (const Matrix& a, int& info) { info = init (a); } + +inline EIG::EIG (const ComplexMatrix& a) { init (a); } +inline EIG::EIG (const ComplexMatrix& a, int& info) { info = init (a); } + +inline EIG::EIG (const EIG& a) { lambda = a.lambda; v = a.v; } + +inline EIG& EIG::operator = (const EIG& a) + { lambda = a.lambda; v = a.v; return *this; } + +inline ComplexColumnVector EIG::eigenvalues (void) const { return lambda; } + +inline ComplexMatrix EIG::eigenvectors (void) const { return v; } + +/* + * Result of an LU decomposition. + */ + +class LU +{ +friend class Matrix; + +public: + LU (void) {} + + LU (const Matrix& a); + + LU (const LU& a); + + LU& operator = (const LU& a); + + Matrix L (void) const; + Matrix U (void) const; + Matrix P (void) const; + + friend ostream& operator << (ostream& os, const LU& a); + +private: + + Matrix l; + Matrix u; + Matrix p; +}; + +inline LU::LU (const LU& a) { l = a.l; u = a.u; p = a.p; } + +inline LU& LU::operator = (const LU& a) + { l = a.l; u = a.u; p = a.p; return *this; } + +inline Matrix LU::L (void) const { return l; } +inline Matrix LU::U (void) const { return u; } +inline Matrix LU::P (void) const { return p; } + +class ComplexLU +{ +friend class ComplexMatrix; + +public: + ComplexLU (void) {} + + ComplexLU (const ComplexMatrix& a); + + ComplexLU (const ComplexLU& a); + + ComplexLU& operator = (const ComplexLU& a); + + ComplexMatrix L (void) const; + ComplexMatrix U (void) const; + Matrix P (void) const; + + friend ostream& operator << (ostream& os, const ComplexLU& a); + +private: + + ComplexMatrix l; + ComplexMatrix u; + Matrix p; +}; + +inline ComplexLU::ComplexLU (const ComplexLU& a) { l = a.l; u = a.u; p = a.p; } + +inline ComplexLU& ComplexLU::operator = (const ComplexLU& a) + { l = a.l; u = a.u; p = a.p; return *this; } + +inline ComplexMatrix ComplexLU::L (void) const { return l; } +inline ComplexMatrix ComplexLU::U (void) const { return u; } +inline Matrix ComplexLU::P (void) const { return p; } + +/* + * Result of a QR decomposition. + */ + +class QR +{ +public: + QR (void) {} + + QR (const Matrix& A); + + QR (const QR& a); + + QR& operator = (const QR& a); + + Matrix Q (void) const; + Matrix R (void) const; + + friend ostream& operator << (ostream& os, const QR& a); + +private: + Matrix q; + Matrix r; +}; + +inline QR::QR (const QR& a) { q = a.q; r = a.r; } + +inline QR& QR::operator = (const QR& a) { q = a.q; r = a.r; return *this; } + +inline Matrix QR::Q (void) const { return q; } +inline Matrix QR::R (void) const { return r; } + +class ComplexQR +{ +public: + ComplexQR (void) {} + + ComplexQR (const ComplexMatrix& A); + + ComplexQR (const ComplexQR& a); + + ComplexQR& operator = (const ComplexQR& a); + + ComplexMatrix Q (void) const; + ComplexMatrix R (void) const; + + friend ostream& operator << (ostream& os, const ComplexQR& a); + +private: + ComplexMatrix q; + ComplexMatrix r; +}; + +inline ComplexQR::ComplexQR (const ComplexQR& a) { q = a.q; r = a.r; } + +inline ComplexQR& ComplexQR::operator = (const ComplexQR& a) + { q = a.q; r = a.r; return *this; } + +inline ComplexMatrix ComplexQR::Q (void) const { return q; } +inline ComplexMatrix ComplexQR::R (void) const { return r; } + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLConst.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLConst.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,65 @@ +// NLConst.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "NLConst.h" + +NLConst::NLConst (void) : Bounds (), NLFunc () +{ +} + +NLConst::NLConst (int n) : Bounds (n), NLFunc () +{ +} + +NLConst::NLConst (const Vector l, const NLFunc f, const Vector u) + : Bounds (l, u), NLFunc (f) +{ +} + +NLConst::NLConst (const NLConst& a) + : Bounds (a.lb, a.ub), NLFunc (a.fun, a.jac) +{ +} + +NLConst& +NLConst::operator = (const NLConst& a) +{ + nb = a.nb; + lb = a.lb; + fun = a.fun; + jac = a.jac; + ub = a.ub; + + return *this; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLConst.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLConst.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,63 @@ +// NLConst.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_NLConst_h) +#define _NLConst_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" +#include "NLFunc.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class NLConst : public Bounds, public NLFunc +{ +public: + + NLConst (void); + NLConst (int n); + NLConst (const Vector lb, const NLFunc f, const ColumnVector ub); + NLConst (const NLConst& a); + + NLConst& operator = (const NLConst& a); + +private: + + void error (const char *msg); + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLEqn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLEqn.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,239 @@ +// NLEqn.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "NLEqn.h" +#include "f77-uscore.h" + +extern "C" +{ + int F77_FCN (hybrd1) (int (*)(), const int*, double*, double*, + const double*, int*, double*, const int*); + + int F77_FCN (hybrj1) (int (*)(), const int*, double*, double*, + double*, const int*, const double*, int*, + double*, const int*); +} + +static nonlinear_fcn user_fun; +static jacobian_fcn user_jac; + +// error handling + +void +NLEqn::error (const char* msg) +{ + cerr << "Fatal NLEqn error. " << msg << "\n"; + exit(1); +} + +// Constructors + +NLEqn::NLEqn (void) : NLFunc (), x (), n (0) {} + +NLEqn::NLEqn (const Vector& xvec, const NLFunc f) + : NLFunc (f), x (xvec), n (x.capacity ()) {} + +NLEqn::NLEqn (const NLEqn& a) : NLFunc (a.fun, a.jac), x (a.x), n (a.n) {} + +void +NLEqn::resize (int nn) +{ + if (n != nn) + { + n = nn; + x.resize (n); + } +} + +int +NLEqn::size (void) const +{ + return n; +} + +// Assignment + +NLEqn& +NLEqn::operator = (const NLEqn& a) +{ + fun = a.fun; + jac = a.jac; + x = a.n; + + return *this; +} + +Vector +NLEqn::states (void) const +{ + return x; +} + +void +NLEqn::set_states (const Vector& xvec) +{ + if (xvec.capacity () != n) + error ("dimension error"); + + x = xvec; +} + +// Other operations + +Vector +NLEqn::solve (const Vector& xvec) +{ + set_states (xvec); + int info; + return solve (info); +} + +Vector +NLEqn::solve (const Vector& xvec, int& info) +{ + set_states (xvec); + return solve (info); +} + +Vector +NLEqn::solve (void) +{ + int info; + return solve (info); +} + +int +hybrd1_fcn (int *n, double *x, double *fvec, int *iflag) +{ + int nn = *n; + Vector tmp_f (nn); + Vector tmp_x (nn); + + for (int i = 0; i < nn; i++) + tmp_x.elem (i) = x[i]; + + tmp_f = (*user_fun) (tmp_x); + + for (i = 0; i < nn; i++) + fvec[i] = tmp_f.elem (i); + + return 0; +} + +int +hybrj1_fcn (int *n, double *x, double *fvec, double *fjac, + int *ldfjac, int *iflag) +{ + int nn = *n; + Vector tmp_x (nn); + + for (int i = 0; i < nn; i++) + tmp_x.elem (i) = x[i]; + + int flag = *iflag; + if (flag == 1) + { + Vector tmp_f (nn); + + tmp_f = (*user_fun) (tmp_x); + + for (i = 0; i < nn; i++) + fvec[i] = tmp_f.elem (i); + } + else + { + Matrix tmp_fj (nn, nn); + + tmp_fj = (*user_jac) (tmp_x); + + int ld = *ldfjac; + for (int j = 0; j < nn; j++) + for (i = 0; i < nn; i++) + fjac[j*ld+i] = tmp_fj.elem (i, j); + } + + return 0; +} + +Vector +NLEqn::solve (int& info) +{ + int tmp_info = 0; + + if (n == 0) + error ("Equation set not initialized"); + + double tol = sqrt (DBL_EPSILON); + + double *fvec = new double [n]; + double *px = new double [n]; + for (int i = 0; i < n; i++) + px[i] = x.elem (i); + + user_fun = fun; + user_jac = jac; + + if (jac == NULL) + { + int lwa = (n*(3*n+13))/2; + double *wa = new double [lwa]; + + F77_FCN (hybrd1) (hybrd1_fcn, &n, px, fvec, &tol, &tmp_info, wa, &lwa); + + delete [] wa; + } + else + { + int lwa = (n*(n+13))/2; + double *wa = new double [lwa]; + double *fjac = new double [n*n]; + + F77_FCN (hybrj1) (hybrj1_fcn, &n, px, fvec, fjac, &n, &tol, + &tmp_info, wa, &lwa); + + delete [] wa; + delete [] fjac; + } + + info = tmp_info; + + Vector retval (n); + + for (i = 0; i < n; i++) + retval.elem (i) = px[i]; + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLEqn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLEqn.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,79 @@ +// NLEqn.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_NLEqn_h) +#define _NLEqn_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class NLEqn : public NLFunc +{ + public: + + NLEqn (void); + NLEqn (const Vector&, const NLFunc); + + NLEqn (const NLEqn &); + + NLEqn& operator = (const NLEqn& a); + + void resize (int); + + void set_states (const Vector&); + + Vector states (void) const; + + int size (void) const; + + Vector solve (void); + Vector solve (const Vector&); + + Vector solve (int& info); + Vector solve (const Vector&, int& info); + + private: + + int n; + Vector x; + + void error (const char* msg); + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLFunc.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLFunc.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,97 @@ +// NLFunc.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "NLFunc.h" + +NLFunc::NLFunc (void) +{ + fun = NULL; + jac = NULL; +} + +NLFunc::NLFunc (const nonlinear_fcn f) +{ + fun = f; + jac = NULL; +} + +NLFunc::NLFunc (const nonlinear_fcn f, const jacobian_fcn j) +{ + fun = f; + jac = j; +} + +NLFunc::NLFunc (const NLFunc& a) +{ + fun = a.function (); + jac = a.jacobian_function (); +} + +NLFunc& +NLFunc::operator = (const NLFunc& a) +{ + fun = a.function (); + jac = a.jacobian_function (); + + return *this; +} + +nonlinear_fcn +NLFunc::function (void) const +{ + return fun; +} + +NLFunc& +NLFunc::set_function (const nonlinear_fcn f) +{ + fun = f; + + return *this; +} + +jacobian_fcn +NLFunc::jacobian_function (void) const +{ + return jac; +} + +NLFunc& +NLFunc::set_jacobian_function (const jacobian_fcn j) +{ + jac = j; + + return *this; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLFunc.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLFunc.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,75 @@ +// NLFunc.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_NLFunc_h) +#define _NLFunc_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +typedef Vector (*nonlinear_fcn) (Vector&); +typedef Matrix (*jacobian_fcn) (Vector&); + +class NLFunc +{ +public: + + NLFunc (void); + NLFunc (const nonlinear_fcn); + NLFunc (const nonlinear_fcn, const jacobian_fcn); + + NLFunc (const NLFunc& a); + + NLFunc& operator = (const NLFunc& a); + + nonlinear_fcn function (void) const; + + NLFunc& set_function (const nonlinear_fcn f); + + jacobian_fcn jacobian_function (void) const; + + NLFunc& set_jacobian_function (const jacobian_fcn j); + +protected: + + nonlinear_fcn fun; + jacobian_fcn jac; + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NLP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NLP.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,121 @@ +// NLP.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_NLP_h) +#define _NLP_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "Objective.h" +#include "Bounds.h" +#include "LinConst.h" +#include "NLConst.h" +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class NLP +{ + public: + + NLP (void); + + NLP (const Vector& x, const Objective& phi); + + NLP (const Vector& x, const Objective& phi, const Bounds& b); + + NLP (const Vector& x, const Objective& phi, const Bounds& b, const + LinConst& lc); + + NLP (const Vector& x, const Objective& phi, const Bounds& b, const + LinConst& lc, const NLConst& nlc); + + NLP (const Vector& x, const Objective& phi, const LinConst& lc); + + NLP (const Vector& x, const Objective& phi, const LinConst& lc, + const NLConst& nlc); + + NLP (const Vector& x, const Objective& phi, const NLConst& nlc); + + NLP (const Vector& x, const Objective& phi, const Bounds& b, const + NLConst& nlc); + + int size (void) const; + + protected: + + Vector x; + Objective phi; + Bounds bnds; + LinConst lc; + NLConst nlc; +}; + +inline NLP::NLP (void) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj) + : x (xx), phi (obj) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const Bounds& b) + : x (xx), phi (obj), bnds (b) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const Bounds& b, + const LinConst& l) + : x (xx), phi (obj), bnds (b), lc (l) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const Bounds& b, + const LinConst& l, const NLConst& nl) + : x (xx), phi (obj), bnds (b), lc (l), nlc (nl) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const LinConst& l) + : x (xx), phi (obj), lc (l) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const LinConst& l, + const NLConst& nl) + : x (xx), phi (obj), lc (l), nlc (nl) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const NLConst& nl) + : x (xx), phi (obj), nlc (nl) {} + +inline NLP::NLP (const Vector& xx, const Objective& obj, const Bounds& b, + const NLConst& nl) + : x (xx), phi (obj), bnds (b), nlc (nl) {} + +inline int +NLP::size (void) const +{ + return x.capacity (); +} + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NPSOL.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NPSOL.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,329 @@ +// NPSOL.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifndef NPSOL_MISSING + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "NPSOL.h" +#include "f77-uscore.h" +#include "sun-utils.h" + +extern "C" +{ + int F77_FCN (npoptn) (char *, long); + + int F77_FCN (npsol) (int *, int *, int *, int *, int *, int *, + double *, double *, double *, int (*)(), + int (*)(), int *, int *, int *, double *, + double *, double *, double *, double *, + double *, double *, int *, int *, double *, + int *); +} + +static objective_fcn user_phi; +static gradient_fcn user_grad; +static nonlinear_fcn user_g; +static jacobian_fcn user_jac; + +int +npsol_objfun (int *mode, int *n, double *xx, double *objf, + double *objgrd, int *nstate) +{ + int nn = *n; + Vector tmp_x (nn); + + for (int i = 0; i < nn; i++) + tmp_x.elem (i) = xx[i]; + + if (*mode == 0 || *mode == 2) + { + double value = (*user_phi) (tmp_x); +#if defined (sun) && defined (__GNUC__) + assign_double (objf, value); +#else + *objf = value; +#endif + } + + if ((*mode == 1 || *mode == 2) && user_grad != NULL) + { + Vector tmp_grad (nn); + + tmp_grad = (*user_grad) (tmp_x); + + for (i = 0; i < nn; i++) + objgrd[i] = tmp_grad.elem (i); + } + + return 0; +} + +int +npsol_confun (int *mode, int *ncnln, int *n, int *nrowj, int *needc, + double *xx, double *cons, double *cjac, int *nstate) +{ + int nn = *n, nncnln = *ncnln; + Vector tmp_x (nn); + Vector tmp_c (nncnln); + + for (int i = 0; i < nn; i++) + tmp_x.elem (i) = xx[i]; + + tmp_c = (*user_g) (tmp_x); + + for (i = 0; i < nncnln; i++) + cons[i] = tmp_c.elem (i); + + if (user_jac != NULL) + { + Matrix tmp_jac (nncnln, nn); + + tmp_jac = (*user_jac) (tmp_x); + + int ld = *nrowj; + for (int j = 0; j < nn; j++) + for (i = 0; i < nncnln; i++) + cjac[i+j*ld] = tmp_jac (i, j); + } + + return 0; +} + +Vector +NPSOL::minimize (void) +{ + double objf; + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +NPSOL::minimize (double& objf) +{ + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +NPSOL::minimize (double& objf, int& inform) +{ + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +NPSOL::minimize (double& objf, int& inform, Vector& lambda) +{ + // Dimensions of various things. + + int n = x.capacity (); + int nclin = lc.size (); + int ncnln = nlc.size (); + int nrowa = 1 > nclin ? 1 : nclin; + int nrowj = 1 > ncnln ? 1 : ncnln; + int nrowr = n; + + // Informative stuff. + + int iter; + int *istate = new int [n+nclin+ncnln]; + + // User defined function stuff is defined above in the functions + // npsol_confun() and npsol_objfun(); + + // Constraint stuff. + + double dummy; + double *pclin = &dummy; + Matrix clin; + if (nclin > 0) + { + clin = lc.constraint_matrix (); + pclin = clin.fortran_vec (); + } + + double *clow = new double [n+nclin+ncnln]; + double *cup = new double [n+nclin+ncnln]; + + if (bnds.size () > 0) + { + for (int i = 0; i < n; i++) + { + clow[i] = bnds.lower_bound (i); + cup[i] = bnds.upper_bound (i); + } + } + else + { + double huge = 1.0e30; + for (int i = 0; i < n; i++) + { + clow[i] = -huge; + cup[i] = huge; + } + } + + for (int i = 0; i < nclin; i++) + { + clow[i+n] = lc.lower_bound (i); + cup[i+n] = lc.upper_bound (i); + } + + for (i = 0; i < ncnln; i++) + { + clow[i+n+nclin] = nlc.lower_bound (i); + cup[i+n+nclin] = nlc.upper_bound (i); + } + + double *c = &dummy; + double *cjac = &dummy; + if (ncnln > 0) + { + c = new double [ncnln]; + cjac = new double [nrowj*n]; + } + + // Objective stuff. + + double *objgrd = new double [n]; + + // Other stuff. + + double *r = new double [n*n]; + + lambda.resize (n+nclin+ncnln); + double *pclambda = lambda.fortran_vec (); + + // Decision variable stuff. + + double *px = x.fortran_vec (); + + // Workspace parameters. + + int lenw; + int leniw = 3 * n + nclin + 2 * ncnln; + if (nclin == 0 && ncnln == 0) + lenw = 20*n; + else if (ncnln == 0) + lenw = 2*n*(10 + n) + 11*nclin; + else + lenw = 2*n*(n + 10) + nclin*(n + 11) + ncnln*(2*n + 21); + + int *iw = new int [leniw]; + double *w = new double [lenw]; + + user_phi = phi.objective_function (); + user_grad = phi.gradient_function (); + user_g = nlc.function (); + user_jac = nlc.jacobian_function (); + + // Solve the damn thing. + + if (user_jac == NULL && user_grad == NULL) + F77_FCN (npoptn) ("Derivative Level = 0", 20L); + else if (user_jac == NULL && user_grad != NULL) + F77_FCN (npoptn) ("Derivative Level = 1", 20L); + else if (user_jac != NULL && user_grad == NULL) + F77_FCN (npoptn) ("Derivative Level = 2", 20L); + else if (user_jac != NULL && user_grad != NULL) + F77_FCN (npoptn) ("Derivative Level = 3", 20L); + + int try = 0; + while (try++ < 5) + { + + F77_FCN (npsol) (&n, &nclin, &ncnln, &nrowa, &nrowj, &nrowr, pclin, + clow, cup, npsol_confun, npsol_objfun, &inform, + &iter, istate, c, cjac, pclambda, &objf, objgrd, r, + px, iw, &leniw, w, &lenw); + + if (inform == 6 || inform == 1) + continue; + else + break; + } + + // See how it went. + + return x; +} + +Vector +NPSOL::minimize (const Vector& xnew) +{ + x = xnew; + return minimize (); +} + +Vector +NPSOL::minimize (const Vector& xnew, double& objf) +{ + x = xnew; + return minimize (objf); +} + +Vector +NPSOL::minimize (const Vector& xnew, double& objf, int& inform) +{ + x = xnew; + return minimize (objf, inform); +} + +Vector +NPSOL::minimize (const Vector& xnew, double& objf, int& inform, Vector& lambda) +{ + x = xnew; + return minimize (objf, inform, lambda); +} + +NPSOL& +NPSOL::option (char *s) +{ + long len = strlen (s); + F77_FCN (npoptn) (s, len); + return *this; +} + +void +NPSOL::set_default_options (void) +{ + F77_FCN (npoptn) ("Nolist", 6L); + F77_FCN (npoptn) ("Defaults", 8L); + F77_FCN (npoptn) ("Print Level 0", 13L); +} + +#endif /* NPSOL_MISSING */ + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/NPSOL.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/NPSOL.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,126 @@ +// NPSOL.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifndef NPSOL_MISSING + +#if !defined (_NPSOL_h) +#define _NPSOL_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "NLP.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class NPSOL : public NLP +{ + public: + + NPSOL (void) : NLP () + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi) : NLP (x, phi) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, + const Bounds& b) : NLP (x, phi, b) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, const Bounds& b, + const LinConst& lc) : NLP (x, phi, b, lc) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, const Bounds& b, + const LinConst& lc, const NLConst& nlc) : NLP (x, phi, b, lc, nlc) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, + const LinConst& lc) : NLP (x, phi, lc) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, const LinConst& lc, + const NLConst& nlc) : NLP (x, phi, lc, nlc) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, + const NLConst& nlc) : NLP (x, phi, nlc) + { set_default_options (); } + + NPSOL (const Vector& x, const Objective& phi, const Bounds& b, + const NLConst& nlc) : NLP (x, phi, b, nlc) + { set_default_options (); } + + NPSOL (const NPSOL& a); + + NPSOL& operator = (const NPSOL& a); + + Vector minimize (void); + Vector minimize (double& objf); + Vector minimize (double& objf, int& inform); + Vector minimize (double& objf, int& inform, Vector& lambda); + + Vector minimize (const Vector& x); + Vector minimize (const Vector& x, double& objf); + Vector minimize (const Vector& x, double& objf, int& inform); + Vector minimize (const Vector& x, double& objf, int& inform, Vector& lambda); + + NPSOL& option (char *s); + +private: + void set_default_options (void); + +}; + +inline NPSOL::NPSOL (const NPSOL& a) : NLP (a.x, a.phi, a.bnds, a.lc, a.nlc) + { set_default_options (); } + +inline NPSOL& +NPSOL::operator = (const NPSOL& a) +{ + x = a.x; + phi = a.phi; + bnds = a.bnds; + lc = a.lc; + nlc = a.nlc; + + cerr << "warning: NPSOL options reset to default values\n"; + + set_default_options (); + + return *this; +} + +#endif + +#endif /* NPSOL_MISSING */ + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/ODE.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/ODE.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,107 @@ +// ODE.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_ODE_h) +#define _ODE_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "ODEFunc.h" +#include "Matrix.h" + +class ODE : public ODEFunc +{ +public: + + ODE (void); + + ODE (int n); + + ODE (const ColumnVector& state, double time, const ODEFunc& f); + + virtual ~ODE (void); + + virtual int size (void) const; + virtual ColumnVector state (void) const; + virtual double time (void) const; + + virtual void force_restart (void); + virtual void initialize (const ColumnVector& x, double t); + virtual void set_stop_time (double t); + virtual void clear_stop_time (void); + + virtual ColumnVector integrate (double t); + + void integrate (int nsteps, double tstep, ostream& s); + + Matrix integrate (const ColumnVector& tout); + Matrix integrate (const ColumnVector& tout, const ColumnVector& tcrit); + +protected: + +/* + * Some of this is probably too closely related to LSODE, but hey, + * this is just a first attempt... + */ + + int n; + double t; + ColumnVector x; + + double absolute_tolerance; + double relative_tolerance; + + double stop_time; + int stop_time_set; + +private: + + int restart; + int method_flag; + int *iwork; + double *rwork; + int istate; + int itol; + int itask; + int iopt; + int liw; + int lrw; + + friend int lsode_f (int *neq, double *t, double *y, double *ydot); + + friend int lsode_j (int *neq, double *t, double *y, int *ml, int *mu, + double *pd, int *nrowpd); + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/ODEFunc.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/ODEFunc.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,95 @@ +// ODEFunc.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "ODEFunc.h" + +ODEFunc::ODEFunc (void) +{ + fun = NULL; + jac = NULL; +} + +ODEFunc::ODEFunc (ODERHSFunc f) +{ + fun = f; + jac = NULL; +} + +ODEFunc::ODEFunc (ODERHSFunc f, ODEJacFunc j) +{ + fun = f; + jac = j; +} + +ODEFunc::ODEFunc (const ODEFunc& a) +{ + fun = a.function (); + jac = a.jacobian_function (); +} + +ODEFunc& +ODEFunc::operator = (const ODEFunc& a) +{ + fun = a.function (); + jac = a.jacobian_function (); + + return *this; +} + +ODERHSFunc +ODEFunc::function (void) const +{ + return fun; +} + +ODEFunc& +ODEFunc::set_function (ODERHSFunc f) +{ + fun = f; + return *this; +} + +ODEJacFunc +ODEFunc::jacobian_function (void) const +{ + return jac; +} + +ODEFunc& +ODEFunc::set_jacobian_function (ODEJacFunc j) +{ + jac = j; + return *this; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/ODEFunc.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/ODEFunc.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,82 @@ +// ODEFunc.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_ODEFunc_h) +#define _ODEFunc_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +#ifndef _ODEFunc_typedefs +#define _ODEFunc_typedefs 1 + +typedef Vector (*ODERHSFunc) (const Vector&, double); +typedef Matrix (*ODEJacFunc) (const Vector&, double); + +#endif + +class ODEFunc +{ +public: + + ODEFunc (void); + ODEFunc (ODERHSFunc f); + ODEFunc (ODERHSFunc f, ODEJacFunc j); + + ODEFunc (const ODEFunc& a); + + ODEFunc& operator = (const ODEFunc& a); + + ODERHSFunc function (void) const; + + ODEFunc& set_function (ODERHSFunc f); + + ODEJacFunc jacobian_function (void) const; + + ODEFunc& set_jacobian_function (ODEJacFunc j); + +protected: + + ODERHSFunc fun; + + ODEJacFunc jac; + +private: +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Objective.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Objective.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,93 @@ +// Objective.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "Objective.h" + +Objective::Objective (void) +{ + phi = (objective_fcn) NULL; + grad = (gradient_fcn) NULL; +} + +Objective::Objective (const objective_fcn obj) +{ + phi = obj; + grad = (gradient_fcn) NULL; +} + +Objective::Objective (const objective_fcn obj, const gradient_fcn g) +{ + phi = obj; + grad = g; +} + +Objective::Objective (const Objective& a) +{ + phi = a.phi; + grad = a.grad; +} + +Objective& +Objective::operator = (const Objective& a) +{ + phi = a.phi; + grad = a.grad; + return *this; +} + +objective_fcn +Objective::objective_function (void) const +{ + return phi; +} + +Objective& +Objective::set_objective_function (const objective_fcn obj) +{ + phi = obj; + return *this; +} + +gradient_fcn +Objective::gradient_function (void) const +{ + return grad; +} + +Objective& +Objective::set_gradient_function (const gradient_fcn g) +{ + grad = g; + return *this; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Objective.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Objective.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,75 @@ +// Objective.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_Objective_h) +#define _Objective_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +typedef double (*objective_fcn) (Vector&); +typedef Vector (*gradient_fcn) (Vector&); + +class Objective +{ + public: + + Objective (void); + Objective (const objective_fcn); + Objective (const objective_fcn, const gradient_fcn); + + Objective (const Objective& a); + + Objective& operator = (const Objective& a); + + objective_fcn objective_function (void) const; + + Objective& set_objective_function (const objective_fcn); + + gradient_fcn gradient_function (void) const; + + Objective& set_gradient_function (const gradient_fcn); + + private: + + objective_fcn phi; + gradient_fcn grad; + +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QLD.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QLD.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,131 @@ +// QLD.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "QLD.h" +#include "f77-uscore.h" + +extern "C" +{ + int F77_FCN (qld) (int*, int*, int*, int*, int*, double*, double*, + double*, double*, double*, double*, double*, + double*, int*, int*, int*, double*, int*, int*, + int*); +} + +Vector +QLD::minimize (double& objf, int& inform) +{ + int n = x.capacity (); + + Matrix A1 = lc.eq_constraint_matrix (); + Vector b1 = lc.eq_constraint_vector (); + + Matrix A2 = lc.ineq_constraint_matrix (); + Vector b2 = lc.ineq_constraint_vector (); + + int me = A1.rows (); + int m = me + A2.rows (); + + cout << "n: " << n << "\n"; + cout << "m: " << m << "\n"; + cout << "me: " << me << "\n"; + + A1.stack (A2); + b1.stack (b2); + + int lwar = n*(3*n + 15)/2 + m + 100; + int liwar = n + 100; + + double *war = new double [lwar]; + int *iwar = new int [liwar]; + + iwar[0] = 0; + + double *u = new double [m+n+n + 100]; + + int iout = 0; + + double *px = x.fortran_vec (); + double *ph = H.fortran_vec (); + + cout << x; + cout << H; + cout << c; + + double *pc = (double *) NULL; + if (c.capacity () > 0) + pc = c.fortran_vec (); + + double *pa = (double *) NULL; + if (A1.rows () > 0 && A1.columns () > 0) + pa = A1.fortran_vec (); + + double *pb = (double *) NULL; + if (b1.capacity () > 0) + pb = b1.fortran_vec (); + + Vector xlb = bnds.lower_bounds (); + Vector xub = bnds.upper_bounds (); + if (xlb.capacity () <= 0) + { + xlb.resize (n, -1.0e30); + xub.resize (n, 1.0e30); + } + double *pxl = xlb.fortran_vec (); + double *pxu = xub.fortran_vec (); + + int mmax = m > 0 ? m : 1; + + iprint = 1; + F77_FCN (qld) (&m, &me, &mmax, &n, &n, ph, pc, pa, pb, pxl, pxu, px, + u, &iout, &inform, &iprint, war, &lwar, iwar, &liwar); + + delete war; + delete iwar; + delete u; + + objf = (x.transpose () * H * x) / 2.0; + if (c.capacity () > 0) + objf += c.transpose () * x; + + return x; +} + +void +QLD::set_default_options (void) +{ + iprint = 0; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QLD.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QLD.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,102 @@ +// QLD.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_QLD_h) +#define _QLD_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "QP.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class QLD : public QP +{ + public: + + QLD (void) : QP () + { set_default_options (); } + + QLD (const Vector& x, const Matrix& H) : QP (x, H) + { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Vector& c) : QP (x, H, c) + { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Bounds& b) : QP (x, H, b) + { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const LinConst& lc) : QP (x, H, lc) + { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b) + : QP (x, H, c, b) { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Vector& c, const LinConst& lc) + : QP (x, H, c, lc) { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Bounds& b, const LinConst& lc) + : QP (x, H, b, lc) { set_default_options (); } + + QLD (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b, + const LinConst& lc) + : QP (x, H, c, b, lc) { set_default_options (); } + + QLD (const QLD& a); + + QLD& operator = (const QLD& a); + + Vector minimize (double& objf, int& inform); + +private: + void set_default_options (void); + int iprint; +}; + +inline QLD::QLD (const QLD& a) : QP (a.x, a.H, a.c, a.bnds, a.lc) + { set_default_options (); } + +inline QLD& +QLD::operator = (const QLD& a) +{ + x = a.x; + H = a.H; + c = a.c; + bnds = a.bnds; + lc = a.lc; + iprint = a.iprint; + return *this; +} + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QP.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QP.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,158 @@ +// QP.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "QP.h" + +QP::QP (void) {} + +QP::QP (const Vector& x0, const Matrix& H_arg) : x (x0), H (H_arg) +{ + make_h_symmetric (); +} + +QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg) + : x (x0), H (H_arg), c (c_arg) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const Bounds& b) + : x (x0), H (H_arg), bnds (b) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const LinConst& l) + : x (x0), H (H_arg), lc (l) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, + const Bounds& b) + : x (x0), H (H_arg), c (c_arg), bnds (b) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, + const LinConst& l) + : x (x0), H (H_arg), c (c_arg), lc (l) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const Bounds& b, + const LinConst& l) + : x (x0), H (H_arg), bnds (b), lc (l) +{ + make_h_symmetric (); +} + + +QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, + const Bounds& b, const LinConst& l) + : x (x0), H (H_arg), c (c_arg), bnds (b), lc (l) +{ + make_h_symmetric (); +} + +Matrix +QP::make_h_symmetric (void) +{ + return 0.5 * (H + H.transpose ()); +} + +Vector +QP::minimize (void) +{ + double objf; + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (double& objf) +{ + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (double& objf, int& inform) +{ + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (const Vector& x0) +{ + x = x0; + double objf; + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (const Vector& x0, double& objf) +{ + x = x0; + int inform; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (const Vector& x0, double& objf, int& inform) +{ + x = x0; + Vector lambda; + return minimize (objf, inform, lambda); +} + +Vector +QP::minimize (const Vector& x0, double& objf, int& inform, Vector& lambda) +{ + x = x0; + return minimize (objf, inform, lambda); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QP.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,85 @@ +// QP.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_QP_h) +#define _QP_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "Bounds.h" +#include "LinConst.h" +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class QP +{ + public: + + QP (void); + QP (const Vector& x, const Matrix& H); + QP (const Vector& x, const Matrix& H, const Vector& c); + QP (const Vector& x, const Matrix& H, const Bounds& b); + QP (const Vector& x, const Matrix& H, const LinConst& lc); + QP (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b); + QP (const Vector& x, const Matrix& H, const Vector& c, const LinConst& lc); + QP (const Vector& x, const Matrix& H, const Bounds& b, const LinConst& lc); + QP (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b, + const LinConst& lc); + + virtual Vector minimize (void); + virtual Vector minimize (double& objf); + virtual Vector minimize (double& objf, int& inform); + virtual Vector minimize (double& objf, int& inform, Vector& lambda) = 0; + + virtual Vector minimize (const Vector& x); + virtual Vector minimize (const Vector& x, double& objf); + virtual Vector minimize (const Vector& x, double& objf, int& inform); + virtual Vector minimize (const Vector& x, double& objf, int& inform, + Vector& lambda); + + protected: + + Vector x; + Matrix H; + Vector c; + Bounds bnds; + LinConst lc; + + private: + + Matrix make_h_symmetric (void); +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QPSOL.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QPSOL.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,182 @@ +// QPSOL.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include +#include "QPSOL.h" +#include "f77-uscore.h" + +extern "C" +{ + int F77_FCN (qpsol) (int*, int*, int*, int*, int*, int*, int*, int*, + double*, double*, double*, double*, double*, + double*, double*, int (*)(), int*, int*, int*, + int*, double*, int*, int*, double*, double*, + int*, int*, double*, int*); + + int F77_FCN (dgemv) (const char*, const int*, const int*, + const double*, const double*, const int*, + const double*, const int*, const double*, + double*, const int*, long); +} + +int +qphess (int *pn, int *pnrowh, int *ncolh, int *pcol, double *hess, + double *x, double *hx) +{ + int n = *pn; + int nrowh = *pnrowh; + int jthcol = *pcol; + + if (jthcol > 0) + { + int hp = (jthcol - 1) * nrowh; + for (int i = 0; i < n; i++) + hx[i] = hess[hp+i]; + } + else + { + char trans = 'N'; + double alpha = 1.0; + double beta = 0.0; + int i_one = 1; + + F77_FCN (dgemv) (&trans, pn, pn, &alpha, hess, pn, x, &i_one, + &beta, hx, &i_one, 1L); + } + + return 0; +} + +Vector +QPSOL::minimize (double& objf, int& inform, Vector& lambda) +{ + int i; + + int n = x.capacity (); + + int itmax = 50 * n; + int msglvl = 0; + int nclin = lc.size (); + int nctotl = nclin + n; + + double bigbnd = 1e30; + + double dummy; + double *pa = &dummy; + Matrix clin; + if (nclin > 0) + { + clin = lc.constraint_matrix (); + pa = clin.fortran_vec (); + } + + double *pbl = new double [nctotl]; + double *pbu = new double [nctotl]; + + if (bnds.size () > 0) + { + for (i = 0; i < n; i++) + { + pbl[i] = bnds.lower_bound (i); + pbu[i] = bnds.upper_bound (i); + } + } + else + { + for (i = 0; i < n; i++) + { + pbl[i] = -bigbnd; + pbu[i] = bigbnd; + } + } + + for (i = 0; i < nclin; i++) + { + pbl[i+n] = lc.lower_bound (i); + pbu[i+n] = lc.upper_bound (i); + } + + double *pc = c.fortran_vec (); + + double sqrt_eps = sqrt (DBL_EPSILON); + double *featol = new double [nctotl]; + for (i = 0; i < nctotl; i++) + featol[i] = sqrt_eps; + + double *ph = H.fortran_vec (); + + int cold = 1; + int lp = 0; + int orthog = 1; + + int *istate = new int [nctotl]; + + double *px = x.fortran_vec (); + + int iter = 0; + lambda.resize (nctotl); + double *pclambda = lambda.fortran_vec (); + + int tmp = n < nclin ? n : nclin; + int leniw = n + 2 + tmp; + + int lenw; + int ncon = nclin > 1 ? nclin : 1; + if (lp == 0 || nclin >= n) + lenw = 2*n*(n + 2) + nclin + 2*ncon; + else + lenw = 2*ncon*(1 + ncon) + 4*n + nclin; + + int *iw = new int [leniw]; + double *w = new double [lenw]; + + F77_FCN (qpsol) (&itmax, &msglvl, &n, &nclin, &nctotl, &n, &n, &n, + &bigbnd, pa, pbl, pbu, pc, featol, ph, qphess, + &cold, &lp, &orthog, istate, px, &inform, &iter, + &objf, pclambda, iw, &leniw, w, &lenw); + + delete [] featol; + delete [] istate; + delete [] iw; + delete [] w; + + return x; +} + +void +QPSOL::set_default_options (void) +{ + iprint = 0; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/QPSOL.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/QPSOL.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,102 @@ +// QPSOL.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_QPSOL_h) +#define _QPSOL_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "QP.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +class QPSOL : public QP +{ + public: + + QPSOL (void) : QP () + { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H) : QP (x, H) + { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Vector& c) : QP (x, H, c) + { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Bounds& b) : QP (x, H, b) + { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const LinConst& lc) : QP (x, H, lc) + { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b) + : QP (x, H, c, b) { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Vector& c, const LinConst& lc) + : QP (x, H, c, lc) { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Bounds& b, const LinConst& lc) + : QP (x, H, b, lc) { set_default_options (); } + + QPSOL (const Vector& x, const Matrix& H, const Vector& c, const Bounds& b, + const LinConst& lc) + : QP (x, H, c, b, lc) { set_default_options (); } + + QPSOL (const QPSOL& a); + + QPSOL& operator = (const QPSOL& a); + + Vector minimize (double& objf, int& inform, Vector& lambda); + +private: + void set_default_options (void); + int iprint; +}; + +inline QPSOL::QPSOL (const QPSOL& a) : QP (a.x, a.H, a.c, a.bnds, a.lc) + { set_default_options (); } + +inline QPSOL& +QPSOL::operator = (const QPSOL& a) +{ + x = a.x; + H = a.H; + c = a.c; + bnds = a.bnds; + lc = a.lc; + iprint = a.iprint; + return *this; +} + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Quad.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Quad.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,245 @@ +// Quad.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include +#include "Quad.h" +#include "f77-uscore.h" +#include "sun-utils.h" + +static integrand_fcn user_fcn; + +extern "C" +{ + int F77_FCN (dqagp) (const double (*)(double*), const double*, + const double*, const int*, const double*, + const double*, const double*, double*, double*, + int*, int*, const int*, const int*, int*, int*, + double*); + + int F77_FCN (dqagi) (const double (*)(double*), const double*, + const int*, const double*, const double*, + double*, double*, int*, int*, const int*, + const int*, int*, int*, double*); +} + +Quad::Quad (integrand_fcn fcn) +{ + absolute_tolerance = 1.0e-6; + relative_tolerance = 1.0e-6; + f = fcn; +} + +Quad::Quad (integrand_fcn fcn, double abs, double rel) +{ + absolute_tolerance = abs; + relative_tolerance = rel; + f = fcn; +} + +double +Quad::integrate (void) +{ + int ier, neval; + double abserr; + return integrate (ier, neval, abserr); +} + +double +Quad::integrate (int& ier) +{ + int neval; + double abserr; + return integrate (ier, neval, abserr); +} + +double +Quad::integrate (int& ier, int& neval) +{ + double abserr; + return integrate (ier, neval, abserr); +} + +static double +user_function (double *x) +{ +#if defined (sun) && defined (__GNUC__) + double xx = access_double (x); +#else + double xx = *x; +#endif + + return (*user_fcn) (xx); +} + +DefQuad::DefQuad (integrand_fcn fcn) : Quad (fcn) +{ + lower_limit = 0.0; + upper_limit = 1.0; +} + +DefQuad::DefQuad (integrand_fcn fcn, double ll, double ul) + : Quad (fcn) +{ + lower_limit = ll; + upper_limit = ul; +} + +DefQuad::DefQuad (integrand_fcn fcn, double ll, double ul, + double abs, double rel) : Quad (fcn, abs, rel) +{ + lower_limit = ll; + upper_limit = ul; +} + +DefQuad::DefQuad (integrand_fcn fcn, double ll, double ul, + const Vector& sing) : Quad (fcn) +{ + lower_limit = ll; + upper_limit = ul; + singularities = sing; +} + +DefQuad::DefQuad (integrand_fcn fcn, const Vector& sing, + double abs, double rel) : Quad (fcn, abs, rel) +{ + lower_limit = 0.0; + upper_limit = 1.0; + singularities = sing; +} + +DefQuad::DefQuad (integrand_fcn fcn, const Vector& sing) + : Quad (fcn) +{ + lower_limit = 0.0; + upper_limit = 1.0; + singularities = sing; +} + +DefQuad::DefQuad (integrand_fcn fcn, double ll, double ul, + const Vector& sing, double abs, double rel) + : Quad (fcn, abs, rel) +{ + lower_limit = ll; + upper_limit = ul; + singularities = sing; +} + +double +DefQuad::integrate (int& ier, int& neval, double& abserr) +{ + int npts = singularities.capacity () + 2; + double *points = singularities.fortran_vec (); + double result = 0.0; + int leniw = 183*npts - 122; + int lenw = 2*leniw - npts; + int *iwork = new int [leniw]; + double *work = new double [lenw]; + user_fcn = f; + int last; + + F77_FCN (dqagp) (user_function, &lower_limit, &upper_limit, &npts, + points, &absolute_tolerance, &relative_tolerance, + &result, &abserr, &neval, &ier, &leniw, &lenw, + &last, iwork, work); + + delete [] iwork; + delete [] work; + + return result; +} + +IndefQuad::IndefQuad (integrand_fcn fcn) : Quad (fcn) +{ + bound = 0.0; + type = bound_to_inf; +} + +IndefQuad::IndefQuad (integrand_fcn fcn, double b, IntegralType t) + : Quad (fcn) +{ + bound = b; + type = t; +} + +IndefQuad::IndefQuad (integrand_fcn fcn, double b, IntegralType t, + double abs, double rel) : Quad (fcn, abs, rel) +{ + bound = b; + type = t; +} + +IndefQuad::IndefQuad (integrand_fcn fcn, double abs, double rel) + : Quad (fcn, abs, rel) +{ + bound = 0.0; + type = bound_to_inf; +} + +double +IndefQuad::integrate (int& ier, int& neval, double& abserr) +{ + double result = 0.0; + int leniw = 128; + int lenw = 8*leniw; + int *iwork = new int [leniw]; + double *work = new double [lenw]; + user_fcn = f; + int last; + + int inf; + switch (type) + { + case bound_to_inf: + inf = 1; + break; + case neg_inf_to_bound: + inf = -1; + break; + case doubly_infinite: + inf = 2; + break; + default: + assert (0); + break; + } + + F77_FCN (dqagi) (user_function, &bound, &inf, &absolute_tolerance, + &relative_tolerance, &result, &abserr, &neval, + &ier, &leniw, &lenw, &last, iwork, work); + + delete [] iwork; + delete [] work; + + return result; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Quad.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Quad.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,114 @@ +// Quad.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_Quad_h) +#define _Quad_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include "Matrix.h" + +#ifndef Vector +#define Vector ColumnVector +#endif + +#ifndef _Quad_typedefs +#define _Quad_typedefs 1 + +typedef double (*integrand_fcn) (double x); + +#endif + +class Quad +{ + public: + + Quad (integrand_fcn fcn); + Quad (integrand_fcn fcn, double abs, double rel); + + virtual double integrate (void); + virtual double integrate (int& ier); + virtual double integrate (int& ier, int& neval); + virtual double integrate (int& ier, int& neval, double& abserr) = 0; + + protected: + + double absolute_tolerance; + double relative_tolerance; + + integrand_fcn f; +}; + +class DefQuad : public Quad +{ + public: + + DefQuad (integrand_fcn fcn); + DefQuad (integrand_fcn fcn, double ll, double ul); + DefQuad (integrand_fcn fcn, double ll, double ul, double abs, double rel); + DefQuad (integrand_fcn fcn, double ll, double ul, const Vector& sing); + DefQuad (integrand_fcn fcn, const Vector& sing, double abs, double rel); + DefQuad (integrand_fcn fcn, const Vector& sing); + DefQuad (integrand_fcn fcn, double ll, double ul, const Vector& sing, + double abs, double rel); + + double integrate (int& ier, int& neval, double& abserr); + + private: + + double lower_limit; + double upper_limit; + + Vector singularities; +}; + +class IndefQuad : public Quad +{ + public: + + enum IntegralType { bound_to_inf, neg_inf_to_bound, doubly_infinite }; + + IndefQuad (integrand_fcn fcn); + IndefQuad (integrand_fcn fcn, double b, IntegralType t); + IndefQuad (integrand_fcn fcn, double b, IntegralType t, double abs, + double rel); + IndefQuad (integrand_fcn fcn, double abs, double rel); + + double integrate (int& ier, int& neval, double& abserr); + + private: + + double bound; + IntegralType type; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Range.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Range.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,132 @@ +// Range.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include + +#include "Range.h" + +void +Range::print_range (void) +{ + cerr << "Range: _base = " << _base + << " _limit " << _limit + << " _inc " << _inc + << " _nelem " << _nelem << "\n"; +} + +ostream& +operator << (ostream& os, const Range& a) +{ + double b = a.base (); + double increment = a.inc (); + int num_elem = a.nelem (); + + for (int i = 0; i < num_elem; i++) + os << b + i * increment << " "; + + os << "\n"; + + return os; +} + +istream& +operator >> (istream& is, Range& a) +{ + is >> a._base; + if (is) + { + is >> a._limit; + if (is) + { + is >> a._inc; + a._nelem = a.nelem_internal (); + } + } + + return is; +} + +int +Range::nelem_internal (void) const +{ +// Find an approximate number of elements, then do the best we can to +// find the number of elements that we would get if we had done +// something like +// +// nelem = 0; +// while (base + nelem * inc <= limit) +// nelem++; +// +// (for limit > base && inc > 0) + + double ntry = (_limit - _base) / _inc; + double max_val = (double) INT_MAX; + + if (ntry > max_val) + return -1; + + if (_limit > _base && _inc > 0) + { +// Our approximation may have been too big. + + while (_base + ntry * _inc > _limit && ntry > 0) + ntry = ntry - 1; + +// Now that we are close, get the actual number. + + while (_base + ntry * _inc <= _limit && ntry <= max_val) + ntry = ntry + 1; + } + else if (_limit < _base && _inc < 0) + { +// Our approximation may have been too big. + + while (_base + ntry * _inc < _limit && ntry > 0) + ntry = ntry - 1; + +// Now that we are close, get the actual number. + + while (_base + ntry * _inc >= _limit && ntry <= max_val) + ntry = ntry + 1; + } + else if (_limit == _base) + ntry = 1; + else + ntry = 0; + + if (ntry > max_val) + return -1; + else + return (int) ntry; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/Range.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/Range.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,100 @@ +// Range.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_Range_h) +#define _Range_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#include + +class Range +{ + public: + Range (void); + Range (const Range& r); + Range (double b, double l); + Range (double b, double l, double i); + + double base (void) const; + double limit (void) const; + double inc (void) const; + int nelem (void) const; + + double min (void) const; + double max (void) const; + + void set_base (double b); + void set_limit (double l); + void set_inc (double i); + + friend ostream& operator << (ostream& os, const Range& r); + friend istream& operator >> (istream& is, Range& r); + + void print_range (void); + + private: + double _base; + double _limit; + double _inc; + int _nelem; + + int nelem_internal (void) const; +}; + +inline Range::Range (void) + { _base = -1; _limit = -1; _inc = -1; _nelem = -1; } + +inline Range::Range (const Range& r) + { _base = r._base; _limit = r._limit; _inc = r._inc; _nelem = r._nelem; } + +inline Range::Range (double b, double l) + { _base = b; _limit = l; _inc = 1; _nelem = nelem_internal (); } + +inline Range::Range (double b, double l, double i) + { _base = b; _limit = l; _inc = i; _nelem = nelem_internal (); } + +inline double Range::base (void) const { return _base; } +inline double Range::limit (void) const { return _limit; } +inline double Range::inc (void) const { return _inc; } +inline int Range::nelem (void) const { return _nelem; } + +inline void Range::set_base (double b) { _base = b; } +inline void Range::set_limit (double l) { _limit = l; } +inline void Range::set_inc (double i) { _inc = i; } + +// NOTE: max and min only return useful values if nelem > 0. + +inline double Range::min (void) const { return _inc > 0 ? _base : _limit; } +inline double Range::max (void) const { return _inc > 0 ? _limit : _base; } + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/RowVector.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/RowVector.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,1259 @@ +// RowVector manipulations. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +// I\'m not sure how this is supposed to work if the .h file declares +// several classes, each of which is defined in a separate file... +// +// #ifdef __GNUG__ +// #pragma implementation "Matrix.h" +// #endif + +#include "Matrix.h" +#include "mx-inlines.cc" + +/* + * Row Vector class. + */ + +RowVector::RowVector (int n) +{ + if (n < 0) + FAIL; + + len = n; + if (len > 0) + data = new double [len]; + else + data = (double *) NULL; +} + +RowVector::RowVector (int n, double val) +{ + if (n < 0) + FAIL; + + len = n; + if (len > 0) + { + data = new double [len]; + copy (data, len, val); + } + else + data = (double *) NULL; +} + +RowVector::RowVector (const RowVector& a) +{ + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; +} + +RowVector::RowVector (double a) +{ + len = 1; + data = new double [1]; + data[0] = a; +} + +RowVector& +RowVector::operator = (const RowVector& a) +{ + if (this != &a) + { + delete [] data; + len = a.len; + if (len > 0) + { + data = new double [len]; + copy (data, a.data, len); + } + else + data = (double *) NULL; + } + return *this; +} + +RowVector& +RowVector::resize (int n) +{ + if (n < 0) + FAIL; + + double *new_data = (double *) NULL; + if (n > 0) + { + new_data = new double [n]; + int min_len = len < n ? len : n; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + len = n; + data = new_data; + + return *this; +} + +RowVector& +RowVector::resize (int n, double val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +int +RowVector::operator == (const RowVector& a) const +{ + if (len != a.len) + return 0; + return equal (data, a.data, len); +} + +int +RowVector::operator != (const RowVector& a) const +{ + if (len != a.len) + return 1; + return !equal (data, a.data, len); +} + +RowVector& +RowVector::insert (const RowVector& a, int c) +{ + if (c < 0 || c + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[c+i] = a.data[i]; + + return *this; +} + +RowVector& +RowVector::fill (double val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +RowVector& +RowVector::fill (double val, int c1, int c2) +{ + if (c1 < 0 || c2 < 0 || c1 >= len || c2 >= len) + FAIL; + + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int i = c1; i <= c2; i++) + data[i] = val; + + return *this; +} + +RowVector +RowVector::append (const RowVector& a) const +{ + int nc_insert = len; + RowVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nc_insert); + return retval; +} + +ColumnVector +RowVector::transpose (void) const +{ + return ColumnVector (dup (data, len), len); +} + +RowVector +RowVector::extract (int c1, int c2) const +{ + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_c = c2 - c1 + 1; + + RowVector result (new_c); + + for (int i = 0; i < new_c; i++) + result.data[i] = elem (c1+i); + + return result; +} + +// row vector by scalar -> row vector operations + +RowVector +RowVector::operator + (double s) const +{ + return RowVector (add (data, len, s), len); +} + +RowVector +RowVector::operator - (double s) const +{ + return RowVector (subtract (data, len, s), len); +} + +RowVector +RowVector::operator * (double s) const +{ + return RowVector (multiply (data, len, s), len); +} + +RowVector +RowVector::operator / (double s) const +{ + return RowVector (divide (data, len, s), len); +} + +ComplexRowVector +RowVector::operator + (Complex s) const +{ + return ComplexRowVector (add (data, len, s), len); +} + +ComplexRowVector +RowVector::operator - (Complex s) const +{ + return ComplexRowVector (subtract (data, len, s), len); +} + +ComplexRowVector +RowVector::operator * (Complex s) const +{ + return ComplexRowVector (multiply (data, len, s), len); +} + +ComplexRowVector +RowVector::operator / (Complex s) const +{ + return ComplexRowVector (divide (data, len, s), len); +} + +// scalar by row vector -> row vector operations + +RowVector +operator + (double s, const RowVector& a) +{ + return RowVector (add (a.data, a.len, s), a.len); +} + +RowVector +operator - (double s, const RowVector& a) +{ + return RowVector (subtract (s, a.data, a.len), a.len); +} + +RowVector +operator * (double s, const RowVector& a) +{ + return RowVector (multiply (a.data, a.len, s), a.len); +} + +RowVector +operator / (double s, const RowVector& a) +{ + return RowVector (divide (s, a.data, a.len), a.len); +} + +// row vector by column vector -> scalar + +double +RowVector::operator * (const ColumnVector& a) const +{ + if (len != a.len) + FAIL; + + return 0.0; + + int i_one = 1; + return F77_FCN (ddot) (&len, data, &i_one, a.data, &i_one); +} + +Complex +RowVector::operator * (const ComplexColumnVector& a) const +{ + ComplexRowVector tmp (*this); + return tmp * a; +} + +// row vector by matrix -> row vector + +RowVector +RowVector::operator * (const Matrix& a) const +{ + if (a.nr != len) + FAIL; + + if (len == 0 || a.nc == 0) + return RowVector (0); + +// Transpose A to form A'*x == (x'*A)' + + int anr = a.nr; + int anc = a.nc; + + char trans = 'T'; + int ld = anr; + double alpha = 1.0; + double beta = 0.0; + int i_one = 1; + + double *y = new double [len]; + + F77_FCN (dgemv) (&trans, &anc, &anr, &alpha, a.data, &ld, data, + &i_one, &beta, y, &i_one, 1L); + + return RowVector (y, len); +} + +ComplexRowVector +RowVector::operator * (const ComplexMatrix& a) const +{ + ComplexRowVector tmp (*this); + return tmp * a; +} + +// row vector by row vector -> row vector operations + +RowVector +RowVector::operator + (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return RowVector (0); + + return RowVector (add (data, a.data, len), len); +} + +RowVector +RowVector::operator - (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return RowVector (0); + + return RowVector (subtract (data, a.data, len), len); +} + +ComplexRowVector +RowVector::operator + (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (add (data, a.data, len), len); +} + +ComplexRowVector +RowVector::operator - (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (subtract (data, a.data, len), len); +} + +RowVector +RowVector::product (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return RowVector (0); + + return RowVector (multiply (data, a.data, len), len); +} + +RowVector +RowVector::quotient (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return RowVector (0); + + return RowVector (divide (data, a.data, len), len); +} + +ComplexRowVector +RowVector::product (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (multiply (data, a.data, len), len); +} + +ComplexRowVector +RowVector::quotient (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (divide (data, a.data, len), len); +} + +RowVector& +RowVector::operator += (const RowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +RowVector& +RowVector::operator -= (const RowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// unary operations + +RowVector +RowVector::operator - (void) const +{ + if (len == 0) + return RowVector (0); + + return RowVector (negate (data, len), len); +} + +RowVector +map (d_d_Mapper f, const RowVector& a) +{ + RowVector b (a); + b.map (f); + return b; +} + +void +RowVector::map (d_d_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +double +RowVector::min (void) const +{ + if (len == 0) + return 0; + + double res = data[0]; + + for (int i = 1; i < len; i++) + if (data[i] < res) + res = data[i]; + + return res; +} + +double +RowVector::max (void) const +{ + if (len == 0) + return 0; + + double res = data[0]; + + for (int i = 1; i < len; i++) + if (data[i] > res) + res = data[i]; + + return res; +} + +ostream& +operator << (ostream& os, const RowVector& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.len; i++) + os << " " /* setw (field_width) */ << a.data[i]; + return os; +} + +/* + * Complex Row Vector class + */ + +ComplexRowVector::ComplexRowVector (int n) +{ + if (n < 0) + FAIL; + + len = n; + if (len > 0) + data = new Complex [len]; + else + data = (Complex *) NULL; +} + +ComplexRowVector::ComplexRowVector (int n, double val) +{ + if (n < 0) + FAIL; + + len = n; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexRowVector::ComplexRowVector (int n, Complex val) +{ + if (n < 0) + FAIL; + + len = n; + if (len > 0) + { + data = new Complex [len]; + copy (data, len, val); + } + else + data = (Complex *) NULL; +} + +ComplexRowVector::ComplexRowVector (const RowVector& a) +{ + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexRowVector::ComplexRowVector (const ComplexRowVector& a) +{ + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; +} + +ComplexRowVector::ComplexRowVector (double a) +{ + len = 1; + data = new Complex [1]; + data[0] = a; +} + +ComplexRowVector::ComplexRowVector (Complex a) +{ + len = 1; + data = new Complex [1]; + data[0] = Complex (a); +} + +ComplexRowVector& +ComplexRowVector::operator = (const RowVector& a) +{ + delete [] data; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::operator = (const ComplexRowVector& a) +{ + if (this != &a) + { + delete [] data; + len = a.len; + if (len > 0) + { + data = new Complex [len]; + copy (data, a.data, len); + } + else + data = (Complex *) NULL; + } + return *this; +} + +ComplexRowVector& +ComplexRowVector::resize (int n) +{ + if (n < 0) + FAIL; + + Complex *new_data = (Complex *) NULL; + if (n > 0) + { + new_data = new Complex [n]; + int min_len = len < n ? len : n; + + for (int i = 0; i < min_len; i++) + new_data[i] = data[i]; + } + + delete [] data; + len = n; + data = new_data; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::resize (int n, double val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::resize (int n, Complex val) +{ + int old_len = len; + resize (n); + for (int i = old_len; i < len; i++) + data[i] = val; + + return *this; +} + +int +ComplexRowVector::operator == (const ComplexRowVector& a) const +{ + if (len != a.len) + return 0; + return equal (data, a.data, len); +} + +int +ComplexRowVector::operator != (const ComplexRowVector& a) const +{ + if (len != a.len) + return 1; + return !equal (data, a.data, len); +} + +// destructive insert/delete/reorder operations + +ComplexRowVector& +ComplexRowVector::insert (const RowVector& a, int c) +{ + if (c < 0 || c + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[c+i] = a.data[i]; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::insert (const ComplexRowVector& a, int c) +{ + if (c < 0 || c + a.len - 1 > len) + FAIL; + + for (int i = 0; i < a.len; i++) + data[c+i] = a.data[i]; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::fill (double val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +ComplexRowVector& +ComplexRowVector::fill (Complex val) +{ + if (len > 0) + copy (data, len, val); + return *this; +} + +ComplexRowVector& +ComplexRowVector::fill (double val, int c1, int c2) +{ + if (c1 < 0 || c2 < 0 || c1 >= len || c2 >= len) + FAIL; + + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int i = c1; i <= c2; i++) + data[i] = val; + + return *this; +} + +ComplexRowVector& +ComplexRowVector::fill (Complex val, int c1, int c2) +{ + if (c1 < 0 || c2 < 0 || c1 >= len || c2 >= len) + FAIL; + + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + for (int i = c1; i <= c2; i++) + data[i] = val; + + return *this; +} + +ComplexRowVector +ComplexRowVector::append (const RowVector& a) const +{ + int nc_insert = len; + ComplexRowVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nc_insert); + return retval; +} + +ComplexRowVector +ComplexRowVector::append (const ComplexRowVector& a) const +{ + int nc_insert = len; + ComplexRowVector retval (len + a.len); + retval.insert (*this, 0); + retval.insert (a, nc_insert); + return retval; +} + +ComplexColumnVector +ComplexRowVector::hermitian (void) const +{ + return ComplexColumnVector (conj_dup (data, len), len); +} + +ComplexColumnVector +ComplexRowVector::transpose (void) const +{ + return ComplexColumnVector (dup (data, len), len); +} + +RowVector +real (const ComplexRowVector& a) +{ + RowVector retval; + if (a.len > 0) + retval = RowVector (real_dup (a.data, a.len), a.len); + return retval; +} + +RowVector +imag (const ComplexRowVector& a) +{ + RowVector retval; + if (a.len > 0) + retval = RowVector (imag_dup (a.data, a.len), a.len); + return retval; +} + +ComplexRowVector +conj (const ComplexRowVector& a) +{ + ComplexRowVector retval; + if (a.len > 0) + retval = ComplexRowVector (conj_dup (a.data, a.len), a.len); + return retval; +} + +// resize is the destructive equivalent for this one + +ComplexRowVector +ComplexRowVector::extract (int c1, int c2) const +{ + if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; } + + int new_c = c2 - c1 + 1; + + ComplexRowVector result (new_c); + + for (int i = 0; i < new_c; i++) + result.data[i] = elem (c1+i); + + return result; +} + +// row vector by scalar -> row vector operations + +ComplexRowVector +ComplexRowVector::operator + (double s) const +{ + return ComplexRowVector (add (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator - (double s) const +{ + return ComplexRowVector (subtract (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator * (double s) const +{ + return ComplexRowVector (multiply (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator / (double s) const +{ + return ComplexRowVector (divide (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator + (Complex s) const +{ + return ComplexRowVector (add (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator - (Complex s) const +{ + return ComplexRowVector (subtract (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator * (Complex s) const +{ + return ComplexRowVector (multiply (data, len, s), len); +} + +ComplexRowVector +ComplexRowVector::operator / (Complex s) const +{ + return ComplexRowVector (divide (data, len, s), len); +} + +// scalar by row vector -> row vector operations + +ComplexRowVector +operator + (double s, const ComplexRowVector& a) +{ + return ComplexRowVector (add (a.data, a.len, s), a.len); +} + +ComplexRowVector +operator - (double s, const ComplexRowVector& a) +{ + return ComplexRowVector (subtract (s, a.data, a.len), a.len); +} + +ComplexRowVector +operator * (double s, const ComplexRowVector& a) +{ + return ComplexRowVector (multiply (a.data, a.len, s), a.len); +} + +ComplexRowVector +operator / (double s, const ComplexRowVector& a) +{ + return ComplexRowVector (divide (s, a.data, a.len), a.len); +} + +ComplexRowVector +operator + (Complex s, const ComplexRowVector& a) +{ + return ComplexRowVector (add (a.data, a.len, s), a.len); +} + +ComplexRowVector +operator - (Complex s, const ComplexRowVector& a) +{ + return ComplexRowVector (subtract (s, a.data, a.len), a.len); +} + +ComplexRowVector +operator * (Complex s, const ComplexRowVector& a) +{ + return ComplexRowVector (multiply (a.data, a.len, s), a.len); +} + +ComplexRowVector +operator / (Complex s, const ComplexRowVector& a) +{ + return ComplexRowVector (divide (s, a.data, a.len), a.len); +} + +// row vector by column vector -> scalar + +Complex +ComplexRowVector::operator * (const ColumnVector& a) const +{ + ComplexColumnVector tmp (a); + return *this * tmp; +} + +Complex +ComplexRowVector::operator * (const ComplexColumnVector& a) const +{ +// XXX FIXME XXX -- need function body + assert (0); + return Complex (0.0, 0.0); +} + +// row vector by matrix -> row vector + +ComplexRowVector +ComplexRowVector::operator * (const Matrix& a) const +{ + ComplexMatrix tmp (a); + return *this * tmp; +} + +ComplexRowVector +ComplexRowVector::operator * (const ComplexMatrix& a) const +{ + if (a.nr != len) + FAIL; + + if (len == 0 || a.nc == 0) + return ComplexRowVector (0); + +// Transpose A to form A'*x == (x'*A)' + + int anr = a.nr; + int anc = a.nc; + + char trans = 'T'; + int ld = anr; + Complex alpha (1.0); + Complex beta (0.0); + int i_one = 1; + + Complex *y = new Complex [len]; + + F77_FCN (zgemv) (&trans, &anc, &anr, &alpha, a.data, &ld, data, + &i_one, &beta, y, &i_one, 1L); + + return ComplexRowVector (y, len); +} + +// row vector by row vector -> row vector operations + +ComplexRowVector +ComplexRowVector::operator + (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (add (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::operator - (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (subtract (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::operator + (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (add (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::operator - (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (subtract (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::product (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (multiply (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::quotient (const RowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (divide (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::product (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (multiply (data, a.data, len), len); +} + +ComplexRowVector +ComplexRowVector::quotient (const ComplexRowVector& a) const +{ + if (len != a.len) + FAIL; + + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (divide (data, a.data, len), len); +} + +ComplexRowVector& +ComplexRowVector::operator += (const RowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexRowVector& +ComplexRowVector::operator -= (const RowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +ComplexRowVector& +ComplexRowVector::operator += (const ComplexRowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + add2 (data, a.data, len); + return *this; +} + +ComplexRowVector& +ComplexRowVector::operator -= (const ComplexRowVector& a) +{ + if (len != a.len) + FAIL; + + if (len == 0) + return *this; + + subtract2 (data, a.data, len); + return *this; +} + +// unary operations + +ComplexRowVector +ComplexRowVector::operator - (void) const +{ + if (len == 0) + return ComplexRowVector (0); + + return ComplexRowVector (negate (data, len), len); +} + +ComplexRowVector +map (c_c_Mapper f, const ComplexRowVector& a) +{ + ComplexRowVector b (a); + b.map (f); + return b; +} + +RowVector +map (d_c_Mapper f, const ComplexRowVector& a) +{ + RowVector b (a.len); + for (int i = 0; i < a.len; i++) + b.elem (i) = f (a.elem (i)); + return b; +} + +void +ComplexRowVector::map (c_c_Mapper f) +{ + for (int i = 0; i < len; i++) + data[i] = f (data[i]); +} + +Complex +ComplexRowVector::min (void) const +{ + if (len == 0) + return Complex (0.0); + + Complex res = data[0]; + double absres = abs (res); + + for (int i = 1; i < len; i++) + if (abs (data[i]) < absres) + { + res = data[i]; + absres = abs (res); + } + + return res; +} + +Complex +ComplexRowVector::max (void) const +{ + if (len == 0) + return Complex (0.0); + + Complex res = data[0]; + double absres = abs (res); + + for (int i = 1; i < len; i++) + if (abs (data[i]) > absres) + { + res = data[i]; + absres = abs (res); + } + + return res; +} + +// i/o + +ostream& +operator << (ostream& os, const ComplexRowVector& a) +{ +// int field_width = os.precision () + 7; + for (int i = 0; i < a.len; i++) + os << " " /* setw (field_width) */ << a.data[i]; + return os; +} + + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/f77-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/f77-fcn.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,44 @@ +// f77-uscore.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_f77_uscore_h) +#define _f77_uscore_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#if defined (F77_APPEND_UNDERSCORE) +#define F77_FCN(f) f##_ +#else +#define F77_FCN(f) f +#endif + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/mx-inlines.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/mx-inlines.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,836 @@ +// Helper functions for matrix classes. -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +// But first, some helper functions... + +static inline double * +add (double *d, int len, double s) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] + s; + } + return result; +} + +static inline double * +subtract (double *d, int len, double s) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] - s; + } + return result; +} + +static inline double * +subtract (double s, double *d, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = s - d[i]; + } + return result; +} + +static inline double * +multiply (double *d, int len, double s) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] * s; + } + return result; +} + +static inline double * +divide (double *d, int len, double s) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] / s; + } + return result; +} + +static inline double * +divide (double s, double *d, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = s / d[i]; + } + return result; +} + +static inline double * +add (double *x, double *y, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] + y[i]; + } + return result; +} + +static inline double * +subtract (double *x, double *y, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] - y[i]; + } + return result; +} + +static inline double * +multiply (double *x, double *y, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] * y[i]; + } + return result; +} + +static inline double * +divide (double *x, double *y, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] / y[i]; + } + return result; +} + +static inline double * +add2 (double *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] += y[i]; + return x; +} + +static inline double * +subtract2 (double *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] -= y[i]; + return x; +} + +static inline double * +negate (double *d, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = -d[i]; + } + return result; +} + +static inline void +copy (double *d, int len, double s) +{ + for (int i = 0; i < len; i++) + d[i] = s; +} + +static inline void +copy (double *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] = y[i]; +} + +static inline double * +dup (double *x, int len) +{ + double *retval = (double *) NULL; + if (len > 0) + { + retval = new double [len]; + for (int i = 0; i < len; i++) + retval[i] = x[i]; + } + return retval; +} + +static inline int +equal (double *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + if (x[i] != y[i]) + return 0; + return 1; +} + +// And some for Complex too... + +static inline Complex * +add (Complex *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] + s; + } + return result; +} + +static inline Complex * +add (Complex s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s + d[i]; + } + return result; +} + +static inline Complex * +subtract (Complex *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] - s; + } + return result; +} + +static inline Complex * +subtract (Complex s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s - d[i]; + } + return result; +} + +static inline Complex * +multiply (Complex *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] * s; + } + return result; +} + +static inline Complex * +multiply (Complex s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s * d[i]; + } + return result; +} + +static inline Complex * +divide (Complex *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] / s; + } + return result; +} + +static inline Complex * +divide (Complex s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s / d[i]; + } + return result; +} + +static inline Complex * +add (Complex *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] + y[i]; + } + return result; +} + +static inline Complex * +subtract (Complex *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] - y[i]; + } + return result; +} + +static inline Complex * +multiply (Complex *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] * y[i]; + } + return result; +} + +static inline Complex * +divide (Complex *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] / y[i]; + } + return result; +} + +static inline Complex * +add2 (Complex *x, Complex *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] += y[i]; + return x; +} + +static inline Complex * +subtract2 (Complex *x, Complex *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] -= y[i]; + return x; +} + +static inline Complex * +negate (Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = -d[i]; + } + return result; +} + +static inline double * +not (Complex *d, int len) +{ + double *result = 0; + if (len > 0) + { + result = new double [len]; + for (int i = 0; i < len; i++) + result[i] = (d[i] == 0.0); + } + return result; +} + +static inline void +copy (Complex *d, int len, Complex s) +{ + for (int i = 0; i < len; i++) + d[i] = s; +} + +static inline void +copy (Complex *x, Complex *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] = y[i]; +} + +static inline Complex * +dup (Complex *x, int len) +{ + Complex *retval = (Complex *) NULL; + if (len > 0) + { + retval = new Complex [len]; + for (int i = 0; i < len; i++) + retval[i] = x[i]; + } + return retval; +} + +static inline Complex * +make_complex (double *x, int len) +{ + Complex *retval = (Complex *) NULL; + if (len > 0) + { + retval = new Complex [len]; + for (int i = 0; i < len; i++) + retval[i] = x[i]; + } + return retval; +} + +static inline Complex * +conj_dup (Complex *x, int len) +{ + Complex *retval = (Complex *) NULL; + if (len > 0) + { + retval = new Complex [len]; + for (int i = 0; i < len; i++) + retval[i] = conj (x[i]); + } + return retval; +} + +static inline double * +real_dup (Complex *x, int len) +{ + double *retval = (double *) NULL; + if (len > 0) + { + retval = new double [len]; + for (int i = 0; i < len; i++) + retval[i] = real (x[i]); + } + return retval; +} + +static inline double * +imag_dup (Complex *x, int len) +{ + double *retval = (double *) NULL; + if (len > 0) + { + retval = new double [len]; + for (int i = 0; i < len; i++) + retval[i] = imag (x[i]); + } + return retval; +} + +static inline int +equal (Complex *x, Complex *y, int len) +{ + for (int i = 0; i < len; i++) + if (x[i] != y[i]) + return 0; + return 1; +} + +// And still some more for mixed Complex/double operations... + +static inline Complex * +add (Complex *d, int len, double s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] + s; + } + return result; +} + +static inline Complex * +add (double *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] + s; + } + return result; +} + +static inline Complex * +add (double s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s + d[i]; + } + return result; +} + +static inline Complex * +add (Complex s, double *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s + d[i]; + } + return result; +} + +static inline Complex * +subtract (Complex *d, int len, double s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] - s; + } + return result; +} + +static inline Complex * +subtract (double *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] - s; + } + return result; +} + +static inline Complex * +subtract (double s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s - d[i]; + } + return result; +} + +static inline Complex * +subtract (Complex s, double *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s - d[i]; + } + return result; +} + +static inline Complex * +multiply (Complex *d, int len, double s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] * s; + } + return result; +} + +static inline Complex * +multiply (double *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] * s; + } + return result; +} + +static inline Complex * +divide (Complex *d, int len, double s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] / s; + } + return result; +} + +static inline Complex * +divide (double *d, int len, Complex s) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = d[i] / s; + } + return result; +} + +static inline Complex * +divide (double s, Complex *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s / d[i]; + } + return result; +} + +static inline Complex * +divide (Complex s, double *d, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = s / d[i]; + } + return result; +} + +static inline Complex * +add (Complex *x, double *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] + y[i]; + } + return result; +} + +static inline Complex * +add (double *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] + y[i]; + } + return result; +} + +static inline Complex * +subtract (Complex *x, double *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] - y[i]; + } + return result; +} + +static inline Complex * +subtract (double *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] - y[i]; + } + return result; +} + +static inline Complex * +multiply (Complex *x, double *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] * y[i]; + } + return result; +} + +static inline Complex * +multiply (double *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] * y[i]; + } + return result; +} + +static inline Complex * +divide (Complex *x, double *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] / y[i]; + } + return result; +} + +static inline Complex * +divide (double *x, Complex *y, int len) +{ + Complex *result = 0; + if (len > 0) + { + result = new Complex [len]; + for (int i = 0; i < len; i++) + result[i] = x[i] / y[i]; + } + return result; +} + +static inline Complex * +add2 (Complex *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] += y[i]; + return x; +} + +static inline Complex * +subtract2 (Complex *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] -= y[i]; + return x; +} + +static inline void +copy (Complex *d, int len, double s) +{ + for (int i = 0; i < len; i++) + d[i] = s; +} + +static inline void +copy (Complex *x, double *y, int len) +{ + for (int i = 0; i < len; i++) + x[i] = y[i]; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/sun-utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/sun-utils.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,55 @@ +// sun-utils.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef sun + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include + +/* + * I think that this is really only needed if linking to Fortran + * compiled libraries on a Sun. It should never be called. + * There should probably be a sysdep.cc file, eh? + */ + +extern "C" +{ + int MAIN_ (void) + { + assert (0); + return 0; + } +} + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ + diff -r c0190df9885d -r 9a4c07481e61 liboctave/sun-utils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/sun-utils.h Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,89 @@ +// sun-utils.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#if !defined (_sun_utils_h) +#define _sun_utils_h 1 + +#ifdef __GNUG__ +#pragma interface +#endif + +#ifdef sun + +/* + * I think that this is really only needed if linking to Fortran + * compiled libraries on a Sun. It should never be called. + * There should probably be a sysdep.cc file, eh? + */ + +extern "C" int MAIN_ (void); + +/* + * This is only needed to dereference pointers to doubles if mixing + * GCC and Sun f77/cc compiled code. See the GCC manual (where the + * function access_double() is described) and the Sun f77 manual, + * which explains that doubles are not always aligned on 8 byte + * boundaries. + */ + +#ifdef __GNUC__ + +inline double +access_double (double *unaligned_ptr) +{ + union d2i { double d; int i[2]; }; + + union d2i *p = (union d2i *) unaligned_ptr; + union d2i u; + + u.i[0] = p->i[0]; + u.i[1] = p->i[1]; + + return u.d; +} + +inline void +assign_double (double *unaligned_ptr, double value) +{ + union d2i { double d; int i[2]; }; + + double *ptr = &value; + union d2i *v = (union d2i *) ptr; + union d2i *p = (union d2i *) unaligned_ptr; + + p->i[0] = v->i[0]; + p->i[1] = v->i[1]; +} + +#endif + +#endif + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff -r c0190df9885d -r 9a4c07481e61 liboctave/utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/liboctave/utils.cc Sun Aug 08 01:21:46 1993 +0000 @@ -0,0 +1,64 @@ +// utils.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include +#include +#include + +#include "f77-uscore.h" + +/* + * All the STOP statements in the Fortran routines have been replaced + * with a call to XSTOPX, defined in the file libcruft/misc/xstopx.f. + * + * The XSTOPX function calls this function, which will send a SIGINT + * signal to the program that invoked it. + * + * Octave\'s SIGINT signal handler calls jump_to_top_level(), and the + * user will end up at the top level instead of the shell prompt. + * + * Programs that don\'t handle SIGINT will be interrupted. + */ + +extern "C" +{ + + volatile void +#if defined (F77_APPEND_UNDERSCORE) + do_stop_ (void) +#else + do_stop (void) +#endif + { + kill (getpid (), SIGINT); + abort (); + } +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/