boost-bindings/0000755000175000017500000000000010714455203013614 5ustar andreasandreasboost-bindings/configure0000755000175000017500000000313510664337365015541 0ustar andreasandreas#! /usr/bin/env python def var_to_option(caps_name): return caps_name.lower().replace("_", "-") def var_kind(caps_name): last_underscore = caps_name.rfind("_") return caps_name[last_underscore+1:] if __name__ == "__main__": from optparse import OptionParser parser = OptionParser() parser.add_option("--prefix", default="/usr/local", help="Where to install the header files") options, args = parser.parse_args() substitutions = { "PREFIX": options.prefix } import re var_re = re.compile(r"\$\{([A-Za-z_0-9]+)\}") string_var_re = re.compile(r"\$str\{([A-Za-z_0-9]+)\}") for fname in ["Makefile"]: lines = open(fname+".in", "r").readlines() new_lines = [] for l in lines: made_change = True while made_change: made_change = False match = var_re.search(l) if match: varname = match.group(1) l = l[:match.start()] + str(substitutions[varname]) + l[match.end():] made_change = True match = string_var_re.search(l) if match: varname = match.group(1) subst = substitutions[varname] if subst is None: subst = "" else: subst = '"%s"' % subst l = l[:match.start()] + subst + l[match.end():] made_change = True new_lines.append(l) file(fname, "w").write("".join(new_lines)) boost-bindings/boost/0000755000175000017500000000000010664336361014751 5ustar andreasandreasboost-bindings/boost/numeric/0000755000175000017500000000000010664336046016413 5ustar andreasandreasboost-bindings/boost/numeric/bindings/0000755000175000017500000000000010664336046020210 5ustar andreasandreasboost-bindings/boost/numeric/bindings/amos/0000755000175000017500000000000010664335722021147 5ustar andreasandreasboost-bindings/boost/numeric/bindings/amos/amos.hpp0000644000175000017500000000721007707750440022621 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_AMOS_AMOS_HPP #define BOOST_NUMERIC_BINDINGS_AMOS_AMOS_HPP #include #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace amos { template < typename vector_type, typename value_type > int besi(const value_type& z, // std::complex< float > or std::complex< double > const typename traits::type_traits< value_type >::real_type fnu, // float or double int kode, vector_type& cy, int& nz) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename traits::vector_traits::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename vector_type::value_type >::value ) ) ; #endif int n = traits::vector_size( cy ) ; value_type * cy_ptr = traits::vector_storage( cy ) ; int error = 0 ; detail::besi( z, fnu, kode, n, cy_ptr, nz, error ) ; return error ; } template < typename vector_type, typename value_type > int besj(const value_type& z, const typename traits::type_traits< value_type >::real_type fnu, int kode, vector_type& cy, int& nz) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename traits::vector_traits::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename vector_type::value_type >::value ) ) ; #endif int n = traits::vector_size( cy ) ; value_type * cy_ptr = traits::vector_storage( cy ) ; int error = 0 ; detail::besj( z, fnu, kode, n, cy_ptr, nz, error ) ; return error ; } template < typename vector_type, typename value_type > int besy(const value_type& z, const typename traits::type_traits< value_type >::real_type fnu, int kode, vector_type& cy, int& nz) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename traits::vector_traits::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename vector_type::value_type >::value ) ) ; #endif int n = traits::vector_size( cy ) ; value_type * cy_ptr = traits::vector_storage( cy ) ; int error = 0 ; value_type * cwrk = new value_type[n]; detail::besy( z, fnu, kode, n, cy_ptr, nz, cwrk, error ) ; delete[] cwrk ; return error ; } }}}} #endif // BOOST_NUMERIC_BINDINGS_AMOS_AMOS_HPP boost-bindings/boost/numeric/bindings/amos/amos.h0000644000175000017500000000374507676532711022276 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // // Copyright Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_AMOS_AMOS_H #define BOOST_NUMERIC_BINDINGS_AMOS_AMOS_H #include #include extern "C" { void AMOS_DBESI(const double* z, const double* fnu, const int* kode, const int* n, double* cy, int* nz ) ; void AMOS_CBESI(const fcomplex_t* z, const float* fnu, const int* kode, const int* n, fcomplex_t* cy, int* nz, int* ierr) ; void AMOS_ZBESI(const double* zr, const double* zi, const double* fnu, const int* kode, const int* n, double* cyr, double* cyi, int* nz, int* ierr) ; void AMOS_DBESJ(const double * z, const double* fnu, const int* n, double* cy, int* nz ) ; void AMOS_CBESJ(const fcomplex_t* z, const float* fnu, const int* kode, const int* n, fcomplex_t* cy, int* nz, int* ierr) ; void AMOS_ZBESJ(const double* zr, const double* zi, const double* fnu, const int* kode, const int* n, double* cyr, double* cyi, int* nz, int* ierr) ; void AMOS_DBESY(const double * z, const double* fnu, const int* n, double* cy ) ; void AMOS_CBESY(const fcomplex_t* z, const float* fnu, const int* kode, const int* n, fcomplex_t* cy, int* nz, fcomplex_t *cwrk, int* ierr) ; void AMOS_ZBESY(const double* zr, const double* zi, const double* fnu, const int* kode, const int* n, double* cyr, double* cyi, int* nz, double *cwrkr, double *cwrki, int* ierr) ; } #endif // BOOST_NUMERIC_BINDINGS_AMOS_AMOS_HPP boost-bindings/boost/numeric/bindings/amos/amos_names.h0000644000175000017500000000154307676532711023453 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // // Copyright Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_AMOS_AMOS_NAMES_H #define BOOST_NUMERIC_BINDINGS_AMOS_AMOS_NAMES_H #include #define AMOS_DBESI FORTRAN_ID( dbesi ) #define AMOS_CBESI FORTRAN_ID( cbesi ) #define AMOS_ZBESI FORTRAN_ID( zbesi ) #define AMOS_DBESJ FORTRAN_ID( dbesj ) #define AMOS_CBESJ FORTRAN_ID( cbesj ) #define AMOS_ZBESJ FORTRAN_ID( zbesj ) #define AMOS_DBESY FORTRAN_ID( dbesy ) #define AMOS_CBESY FORTRAN_ID( cbesy ) #define AMOS_ZBESY FORTRAN_ID( zbesy ) #endif // BOOST_NUMERIC_BINDINGS_AMOS_AMOS_NAMES_HPP boost-bindings/boost/numeric/bindings/amos/amos_overloads.hpp0000644000175000017500000000405607707750440024704 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_AMOS_AMOS_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_AMOS_AMOS_OVERLOADS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace amos { namespace detail { using namespace ::boost::numeric::bindings::traits ; // // BESI // //inline //void besi(const fcomplex * z, const fcomplex * fnu, const int * kode, const int * n, fcomplex* cy, int * nz, int * error) ; inline void besi(const double& z, const double& fnu, const int& kode, const int& n, double* cy, int& nz, int& error) { AMOS_DBESI( &z, &fnu, &kode, &n, cy, &nz ) ; } inline void besi(const complex_f& z, const float& fnu, const int& kode, const int& n, complex_f* cy, int & nz, int & error) { AMOS_CBESI( complex_ptr( &z ), &fnu, &kode, &n, complex_ptr( cy ), &nz, &error ) ; } // inline // void besi(const complex_d* z, const double* fnu, const int * kode, const int * n, complex_d* cy, int * nz, int * error) ; // // BESJ // inline void besj(const double& z, const double& fnu, const int& kode, const int& n, double* cy, int& nz, int& error) { AMOS_DBESJ( &z, &fnu, &n, cy, &nz ) ; } inline void besj(const complex_f& z, const float& fnu, const int& kode, const int& n, complex_f* cy, int & nz, int & error) { AMOS_CBESJ( complex_ptr( &z ), &fnu, &kode, &n, complex_ptr( cy ), &nz, &error ) ; } // // BESY // inline void besy(const double& z, const double& fnu, const int& kode, const int& n, double* cy, int& nz, double* wrk, int& error) { AMOS_DBESY( &z, &fnu, &n, cy ) ; } }}}}} #endif // BOOST_NUMERIC_BINDINGS_AMOS_AMOS_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/atlas/0000755000175000017500000000000010664335722021314 5ustar andreasandreasboost-bindings/boost/numeric/bindings/atlas/cblas.hpp0000644000175000017500000000136107725607601023114 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS_HPP #include #include #include #endif boost-bindings/boost/numeric/bindings/atlas/cblas1.hpp0000644000175000017500000003013507725607602023177 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_1_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_1_HPP #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_TYPE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace atlas { // x_i <- alpha for all i template inline void set (T const& alpha, Vct& x) { detail::set (traits::vector_size (x), alpha, traits::vector_storage (x), traits::vector_stride (x)); } // y <- x template inline void copy (VctX const& x, VctY& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::copy (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::vector_storage (y), traits::vector_stride (y)); } // x <-> y template inline void swap (VctX& x, VctY& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::swap (traits::vector_size (x), traits::vector_storage (x), traits::vector_stride (x), traits::vector_storage (y), traits::vector_stride (y)); } // x <- alpha * x template inline void scal (T const& alpha, Vct& x) { #ifndef BOOST_NUMERIC_BINDINGS_NO_TYPE_CHECK typedef traits::vector_traits vtraits; BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::real_type >::value )); #endif detail::scal (traits::vector_size (x), alpha, traits::vector_storage (x), traits::vector_stride (x)); } // y <- alpha * x + y template inline void axpy (T const& alpha, VctX const& x, VctY& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::axpy (traits::vector_size (x), alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::vector_storage (y), traits::vector_stride (y)); } // y <- x + y template inline void xpy (VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::vector_traits::value_type val_t; #else typedef typename VctX::value_type val_t; #endif axpy ((val_t) 1, x, y); } // y <- alpha * x + beta * y template inline void axpby (T const& alpha, VctX const& x, T const& beta, VctY& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::axpby (traits::vector_size (x), alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } /////////////////////////////////////////// // dot <- x^T * y // .. real & complex types template inline #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type #else typename VctX::value_type #endif dot (VctX const& x, VctY const& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); return detail::dot (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y)); } // dot <- x^T * y // .. float only -- with double accumulation template inline double dsdot (VctX const& x, VctY const& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); return cblas_dsdot (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y)); } // apdot <- alpha + x^T * y // .. float only -- computation uses double precision template inline float sdsdot (float const alpha, VctX const& x, VctY const& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); return cblas_sdsdot (traits::vector_size (x), alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y)); } // dotu <- x^T * y // .. complex types only // .. function template inline #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type #else typename VctX::value_type #endif dotu (VctX const& x, VctY const& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type val; #else typename VctX::value_type val; #endif detail::dotu (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), &val); return val; } // .. procedure template inline void dotu (VctX const& x, VctY const& y, #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type& val #else typename VctX::value_type& val #endif ) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::dotu (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), &val); } // dotc <- x^H * y // .. complex types only // .. function template inline #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type #else typename VctX::value_type #endif dotc (VctX const& x, VctY const& y) { assert (traits::vector_size (y) >= traits::vector_size (x)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type val; #else typename VctX::value_type val; #endif detail::dotc (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), &val); return val; } // .. procedure template inline void dotc (VctX const& x, VctY const& y, #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type& val #else typename VctX::value_type& val #endif ) { assert (traits::vector_size (y) >= traits::vector_size (x)); detail::dotc (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), &val); } // nrm2 <- ||x||_2 template inline typename traits::type_traits< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type #else typename Vct::value_type #endif >::real_type nrm2 (Vct const& x) { return detail::nrm2 (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x)); } // asum <- ||re (x)|| + ||im (x)|| template inline typename traits::type_traits< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits::value_type #else typename Vct::value_type #endif >::real_type asum (Vct const& x) { return detail::asum (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x)); } // iamax <- 1st i: max (|re (x_i)| + |im (x_i)|) template inline CBLAS_INDEX iamax (Vct const& x) { return detail::iamax (traits::vector_size (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x)); } // TO DO: plane rotations } // namespace atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_1_HPP boost-bindings/boost/numeric/bindings/atlas/cblas1_overloads.hpp0000644000175000017500000002763307725607602025266 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS1_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS1_OVERLOADS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace atlas { namespace detail { // dot <- x^T * y // .. real types: calls cblas_xdot // .. complex types: calls cblas_xdotu inline float dot (int const N, float const* X, int const incX, float const* Y, int const incY) { return cblas_sdot (N, X, incX, Y, incY); } inline double dot (int const N, double const* X, int const incX, double const* Y, int const incY) { return cblas_ddot (N, X, incX, Y, incY); } inline traits::complex_f dot (int const N, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY) { traits::complex_f val; cblas_cdotu_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (&val)); return val; } inline traits::complex_d dot (int const N, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY) { traits::complex_d val; cblas_zdotu_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (&val)); return val; } // dotu <- x^T * y // .. complex types only inline void dotu (int const N, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* val) { cblas_cdotu_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (val)); } inline void dotu (int const N, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* val) { cblas_zdotu_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (val)); } // dotc <- x^H * y // .. complex types only inline void dotc (int const N, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* val) { cblas_cdotc_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (val)); } inline void dotc (int const N, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* val) { cblas_zdotc_sub (N, static_cast (X), incX, static_cast (Y), incY, static_cast (val)); } // nrm2 <- ||x||_2 inline float nrm2 (int const N, float const* X, int const incX) { return cblas_snrm2 (N, X, incX); } inline double nrm2 (int const N, double const* X, int const incX) { return cblas_dnrm2 (N, X, incX); } inline float nrm2 (int const N, traits::complex_f const* X, int const incX) { return cblas_scnrm2 (N, static_cast (X), incX); } inline double nrm2 (int const N, traits::complex_d const* X, int const incX) { return cblas_dznrm2 (N, static_cast (X), incX); } // asum <- ||re (x)|| + ||im (x)|| inline float asum (int const N, float const* X, int const incX) { return cblas_sasum (N, X, incX); } inline double asum (int const N, double const* X, int const incX) { return cblas_dasum (N, X, incX); } inline float asum (int const N, traits::complex_f const* X, int const incX) { return cblas_scasum (N, static_cast (X), incX); } inline double asum (int const N, traits::complex_d const* X, int const incX) { return cblas_dzasum (N, static_cast (X), incX); } // iamax <- 1st i: max (|re (x_i)| + |im (x_i)|) inline CBLAS_INDEX iamax (int const N, float const* X, int const incX) { return cblas_isamax (N, X, incX); } inline CBLAS_INDEX iamax (int const N, double const* X, int const incX) { return cblas_idamax (N, X, incX); } inline CBLAS_INDEX iamax (int const N, traits::complex_f const* X, int const incX) { return cblas_icamax (N, static_cast (X), incX); } inline CBLAS_INDEX iamax (int const N, traits::complex_d const* X, int const incX) { return cblas_izamax (N, static_cast (X), incX); } // x <-> y inline void swap (int const N, float* X, int const incX, float* Y, int const incY) { cblas_sswap (N, X, incX, Y, incY); } inline void swap (int const N, double* X, int const incX, double* Y, int const incY) { cblas_dswap (N, X, incX, Y, incY); } inline void swap (int const N, traits::complex_f* X, int const incX, traits::complex_f* Y, int const incY) { cblas_cswap (N, static_cast (X), incX, static_cast (Y), incY); } inline void swap (int const N, traits::complex_d* X, int const incX, traits::complex_d* Y, int const incY) { cblas_zswap (N, static_cast (X), incX, static_cast (Y), incY); } // y <- x inline void copy (int const N, float const* X, int const incX, float* Y, int const incY) { cblas_scopy (N, X, incX, Y, incY); } inline void copy (int const N, double const* X, int const incX, double* Y, int const incY) { cblas_dcopy (N, X, incX, Y, incY); } inline void copy (int const N, traits::complex_f const* X, int const incX, traits::complex_f* Y, int const incY) { cblas_ccopy (N, static_cast (X), incX, static_cast (Y), incY); } inline void copy (int const N, traits::complex_d const* X, int const incX, traits::complex_d* Y, int const incY) { cblas_zcopy (N, static_cast (X), incX, static_cast (Y), incY); } // y <- alpha * x + y inline void axpy (int const N, float const alpha, float const* X, int const incX, float* Y, int const incY) { cblas_saxpy (N, alpha, X, incX, Y, incY); } inline void axpy (int const N, double const alpha, double const* X, int const incX, double* Y, int const incY) { cblas_daxpy (N, alpha, X, incX, Y, incY); } inline void axpy (int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f* Y, int const incY) { cblas_caxpy (N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY); } inline void axpy (int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d* Y, int const incY) { cblas_zaxpy (N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY); } // y <- alpha * x + beta * y inline void axpby (int const N, float const alpha, float const* X, int const incX, float const beta, float* Y, int const incY) { catlas_saxpby (N, alpha, X, incX, beta, Y, incY); } inline void axpby (int const N, double const alpha, double const* X, int const incX, double const beta, double* Y, int const incY) { catlas_daxpby (N, alpha, X, incX, beta, Y, incY); } inline void axpby (int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const& beta, traits::complex_f* Y, int const incY) { catlas_caxpby (N, static_cast (&alpha), static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } inline void axpby (int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const& beta, traits::complex_d* Y, int const incY) { catlas_zaxpby (N, static_cast (&alpha), static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } // x_i <- alpha for all i inline void set (int const N, float const alpha, float* X, int const incX) { catlas_sset (N, alpha, X, incX); } inline void set (int const N, double const alpha, double* X, int const incX) { catlas_dset (N, alpha, X, incX); } inline void set (int const N, traits::complex_f const& alpha, traits::complex_f* X, int const incX) { catlas_cset (N, static_cast (&alpha), static_cast (X), incX); } inline void set (int const N, traits::complex_d const& alpha, traits::complex_d* X, int const incX) { catlas_zset (N, static_cast (&alpha), static_cast (X), incX); } // x <- alpha * x inline void scal (int const N, float const alpha, float* X, int const incX) { cblas_sscal (N, alpha, X, incX); } inline void scal (int const N, double const alpha, double* X, int const incX) { cblas_dscal (N, alpha, X, incX); } inline void scal (int const N, traits::complex_f const& alpha, traits::complex_f* X, int const incX) { cblas_cscal (N, static_cast (&alpha), static_cast (X), incX); } inline void scal (int const N, float const alpha, traits::complex_f* X, int const incX) { cblas_csscal (N, alpha, static_cast (X), incX); } inline void scal (int const N, traits::complex_d const& alpha, traits::complex_d* X, int const incX) { cblas_zscal (N, static_cast (&alpha), static_cast (X), incX); } inline void scal (int const N, double const alpha, traits::complex_d* X, int const incX) { cblas_zdscal (N, alpha, static_cast (X), incX); } }} // namepaces detail & atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS1_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/atlas/cblas2.hpp0000644000175000017500000012513307725607602023203 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002, 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_2_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_2_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace atlas { // y <- alpha * op (A) * x + beta * y // op (A) == A || A^T || A^H template inline void gemv (CBLAS_TRANSPOSE const TransA, T const& alpha, Matr const& a, VctX const& x, T const& beta, VctY& y ) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (traits::vector_size (x) >= (TransA == CblasNoTrans ? n : m)); assert (traits::vector_size (y) >= (TransA == CblasNoTrans ? m : n)); // .. what about AtlasConj? CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename Matr::orientation_category #endif >::value); detail::gemv (stor_ord, TransA, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } // y <- alpha * A * x + beta * y template inline void gemv (T const& alpha, Matr const& a, VctX const& x, T const& beta, VctY& y) { gemv (CblasNoTrans, alpha, a, x, beta, y); } // y <- A * x template inline void gemv (Matr const& a, VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename Matr::value_type val_t; #endif gemv (CblasNoTrans, (val_t) 1, a, x, (val_t) 0, y); } // y <- alpha * A * x + beta * y // A real symmetric matrix (T == float | double) // [from 'dsymv.f':] /* [...] with UPLO = 'U' or 'u', the leading n by n upper * triangular part of the array A must contain the upper triangular * part of the symmetric matrix and the strictly lower triangular * part of A is not referenced. * [...] with UPLO = 'L' or 'l', the leading n by n lower * triangular part of the array A must contain the lower triangular * part of the symmetric matrix and the strictly upper * triangular part of A is not referenced. */ template inline void symv (CBLAS_UPLO const uplo, T const& alpha, SymmMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmMatr::orientation_category #endif >::value); detail::symv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } template inline void symv (T const& alpha, SymmMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmMatr::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmMatr::packed_category #endif >::value); detail::symv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } // y <- A * x template inline void symv (SymmMatr const& a, VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmMatr::value_type val_t; #endif symv ((val_t) 1, a, x, (val_t) 0, y); } // y <- alpha * A * x + beta * y // A real symmetric matrix (T == float | double) in packed form // [from 'dspmv.f' (description assumes column major order):] /* A is an array of DIMENSION ( ( n*( n + 1 ) )/2 ). * Before entry with UPLO = 'U' or 'u', the array A must contain * the upper triangular part of the symmetric matrix packed * sequentially, column by column, so that A( 1 ) contains a(1,1), * A( 2 ) and A( 3 ) contain a(1,2) and a(2,2) respectively, and * so on. * Before entry with UPLO = 'L' or 'l', the array A must contain * the lower triangular part of the symmetric matrix packed * sequentially, column by column, so that A( 1 ) contains a(1,1), * A( 2 ) and A( 3 ) contain a(2,1) and a(3,1) respectively, and * so on. */ template inline void spmv (T const& alpha, SymmMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmMatr::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmMatr::packed_category #endif >::value); detail::spmv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), traits::vector_storage (x), #else traits::matrix_storage_const (a), traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } // y <- A * x template inline void spmv (SymmMatr const& a, VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmMatr::value_type val_t; #endif spmv ((val_t) 1, a, x, (val_t) 0, y); } // y <- alpha * A * x + beta * y // A complex hermitian matrix // (T == std::complex | std::complex) template inline void hemv (CBLAS_UPLO const uplo, T const& alpha, HermMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermMatr::orientation_category #endif >::value); detail::hemv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } template inline void hemv (T const& alpha, HermMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermMatr::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermMatr::packed_category #endif >::value); detail::hemv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } // y <- A * x template inline void hemv (HermMatr const& a, VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermMatr::value_type val_t; #endif hemv ((val_t) 1, a, x, (val_t) 0, y); } // y <- alpha * A * x + beta * y // A complex hermitian matrix in packed form // (T == std::complex | std::complex) template inline void hpmv (T const& alpha, HermMatr const& a, VctX const& x, T const& beta, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermMatr::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermMatr::packed_category #endif >::value); detail::hpmv (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), traits::vector_storage (x), #else traits::matrix_storage_const (a), traits::vector_storage_const (x), #endif traits::vector_stride (x), beta, traits::vector_storage (y), traits::vector_stride (y)); } // y <- A * x template inline void hpmv (HermMatr const& a, VctX const& x, VctY& y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermMatr::value_type val_t; #endif hpmv ((val_t) 1, a, x, (val_t) 0, y); } // A <- alpha * x * y^T + A // .. real & complex types template inline void ger (T const& alpha, VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (traits::vector_size (x) >= m); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename Matr::orientation_category #endif >::value); detail::ger (stor_ord, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * y^T + A template inline void ger (VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename Matr::value_type val_t; #endif ger ((val_t) 1, x, y, a); } // A <- alpha * x * y^T + A // .. complex types only template inline void geru (T const& alpha, VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (traits::vector_size (x) >= m); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename Matr::orientation_category #endif >::value); detail::geru (stor_ord, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * y^T + A template inline void geru (VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename Matr::value_type val_t; #endif geru ((val_t) 1, x, y, a); } // A <- alpha * x * y^H + A // .. complex types only template inline void gerc (T const& alpha, VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (traits::vector_size (x) >= m); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename Matr::orientation_category #endif >::value); detail::gerc (stor_ord, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * y^H + A template inline void gerc (VctX const& x, VctY const& y, Matr& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename Matr::value_type val_t; #endif gerc ((val_t) 1, x, y, a); } // A <- alpha * x * x^T + A // A real symmetric (see leading comments for 'symv()') template inline void syr (CBLAS_UPLO const uplo, T const& alpha, VctX const& x, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); detail::syr (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a), traits::leading_dimension (a)); } template inline void syr (T const& alpha, VctX const& x, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmM::packed_category #endif >::value); detail::syr (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * x^T + A template inline void syr (VctX const& x, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmM::value_type val_t; #endif syr ((val_t) 1, x, a); } // A <- alpha * x * x^T + A // A real symmetric in packed form (see leading comments for 'spmv()') template inline void spr (T const& alpha, VctX const& x, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmM::packed_category #endif >::value); detail::spr (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a)); } // A <- x * x^T + A template inline void spr (VctX const& x, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmM::value_type val_t; #endif spr ((val_t) 1, x, a); } // A <- alpha * x * y^T + alpha * y * x^T + A // A real symmetric (see leading comments for 'symv()') template inline void syr2 (CBLAS_UPLO const uplo, T const& alpha, VctX const& x, VctY const& y, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); detail::syr2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } template inline void syr2 (T const& alpha, VctX const& x, VctY const& y, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmM::packed_category #endif >::value); detail::syr2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * y^T + y * x^T + A template inline void syr2 (VctX const& x, VctY const& y, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmM::value_type val_t; #endif syr2 ((val_t) 1, x, y, a); } // A <- alpha * x * y^T + alpha * y * x^T + A // A real symmetric in packed form (see leading comments for 'spmv()') template inline void spr2 (T const& alpha, VctX const& x, VctY const& y, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmM::packed_category #endif >::value); detail::spr2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a)); } // A <- x * y^T + y * x^T + A template inline void spr2 (VctX const& x, VctY const& y, SymmM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmM::value_type val_t; #endif spr2 ((val_t) 1, x, y, a); } // A <- alpha * x * x^H + A // A hermitian template inline void her (CBLAS_UPLO const uplo, T const& alpha, VctX const& x, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); detail::her (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a), traits::leading_dimension (a)); } template inline void her (T const& alpha, VctX const& x, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermM::packed_category #endif >::value); detail::her (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * x^H + A template inline void her (VctX const& x, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermM::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; her ((real_t) 1, x, a); } // A <- alpha * x * x^H + A // A hermitian in packed form template inline void hpr (T const& alpha, VctX const& x, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermM::packed_category #endif >::value); detail::hpr (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), traits::matrix_storage (a)); } // A <- x * x^H + A template inline void hpr (VctX const& x, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermM::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; hpr ((real_t) 1, x, a); } // A <- alpha * x * y^H + y * (alpha * x)^H + A // A hermitian template inline void her2 (CBLAS_UPLO const uplo, T const& alpha, VctX const& x, VctY const& y, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); detail::her2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } template inline void her2 (T const& alpha, VctX const& x, VctY const& y, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermM::packed_category #endif >::value); detail::her2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a), traits::leading_dimension (a)); } // A <- x * y^H + y * x^H + A template inline void her2 (VctX const& x, VctY const& y, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermM::value_type val_t; #endif her2 ((val_t) 1, x, y, a); } // A <- alpha * x * y^H + y * (alpha * x)^H + A // A hermitian in packed form template inline void hpr2 (T const& alpha, VctX const& x, VctY const& y, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (x) >= n); assert (traits::vector_size (y) >= n); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermM::orientation_category #endif >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermM::packed_category #endif >::value); detail::hpr2 (stor_ord, uplo, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (x), #else traits::vector_storage_const (x), #endif traits::vector_stride (x), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (y), #else traits::vector_storage_const (y), #endif traits::vector_stride (y), traits::matrix_storage (a)); } // A <- x * y^H + y * x^H + A template inline void hpr2 (VctX const& x, VctY const& y, HermM& a) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermM::value_type val_t; #endif hpr2 ((val_t) 1, x, y, a); } } // namespace atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_2_HPP boost-bindings/boost/numeric/bindings/atlas/cblas2_overloads.hpp0000644000175000017500000004421307725607602025260 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002, 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS2_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS2_OVERLOADS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace atlas { namespace detail { // y <- alpha * op (A) * x + beta * y inline void gemv (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, int const M, int const N, float const alpha, float const* A, int const lda, float const* X, int const incX, float const beta, float* Y, int const incY) { cblas_sgemv (Order, TransA, M, N, alpha, A, lda, X, incX, beta, Y, incY); } inline void gemv (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, int const M, int const N, double const alpha, double const* A, int const lda, double const* X, int const incX, double const beta, double* Y, int const incY) { cblas_dgemv (Order, TransA, M, N, alpha, A, lda, X, incX, beta, Y, incY); } inline void gemv (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* X, int const incX, traits::complex_f const& beta, traits::complex_f* Y, int const incY) { cblas_cgemv (Order, TransA, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } inline void gemv (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* X, int const incX, traits::complex_d const& beta, traits::complex_d* Y, int const incY) { cblas_zgemv (Order, TransA, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } // y <- alpha * A * x + beta * y // A real symmetric inline void symv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* A, int const lda, float const* X, int const incX, float const beta, float* Y, int const incY) { cblas_ssymv (Order, Uplo, N, alpha, A, lda, X, incX, beta, Y, incY); } inline void symv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* A, int const lda, double const* X, int const incX, double const beta, double* Y, int const incY) { cblas_dsymv (Order, Uplo, N, alpha, A, lda, X, incX, beta, Y, incY); } // y <- alpha * A * x + beta * y // A real symmetric in packed form inline void spmv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* Ap, float const* X, int const incX, float const beta, float* Y, int const incY) { cblas_sspmv (Order, Uplo, N, alpha, Ap, X, incX, beta, Y, incY); } inline void spmv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* Ap, double const* X, int const incX, double const beta, double* Y, int const incY) { cblas_dspmv (Order, Uplo, N, alpha, Ap, X, incX, beta, Y, incY); } // y <- alpha * A * x + beta * y // A complex hermitian inline void hemv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* X, int const incX, traits::complex_f const& beta, traits::complex_f* Y, int const incY) { cblas_chemv (Order, Uplo, N, static_cast (&alpha), static_cast (A), lda, static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } inline void hemv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* X, int const incX, traits::complex_d const& beta, traits::complex_d* Y, int const incY) { cblas_zhemv (Order, Uplo, N, static_cast (&alpha), static_cast (A), lda, static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } // y <- alpha * A * x + beta * y // A complex hermitian in packed form inline void hpmv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f const& alpha, traits::complex_f const* Ap, traits::complex_f const* X, int const incX, traits::complex_f const& beta, traits::complex_f* Y, int const incY) { cblas_chpmv (Order, Uplo, N, static_cast (&alpha), static_cast (Ap), static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } inline void hpmv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d const& alpha, traits::complex_d const* Ap, traits::complex_d const* X, int const incX, traits::complex_d const& beta, traits::complex_d* Y, int const incY) { cblas_zhpmv (Order, Uplo, N, static_cast (&alpha), static_cast (Ap), static_cast (X), incX, static_cast (&beta), static_cast (Y), incY); } // A <- alpha * x * y^T + A // .. real types: calls cblas_xger // .. complex types: calls cblas_xgeru inline void ger (CBLAS_ORDER const Order, int const M, int const N, float const alpha, float const* X, int const incX, float const* Y, int const incY, float* A, int const lda) { cblas_sger (Order, M, N, alpha, X, incX, Y, incY, A, lda); } inline void ger (CBLAS_ORDER const Order, int const M, int const N, double const alpha, double const* X, int const incX, double const* Y, int const incY, double* A, int const lda) { cblas_dger (Order, M, N, alpha, X, incX, Y, incY, A, lda); } inline void ger (CBLAS_ORDER const Order, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* A, int const lda) { cblas_cgeru (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } inline void ger (CBLAS_ORDER const Order, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* A, int const lda) { cblas_zgeru (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } // A <- alpha * x * y^T + A // .. complex types only inline void geru (CBLAS_ORDER const Order, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* A, int const lda) { cblas_cgeru (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } inline void geru (CBLAS_ORDER const Order, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* A, int const lda) { cblas_zgeru (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } // A <- alpha * x * y^H + A // .. complex types only inline void gerc (CBLAS_ORDER const Order, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* A, int const lda) { cblas_cgerc (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } inline void gerc (CBLAS_ORDER const Order, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* A, int const lda) { cblas_zgerc (Order, M, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } // A <- alpha * x * x^T + A // A real symmetric inline void syr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* X, int const incX, float* A, int const lda) { cblas_ssyr (Order, Uplo, N, alpha, X, incX, A, lda); } inline void syr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* X, int const incX, double* A, int const lda) { cblas_dsyr (Order, Uplo, N, alpha, X, incX, A, lda); } // A <- alpha * x * x^T + A // A real symmetric in packed form inline void spr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* X, int const incX, float* Ap) { cblas_sspr (Order, Uplo, N, alpha, X, incX, Ap); } inline void spr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* X, int const incX, double* Ap) { cblas_dspr (Order, Uplo, N, alpha, X, incX, Ap); } // A <- alpha * x * y^T + alpha * y * x^T + A // A real symmetric inline void syr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* X, int const incX, float const* Y, int const incY, float* A, int const lda) { cblas_ssyr2 (Order, Uplo, N, alpha, X, incX, Y, incY, A, lda); } inline void syr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* X, int const incX, double const* Y, int const incY, double* A, int const lda) { cblas_dsyr2 (Order, Uplo, N, alpha, X, incX, Y, incY, A, lda); } // A <- alpha * x * y^T + alpha * y * x^T + A // A real symmetric in packed form inline void spr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, float const* X, int const incX, float const* Y, int const incY, float* Ap) { cblas_sspr2 (Order, Uplo, N, alpha, X, incX, Y, incY, Ap); } inline void spr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, double const* X, int const incX, double const* Y, int const incY, double* Ap) { cblas_dspr2 (Order, Uplo, N, alpha, X, incX, Y, incY, Ap); } // A <- alpha * x * x^H + A // A hermitian inline void her (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, traits::complex_f const* X, int const incX, traits::complex_f* A, int const lda) { cblas_cher (Order, Uplo, N, alpha, static_cast (X), incX, static_cast (A), lda); } inline void her (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, traits::complex_d const* X, int const incX, traits::complex_d* A, int const lda) { cblas_zher (Order, Uplo, N, alpha, static_cast (X), incX, static_cast (A), lda); } // A <- alpha * x * x^H + A // A hermitian in packed form inline void hpr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float const alpha, traits::complex_f const* X, int const incX, traits::complex_f* Ap) { cblas_chpr (Order, Uplo, N, alpha, static_cast (X), incX, static_cast (Ap)); } inline void hpr (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double const alpha, traits::complex_d const* X, int const incX, traits::complex_d* Ap) { cblas_zhpr (Order, Uplo, N, alpha, static_cast (X), incX, static_cast (Ap)); } // A <- alpha * x * y^H + y * (alpha * x)^H + A // A hermitian inline void her2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* A, int const lda) { cblas_cher2 (Order, Uplo, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } inline void her2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* A, int const lda) { cblas_zher2 (Order, Uplo, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (A), lda); } // A <- alpha * x * y^H + y * (alpha * x)^H + A // A hermitian in packed form inline void hpr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f const& alpha, traits::complex_f const* X, int const incX, traits::complex_f const* Y, int const incY, traits::complex_f* Ap) { cblas_chpr2 (Order, Uplo, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (Ap)); } inline void hpr2 (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d const& alpha, traits::complex_d const* X, int const incX, traits::complex_d const* Y, int const incY, traits::complex_d* Ap) { cblas_zhpr2 (Order, Uplo, N, static_cast (&alpha), static_cast (X), incX, static_cast (Y), incY, static_cast (Ap)); } }} // namepaces detail & atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS2_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/atlas/cblas3.hpp0000644000175000017500000011735707725607602023215 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_3_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_3_HPP #include #include #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include #endif namespace boost { namespace numeric { namespace bindings { namespace atlas { // C <- alpha * op (A) * op (B) + beta * C // op (A) == A || A^T || A^H template inline void gemm (CBLAS_TRANSPOSE const TransA, CBLAS_TRANSPOSE const TransB, T const& alpha, MatrA const& a, MatrB const& b, T const& beta, MatrC& c ) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (TransA == CblasNoTrans || TransA == CblasTrans || TransA == CblasConjTrans); assert (TransB == CblasNoTrans || TransB == CblasTrans || TransB == CblasConjTrans); int const m = TransA == CblasNoTrans ? traits::matrix_size1 (a) : traits::matrix_size2 (a); int const n = TransB == CblasNoTrans ? traits::matrix_size2 (b) : traits::matrix_size1 (b); int const k = TransA == CblasNoTrans ? traits::matrix_size2 (a) : traits::matrix_size1 (a); assert (m == traits::matrix_size1 (c)); assert (n == traits::matrix_size2 (c)); #ifndef NDEBUG int const k1 = TransB == CblasNoTrans ? traits::matrix_size1 (b) : traits::matrix_size2 (b); assert (k == k1); #endif // .. what about AtlasConj? CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); detail::gemm (stor_ord, TransA, TransB, m, n, k, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (b), #else traits::matrix_storage_const (b), #endif traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } // C <- alpha * A * B + beta * C template inline void gemm (T const& alpha, MatrA const& a, MatrB const& b, T const& beta, MatrC& c) { gemm (CblasNoTrans, CblasNoTrans, alpha, a, b, beta, c) ; } // C <- A * B template inline void gemm (MatrA const& a, MatrB const& b, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrC::value_type val_t; #endif gemm (CblasNoTrans, CblasNoTrans, (val_t) 1, a, b, (val_t) 0, c); } // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^T namespace detail { template inline void symm (CBLAS_SIDE const side, CBLAS_UPLO const uplo, T const& alpha, SymmA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (side == CblasLeft || side == CblasRight); assert (uplo == CblasUpper || uplo == CblasLower); int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (side == CblasLeft ? m == traits::matrix_size1 (a) && m == traits::matrix_size2 (a) : n == traits::matrix_size1 (a) && n == traits::matrix_size2 (a)); assert (m == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmA::orientation_category #endif >::value); symm (stor_ord, side, uplo, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (b), #else traits::matrix_storage_const (b), #endif traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^T template inline void symm (CBLAS_SIDE const side, CBLAS_UPLO const uplo, T const& alpha, SymmA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::symm (side, uplo, alpha, a, b, beta, c); } template inline void symm (CBLAS_SIDE const side, T const& alpha, SymmA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmA::packed_category #endif >::value); detail::symm (side, uplo, alpha, a, b, beta, c); } #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS namespace detail { // C <- alpha * A * B + beta * C ; A == A^T struct symm_left { template static void f (T const& alpha, SymmA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (m == traits::matrix_size1 (a) && m == traits::matrix_size2 (a)); assert (m == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< typename traits::matrix_traits::ordering_type >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< typename traits::matrix_traits::uplo_type >::value); symm (stor_ord, CblasLeft, uplo, m, n, alpha, traits::matrix_storage (a), traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } }; // C <- alpha * A * B + beta * C ; B == B^T struct symm_right { template static void f (T const& alpha, MatrA const& a, SymmB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (n == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); assert (m == traits::matrix_size1 (a) && n == traits::matrix_size2 (a)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< typename traits::matrix_traits::ordering_type >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< typename traits::matrix_traits::uplo_type >::value); symm (stor_ord, CblasRight, uplo, m, n, alpha, traits::matrix_storage (b), traits::leading_dimension (b), traits::matrix_storage (a), traits::leading_dimension (a), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } }; } // detail // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^T template inline void symm (T const& alpha, MatrA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif typedef typename boost::mpl::if_c< boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value, detail::symm_left, detail::symm_right >::type functor; functor::f (alpha, a, b, beta, c); } // C <- A * B // C <- B * A template inline void symm (MatrA const& a, MatrB const& b, MatrC& c) { typedef typename traits::matrix_traits::value_type val_t; symm ((val_t) 1, a, b, (val_t) 0, c); } #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^H namespace detail { template inline void hemm (CBLAS_SIDE const side, CBLAS_UPLO const uplo, T const& alpha, HermA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (side == CblasLeft || side == CblasRight); assert (uplo == CblasUpper || uplo == CblasLower); int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (side == CblasLeft ? m == traits::matrix_size1 (a) && m == traits::matrix_size2 (a) : n == traits::matrix_size1 (a) && n == traits::matrix_size2 (a)); assert (m == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermA::orientation_category #endif >::value); hemm (stor_ord, side, uplo, m, n, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (b), #else traits::matrix_storage_const (b), #endif traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^H template inline void hemm (CBLAS_SIDE const side, CBLAS_UPLO const uplo, T const& alpha, HermA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::hemm (side, uplo, alpha, a, b, beta, c); } template inline void hemm (CBLAS_SIDE const side, T const& alpha, HermA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermA::packed_category #endif >::value); detail::hemm (side, uplo, alpha, a, b, beta, c); } #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS namespace detail { // C <- alpha * A * B + beta * C ; A == A^H struct hemm_left { template static void f (T const& alpha, HermA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (m == traits::matrix_size1 (a) && m == traits::matrix_size2 (a)); assert (m == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< typename traits::matrix_traits::ordering_type >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< typename traits::matrix_traits::uplo_type >::value); hemm (stor_ord, CblasLeft, uplo, m, n, alpha, traits::matrix_storage (a), traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } }; // C <- alpha * A * B + beta * C ; B == B^H struct hemm_right { template static void f (T const& alpha, MatrA const& a, HermB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); assert (n == traits::matrix_size1 (b) && n == traits::matrix_size2 (b)); assert (m == traits::matrix_size1 (a) && n == traits::matrix_size2 (a)); CBLAS_ORDER const stor_ord = enum_cast (storage_order< typename traits::matrix_traits::ordering_type >::value); CBLAS_UPLO const uplo = enum_cast (uplo_triang< typename traits::matrix_traits::uplo_type >::value); hemm (stor_ord, CblasRight, uplo, m, n, alpha, traits::matrix_storage (b), traits::leading_dimension (b), traits::matrix_storage (a), traits::leading_dimension (a), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } }; } template inline void hemm (T const& alpha, MatrA const& a, MatrB const& b, T const& beta, MatrC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif typedef typename boost::mpl::if_c< boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value, detail::hemm_left, detail::hemm_right >::type functor; functor::f (alpha, a, b, beta, c); } // C <- A * B // C <- B * A template inline void hemm (MatrA const& a, MatrB const& b, MatrC& c) { typedef typename traits::matrix_traits::value_type val_t; hemm ((val_t) 1, a, b, (val_t) 0, c); } #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS // C <- alpha * A * A^T + beta * C // C <- alpha * A^T * A + beta * C // C == C^T namespace detail { template inline void syrk (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); assert (trans == CblasNoTrans || trans == CblasTrans || trans == CblasConjTrans); int const n = traits::matrix_size1 (c); assert (n == traits::matrix_size2 (c)); int const k = trans == CblasNoTrans ? traits::matrix_size2 (a) : traits::matrix_size1 (a); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (a) : traits::matrix_size2 (a))); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmC::orientation_category #endif >::value); syrk (stor_ord, uplo, trans, n, k, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * A^T + beta * C // C <- alpha * A^T * A + beta * C // C == C^T template inline void syrk (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::syrk (uplo, trans, alpha, a, beta, c); } template inline void syrk (CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmC::packed_category #endif >::value); detail::syrk (uplo, trans, alpha, a, beta, c); } // C <- A * A^T + C // C <- A^T * A + C template inline void syrk (CBLAS_TRANSPOSE trans, MatrA const& a, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmC::value_type val_t; #endif syrk (trans, (val_t) 1, a, (val_t) 0, c); } // C <- alpha * A * B^T + conj(alpha) * B * A^T + beta * C // C <- alpha * A^T * B + conj(alpha) * B^T * A + beta * C // C == C^T namespace detail { template inline void syr2k (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, MatrB const& b, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); assert (trans == CblasNoTrans || trans == CblasTrans || trans == CblasConjTrans); int const n = traits::matrix_size1 (c); assert (n == traits::matrix_size2 (c)); int const k = trans == CblasNoTrans ? traits::matrix_size2 (a) : traits::matrix_size1 (a); assert (k == (trans == CblasNoTrans ? traits::matrix_size2 (b) : traits::matrix_size1 (b))); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (a) : traits::matrix_size2 (a))); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmC::orientation_category #endif >::value); syr2k (stor_ord, uplo, trans, n, k, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (b), #else traits::matrix_storage_const (b), #endif traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * B^T + conj(alpha) * B * A^T + beta * C // C <- alpha * A^T * B + conj(alpha) * B^T * A + beta * C // C == C^T template inline void syr2k (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, MatrB const& b, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::syr2k (uplo, trans, alpha, a, b, beta, c); } template inline void syr2k (CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, MatrB const& b, T const& beta, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmC::packed_category #endif >::value); detail::syr2k (uplo, trans, alpha, a, b, beta, c); } // C <- A * B^T + B * A^T + C // C <- A^T * B + B^T * A + C template inline void syr2k (CBLAS_TRANSPOSE trans, MatrA const& a, MatrB const& b, SymmC& c) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmC::value_type val_t; #endif syr2k (trans, (val_t) 1, a, b, (val_t) 0, c); } // C <- alpha * A * A^H + beta * C // C <- alpha * A^H * A + beta * C // C == C^H namespace detail { template inline void herk (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); assert (trans == CblasNoTrans || trans == CblasConjTrans); int const n = traits::matrix_size1 (c); assert (n == traits::matrix_size2 (c)); int const k = trans == CblasNoTrans ? traits::matrix_size2 (a) : traits::matrix_size1 (a); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (a) : traits::matrix_size2 (a))); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermC::orientation_category #endif >::value); herk (stor_ord, uplo, trans, n, k, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * A^H + beta * C // C <- alpha * A^H * A + beta * C // C == C^H template inline void herk (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::herk (uplo, trans, alpha, a, beta, c); } template inline void herk (CBLAS_TRANSPOSE trans, T const& alpha, MatrA const& a, T const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermC::packed_category #endif >::value); detail::herk (uplo, trans, alpha, a, beta, c); } // C <- A * A^H + C // C <- A^H * A + C template inline void herk (CBLAS_TRANSPOSE trans, MatrA const& a, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermC::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; herk (trans, (real_t) 1, a, (real_t) 0, c); } // C <- alpha * A * B^H + conj(alpha) * B * A^H + beta * C // C <- alpha * A^H * B + conj(alpha) * B^H * A + beta * C // C == C^H namespace detail { template inline void her2k (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T1 const& alpha, MatrA const& a, MatrB const& b, T2 const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); assert (trans == CblasNoTrans || trans == CblasConjTrans); int const n = traits::matrix_size1 (c); assert (n == traits::matrix_size2 (c)); int const k = trans == CblasNoTrans ? traits::matrix_size2 (a) : traits::matrix_size1 (a); assert (k == (trans == CblasNoTrans ? traits::matrix_size2 (b) : traits::matrix_size1 (b))); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (a) : traits::matrix_size2 (a))); assert (n == (trans == CblasNoTrans ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename HermC::orientation_category #endif >::value); her2k (stor_ord, uplo, trans, n, k, alpha, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (b), #else traits::matrix_storage_const (b), #endif traits::leading_dimension (b), beta, traits::matrix_storage (c), traits::leading_dimension (c)); } } // detail // C <- alpha * A * B^H + conj(alpha) * B * A^H + beta * C // C <- alpha * A^H * B + conj(alpha) * B^H * A + beta * C // C == C^H template inline void her2k (CBLAS_UPLO const uplo, CBLAS_TRANSPOSE trans, T1 const& alpha, MatrA const& a, MatrB const& b, T2 const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif detail::her2k (uplo, trans, alpha, a, b, beta, c); } template inline void her2k (CBLAS_TRANSPOSE trans, T1 const& alpha, MatrA const& a, MatrB const& b, T2 const& beta, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename HermC::packed_category #endif >::value); detail::her2k (uplo, trans, alpha, a, b, beta, c); } // C <- A * B^H + B * A^H + C // C <- A^H * B + B^H * A + C template inline void her2k (CBLAS_TRANSPOSE trans, MatrA const& a, MatrB const& b, HermC& c) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermC::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; her2k (trans, (val_t) 1, a, b, (real_t) 0, c); } } // namespace atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS_LEVEL_3_HPP boost-bindings/boost/numeric/bindings/atlas/cblas3_overloads.hpp0000644000175000017500000003461107725607602025262 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS3_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS3_OVERLOADS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace atlas { namespace detail { // C <- alpha * op (A) * op (B) + beta * C inline void gemm (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, CBLAS_TRANSPOSE const TransB, int const M, int const N, int const K, float const alpha, float const* A, int const lda, float const* B, int const ldb, float const beta, float* C, int const ldc) { cblas_sgemm (Order, TransA, TransB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc); } inline void gemm (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, CBLAS_TRANSPOSE const TransB, int const M, int const N, int const K, double const alpha, double const* A, int const lda, double const* B, int const ldb, double const beta, double* C, int const ldc) { cblas_dgemm (Order, TransA, TransB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc); } inline void gemm (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, CBLAS_TRANSPOSE const TransB, int const M, int const N, int const K, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* B, int const ldb, traits::complex_f const& beta, traits::complex_f* C, int const ldc) { cblas_cgemm (Order, TransA, TransB, M, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } inline void gemm (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const TransA, CBLAS_TRANSPOSE const TransB, int const M, int const N, int const K, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* B, int const ldb, traits::complex_d const& beta, traits::complex_d* C, int const ldc) { cblas_zgemm (Order, TransA, TransB, M, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^T inline void symm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, float const alpha, float const* A, int const lda, float const* B, int const ldb, float const beta, float* C, int const ldc) { cblas_ssymm (Order, Side, Uplo, M, N, alpha, A, lda, B, ldb, beta, C, ldc); } inline void symm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, double const alpha, double const* A, int const lda, double const* B, int const ldb, double const beta, double* C, int const ldc) { cblas_dsymm (Order, Side, Uplo, M, N, alpha, A, lda, B, ldb, beta, C, ldc); } inline void symm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* B, int const ldb, traits::complex_f const& beta, traits::complex_f* C, int const ldc) { cblas_csymm (Order, Side, Uplo, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } inline void symm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* B, int const ldb, traits::complex_d const& beta, traits::complex_d* C, int const ldc) { cblas_zsymm (Order, Side, Uplo, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } // C <- alpha * A * B + beta * C // C <- alpha * B * A + beta * C // A == A^H inline void hemm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* B, int const ldb, traits::complex_f const& beta, traits::complex_f* C, int const ldc) { cblas_chemm (Order, Side, Uplo, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } inline void hemm (CBLAS_ORDER const Order, CBLAS_SIDE const Side, CBLAS_UPLO const Uplo, int const M, int const N, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* B, int const ldb, traits::complex_d const& beta, traits::complex_d* C, int const ldc) { cblas_zhemm (Order, Side, Uplo, M, N, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } // C <- alpha * A * A^T + beta * C // C <- alpha * A^T * A + beta * C // C == C^T inline void syrk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, float const alpha, float const* A, int const lda, float const beta, float* C, int const ldc) { cblas_ssyrk (Order, Uplo, Trans, N, K, alpha, A, lda, beta, C, ldc); } inline void syrk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, double const alpha, double const* A, int const lda, double const beta, double* C, int const ldc) { cblas_dsyrk (Order, Uplo, Trans, N, K, alpha, A, lda, beta, C, ldc); } inline void syrk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const& beta, traits::complex_f* C, int const ldc) { cblas_csyrk (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (&beta), static_cast (C), ldc); } inline void syrk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const& beta, traits::complex_d* C, int const ldc) { cblas_zsyrk (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (&beta), static_cast (C), ldc); } // C <- alpha * A * B^T + conj(alpha) * B * A^T + beta * C // C <- alpha * A^T * B + conj(alpha) * B^T * A + beta * C // C == C^T inline void syr2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, float const alpha, float const* A, int const lda, float const* B, int const ldb, float const beta, float* C, int const ldc) { cblas_ssyr2k (Order, Uplo, Trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc); } inline void syr2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, double const alpha, double const* A, int const lda, double const* B, int const ldb, double const beta, double* C, int const ldc) { cblas_dsyr2k (Order, Uplo, Trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc); } inline void syr2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* B, int const ldb, traits::complex_f const& beta, traits::complex_f* C, int const ldc) { cblas_csyr2k (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } inline void syr2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* B, int const ldb, traits::complex_d const& beta, traits::complex_d* C, int const ldc) { cblas_zsyr2k (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, static_cast (&beta), static_cast (C), ldc); } // C <- alpha * A * A^H + beta * C // C <- alpha * A^H * A + beta * C // C == C^H inline void herk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, float alpha, traits::complex_f const* A, int const lda, float beta, traits::complex_f* C, int const ldc) { cblas_cherk (Order, Uplo, Trans, N, K, alpha, static_cast (A), lda, beta, static_cast (C), ldc); } inline void herk (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, double alpha, traits::complex_d const* A, int const lda, double beta, traits::complex_d* C, int const ldc) { cblas_zherk (Order, Uplo, Trans, N, K, alpha, static_cast (A), lda, beta, static_cast (C), ldc); } // C <- alpha * A * B^H + conj(alpha) * B * A^H + beta * C // C <- alpha * A^H * B + conj(alpha) * B^H * A + beta * C // C == C^H inline void her2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_f const& alpha, traits::complex_f const* A, int const lda, traits::complex_f const* B, int const ldb, float beta, traits::complex_f* C, int const ldc) { cblas_cher2k (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, beta, static_cast (C), ldc); } inline void her2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, CBLAS_TRANSPOSE const Trans, int const N, int const K, traits::complex_d const& alpha, traits::complex_d const* A, int const lda, traits::complex_d const* B, int const ldb, double beta, traits::complex_d* C, int const ldc) { cblas_zher2k (Order, Uplo, Trans, N, K, static_cast (&alpha), static_cast (A), lda, static_cast (B), ldb, beta, static_cast (C), ldc); } }} // namepaces detail & atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CBLAS3_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/atlas/cblas_enum.hpp0000644000175000017500000000444707725607602024151 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_ENUM_HPP #define BOOST_NUMERIC_BINDINGS_CBLAS_ENUM_HPP #include #include #ifdef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS # include #endif namespace boost { namespace numeric { namespace bindings { namespace atlas { template struct storage_order {}; #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS template<> struct storage_order { // 'ename' - como (in enum_cast<>): // a template argument may not reference an unnamed type enum ename { value = CblasRowMajor }; }; template<> struct storage_order { enum ename { value = CblasColMajor }; }; #else template<> struct storage_order { enum ename { value = CblasRowMajor }; }; template<> struct storage_order { enum ename { value = CblasColMajor }; }; #endif template struct uplo_triang {}; #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS template<> struct uplo_triang { enum ename { value = CblasUpper }; }; template<> struct uplo_triang { enum ename { value = CblasLower }; }; #else template<> struct uplo_triang { enum ename { value = CblasUpper }; }; template<> struct uplo_triang { enum ename { value = CblasLower }; }; #endif // g++ 3.0.4 rejects 'static_cast (e2)' template E1 enum_cast (E2 e2) { return static_cast (static_cast (e2)); } } }}} #endif boost-bindings/boost/numeric/bindings/atlas/cblas_inc.hpp0000644000175000017500000000203607725607602023746 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ ////////////////////////////////////////////////////////////////////////// // // ATLAS (Automatically Tuned Linear Algebra Software) // // ''At present, it provides C and Fortran77 interfaces to a portably // efficient BLAS implementation, as well as a few routines from LAPACK.'' // // see: http://math-atlas.sourceforge.net/ // ////////////////////////////////////////////////////////////////////////// #ifndef BOOST_NUMERIC_BINDINGS_CBLAS_INC_H #define BOOST_NUMERIC_BINDINGS_CBLAS_INC_H extern "C" { # include } #endif boost-bindings/boost/numeric/bindings/atlas/clapack.hpp0000644000175000017500000006420307725607602023433 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CLAPACK_HPP #define BOOST_NUMERIC_BINDINGS_CLAPACK_HPP #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS # include #endif #include // see libs/numeric/bindings/atlas/doc/index.html, section 2.5.2 //#define BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace atlas { ///////////////////////////////////////////////////////////////////// // // general system of linear equations A * X = B // ///////////////////////////////////////////////////////////////////// // gesv(): 'driver' function // // [comments from 'clapack_dgesv.c':] /* clapack_xgesv computes the solution to a system of linear equations * A * X = B, * where A is an N-by-N matrix and X and B are N-by-NRHS matrices. */ // [but ATLAS FAQ says:] /* What's the deal with the RHS in the row-major factorization/solves? * Most users are confused by the row major factorization and related * solves. The right-hand side vectors are probably the biggest source * of confusion. The RHS array does not represent a matrix in the * mathematical sense, it is instead a pasting together of the various * RHS into one array for calling convenience. As such, RHS vectors are * always stored contiguously, regardless of the row/col major that is * chosen. This means that ldb/ldx is always independent of NRHS, and * dependant on N, regardless of the row/col major setting. */ // That is, it seems that, if B is row-major, it should be NRHS-by-N, // and RHS vectors should be its rows, not columns. // // [comments from 'clapack_dgesv.c':] /* The LU factorization used to factor A is dependent on the Order * parameter, as detailed in the leading comments of clapack_dgetrf. * The factored form of A is then used to solve the system of equations * A * X = B. * A is overwritten with the appropriate LU factorization, and B [...] * is overwritten with the solution X on output. */ // If B is row-major, solution vectors are its rows. template inline int gesv (MatrA& a, IVec& ipiv, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); int const nrhs = stor_ord == CblasColMajor ? traits::matrix_size2 (b) : traits::matrix_size1 (b); assert (n == traits::matrix_size2 (a)); assert (n == (stor_ord == CblasColMajor ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); assert (n == traits::vector_size (ipiv)); return detail::gesv (stor_ord, n, nrhs, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (ipiv), traits::matrix_storage (b), traits::leading_dimension (b)); } template inline int gesv (MatrA& a, MatrB& b) { // with 'internal' pivot vector #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); int const nrhs = stor_ord == CblasColMajor ? traits::matrix_size2 (b) : traits::matrix_size1 (b); assert (n == traits::matrix_size2 (a)); assert (n == (stor_ord == CblasColMajor ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); int *ipiv = new (std::nothrow) int[n]; int ierr = -101; // clapack_dgesv() errors: // if (ierr == 0), successful // if (ierr < 0), the -ierr argument had an illegal value // -- we will use -101 if allocation fails // if (ierr > 0), U(i-1,i-1) (or L(i-1,i-1)) is exactly zero if (ipiv) { ierr = detail::gesv (stor_ord, n, nrhs, traits::matrix_storage (a), traits::leading_dimension (a), ipiv, traits::matrix_storage (b), traits::leading_dimension (b)); delete[] ipiv; } return ierr; } template inline int lu_solve (MatrA& a, MatrB& b) { return gesv (a, b); } // getrf(): LU factorization of A // [comments from 'clapack_dgetrf.c':] /* Computes one of two LU factorizations based on the setting of * the Order parameter, as follows: * --------------------------------------------------------------- * Order == CblasColMajor * Column-major factorization of form * A = P * L * U * where P is a row-permutation matrix, L is lower triangular with * unit diagonal elements (lower trapezoidal if M > N), and U is * upper triangular (upper trapezoidal if M < N). * --------------------------------------------------------------- * Order == CblasRowMajor * Row-major factorization of form * A = P * L * U * where P is a column-permutation matrix, L is lower triangular * (lower trapezoidal if M > N), and U is upper triangular with * unit diagonals (upper trapezoidal if M < N). */ template inline int getrf (MatrA& a, IVec& ipiv) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (traits::vector_size (ipiv) == (m < n ? m : n)); return detail::getrf (stor_ord, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (ipiv)); } template inline int lu_factor (MatrA& a, IVec& ipiv) { return getrf (a, ipiv); } // getrs(): solves a system of linear equations // A * X = B or A' * X = B // using the LU factorization previously computed by getrf() template inline int getrs (CBLAS_TRANSPOSE const Trans, MatrA const& a, IVec const& ipiv, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif assert (Trans == CblasNoTrans || Trans == CblasTrans || Trans == CblasConjTrans); CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); int const nrhs = stor_ord == CblasColMajor ? traits::matrix_size2 (b) : traits::matrix_size1 (b); assert (n == traits::matrix_size2 (a)); assert (n == (stor_ord == CblasColMajor ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); assert (n == traits::vector_size (ipiv)); return detail::getrs (stor_ord, Trans, n, nrhs, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (ipiv), #else traits::vector_storage_const (ipiv), #endif traits::matrix_storage (b), traits::leading_dimension (b)); } // getrs(): solves A * X = B (after getrf()) template inline int getrs (MatrA const& a, IVec const& ipiv, MatrB& b) { return getrs (CblasNoTrans, a, ipiv, b); } template inline int lu_substitute (MatrA const& a, IVec const& ipiv, MatrB& b) { return getrs (CblasNoTrans, a, ipiv, b); } // getri(): computes the inverse of a matrix A // using the LU factorization previously computed by getrf() template inline int getri (MatrA& a, IVec const& ipiv) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename MatrA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (traits::vector_size (ipiv) == n); return detail::getri (stor_ord, n, traits::matrix_storage (a), traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (ipiv) #else traits::vector_storage_const (ipiv) #endif ); } template inline int lu_invert (MatrA& a, IVec& ipiv) { return getri (a, ipiv); } ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B // with A symmetric or Hermitian positive definite matrix // ///////////////////////////////////////////////////////////////////// #ifndef BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // posv(): 'driver' function // // [from 'dposv.f' (slightly edited):] /* XPOSV computes the solution to a system of linear equations * A * X = B, * where A is an N-by-N symmetric/Hermitian positive definite matrix * and X and B are N-by-NRHS matrices. [See also comments of gesv().] * * A -- On entry, the symmetric/Hermitian matrix A. * If UPLO = 'U', the leading N-by-N upper triangular part of A * contains the upper triangular part of the matrix A, and the * strictly lower triangular part of A is not referenced. * If UPLO = 'L', the leading N-by-N lower triangular part of A * contains the lower triangular part of the matrix A, and the * strictly upper triangular part of A is not referenced. * * On exit, if INFO = 0, the factor U or L from the Cholesky * factorization A = U**T*U or A = L*L**T * [or A = U**H*U or A = L*L**H]. * * B -- On entry, the right hand side matrix B. * On exit, if INFO = 0, the solution matrix X. */ namespace detail { template inline int posv (CBLAS_UPLO const uplo, SymmA& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); int const nrhs = stor_ord == CblasColMajor ? traits::matrix_size2 (b) : traits::matrix_size1 (b); assert (n == traits::matrix_size2 (a)); assert (n == (stor_ord == CblasColMajor ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); return posv (stor_ord, uplo, n, nrhs, traits::matrix_storage (a), traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b)); } } // detail template inline int posv (CBLAS_UPLO const uplo, SymmA& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); return detail::posv (uplo, a, b); } template inline int posv (SymmA& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef typename traits::matrix_traits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmA::packed_category #endif >::value); return detail::posv (uplo, a, b); } template inline int cholesky_solve (SymmA& a, MatrB& b) { return posv (a, b); } #endif // BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // potrf(): Cholesky factorization of A namespace detail { template inline int potrf (CBLAS_UPLO const uplo, SymmA& a) { CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); return potrf (stor_ord, uplo, n, traits::matrix_storage (a), traits::leading_dimension (a)); } } // detail template inline int potrf (CBLAS_UPLO const uplo, SymmA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); return detail::potrf (uplo, a); } template inline int potrf (SymmA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef typename traits::matrix_traits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmA::packed_category #endif >::value); return detail::potrf (uplo, a); } template inline int cholesky_factor (SymmA& a) { return potrf (a); } // potrs(): solves a system of linear equations A * X = B // using the Cholesky factorization computed by potrf() namespace detail { template inline int potrs (CBLAS_UPLO const uplo, SymmA const& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::ordering_type, typename traits::matrix_traits::ordering_type >::value)); #endif CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); int const nrhs = stor_ord == CblasColMajor ? traits::matrix_size2 (b) : traits::matrix_size1 (b); assert (n == traits::matrix_size2 (a)); assert (n == (stor_ord == CblasColMajor ? traits::matrix_size1 (b) : traits::matrix_size2 (b))); #ifndef BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG return potrs (stor_ord, uplo, n, nrhs, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b)); #else // BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG int ierr; if (stor_ord == CblasColMajor) ierr = potrs (stor_ord, uplo, n, nrhs, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b)); else // ATLAS bug with CblasRowMajor ierr = potrs_bug (stor_ord, uplo, n, nrhs, #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b)); return ierr; #endif // BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG } } // detail template inline int potrs (CBLAS_UPLO const uplo, SymmA const& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); return detail::potrs (uplo, a, b); } template inline int potrs (SymmA const& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef typename traits::matrix_traits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmA::packed_category #endif >::value); return detail::potrs (uplo, a, b); } template inline int cholesky_substitute (SymmA const& a, MatrB& b) { return potrs (a, b); } #ifdef BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // posv(): 'driver' function template inline int posv (CBLAS_UPLO const uplo, SymmA& a, MatrB& b) { int ierr = potrf (uplo, a); if (ierr == 0) ierr = potrs (uplo, a, b); return ierr; } template inline int posv (SymmA& a, MatrB& b) { int ierr = potrf (a); if (ierr == 0) ierr = potrs (a, b); return ierr; } template inline int cholesky_solve (SymmA& a, MatrB& b) { return posv (a, b); } #endif // BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // potri(): computes the inverse of a symmetric or Hermitian positive // definite matrix A using the Cholesky factorization // previously computed by potrf() namespace detail { template inline int potri (CBLAS_UPLO const uplo, SymmA& a) { CBLAS_ORDER const stor_ord = enum_cast (storage_order< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::ordering_type #else typename SymmA::orientation_category #endif >::value); int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); return potri (stor_ord, uplo, n, traits::matrix_storage (a), traits::leading_dimension (a)); } } // detail template inline int potri (CBLAS_UPLO const uplo, SymmA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (uplo == CblasUpper || uplo == CblasLower); return detail::potri (uplo, a); } template inline int potri (SymmA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef typename traits::matrix_traits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); #endif CBLAS_UPLO const uplo = enum_cast (uplo_triang< #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::matrix_traits::uplo_type #else typename SymmA::packed_category #endif >::value); return detail::potri (uplo, a); } template inline int cholesky_invert (SymmA& a) { return potri (a); } } // namespace atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CLAPACK_HPP boost-bindings/boost/numeric/bindings/atlas/clapack_inc.hpp0000644000175000017500000000221607725607602024260 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ ////////////////////////////////////////////////////////////////////////// // // ATLAS (Automatically Tuned Linear Algebra Software) // // ''At present, it provides C and Fortran77 interfaces to a portably // efficient BLAS implementation, as well as a few routines from LAPACK.'' // // see: http://math-atlas.sourceforge.net/ // ////////////////////////////////////////////////////////////////////////// #ifndef BOOST_NUMERIC_BINDINGS_CLAPACK_INC_H #define BOOST_NUMERIC_BINDINGS_CLAPACK_INC_H extern "C" { /* see footnote [2] in libs/numeric/bindings/lapack/doc/index.html */ /* #include */ #include } #endif boost-bindings/boost/numeric/bindings/atlas/clapack_overloads.hpp0000644000175000017500000003067407725607602025516 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_CLAPACK_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_CLAPACK_OVERLOADS_HPP #include #include namespace boost { namespace numeric { namespace bindings { namespace atlas { namespace detail { // // general system of linear equations A * X = B // // 'driver' function -- factor and solve inline int gesv (CBLAS_ORDER const Order, int const N, int const NRHS, float* A, int const lda, int* ipiv, float* B, int const ldb) { return clapack_sgesv (Order, N, NRHS, A, lda, ipiv, B, ldb); } inline int gesv (CBLAS_ORDER const Order, int const N, int const NRHS, double* A, int const lda, int* ipiv, double* B, int const ldb) { return clapack_dgesv (Order, N, NRHS, A, lda, ipiv, B, ldb); } inline int gesv (CBLAS_ORDER const Order, int const N, int const NRHS, traits::complex_f* A, int const lda, int* ipiv, traits::complex_f* B, int const ldb) { return clapack_cgesv (Order, N, NRHS, static_cast (A), lda, ipiv, static_cast (B), ldb); } inline int gesv (CBLAS_ORDER const Order, int const N, int const NRHS, traits::complex_d* A, int const lda, int* ipiv, traits::complex_d* B, int const ldb) { return clapack_zgesv (Order, N, NRHS, static_cast (A), lda, ipiv, static_cast (B), ldb); } // LU factorization inline int getrf (CBLAS_ORDER const Order, int const M, int const N, float* A, int const lda, int* ipiv) { return clapack_sgetrf (Order, M, N, A, lda, ipiv); } inline int getrf (CBLAS_ORDER const Order, int const M, int const N, double* A, int const lda, int* ipiv) { return clapack_dgetrf (Order, M, N, A, lda, ipiv); } inline int getrf (CBLAS_ORDER const Order, int const M, int const N, traits::complex_f* A, int const lda, int* ipiv) { return clapack_cgetrf (Order, M, N, static_cast (A), lda, ipiv); } inline int getrf (CBLAS_ORDER const Order, int const M, int const N, traits::complex_d* A, int const lda, int* ipiv) { return clapack_zgetrf (Order, M, N, static_cast (A), lda, ipiv); } // solve (using factorization computed by getrf()) inline int getrs (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const Trans, int const N, int const NRHS, float const* A, int const lda, int const* ipiv, float* B, int const ldb) { return clapack_sgetrs (Order, Trans, N, NRHS, A, lda, ipiv, B, ldb); } inline int getrs (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const Trans, int const N, int const NRHS, double const* A, int const lda, int const* ipiv, double* B, int const ldb) { return clapack_dgetrs (Order, Trans, N, NRHS, A, lda, ipiv, B, ldb); } inline int getrs (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const Trans, int const N, int const NRHS, traits::complex_f const* A, int const lda, int const* ipiv, traits::complex_f* B, int const ldb) { return clapack_cgetrs (Order, Trans, N, NRHS, static_cast (A), lda, ipiv, static_cast (B), ldb); } inline int getrs (CBLAS_ORDER const Order, CBLAS_TRANSPOSE const Trans, int const N, int const NRHS, traits::complex_d const* A, int const lda, int const* ipiv, traits::complex_d* B, int const ldb) { return clapack_zgetrs (Order, Trans, N, NRHS, static_cast (A), lda, ipiv, static_cast (B), ldb); } // invert (using factorization computed by getrf()) inline int getri (CBLAS_ORDER const Order, int const N, float* A, int const lda, int const* ipiv) { return clapack_sgetri (Order, N, A, lda, ipiv); } inline int getri (CBLAS_ORDER const Order, int const N, double* A, int const lda, int const* ipiv) { return clapack_dgetri (Order, N, A, lda, ipiv); } inline int getri (CBLAS_ORDER const Order, int const N, traits::complex_f* A, int const lda, int const* ipiv) { return clapack_cgetri (Order, N, static_cast (A), lda, ipiv); } inline int getri (CBLAS_ORDER const Order, int const N, traits::complex_d* A, int const lda, int const* ipiv) { return clapack_zgetri (Order, N, static_cast (A), lda, ipiv); } // // system of linear equations A * X = B // with A symmetric positive definite matrix // // 'driver' function -- factor and solve inline int posv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, float* A, int const lda, float* B, int const ldb) { return clapack_sposv (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int posv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, double* A, int const lda, double* B, int const ldb) { return clapack_dposv (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int posv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_f* A, int const lda, traits::complex_f* B, int const ldb) { return clapack_cposv (Order, Uplo, N, NRHS, static_cast (A), lda, static_cast (B), ldb); } inline int posv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_d* A, int const lda, traits::complex_d* B, int const ldb) { return clapack_zposv (Order, Uplo, N, NRHS, static_cast (A), lda, static_cast (B), ldb); } // Cholesky factorization inline int potrf (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float* A, int const lda) { return clapack_spotrf (Order, Uplo, N, A, lda); } inline int potrf (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double* A, int const lda) { return clapack_dpotrf (Order, Uplo, N, A, lda); } inline int potrf (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f* A, int const lda) { return clapack_cpotrf (Order, Uplo, N, static_cast (A), lda); } inline int potrf (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d* A, int const lda) { return clapack_zpotrf (Order, Uplo, N, static_cast (A), lda); } // solve (using factorization computed by potrf()) inline int potrs (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, float const* A, int const lda, float* B, int const ldb) { return clapack_spotrs (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int potrs (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, double const* A, int const lda, double* B, int const ldb) { return clapack_dpotrs (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int potrs (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_f const* A, int const lda, traits::complex_f* B, int const ldb) { return clapack_cpotrs (Order, Uplo, N, NRHS, static_cast (A), lda, static_cast (B), ldb); } inline int potrs (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_d const* A, int const lda, traits::complex_d* B, int const ldb) { return clapack_zpotrs (Order, Uplo, N, NRHS, static_cast (A), lda, static_cast (B), ldb); } #ifdef BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // .. ATLAS bug with row major hermitian matrices // .... symmetric matrices are OK, but to simplify generic potrs() ... inline int potrs_bug (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, float const* A, int const lda, float* B, int const ldb) { return clapack_spotrs (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int potrs_bug (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, double const* A, int const lda, double* B, int const ldb) { return clapack_dpotrs (Order, Uplo, N, NRHS, A, lda, B, ldb); } inline int potrs_bug (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_f const* A, int const lda, traits::complex_f* B, int const ldb) { int sz = N * lda; traits::complex_f* A1 = new traits::complex_f[sz]; for (int i = 0; i < sz; ++i) A1[i] = std::conj (A[i]); int r = clapack_cpotrs (Order, Uplo, N, NRHS, static_cast (A1), lda, static_cast (B), ldb); delete[] A1; return r; } inline int potrs_bug (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, int const NRHS, traits::complex_d const* A, int const lda, traits::complex_d* B, int const ldb) { int sz = N * lda; traits::complex_d* A1 = new traits::complex_d[sz]; for (int i = 0; i < sz; ++i) A1[i] = std::conj (A[i]); int r = clapack_zpotrs (Order, Uplo, N, NRHS, static_cast (A1), lda, static_cast (B), ldb); delete[] A1; return r; } #endif // BOOST_NUMERIC_BINDINGS_ATLAS_POTRF_BUG // invert (using factorization computed by potrf()) inline int potri (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, float* A, int const lda) { return clapack_spotri (Order, Uplo, N, A, lda); } inline int potri (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, double* A, int const lda) { return clapack_dpotri (Order, Uplo, N, A, lda); } inline int potri (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_f* A, int const lda) { return clapack_cpotri (Order, Uplo, N, static_cast (A), lda); } inline int potri (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo, int const N, traits::complex_d* A, int const lda) { return clapack_zpotri (Order, Uplo, N, static_cast (A), lda); } }} // namepaces detail & atlas }}} #endif // BOOST_NUMERIC_BINDINGS_CLAPACK_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/blas/0000755000175000017500000000000010664335722021131 5ustar andreasandreasboost-bindings/boost/numeric/bindings/blas/blas.hpp0000644000175000017500000000043407675623321022567 0ustar andreasandreas#ifndef boost_blasbindings_blasbindings_hpp #define boost_blasbindings_blasbindings_hpp #include #include #include #endif // boost_blasbindings_blasbindings_hpp boost-bindings/boost/numeric/bindings/blas/blas.h0000644000175000017500000002051210201624745022214 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright (C) 2002, 2003 Si-Lab b.v.b.a and Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS_H #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS_H /* * const-correct prototypes for BLAS functions * */ #include #include extern "C" { // // Level 1 // void BLAS_SSCAL(const int *n, const float* alpha, float* x, const int* incx); void BLAS_DSCAL(const int *n, const double* alpha, double* x, const int* incx); void BLAS_CSCAL(const int *n, const fcomplex_t* alpha, fcomplex_t* x, const int* incx); void BLAS_ZSCAL(const int *n, const dcomplex_t* alpha, dcomplex_t* x, const int* incx); void BLAS_SAXPY(const int *n, const float* alpha, const float* x, const int* incx, float* y, const int* incy); void BLAS_DAXPY(const int *n, const double* alpha, const double* x, const int* incx, double* y, const int* incy); void BLAS_CAXPY(const int *n, const fcomplex_t* alpha, const fcomplex_t* x, const int* incx, fcomplex_t* y, const int* incy); void BLAS_ZAXPY(const int *n, const dcomplex_t* alpha, const dcomplex_t* x, const int* incx, dcomplex_t* y, const int* incy); float BLAS_SDOT (const int *n, const float *x, const int *incx, const float *y, const int *incy); double BLAS_DDOT (const int *n, const double *x, const int *incx, const double *y, const int *incy); void BLAS_CDOTU(fcomplex_t* ret, const int *n, const fcomplex_t *x, const int *incx, const fcomplex_t *y, const int *incy); void BLAS_ZDOTU(dcomplex_t* ret, const int *n, const dcomplex_t *x, const int *incx, const dcomplex_t *y, const int *incy); void BLAS_CDOTC(fcomplex_t* ret, const int *n, const fcomplex_t *x, const int *incx, const fcomplex_t *y, const int *incy); void BLAS_ZDOTC(dcomplex_t* ret, const int *n, const dcomplex_t *x, const int *incx, const dcomplex_t *y, const int *incy); float BLAS_SNRM2(const int *n, const float *x, const int *incx); double BLAS_DNRM2(const int *n, const double *x, const int *incx); float BLAS_SCNRM2(const int *n, const fcomplex_t *x, const int *incx); double BLAS_DZNRM2(const int *n, const dcomplex_t *x, const int *incx); float BLAS_SASUM(const int *n, const float *x, const int *incx); double BLAS_DASUM(const int *n, const double *x, const int *incx); float BLAS_SCASUM(const int *n, const fcomplex_t *x, const int *incx); double BLAS_DZASUM(const int *n, const dcomplex_t *x, const int *incx); void BLAS_SCOPY( const int *n, const float *x, const int *incx, float *y, const int *incy); void BLAS_DCOPY( const int *n, const double *x, const int *incx, double *y, const int *incy); void BLAS_CCOPY( const int *n, const fcomplex_t *x, const int *incx, fcomplex_t *y, const int *incy); void BLAS_ZCOPY( const int *n, const dcomplex_t *x, const int *incx, dcomplex_t *y, const int *incy); // // Level 2 // void BLAS_SGEMV(const char *trans, const int *m, const int *n, const float *alpha, const float *a, const int *lda, const float *x, const int *incx, const float *beta, float *y, const int *incy) ; void BLAS_DGEMV(const char *trans, const int *m, const int *n, const double *alpha, const double *a, const int *lda, const double *x, const int *incx, const double *beta, double *y, const int *incy) ; void BLAS_CGEMV(const char *trans, const int *m, const int *n, const fcomplex_t *alpha, const fcomplex_t *a, const int *lda, const fcomplex_t *x, const int *incx, const fcomplex_t *beta, fcomplex_t *y, const int *incy) ; void BLAS_ZGEMV(const char *trans, const int *m, const int *n, const dcomplex_t *alpha, const dcomplex_t *a, const int *lda, const dcomplex_t *x, const int *incx, const dcomplex_t *beta, dcomplex_t *y, const int *incy) ; void BLAS_SGER (const int *m, const int *n, const float * alpha, const float * x, const int *incx, const float * y, const int *incy, float *a, const int *lda); void BLAS_DGER (const int *m, const int *n, const double *alpha, const double *x, const int *incx, const double *y, const int *incy, double *a, const int *lda); void BLAS_CGERU(const int *m, const int *n, const fcomplex_t *alpha, const fcomplex_t *x, const int *incx, const fcomplex_t *y, const int *incy, fcomplex_t *a, const int *lda); void BLAS_ZGERU(const int *m, const int *n, const dcomplex_t *alpha, const dcomplex_t *x, const int *incx, const dcomplex_t *y, const int *incy, dcomplex_t *a, const int *lda); void BLAS_CGERC(const int *m, const int *n, const fcomplex_t *alpha, const fcomplex_t *x, const int *incx, const fcomplex_t *y, const int *incy, fcomplex_t *a, const int *lda); void BLAS_ZGERC(const int *m, const int *n, const dcomplex_t *alpha, const dcomplex_t *x, const int *incx, const dcomplex_t *y, const int *incy, dcomplex_t *a, const int *lda); // // Level 3 // void BLAS_SGEMM(const char *transa, const char *transb, const int *m, const int *n, const int *k, const float *alpha, const float *a, const int *lda, const float *b, const int *ldb, const float *beta, float *c, const int *ldc); void BLAS_DGEMM(const char *transa, const char *transb, const int *m, const int *n, const int *k, const double *alpha, const double *a, const int *lda, const double *b, const int *ldb, const double *beta, double *c, const int *ldc); void BLAS_CGEMM(const char *transa, const char *transb, const int *m, const int *n, const int *k, const fcomplex_t *alpha, const fcomplex_t *a, const int *lda, const fcomplex_t *b, const int *ldb, const fcomplex_t *beta, fcomplex_t *c, const int *ldc); void BLAS_ZGEMM(const char *transa, const char *transb, const int *m, const int *n, const int *k, const dcomplex_t *alpha, const dcomplex_t *a, const int *lda, const dcomplex_t *b, const int *ldb, const dcomplex_t *beta, dcomplex_t *c, const int *ldc); void BLAS_SSYRK ( const char* uplo, const char* trans, const int* n, const int* k, const float* alpha, const float* a, const int* lda, const float* beta, float* c, const int* ldc ); void BLAS_DSYRK ( const char* uplo, const char* trans, const int* n, const int* k, const double* alpha, const double* a, const int* lda, const double* beta, double* c, const int* ldc ); void BLAS_CSYRK ( const char* uplo, const char* trans, const int* n, const int* k, const fcomplex_t* alpha, const fcomplex_t* a, const int* lda, const fcomplex_t* beta, fcomplex_t* c, const int* ldc ); void BLAS_ZSYRK ( const char* uplo, const char* trans, const int* n, const int* k, const dcomplex_t* alpha, const dcomplex_t* a, const int* lda, const dcomplex_t* beta, dcomplex_t* c, const int* ldc ); void BLAS_CHERK ( const char* uplo, const char* trans, const int* n, const int* k, const float* alpha, const fcomplex_t* a, const int* lda, const float* beta, fcomplex_t* c, const int* ldc ); void BLAS_ZHERK ( const char* uplo, const char* trans, const int* n, const int* k, const double* alpha, const dcomplex_t* a, const int* lda, const double* beta, dcomplex_t* c, const int* ldc ); void BLAS_STRSM( const char* side, const char* uplo, const char* transa, const char* diag, const int* m, const int* n, float const* alpha, float const* a, int const* lda, float* b, int const* ldb ); void BLAS_DTRSM( const char* side, const char* uplo, const char* transa, const char* diag, const int* m, const int* n, double const* alpha, double const* a, int const* lda, double* b, int const* ldb ); void BLAS_CTRSM( const char* side, const char* uplo, const char* transa, const char* diag, const int* m, const int* n, fcomplex_t const* alpha, fcomplex_t const* a, int const* lda, fcomplex_t* b, int const* ldb ); void BLAS_ZTRSM( const char* side, const char* uplo, const char* transa, const char* diag, const int* m, const int* n, dcomplex_t const* alpha, dcomplex_t const* a, int const* lda, dcomplex_t* b, int const* ldb ); } #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS_H boost-bindings/boost/numeric/bindings/blas/blas1.hpp0000644000175000017500000001660107751433751022654 0ustar andreasandreas // Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright Toon Knapen and Kresimir Fresl #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_HPP #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_HPP #include #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { // x <- alpha * x template < typename value_type, typename vector_type > void scal(const value_type &alpha, vector_type &x ) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename traits::vector_traits::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( boost::is_same< value_type, typename vector_type::value_type >::value ) ) ; #endif const int n = traits::vector_size( x ) ; const int stride = traits::vector_stride( x ) ; value_type *x_ptr = traits::vector_storage( x ) ; detail::scal( n, alpha, x_ptr, stride ) ; } // y <- alpha * x + y template < typename value_type, typename vector_type_x, typename vector_type_y > void axpy(const value_type& alpha, const vector_type_x &x, vector_type_y &y ) { #ifdef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( is_same< value_type, typename vector_type_x::value_type >::value ) ) ; BOOST_STATIC_ASSERT( ( is_same< value_type, typename vector_type_y::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( is_same< value_type, typename traits::vector_traits< vector_type_x >::value_type >::value ) ) ; BOOST_STATIC_ASSERT( ( is_same< value_type, typename traits::vector_traits< vector_type_y >::value_type >::value ) ) ; #endif assert( traits::vector_size( x ) == traits::vector_size( y ) ) ; const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; value_type *y_ptr = traits::vector_storage( y ) ; detail::axpy( n, alpha, x_ptr, stride_x, y_ptr, stride_y ) ; } // dot <- x^T * y (real vectors) template < typename vector_type_x, typename vector_type_y > #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits< vector_type_x >::value_type #else typename vector_type_x::value_type #endif dot(const vector_type_x &x, const vector_type_y &y) { #ifdef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( is_same< typename vector_type_y::value_type, typename vector_type_x::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( is_same< typename traits::vector_traits< vector_type_y >::value_type, typename traits::vector_traits< vector_type_x >::value_type >::value ) ) ; #endif assert( traits::vector_size( x ) == traits::vector_size( y ) ) ; typedef typename vector_type_x::value_type value_type ; const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; const value_type *y_ptr = traits::vector_storage( y ) ; return detail::dot( n, x_ptr, stride_x, y_ptr, stride_y ) ; } // dotu <- x^T * y (complex vectors) template < typename vector_type_x, typename vector_type_y > #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits< vector_type_x >::value_type #else typename vector_type_x::value_type #endif dotu(const vector_type_x &x, const vector_type_y &y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( is_same< typename traits::vector_traits< vector_type_y >::value_type, typename traits::vector_traits< vector_type_x >::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( is_same< typename vector_type_y::value_type, typename vector_type_x::value_type >::value ) ) ; #endif assert( traits::vector_size( x ) == traits::vector_size( y ) ) ; typedef typename vector_type_x::value_type value_type ; const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; const value_type *y_ptr = traits::vector_storage( y ) ; value_type ret ; detail::dotu( ret, n, x_ptr, stride_x, y_ptr, stride_y ) ; return ret; } // dotc <- x^H * y (complex vectors) template < typename vector_type_x, typename vector_type_y > #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::vector_traits< vector_type_x >::value_type #else typename vector_type_x::value_type #endif dotc(const vector_type_x &x, const vector_type_y &y) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS BOOST_STATIC_ASSERT( ( is_same< typename traits::vector_traits< vector_type_y >::value_type, typename traits::vector_traits< vector_type_x >::value_type >::value ) ) ; #else BOOST_STATIC_ASSERT( ( is_same< typename vector_type_y::value_type, typename vector_type_x::value_type >::value ) ) ; #endif assert( traits::vector_size( x ) == traits::vector_size( y ) ) ; typedef typename vector_type_x::value_type value_type ; const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; const value_type *y_ptr = traits::vector_storage( y ) ; value_type ret ; detail::dotc( ret, n, x_ptr, stride_x, y_ptr, stride_y ) ; return ret; } // nrm2 <- ||x||_2 template < typename vector_type > #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::type_traits< typename traits::vector_traits< vector_type >::value_type >::real_type #else typename traits::type_traits< typename vector_type::value_type >::real_type #endif nrm2(const vector_type &x) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::vector_traits< vector_type >::value_type value_type; #else typedef vector_type::value_type value_type ; #endif const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const value_type *x_ptr = traits::vector_storage( x ) ; return detail::nrm2( n, x_ptr, stride_x ) ; } // asum <- ||x||_1 // .. for now works only with real vectors template < typename vector_type > #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typename traits::type_traits< typename traits::vector_traits< vector_type >::value_type >::real_type #else typename traits::type_traits< typename vector_type::value_type >::real_type #endif asum(const vector_type &x) { #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::vector_traits< vector_type >::value_type value_type; #else typedef vector_type::value_type value_type ; #endif const int n = traits::vector_size( x ) ; const int stride_x = traits::vector_stride( x ) ; const value_type *x_ptr = traits::vector_storage( x ) ; return detail::asum( n, x_ptr, stride_x ) ; } }}}} #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_HPP boost-bindings/boost/numeric/bindings/blas/blas1_overloads.hpp0000644000175000017500000001210210373447660024720 0ustar andreasandreas// Copyright (C) Toon Knapen 2003 // // Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_OVERLOADS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { namespace detail { using namespace boost::numeric::bindings::traits ; // x *= alpha inline void scal(const int& n, const float& alpha, float* x, const int& incx) { BLAS_SSCAL( &n, &alpha, x , &incx ) ; } inline void scal(const int& n, const double& alpha, double* x, const int& incx) { BLAS_DSCAL( &n, &alpha, x , &incx ) ; } inline void scal(const int& n, const complex_f& alpha, complex_f* x, const int& incx) { BLAS_CSCAL( &n, complex_ptr( &alpha ), complex_ptr( x ), &incx ) ; } inline void scal(const int& n, const complex_d& alpha, complex_d* x, const int& incx) { BLAS_ZSCAL( &n, complex_ptr( &alpha ), complex_ptr( x ), &incx ) ; } // y += alpha * x inline void axpy(const int& n, const float & alpha, const float * x, const int& incx, float * y, const int& incy) { BLAS_SAXPY( &n, &alpha , x , &incx, y , &incy ) ; } inline void axpy(const int& n, const double & alpha, const double * x, const int& incx, double * y, const int& incy) { BLAS_DAXPY( &n, &alpha , x , &incx, y , &incy ) ; } inline void axpy(const int& n, const complex_f& alpha, const complex_f* x, const int& incx, complex_f* y, const int& incy) { BLAS_CAXPY( &n, complex_ptr( &alpha ), complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } inline void axpy(const int& n, const complex_d& alpha, const complex_d* x, const int& incx, complex_d* y, const int& incy) { BLAS_ZAXPY( &n, complex_ptr( &alpha ), complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } // x^T . y inline float dot(const int& n, const float * x, const int& incx, const float * y, const int& incy) { return BLAS_SDOT( &n, x, &incx, y, &incy ) ; } inline double dot(const int& n, const double* x, const int& incx, const double* y, const int& incy) { return BLAS_DDOT( &n, x, &incx, y, &incy ) ; } // x^T . y inline void dotu(complex_f& ret, const int& n, const complex_f* x, const int& incx, const complex_f* y, const int& incy) { BLAS_CDOTU( complex_ptr( &ret ), &n, complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } inline void dotu(complex_d& ret, const int& n, const complex_d* x, const int& incx, const complex_d* y, const int& incy) { BLAS_ZDOTU( complex_ptr( &ret ), &n, complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } // x^H . y inline void dotc(complex_f& ret, const int& n, const complex_f* x, const int& incx, const complex_f* y, const int& incy) { BLAS_CDOTC( complex_ptr( &ret ), &n, complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } inline void dotc(complex_d& ret, const int& n, const complex_d* x, const int& incx, const complex_d* y, const int& incy) { BLAS_ZDOTC( complex_ptr( &ret ), &n, complex_ptr( x ), &incx, complex_ptr( y ), &incy ) ; } // euclidean norm inline float nrm2(const int& n, const float* x, const int& incx) { return BLAS_SNRM2( &n, x, &incx ) ; } inline double nrm2(const int& n, const double* x, const int& incx) { return BLAS_DNRM2( &n, x, &incx ) ; } inline float nrm2(const int& n, const complex_f* x, const int& incx) { return BLAS_SCNRM2( &n, complex_ptr(x), &incx ) ; } inline double nrm2(const int& n, const complex_d* x, const int& incx) { return BLAS_DZNRM2( &n, complex_ptr(x), &incx ) ; } // 1-norm inline float asum(const int& n, const float* x, const int& incx) { return BLAS_SASUM( &n, x, &incx ) ; } inline double asum(const int& n, const double* x, const int& incx) { return BLAS_DASUM( &n, x, &incx ) ; } inline float asum(const int& n, const complex_f* x, const int& incx) { return BLAS_SCASUM( &n, complex_ptr(x), &incx ) ; } inline double asum(const int& n, const complex_d* x, const int& incx) { return BLAS_DZASUM( &n, complex_ptr(x), &incx ) ; } // copy inline void copy(const int& n, const float* x, const int& incx, float* y, const int& incy) { BLAS_SCOPY( &n, x, &incx, y, &incy ) ; } inline void copy(const int& n, const double* x, const int& incx, double* y, const int& incy) { BLAS_DCOPY( &n, x, &incx, y, &incy ) ; } inline void copy(const int& n, const complex_f* x, const int& incx, complex_f* y, const int& incy) { BLAS_CCOPY( &n, complex_ptr(x), &incx, complex_ptr(y), &incy ) ; } inline void copy(const int& n, const complex_d* x, const int& incx, complex_d* y, const int& incy) { BLAS_ZCOPY( &n, complex_ptr(x), &incx, complex_ptr(y), &incy ) ; } }}}}} #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS1_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/blas/blas2.hpp0000644000175000017500000001331307707750440022650 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright Toon Knapen and Kresimir Fresl 2003 #ifndef BOOST_BINDINGS_BLAS_BLAS2_HPP #define BOOST_BINDINGS_BLAS_BLAS2_HPP #include #include #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { // y <- alpha * op (A) * x + beta * y // op (A) == A || A^T || A^H // ! CAUTION this function assumes that all matrices involved are column-major matrices template < typename matrix_type, typename vector_type_x, typename vector_type_y, typename value_type > inline void gemv(const char TRANS, const value_type& alpha, const matrix_type &a, const vector_type_x &x, const value_type& beta, vector_type_y &y ) { // precondition: matrix_type must be dense or dense_proxy /* not all compilers can handle the traits BOOST_STATIC_ASSERT( ( boost::is_same< typename mtraits::matrix_structure, boost::numeric::bindings::traits::general_t >::value ) ) ; */ const int m = traits::matrix_size1( a ) ; const int n = traits::matrix_size2( a ) ; assert ( traits::vector_size( x ) >= (TRANS == traits::NO_TRANSPOSE ? n : m) ) ; assert ( traits::vector_size( y ) >= (TRANS == traits::NO_TRANSPOSE ? m : n) ) ; const int lda = traits::leading_dimension( a ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *a_ptr = traits::matrix_storage( a ) ; const value_type *x_ptr = traits::vector_storage( x ) ; value_type *y_ptr = traits::vector_storage( y ) ; detail::gemv( TRANS, m, n, alpha, a_ptr, lda, x_ptr, stride_x, beta, y_ptr, stride_y ); } // A <- alpha * x * trans(y) ( outer product ), alpha, x and y are real-valued // ! CAUTION this function assumes that all matrices involved are column-major matrices template < typename vector_type_x, typename vector_type_y, typename value_type, typename matrix_type > inline void ger( const value_type& alpha, const vector_type_x &x, const vector_type_y &y, matrix_type &a ) { // precondition: matrix_type must be dense or dense_proxy /* not all compilers can handle the traits BOOST_STATIC_ASSERT( ( boost::is_same< typename mtraits::matrix_structure, boost::numeric::bindings::traits::general_t >::value ) ) ; */ const int m = traits::matrix_size1( a ) ; const int n = traits::matrix_size2( a ) ; assert ( traits::vector_size( x ) <= m ) ; assert ( traits::vector_size( y ) <= n ) ; const int lda = traits::leading_dimension( a ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; const value_type *y_ptr = traits::vector_storage( y ) ; value_type *a_ptr = traits::matrix_storage( a ) ; detail::ger( m, n, alpha, x_ptr, stride_x, y_ptr, stride_y, a_ptr, lda ); } /* // A <- alpha * x * trans(y) ( outer product ), alpha, x and y are complex-valued template < typename vector_type_x, typename vector_type_y, typename value_type, typename matrix_type > inline void geru( const value_type& alpha, const vector_type_x &x, const vector_type_y &y, matrix_type &a ) { // precondition: matrix_type must be dense or dense_proxy // not all compilers can handle the traits // BOOST_STATIC_ASSERT( ( boost::is_same< typename mtraits::matrix_structure, // boost::numeric::bindings::traits::general_t // >::value ) ) ; // BOOST_STATIC_ASSERT( ( boost::is_same< x.value_type(), FEMTown::Complex() >::value ) ) ; const int m = traits::matrix_size1( a ) ; const int n = traits::matrix_size2( a ) ; assert ( traits::vector_size( x ) <= m ) ; assert ( traits::vector_size( y ) <= n ) ; const int lda = traits::leading_dimension( a ) ; const int stride_x = traits::vector_stride( x ) ; const int stride_y = traits::vector_stride( y ) ; const value_type *x_ptr = traits::vector_storage( x ) ; const value_type *y_ptr = traits::vector_storage( y ) ; value_type *a_ptr = traits::matrix_storage( a ) ; detail::geru( m, n, alpha, x_ptr, stride_x, y_ptr, stride_y, a_ptr, lda ); } */ /* // y <- alpha * A * x + beta * y template < typename matrix_type, typename vector_type_x, typename vector_type_y > inline void gemv(const typename traits::matrix_traits::value_type &alpha, const matrix_type &a, const vector_type_x &x, const typename traits::vector_traits::value_type &beta, vector_type_y &y ) { gemv( traits::NO_TRANSPOSE, alpha, a, x, beta, y ); } // y <- A * x template < typename matrix_type, typename vector_type_x, typename vector_type_y > inline void gemv(const matrix_type &a, const vector_type_x &x, vector_type_y &y) { typedef typename traits::matrix_traits::value_type val_t; gemv( traits::NO_TRANSPOSE, (val_t) 1, a, x, (val_t) 0, y ); } */ }}}} #endif // BOOST_BINDINGS_BLAS_BLAS2_HPP boost-bindings/boost/numeric/bindings/blas/blas2_overloads.hpp0000644000175000017500000000661507707750440024735 0ustar andreasandreas// Copyright (C) Toon Knapen 2003 // // Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS2_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS2_OVERLOADS_HPP #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { namespace detail { using namespace boost::numeric::bindings::traits ; inline void gemv( char TRANS, const int& m, const int& n, const float & alpha, const float * a_ptr, const int& lda, const float * x_ptr, const int& incx, const float & beta, float * y_ptr, const int& incy ) { BLAS_SGEMV( &TRANS, &m, &n, ( &alpha ), ( a_ptr ), &lda, ( x_ptr ), &incx, ( &beta ), ( y_ptr ), &incy ) ; } inline void gemv( char TRANS, const int& m, const int& n, const double & alpha, const double * a_ptr, const int& lda, const double * x_ptr, const int& incx, const double & beta, double * y_ptr, const int& incy ) { BLAS_DGEMV( &TRANS, &m, &n, ( &alpha ), ( a_ptr ), &lda, ( x_ptr ), &incx, ( &beta ), ( y_ptr ), &incy ) ; } inline void gemv( char TRANS, const int& m, const int& n, const complex_f& alpha, const complex_f* a_ptr, const int& lda, const complex_f* x_ptr, const int& incx, const complex_f& beta, complex_f* y_ptr, const int& incy ) { BLAS_CGEMV( &TRANS, &m, &n, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( x_ptr ), &incx, complex_ptr( &beta ), complex_ptr( y_ptr ), &incy ) ; } inline void gemv( char TRANS, const int& m, const int& n, const complex_d& alpha, const complex_d* a_ptr, const int& lda, const complex_d* x_ptr, const int& incx, const complex_d& beta, complex_d* y_ptr, const int& incy ) { BLAS_ZGEMV( &TRANS, &m, &n, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( x_ptr ), &incx, complex_ptr( &beta ), complex_ptr( y_ptr ), &incy ) ; } inline void ger( const int& m, const int& n, const float & alpha, const float * x_ptr, const int& incx, const float * y_ptr, const int& incy, float * a_ptr, const int& lda ) { BLAS_SGER( &m, &n, &alpha, x_ptr, &incx, y_ptr, &incy, a_ptr, &lda ) ; } inline void ger( const int& m, const int& n, const double & alpha, const double * x_ptr, const int& incx, const double * y_ptr, const int& incy, double * a_ptr, const int& lda ) { BLAS_DGER( &m, &n, &alpha, x_ptr, &incx, y_ptr, &incy, a_ptr, &lda ) ; } /* inline void geru( const int& m, const int& n, const complex_f & alpha, const complex_f * x_ptr, const int& incx, complex_f * y_ptr, const int& incy, complex_f * a_ptr, const int& lda ) { BLAS_CGERU( &m, &n, complex_ptr( &alpha ), complex_ptr( x_ptr ), &incx, complex_ptr( y_ptr ), &incy, complex_ptr( a_ptr ), &lda ) ; } inline void geru( const int& m, const int& n, const complex_d & alpha, const complex_d * x_ptr, const int& incx, complex_d * y_ptr, const int& incy, complex_d * a_ptr, const int& lda ) { BLAS_ZGERU( &m, &n, complex_ptr( &alpha ), complex_ptr( x_ptr ), &incx, complex_ptr( y_ptr ), &incy, complex_ptr( a_ptr ), &lda ) ; } */ }}}}} #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS2_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/blas/blas3.hpp0000644000175000017500000001324210201624745022641 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright Toon Knapen and Kresimir Fresl #ifndef BOOST_BINDINGS_BLAS_BLAS3_HPP #define BOOST_BINDINGS_BLAS_BLAS3_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { // C <- alpha * op (A) * op (B) + beta * C // op (X) == X || X^T || X^H template < typename value_type, typename matrix_type_a, typename matrix_type_b, typename matrix_type_c > // ! CAUTION this function assumes that all matrices involved are column-major matrices void gemm(const char TRANSA, const char TRANSB, const value_type& alpha, const matrix_type_a &a, const matrix_type_b &b, const value_type &beta, matrix_type_c &c ) { const int m = TRANSA == traits::NO_TRANSPOSE ? traits::matrix_size1( a ) : traits::matrix_size2( a ) ; const int n = TRANSB == traits::NO_TRANSPOSE ? traits::matrix_size2( b ) : traits::matrix_size1( b ); const int k = TRANSA == traits::NO_TRANSPOSE ? traits::matrix_size2( a ) : traits::matrix_size1( a ) ; assert( k == ( TRANSB == traits::NO_TRANSPOSE ? traits::matrix_size1( b ) : traits::matrix_size2( b ) ) ) ; assert( m == traits::matrix_size1( c ) ); assert( n == traits::matrix_size2( c ) ); const int lda = traits::leading_dimension( a ); const int ldb = traits::leading_dimension( b ); const int ldc = traits::leading_dimension( c ); const value_type *a_ptr = traits::matrix_storage( a ) ; const value_type *b_ptr = traits::matrix_storage( b ) ; value_type *c_ptr = traits::matrix_storage( c ) ; detail::gemm( TRANSA, TRANSB, m, n, k, alpha, a_ptr, lda, b_ptr, ldb, beta, c_ptr, ldc ) ; } // C <- alpha * A * B + beta * C template < typename value_type, typename matrix_type_a, typename matrix_type_b, typename matrix_type_c > void gemm(const value_type& alpha, const matrix_type_a &a, const matrix_type_b &b, const value_type &beta, matrix_type_c &c ) { gemm( traits::NO_TRANSPOSE, traits::NO_TRANSPOSE, alpha, a, b, beta, c ) ; } // C <- A * B // ! CAUTION this function assumes that all matrices involved are column-major matrices template < typename matrix_type_a, typename matrix_type_b, typename matrix_type_c > void gemm(const matrix_type_a &a, const matrix_type_b &b, matrix_type_c &c) { typedef typename traits::matrix_traits::value_type val_t; gemm( traits::NO_TRANSPOSE, traits::NO_TRANSPOSE, (val_t) 1, a, b, (val_t) 0, c ) ; } // C <- alpha * A * A^T + beta * C // C <- alpha * A^T * A + beta * C template < typename value_type, typename matrix_type_a, typename matrix_type_c > void syrk( char uplo, char trans, const value_type& alpha, const matrix_type_a& a, const value_type& beta, matrix_type_c& c) { const int n = traits::matrix_size1( c ); assert( n == traits::matrix_size2( c ) ); const int k = trans == traits::NO_TRANSPOSE ? traits::matrix_size2( a ) : traits::matrix_size1( a ) ; assert( n == traits::NO_TRANSPOSE ? traits::matrix_size1( a ) : traits::matrix_size2( a ) ); const int lda = traits::leading_dimension( a ); const int ldc = traits::leading_dimension( c ); const value_type *a_ptr = traits::matrix_storage( a ) ; value_type *c_ptr = traits::matrix_storage( c ) ; detail::syrk( uplo, trans, n, k, alpha, a_ptr, lda, beta, c_ptr, ldc ); } // syrk() // C <- alpha * A * A^H + beta * C // C <- alpha * A^H * A + beta * C template < typename real_type, typename matrix_type_a, typename matrix_type_c > void herk( char uplo, char trans, const real_type& alpha, const matrix_type_a& a, const real_type& beta, matrix_type_c& c) { typedef typename matrix_type_c::value_type value_type ; const int n = traits::matrix_size1( c ); assert( n == traits::matrix_size2( c ) ); const int k = trans == traits::NO_TRANSPOSE ? traits::matrix_size2( a ) : traits::matrix_size1( a ) ; assert( n == traits::NO_TRANSPOSE ? traits::matrix_size1( a ) : traits::matrix_size2( a ) ); const int lda = traits::leading_dimension( a ); const int ldc = traits::leading_dimension( c ); const value_type *a_ptr = traits::matrix_storage( a ) ; value_type *c_ptr = traits::matrix_storage( c ) ; detail::herk( uplo, trans, n, k, alpha, a_ptr, lda, beta, c_ptr, ldc ); } // herk() // B <- alpha * op( A^-1 ) // B <- alpha * B op( A^-1 ) // op( A ) = A, A^T, A^H template < class T, class A, class B > void trsm( char side, char uplo, char transa, char diag, T const& alpha, A const& a, B& b ) { const int m = traits::matrix_size1( b ) ; const int n = traits::matrix_size2( b ) ; assert( ( side=='L' && m==traits::matrix_size2( a ) && m==traits::matrix_size1( a ) ) || ( side=='R' && n==traits::matrix_size2( a ) && n==traits::matrix_size1( a ) ) ) ; assert( side=='R' || side=='L' ) ; assert( uplo=='U' || uplo=='L' ) ; assert( ( side=='L' && m==traits::matrix_size1( a ) ) || ( side=='R' && n==traits::matrix_size1( a ) ) ) ; detail::trsm( side, uplo, transa, diag, m, n, alpha, traits::matrix_storage( a ), traits::leading_dimension( a ), traits::matrix_storage( b ), traits::leading_dimension( b ) ) ; } }}}} #endif // BOOST_BINDINGS_BLAS_BLAS3_HPP boost-bindings/boost/numeric/bindings/blas/blas3_overloads.hpp0000644000175000017500000001441610201624745024723 0ustar andreasandreas// Copyright (C) Toon Knapen 2003 // // Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS3_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS3_OVERLOADS_HPP #include #include namespace boost { namespace numeric { namespace bindings { namespace blas { namespace detail { using namespace boost::numeric::bindings::traits ; inline void gemm( char TRANSA, char TRANSB, const int& m, const int& n, const int& k, const float & alpha, const float * a_ptr, const int& lda, const float * b_ptr, const int& ldb, const float & beta, float * c_ptr, const int& ldc ) { BLAS_SGEMM( &TRANSA, &TRANSB, &m, &n, &k, ( &alpha ), ( a_ptr ), &lda, ( b_ptr ), &ldb, ( &beta ), ( c_ptr ), &ldc ) ; } inline void gemm( char TRANSA, char TRANSB, const int& m, const int& n, const int& k, const double & alpha, const double * a_ptr, const int& lda, const double * b_ptr, const int& ldb, const double & beta, double * c_ptr, const int& ldc ) { BLAS_DGEMM( &TRANSA, &TRANSB, &m, &n, &k, ( &alpha ), ( a_ptr ), &lda, ( b_ptr ), &ldb, ( &beta ), ( c_ptr ), &ldc ) ; } inline void gemm( char TRANSA, char TRANSB, const int& m, const int& n, const int& k, const complex_f& alpha, const complex_f* a_ptr, const int& lda, const complex_f* b_ptr, const int& ldb, const complex_f& beta, complex_f* c_ptr, const int& ldc ) { BLAS_CGEMM( &TRANSA, &TRANSB, &m, &n, &k, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( b_ptr ), &ldb, complex_ptr( &beta ), complex_ptr( c_ptr ), &ldc ) ; } inline void gemm( char TRANSA, char TRANSB, const int& m, const int& n, const int& k, const complex_d& alpha, const complex_d* a_ptr, const int& lda, const complex_d* b_ptr, const int& ldb, const complex_d& beta, complex_d* c_ptr, const int& ldc ) { BLAS_ZGEMM( &TRANSA, &TRANSB, &m, &n, &k, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( b_ptr ), &ldb, complex_ptr( &beta ), complex_ptr( c_ptr ), &ldc ) ; } // // SYRK // inline void syrk( char uplo, char trans, const int& n, const int& k, const float& alpha, const float* a_ptr, const int lda, const float& beta, float* c_ptr, const int& ldc) { BLAS_SSYRK( &uplo, &trans, &n, &k, &alpha, a_ptr, &lda, &beta, c_ptr, &ldc); } inline void syrk( char uplo, char trans, const int& n, const int& k, const double& alpha, const double* a_ptr, const int lda, const double& beta, double* c_ptr, const int& ldc) { BLAS_DSYRK( &uplo, &trans, &n, &k, &alpha, a_ptr, &lda, &beta, c_ptr, &ldc); } inline void syrk( char uplo, char trans, const int& n, const int& k, const complex_f& alpha, const complex_f* a_ptr, const int lda, const complex_f& beta, complex_f* c_ptr, const int& ldc) { BLAS_CSYRK( &uplo, &trans, &n, &k, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( &beta ), complex_ptr( c_ptr ), &ldc); } inline void syrk( char uplo, char trans, const int& n, const int& k, const complex_d& alpha, const complex_d* a_ptr, const int lda, const complex_d& beta, complex_d* c_ptr, const int& ldc) { BLAS_ZSYRK( &uplo, &trans, &n, &k, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( &beta ), complex_ptr( c_ptr ), &ldc); } // // HERK // inline void herk( char uplo, char trans, const int& n, const int& k, const float& alpha, const float* a_ptr, const int lda, const float& beta, float* c_ptr, const int& ldc) { BLAS_SSYRK( &uplo, &trans, &n, &k, &alpha, a_ptr, &lda, &beta, c_ptr, &ldc); } inline void herk( char uplo, char trans, const int& n, const int& k, const double& alpha, const double* a_ptr, const int lda, const double& beta, double* c_ptr, const int& ldc) { BLAS_DSYRK( &uplo, &trans, &n, &k, &alpha, a_ptr, &lda, &beta, c_ptr, &ldc); } inline void herk( char uplo, char trans, const int& n, const int& k, const float& alpha, const complex_f* a_ptr, const int lda, const float& beta, complex_f* c_ptr, const int& ldc) { BLAS_CHERK( &uplo, &trans, &n, &k, &alpha, complex_ptr( a_ptr ), &lda, &beta, complex_ptr( c_ptr ), &ldc); } inline void herk( char uplo, char trans, const int& n, const int& k, const double& alpha, const complex_d* a_ptr, const int lda, const double& beta, complex_d* c_ptr, const int& ldc) { BLAS_ZHERK( &uplo, &trans, &n, &k, &alpha, complex_ptr( a_ptr ), &lda, &beta, complex_ptr( c_ptr ), &ldc); } // // trsm // inline void trsm( char side, char uplo, char transa, char diag, int m, int n, float const& alpha, float const* a_ptr, int lda, float* b_ptr, int ldb ) { BLAS_STRSM( &side, &uplo, &transa, &diag, &m, &n, &alpha, a_ptr, &lda, b_ptr, &ldb ) ; } inline void trsm( char side, char uplo, char transa, char diag, int m, int n, double const& alpha, double const* a_ptr, int lda, double* b_ptr, int ldb ) { BLAS_DTRSM( &side, &uplo, &transa, &diag, &m, &n, &alpha, a_ptr, &lda, b_ptr, &ldb ) ; } inline void trsm( char side, char uplo, char transa, char diag, int m, int n, complex_f const& alpha, complex_f const* a_ptr, int lda, complex_f* b_ptr, int ldb ) { BLAS_CTRSM( &side, &uplo, &transa, &diag, &m, &n, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( b_ptr ), &ldb ) ; } inline void trsm( char side, char uplo, char transa, char diag, int m, int n, complex_d const& alpha, complex_d const* a_ptr, int lda, complex_d* b_ptr, int ldb ) { BLAS_ZTRSM( &side, &uplo, &transa, &diag, &m, &n, complex_ptr( &alpha ), complex_ptr( a_ptr ), &lda, complex_ptr( b_ptr ), &ldb ) ; } }}}}} #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS3_OVERLOADS_HPP boost-bindings/boost/numeric/bindings/blas/blas_names.h0000644000175000017500000000500010201624745023372 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright (C) 2002, 2003 Si-Lab b.v.b.a and Toon Knapen #ifndef BOOST_NUMERIC_BINDINGS_BLAS_BLAS_NAMES_H #define BOOST_NUMERIC_BINDINGS_BLAS_BLAS_NAMES_H #include // // level 1 // #define BLAS_SSCAL FORTRAN_ID( sscal ) #define BLAS_DSCAL FORTRAN_ID( dscal ) #define BLAS_CSCAL FORTRAN_ID( cscal ) #define BLAS_ZSCAL FORTRAN_ID( zscal ) #define BLAS_SAXPY FORTRAN_ID( saxpy ) #define BLAS_DAXPY FORTRAN_ID( daxpy ) #define BLAS_CAXPY FORTRAN_ID( caxpy ) #define BLAS_ZAXPY FORTRAN_ID( zaxpy ) #define BLAS_SDOT FORTRAN_ID( sdot ) #define BLAS_DDOT FORTRAN_ID( ddot ) #define BLAS_CDOTU FORTRAN_ID( cdotu ) #define BLAS_ZDOTU FORTRAN_ID( zdotu ) #define BLAS_CDOTC FORTRAN_ID( cdotc ) #define BLAS_ZDOTC FORTRAN_ID( zdotc ) #define BLAS_SNRM2 FORTRAN_ID( snrm2 ) #define BLAS_DNRM2 FORTRAN_ID( dnrm2 ) #define BLAS_SCNRM2 FORTRAN_ID( scnrm2 ) #define BLAS_DZNRM2 FORTRAN_ID( dznrm2 ) #define BLAS_SASUM FORTRAN_ID( sasum ) #define BLAS_DASUM FORTRAN_ID( dasum ) #define BLAS_SCASUM FORTRAN_ID( scasum ) #define BLAS_DZASUM FORTRAN_ID( dzasum ) #define BLAS_SCOPY FORTRAN_ID( scopy ) #define BLAS_DCOPY FORTRAN_ID( dcopy ) #define BLAS_CCOPY FORTRAN_ID( ccopy ) #define BLAS_ZCOPY FORTRAN_ID( zcopy ) // // level 2 // #define BLAS_SGEMV FORTRAN_ID( sgemv ) #define BLAS_DGEMV FORTRAN_ID( dgemv ) #define BLAS_CGEMV FORTRAN_ID( cgemv ) #define BLAS_ZGEMV FORTRAN_ID( zgemv ) #define BLAS_SGER FORTRAN_ID( sger ) #define BLAS_DGER FORTRAN_ID( dger ) #define BLAS_CGERU FORTRAN_ID( cgeru ) #define BLAS_ZGERU FORTRAN_ID( zgeru ) #define BLAS_CGERC FORTRAN_ID( cgerc ) #define BLAS_ZGERC FORTRAN_ID( zgerc ) // // level 3 // #define BLAS_SGEMM FORTRAN_ID( sgemm ) #define BLAS_DGEMM FORTRAN_ID( dgemm ) #define BLAS_CGEMM FORTRAN_ID( cgemm ) #define BLAS_ZGEMM FORTRAN_ID( zgemm ) #define BLAS_SSYRK FORTRAN_ID( ssyrk ) #define BLAS_DSYRK FORTRAN_ID( dsyrk ) #define BLAS_CSYRK FORTRAN_ID( csyrk ) #define BLAS_ZSYRK FORTRAN_ID( zsyrk ) #define BLAS_CHERK FORTRAN_ID( cherk ) #define BLAS_ZHERK FORTRAN_ID( zherk ) #define BLAS_STRSM FORTRAN_ID( strsm ) #define BLAS_DTRSM FORTRAN_ID( dtrsm ) #define BLAS_CTRSM FORTRAN_ID( ctrsm ) #define BLAS_ZTRSM FORTRAN_ID( ztrsm ) #endif // BOOST_NUMERIC_BINDINGS_BLAS_BLAS_NAMES_H boost-bindings/boost/numeric/bindings/lapack/0000755000175000017500000000000010664335722021443 5ustar andreasandreasboost-bindings/boost/numeric/bindings/lapack/gees.hpp0000644000175000017500000003354707752726051023116 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GEES_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GEES_HPP #include #include #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Schur factorization of general matrix. // /////////////////////////////////////////////////////////////////// /* * gees() computes a Schur factorization of an N-by-N matrix A. * * The Schur decomposition is A = U S * herm(U) where U is a * unitary matrix and S is upper triangular. The eigenvalues of A * are on the main diagonal of S. If A is real, S is in pseudo * upper triangular form. * * Workspace is organized following the arguments in the calling sequence. * optimal_workspace() : for optimizing use of blas 3 kernels * minimal_workspace() : minimum size of workarrays, but does not allow for optimization * of blas 3 kernels * workspace( work ) for real matrices where work is a real array with * vector_size( work ) >= 3*matrix_size1( a ) * workspace( work, rwork ) for complex matrices where work is a complex * array with vector_size( work ) >= 2*matrix_size1( a ) * and rwork is a real array with * vector_size( rwork ) >= matrix_size1( a ). */ namespace detail { inline void gees (char const jobvs, char const sort, logical_t* select, int const n, float* a, int const lda, int& sdim, traits::complex_f* w, float* vs, int const ldvs, float* work, int const lwork, bool* bwork, int& info) { traits::detail::array wr(n); traits::detail::array wi(n); LAPACK_SGEES (&jobvs, &sort, select, &n, a, &lda, &sdim, traits::vector_storage(wr), traits::vector_storage(wi), vs, &ldvs, work, &lwork, bwork, &info); traits::detail::interlace(traits::vector_storage(wr), traits::vector_storage(wr)+n, traits::vector_storage(wi), w); } inline void gees (char const jobvs, char const sort, logical_t* select, int const n, double* a, int const lda, int& sdim, traits::complex_d* w, double* vs, int const ldvs, double* work, int const lwork, bool* bwork, int& info) { traits::detail::array wr(n); traits::detail::array wi(n); LAPACK_DGEES (&jobvs, &sort, select, &n, a, &lda, &sdim, traits::vector_storage(wr), traits::vector_storage(wi), vs, &ldvs, work, &lwork, bwork, &info); traits::detail::interlace(traits::vector_storage(wr), traits::vector_storage(wr)+n, traits::vector_storage(wi), w); } inline void gees (char const jobvs, char const sort, logical_t* select, int const n, traits::complex_f* a, int const lda, int& sdim, traits::complex_f* w, traits::complex_f* vs, int const ldvs, traits::complex_f* work, int lwork, float* rwork, bool* bwork, int& info) { LAPACK_CGEES (&jobvs, &sort, select, &n, traits::complex_ptr(a), &lda, &sdim, traits::complex_ptr(w), traits::complex_ptr (vs), &ldvs, traits::complex_ptr(work), &lwork, rwork, bwork, &info); } inline void gees (char const jobvs, char const sort, logical_t* select, int const n, traits::complex_d* a, int const lda, int& sdim, traits::complex_d* w, traits::complex_d* vs, int const ldvs, traits::complex_d* work, int lwork, double* rwork, bool* bwork, int& info) { LAPACK_ZGEES (&jobvs, &sort, select, &n, traits::complex_ptr(a), &lda, &sdim, traits::complex_ptr(w), traits::complex_ptr(vs), &ldvs, traits::complex_ptr(work), &lwork, rwork, bwork, &info); } } namespace detail { /// Compute Schur factorization, passing one work array. template inline int gees (char jobvs, MatrA& a, EigVal& w, SchVec& vs, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif typedef typename MatrA::value_type value_type ; int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (vs)); assert (n == traits::matrix_size2 (vs)); assert (n == traits::vector_size (w)); assert (3*n <= traits::vector_size (work)); logical_t* select=0; bool* bwork=0; int info, sdim; detail::gees (jobvs, 'N', select, n, traits::matrix_storage (a), traits::leading_dimension (a), sdim, traits::vector_storage (w), traits::matrix_storage (vs), traits::leading_dimension (vs), traits::vector_storage( work ), traits::vector_size( work ), bwork, info); return info ; } // gees() /// Compute Schur factorization, passing two work arrays. template inline int gees (char jobvs, MatrA& a, EigVal& w, SchVec& vs, Work& work, RWork& rwork) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif typedef typename MatrA::value_type value_type ; int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (vs)); assert (n == traits::matrix_size2 (vs)); assert (n == traits::vector_size (w)); assert (2*n <= traits::vector_size (work)); assert (n <= traits::vector_size (rwork)); logical_t* select=0; bool* bwork=0; int info, sdim; detail::gees (jobvs, 'N', select, n, traits::matrix_storage (a), traits::leading_dimension (a), sdim, traits::vector_storage (w), traits::matrix_storage (vs), traits::leading_dimension (vs), traits::vector_storage( work ), traits::vector_size( work ), traits::vector_storage( rwork ), bwork, info); return info ; } // gees() /// Compute Schur factorization, depending on whether we have one or /// two workspace arrays. N= the number of workspace arrays. template struct Gees {}; template <> struct Gees< 2 > { template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, optimal_workspace ) const { typedef typename MatrA::value_type value_type ; typedef typename traits::type_traits< value_type >::real_type real_type ; int n = traits::matrix_size1( a ); traits::detail::array work( 2*n ); traits::detail::array rwork( n ); return gees( jobvs, a, w, vs, work, rwork ); } // gees() template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, minimal_workspace ) const { typedef typename MatrA::value_type value_type ; typedef typename traits::type_traits< value_type >::real_type real_type ; int n = traits::matrix_size1( a ); traits::detail::array work( 2*n ); traits::detail::array rwork( n ); return gees( jobvs, a, w, vs, work, rwork ); } // gees() /// Compute Schur factorization, passing workspace2 as workspace template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, workspace2& workspace ) const { return gees( jobvs, a, w, vs, workspace.w_, workspace.wr_ ); } // gees() }; // Gees<2> template <> struct Gees< 1 > { template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, optimal_workspace ) const { typedef typename MatrA::value_type value_type ; typedef typename traits::type_traits< value_type >::real_type real_type ; int n = traits::matrix_size1( a ); traits::detail::array work( 3*n ); return gees( jobvs, a, w, vs, work ); } // gees() template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, minimal_workspace ) const { typedef typename MatrA::value_type value_type ; typedef typename traits::type_traits< value_type >::real_type real_type ; int n = traits::matrix_size1( a ); traits::detail::array work( 3*n ); return gees( jobvs, a, w, vs, work ); } // gees() /// Compute Schur factorization, passing workspace1 as workspace template inline int operator() (char jobvs, MatrA& a, EigVal& w, SchVec& vs, detail::workspace1 workspace ) const { return gees( jobvs, a, w, vs, workspace.w_ ); } // gees() }; // Gees<1> } // namespace detail /// Compute Schur factorization with Schur vectors. /// /// Workspace can be the following : /// optimal_workspace() : for optimizing use of blas 3 kernels /// minimal_workspace() : minimum size of workarrays, but does not allow for optimization /// of blas 3 kernels /// workspace( real_work ) for real matrices where /// vector_size( real_work ) >= 3*matrix_size1( a ) /// workspace( complex_work, real_work ) for complex matrices where /// vector_size( complex_work ) >= 2*matrix_size1( a ) /// and vector_size( real_work ) >= matrix_size1( a ). template inline int gees (MatrA& a, EigVal& e, SchVec& vs, Workspace workspace ) { return detail::Gees< n_workspace_args::value>() ( 'V', a, e, vs, workspace ); } // gees() // Compute Schur factorization without Schur vectors. /// /// Workspace can be the following : /// optimal_workspace() : for optimizing use of blas 3 kernels /// minimal_workspace() : minimum size of workarrays, but does not allow for optimization /// of blas 3 kernels /// workspace( real_work ) for real matrices where /// vector_size( real_work ) >= 3*matrix_size1( a ) /// workspace( complex_work, real_work ) for complex matrices where /// vector_size( complex_work ) >= 2*matrix_size1( a ) /// and vector_size( real_work ) >= matrix_size1( a ). template inline int gees (MatrA& a, EigVal& e, Workspace workspace) { return detail::Gees< n_workspace_args::value>() ('N', a, e, a, workspace ); } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/geev.hpp0000644000175000017500000002713110507532244023100 0ustar andreasandreas/* * * Copyright (c) Andreas Kloeckner 2004 * Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GEEV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GEEV_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Eigendecomposition of a general matrix A * V = V * D // /////////////////////////////////////////////////////////////////// /* * geev() computes the eigendecomposition of a N x N matrix, * where V is a N x N matrix and D is a diagonal matrix. The * diagonal element D(i,i) is an eigenvalue of A and Q(:,i) is * a corresponding eigenvector. * * * int geev (char jobz, char uplo, A& a, W& w, V* vl, V* vr, optimal_workspace); * * a is the matrix whose eigendecomposition you're interested in. (input) * * w contains the diagonal of D, above. w must always be complex. (output) * * vl is an N x N matrix containing the left eigenvectors of a in its * columns. See remark on complex vs. real below. May be left NULL to indicate * that you do not want left eigenvectors. * * vr is an N x N matrix containing the right ("usual") eigenvectors of a in its * columns. See remark on complex vs. real below. As a matrix, vr fulfills * A * VR = VR * D. (except if real, see below). May be left NULL to indicate * that you do not want right eigenvectors. * * * For real A, vr and vl may be either complex or real, at your option. * If you choose to leave them real, you have to pick apart the complex-conjugate * eigenpairs as per the LAPACK documentation. If you choose them complex, * the code will do the picking-apart on your behalf, at the expense of 4*N * extra storage. Only if vr is complex, it will really fulfill its invariant * on exit to the code in all cases, since complex pairs spoil that relation. */ namespace detail { inline int geev_backend(const char* jobvl, const char* jobvr, const int* n, float* a, const int* lda, float* wr, float* wi, float* vl, const int* ldvl, float* vr, const int* ldvr, float* work, const int* lwork) { int info; LAPACK_SGEEV(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, &info); return info; } inline int geev_backend(const char* jobvl, const char* jobvr, const int* n, double* a, const int* lda, double* wr, double* wi, double* vl, const int* ldvl, double* vr, const int* ldvr, double* work, const int* lwork) { int info; LAPACK_DGEEV(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, &info); return info; } inline int geev_backend(const char* jobvl, const char* jobvr, const int* n, traits::complex_f* a, const int* lda, traits::complex_f* w, traits::complex_f* vl, const int* ldvl, traits::complex_f* vr, const int* ldvr, traits::complex_f* work, const int* lwork, float* rwork) { int info; LAPACK_CGEEV(jobvl, jobvr, n, reinterpret_cast(a), lda, reinterpret_cast(w), reinterpret_cast(vl), ldvl, reinterpret_cast(vr), ldvr, reinterpret_cast(work), lwork, rwork, &info); return info; } inline int geev_backend(const char* jobvl, const char* jobvr, const int* n, traits::complex_d* a, const int* lda, traits::complex_d* w, traits::complex_d* vl, const int* ldvl, traits::complex_d* vr, const int* ldvr, traits::complex_d* work, const int* lwork, double* rwork) { int info; LAPACK_ZGEEV(jobvl, jobvr, n, reinterpret_cast(a), lda, reinterpret_cast(w), reinterpret_cast(vl), ldvl, reinterpret_cast(vr), ldvr, reinterpret_cast(work), lwork, rwork, &info); return info; } struct real_case {}; struct mixed_case {}; struct complex_case {}; // real case template int geev(real_case, const char jobvl, const char jobvr, A& a, W& w, V* vl, V *vr) { int const n = traits::matrix_size1(a); typedef typename A::value_type value_type; traits::detail::array wr(n); traits::detail::array wi(n); traits::detail::array vl2(vl ? 0 : n); traits::detail::array vr2(vr ? 0 : n); value_type* vl_real = vl ? traits::matrix_storage(*vl) : vl2.storage(); const int ldvl = vl ? traits::matrix_size2(*vl) : 1; value_type* vr_real = vr ? traits::matrix_storage(*vr) : vr2.storage(); const int ldvr = vr ? traits::matrix_size2(*vr) : 1; // workspace query int lwork = -1; value_type work_temp; int result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, wr.storage(), wi.storage(), vl_real, &ldvl, vr_real, &ldvr, &work_temp, &lwork); if (result != 0) return result; lwork = (int) work_temp; traits::detail::array work(lwork); result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, wr.storage(), wi.storage(), vl_real, &ldvl, vr_real, &ldvr, work.storage(), &lwork); for (int i = 0; i < n; i++) w[i] = std::complex(wr[i], wi[i]); return result; } // mixed (i.e. real with complex vectors) case template int geev(mixed_case, const char jobvl, const char jobvr, A& a, W& w, V* vl, V *vr) { int const n = traits::matrix_size1(a); typedef typename A::value_type value_type; traits::detail::array wr(n); traits::detail::array wi(n); traits::detail::array vl2(vl ? n*n : n); traits::detail::array vr2(vr ? n*n : n); const int ldvl2 = vl ? n : 1; const int ldvr2 = vr ? n : 1; // workspace query int lwork = -1; value_type work_temp; int result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, wr.storage(), wi.storage(), vl2.storage(), &ldvl2, vr2.storage(), &ldvr2, &work_temp, &lwork); if (result != 0) return result; lwork = (int) work_temp; traits::detail::array work(lwork); result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, wr.storage(), wi.storage(), vl2.storage(), &ldvl2, vr2.storage(), &ldvr2, work.storage(), &lwork); typedef typename V::value_type vec_value_type; vec_value_type* vl_stor = NULL; vec_value_type* vr_stor = NULL; int ldvl = 0, ldvr = 0; if (vl) { vl_stor = traits::matrix_storage(*vl); ldvl = traits::matrix_size2(*vl); } if (vr) { vr_stor = traits::matrix_storage(*vr); ldvr = traits::matrix_size2(*vr); } for (int i = 0; i < n; i++) { w[i] = std::complex(wr[i], wi[i]); if (wi[i] != 0) { assert(i+1 < n); assert(wr[i+1] == wr[i]); assert(wi[i+1] == -wi[i+1]); w[i+1] = std::complex(wr[i+1], wi[i+1]); for (int j = 0; j < n; j++) { if (vl) { vl_stor[i*ldvl+j] = std::complex(vl2[i*n+j], vl2[(i+1)*n+j]); vl_stor[(i+1)*ldvl+j] = std::complex(vl2[i*n+j], -vl2[(i+1)*n+j]); } if (vr) { vr_stor[i*ldvr+j] = std::complex(vr2[i*n+j], vr2[(i+1)*n+j]); vr_stor[(i+1)*ldvr+j] = std::complex(vr2[i*n+j], -vr2[(i+1)*n+j]); } } i++; } else { for (int j = 0; j < n; j++) { if (vl) vl_stor[i*ldvl+j] = vl2[i*n+j]; if (vr) vr_stor[i*ldvr+j] = vr2[i*n+j]; } } } return result; } // complex case template int geev(complex_case, const char jobvl, const char jobvr, A& a, W& w, V* vl, V *vr) { typedef typename A::value_type value_type; typedef typename traits::type_traits::real_type real_type; int const n = traits::matrix_size1(a); traits::detail::array rwork(2*n); traits::detail::array vl2(vl ? 0 : n); traits::detail::array vr2(vr ? 0 : n); value_type* vl_real = vl ? traits::matrix_storage(*vl) : vl2.storage(); const int ldvl = vl ? traits::matrix_size2(*vl) : 1; value_type* vr_real = vr ? traits::matrix_storage(*vr) : vr2.storage(); const int ldvr = vr ? traits::matrix_size2(*vr) : 1; // workspace query int lwork = -1; value_type work_temp; int result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, traits::vector_storage(w), vl_real, &ldvl, vr_real, &ldvr, &work_temp, &lwork, rwork.storage()); if (result != 0) return result; lwork = (int) std::real(work_temp); traits::detail::array work(lwork); result = geev_backend(&jobvl, &jobvr, &n, traits::matrix_storage(a), &n, traits::vector_storage(w), vl_real, &ldvl, vr_real, &ldvr, work.storage(), &lwork, rwork.storage()); return result; } } // namespace detail // gateway / dispatch routine template int geev(A& a, W& w, V* vl, V* vr, optimal_workspace) { // input checking #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif #ifndef NDEBUG int const n = traits::matrix_size1(a); #endif assert(traits::matrix_size2(a)==n); assert(traits::vector_size(w)==n); assert(traits::vector_size(w)==n); assert(!vr || traits::matrix_size1(*vr)==n); assert(!vl || traits::matrix_size1(*vl)==n); // preparation typedef typename A::value_type value_type; typedef typename V::value_type vec_value_type; typedef typename traits::type_traits::real_type real_type; // dispatch return detail::geev(typename boost::mpl::if_< boost::is_same, typename boost::mpl::if_< boost::is_same, detail::real_case, detail::mixed_case>::type, detail::complex_case>::type(), vl != 0 ? 'V' : 'N', vr != 0 ? 'V' : 'N', a, w, vl, vr); } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/geqrf.hpp0000644000175000017500000001361607751671103023266 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GEQRF_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GEQRF_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // QR factorization of a general m x n matrix A = Q * R // /////////////////////////////////////////////////////////////////// /* * geqrf() computes the QR factorization of a rectangular matrix * A = Q * R, where Q is a M x min(M,N) matrix with orthogonal * and normalized column (i.e. herm(Q) $ Q = I) and R is a * min(M,N) x N upper triangular matrix. * * On return of geqrf, the elements on and above the diagonal of * A contain the min(M,N) x N upper trapezoidal matrix R (R is * upper triangular if m >= n); the elements below the diagonal, * with the array TAU, represent the orthogonal matrix Q as a product * of min(M,N) elementary reflectors. */ namespace detail { inline void geqrf (int const m, int const n, float* a, int const lda, float* tau, float* work, int const lwork, int& info) { LAPACK_SGEQRF (&m, &n, a, &lda, tau, work, &lwork, &info); } inline void geqrf (int const m, int const n, double* a, int const lda, double* tau, double* work, int const lwork, int& info) { LAPACK_DGEQRF (&m, &n, a, &lda, tau, work, &lwork, &info); } inline void geqrf (int const m, int const n, std::complex* a, int const lda, std::complex* tau, std::complex* work, int const lwork, int& info) { LAPACK_CGEQRF (&m, &n, reinterpret_cast (a), &lda, reinterpret_cast (tau), reinterpret_cast (work), &lwork, &info ); } inline void geqrf (int const m, int const n, std::complex* a, int const lda, std::complex* tau, std::complex* work, int const lwork, int& info) { LAPACK_ZGEQRF (&m, &n, reinterpret_cast (a), &lda, reinterpret_cast (tau), reinterpret_cast (work), &lwork, &info ); } } template inline int geqrf (A& a, Tau& tau, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); assert (std::min(m,n) <= traits::vector_size (tau)); assert (n <= traits::vector_size (work)); int info; detail::geqrf (m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (tau), traits::vector_storage (work), traits::vector_size (work), info); return info; } // Computation of the QR factorization. // Workspace is allocated dynamically so that the optimization of // blas 3 calls is optimal. template inline int geqrf (A& a, Tau& tau, optimal_workspace ) { typedef typename A::value_type value_type ; const int n = traits::matrix_size2 (a); traits::detail::array work(std::max(1, n*32)); return geqrf( a, tau, work ); } // Computation of the QR factorization. // Workspace is allocated dynamically to its minimum size. // Blas 3 calls are not optimal. template inline int geqrf (A& a, Tau& tau, minimal_workspace ) { typedef typename A::value_type value_type ; const int n = traits::matrix_size2 (a); traits::detail::array work(std::max(1, n)); return geqrf( a, tau, work ); } // Computation of the QR factorization. // Workspace is taken from the array in workspace. // The calling sequence is // geqrf( a, tau, workspace( work ) ) where work is an array with the same value_type // as a. template inline int geqrf (A& a, Tau& tau, detail::workspace1 workspace ) { typedef typename A::value_type value_type ; const int n = traits::matrix_size2 (a); traits::detail::array work(std::max(1, n)); return geqrf( a, tau, workspace.w_ ); } // Function without workarray as argument template inline int geqrf (A& a, Tau& tau) { return geqrf( a, tau, optimal_workspace() ); } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/gesdd.hpp0000644000175000017500000006130510101715755023241 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GESDD_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GESDD_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // singular value decomposition // /////////////////////////////////////////////////////////////////// /* * (divide and conquer driver) * gesdd() computes the singular value decomposition (SVD) of * M-by-N matrix A, optionally computing the left and/or right * singular vectors, by using divide-and-conquer method. * The SVD is written * * A = U * S * V^T or A = U * S * V^H * * where S is an M-by-N matrix which is zero except for its min(m,n) * diagonal elements, U is an M-by-M orthogonal/unitary matrix, and V * is an N-by-N orthogonal/unitary matrix. The diagonal elements of S * are the singular values of A; they are real and non-negative, and * are returnede in descending order. The first min(m,n) columns of * U and V are the left and right singular vectors of A. (Note that * the routine returns V^T or V^H, not V. */ namespace detail { inline void gesdd (char const jobz, int const m, int const n, float* a, int const lda, float* s, float* u, int const ldu, float* vt, int const ldvt, float* work, int const lwork, float* /* dummy */, int* iwork, int* info) { LAPACK_SGESDD (&jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, iwork, info); } inline void gesdd (char const jobz, int const m, int const n, double* a, int const lda, double* s, double* u, int const ldu, double* vt, int const ldvt, double* work, int const lwork, double* /* dummy */, int* iwork, int* info) { LAPACK_DGESDD (&jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, iwork, info); } inline void gesdd (char const jobz, int const m, int const n, traits::complex_f* a, int const lda, float* s, traits::complex_f* u, int const ldu, traits::complex_f* vt, int const ldvt, traits::complex_f* work, int const lwork, float* rwork, int* iwork, int* info) { LAPACK_CGESDD (&jobz, &m, &n, traits::complex_ptr (a), &lda, s, traits::complex_ptr (u), &ldu, traits::complex_ptr (vt), &ldvt, traits::complex_ptr (work), &lwork, rwork, iwork, info); } inline void gesdd (char const jobz, int const m, int const n, traits::complex_d* a, int const lda, double* s, traits::complex_d* u, int const ldu, traits::complex_d* vt, int const ldvt, traits::complex_d* work, int const lwork, double* rwork, int* iwork, int* info) { LAPACK_ZGESDD (&jobz, &m, &n, traits::complex_ptr (a), &lda, s, traits::complex_ptr (u), &ldu, traits::complex_ptr (vt), &ldvt, traits::complex_ptr (work), &lwork, rwork, iwork, info); } inline int gesdd_min_work (float, char jobz, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m3 = 3 * minmn; int m4 = 4 * minmn; int minw; if (jobz == 'N') { // leading comments: // LWORK >= 3*min(M,N) + max(max(M,N), 6*min(M,N)) // code: // LWORK >= 3*min(M,N) + max(max(M,N), 7*min(M,N)) int m7 = 7 * minmn; minw = maxmn < m7 ? m7 : maxmn; minw += m3; } if (jobz == 'O') { // LWORK >= 3*min(M,N)*min(M,N) // + max(max(M,N), 5*min(M,N)*min(M,N)+4*min(M,N)) int m5 = 5 * minmn * minmn + m4; minw = maxmn < m5 ? m5 : maxmn; minw += m3 * minmn; } if (jobz == 'S' || jobz == 'A') { // LWORK >= 3*min(M,N)*min(M,N) // + max(max(M,N), 4*min(M,N)*min(M,N)+4*min(M,N)). int m44 = m4 * minmn + m4; minw = maxmn < m44 ? m44 : maxmn; minw += m3 * minmn; } return minw; } inline int gesdd_min_work (double, char jobz, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m3 = 3 * minmn; int m4 = 4 * minmn; int minw; if (jobz == 'N') { // leading comments: // LWORK >= 3*min(M,N) + max(max(M,N), 6*min(M,N)) // code: // LWORK >= 3*min(M,N) + max(max(M,N), 7*min(M,N)) int m7 = 7 * minmn; minw = maxmn < m7 ? m7 : maxmn; minw += m3; } else if (jobz == 'O') { // LWORK >= 3*min(M,N)*min(M,N) // + max(max(M,N), 5*min(M,N)*min(M,N)+4*min(M,N)) int m5 = 5 * minmn * minmn + m4; minw = maxmn < m5 ? m5 : maxmn; minw += m3 * minmn; } else if (jobz == 'S' || jobz == 'A') { // LWORK >= 3*min(M,N)*min(M,N) // + max(max(M,N), 4*min(M,N)*min(M,N)+4*min(M,N)). int m44 = m4 * minmn + m4; minw = maxmn < m44 ? m44 : maxmn; minw += m3 * minmn; } else { std::cerr << "Invalid option passed to gesdd" << std::endl ; return 0 ; } return minw; } inline int gesdd_min_work (traits::complex_f, char jobz, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m2 = 2 * minmn; int minw = m2 + maxmn; if (jobz == 'N') // LWORK >= 2*min(M,N)+max(M,N) ; if (jobz == 'O') // LWORK >= 2*min(M,N)*min(M,N) + 2*min(M,N) + max(M,N) minw += m2 * minmn; if (jobz == 'S' || jobz == 'A') // LWORK >= min(M,N)*min(M,N) + 2*min(M,N) + max(M,N) minw += minmn * minmn; return minw; } inline int gesdd_min_work (traits::complex_d, char jobz, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m2 = 2 * minmn; int minw = m2 + maxmn; if (jobz == 'N') // LWORK >= 2*min(M,N)+max(M,N) ; if (jobz == 'O') // LWORK >= 2*min(M,N)*min(M,N) + 2*min(M,N) + max(M,N) minw += m2 * minmn; if (jobz == 'S' || jobz == 'A') // LWORK >= min(M,N)*min(M,N) + 2*min(M,N) + max(M,N) minw += minmn * minmn; return minw; } inline int gesdd_rwork (float, char, int, int) { return 1; } inline int gesdd_rwork (double, char, int, int) { return 1; } inline int gesdd_rwork (traits::complex_f, char jobz, int m, int n) { int minmn = m < n ? m : n; int minw; if (jobz == 'N') // LWORK >= 7*min(M,N) minw = 7 * minmn; else // LRWORK >= 5*min(M,N)*min(M,N) + 5*min(M,N) minw = 5 * (minmn * minmn + minmn); return minw; } inline int gesdd_rwork (traits::complex_d, char jobz, int m, int n) { int minmn = m < n ? m : n; int minw; if (jobz == 'N') // LWORK >= 7*min(M,N) minw = 7 * minmn; else // LRWORK >= 5*min(M,N)*min(M,N) + 5*min(M,N) minw = 5 * (minmn * minmn + minmn); return minw; } inline int gesdd_iwork (int m, int n) { int minmn = m < n ? m : n; return 8 * minmn; } } // detail template inline int gesdd_work (char const q, char const jobz, MatrA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif #ifdef BOOST_NUMERIC_BINDINGS_LAPACK_2 assert (q == 'M'); #else assert (q == 'M' || q == 'O'); #endif assert (jobz == 'N' || jobz == 'O' || jobz == 'A' || jobz == 'S'); int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int lw = -13; #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif if (q == 'M') lw = detail::gesdd_min_work (val_t(), jobz, m, n); #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_2 MatrA& a2 = const_cast (a); if (q == 'O') { // traits::detail::array w (1); val_t w; int info; detail::gesdd (jobz, m, n, traits::matrix_storage (a2), traits::leading_dimension (a2), 0, // traits::vector_storage (s), 0, // traits::matrix_storage (u), m, // traits::leading_dimension (u), 0, // traits::matrix_storage (vt), n, // traits::leading_dimension (vt), &w, // traits::vector_storage (w), -1, // traits::vector_size (w), 0, // traits::vector_storage (rw), 0, // traits::vector_storage (iw), &info); assert (info == 0); lw = traits::detail::to_int (w); // // lw = traits::detail::to_int (w[0]); /* * is there a bug in LAPACK? or in Mandrake's .rpm? * if m == 3, n == 4 and jobz == 'N' (real A), * gesdd() returns optimal size == 1 while minimum size == 27 */ // int lwo = traits::detail::to_int (w); // int lwmin = detail::gesdd_min_work (val_t(), jobz, m, n); // lw = lwo < lwmin ? lwmin : lwo; } #endif return lw; } template inline int gesdd_rwork (char jobz, MatrA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (jobz == 'N' || jobz == 'O' || jobz == 'A' || jobz == 'S'); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif return detail::gesdd_rwork (val_t(), jobz, traits::matrix_size1 (a), traits::matrix_size2 (a)); } template inline int gesdd_iwork (MatrA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::gesdd_iwork (traits::matrix_size1 (a), traits::matrix_size2 (a)); } template inline int gesdd (char const jobz, MatrA& a, VecS& s, MatrU& u, MatrV& vt, VecW& w, VecIW& iw) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT( (boost::is_same< typename traits::matrix_traits::value_type, float >::value || boost::is_same< typename traits::matrix_traits::value_type, double >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); assert ((jobz == 'N') || ((jobz == 'O' || jobz == 'A') && m >= n) || ((jobz == 'O' || jobz == 'A') && m < n && m == traits::matrix_size2 (u)) || (jobz == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobz == 'N' && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (u) >= m) || (jobz == 'A' && traits::leading_dimension (u) >= m) || (jobz == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobz == 'N' && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (vt) >= n) || (jobz == 'A' && traits::leading_dimension (vt) >= n) || (jobz == 'S' && traits::leading_dimension (vt) >= minmn)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif assert (traits::vector_size (w) >= detail::gesdd_min_work (val_t(), jobz, m, n)); assert (traits::vector_size (iw) >= detail::gesdd_iwork (m, n)); int info; detail::gesdd (jobz, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), 0, // dummy argument traits::vector_storage (iw), &info); return info; } template inline int gesdd (char const jobz, MatrA& a, VecS& s, MatrU& u, MatrV& vt, VecW& w, VecRW& rw, VecIW& iw) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); assert ((jobz == 'N') || ((jobz == 'O' || jobz == 'A') && m >= n) || ((jobz == 'O' || jobz == 'A') && m < n && m == traits::matrix_size2 (u)) || (jobz == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobz == 'N' && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (u) >= m) || (jobz == 'A' && traits::leading_dimension (u) >= m) || (jobz == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobz == 'N' && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (vt) >= n) || (jobz == 'A' && traits::leading_dimension (vt) >= n) || (jobz == 'S' && traits::leading_dimension (vt) >= minmn)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif assert (traits::vector_size (w) >= detail::gesdd_min_work (val_t(), jobz, m, n)); assert (traits::vector_size (rw) >= detail::gesdd_rwork (val_t(), jobz, m, n)); assert (traits::vector_size (iw) >= detail::gesdd_iwork (m, n)); int info; detail::gesdd (jobz, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), traits::vector_storage (rw), traits::vector_storage (iw), &info); return info; } template inline int gesdd (char const opt, char const jobz, MatrA& a, VecS& s, MatrU& u, MatrV& vt) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); #ifndef NDEBUG int const minmn = m < n ? m : n; #endif // NDEBUG assert (minmn == traits::vector_size (s)); assert ((jobz == 'N') || ((jobz == 'O' || jobz == 'A') && m >= n) || ((jobz == 'O' || jobz == 'A') && m < n && m == traits::matrix_size2 (u)) || (jobz == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobz == 'N' && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (u) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (u) >= m) || (jobz == 'A' && traits::leading_dimension (u) >= m) || (jobz == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobz == 'N' && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m < n && traits::leading_dimension (vt) >= 1) || (jobz == 'O' && m >= n && traits::leading_dimension (vt) >= n) || (jobz == 'A' && traits::leading_dimension (vt) >= n) || (jobz == 'S' && traits::leading_dimension (vt) >= minmn)); #ifdef BOOST_NUMERIC_BINDINGS_LAPACK_2 assert (opt == 'M'); #else assert (opt == 'M' || opt == 'O'); #endif #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; int const lw = gesdd_work (opt, jobz, a); traits::detail::array w (lw); if (!w.valid()) return -101; int const lrw = gesdd_rwork (jobz, a); traits::detail::array rw (lrw); if (!rw.valid()) return -102; int const liw = gesdd_iwork (a); traits::detail::array iw (liw); if (!iw.valid()) return -103; int info; detail::gesdd (jobz, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), lw, //traits::vector_size (w), traits::vector_storage (rw), traits::vector_storage (iw), &info); return info; } #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_2 template inline int gesdd (char const jobz, MatrA& a, VecS& s, MatrU& u, MatrV& vt) { return gesdd ('O', jobz, a, s, u, vt); } template inline int gesdd (MatrA& a, VecS& s, MatrU& u, MatrV& vt) { return gesdd ('O', 'S', a, s, u, vt); } template inline int gesdd (MatrA& a, VecS& s) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; int const lw = gesdd_work ('O', 'N', a); traits::detail::array w (lw); if (!w.valid()) return -101; int const lrw = gesdd_rwork ('N', a); traits::detail::array rw (lrw); if (!rw.valid()) return -102; int const liw = gesdd_iwork (a); traits::detail::array iw (liw); if (!iw.valid()) return -103; int info; detail::gesdd ('N', m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), 0, // traits::matrix_storage (u), 1, // traits::leading_dimension (u), 0, // traits::matrix_storage (vt), 1, // traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), traits::vector_storage (rw), traits::vector_storage (iw), &info); return info; } #endif } // namespace lapack }}} #endif boost-bindings/boost/numeric/bindings/lapack/gesv.hpp0000644000175000017500000002341710414673431023122 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GESV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GESV_HPP #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif #include namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // general system of linear equations A * X = B // /////////////////////////////////////////////////////////////////// /* * gesv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N matrix and X and B are N-by-NRHS * matrices. * * The LU decomposition with partial pivoting and row interchanges * is used to factor A as A = P * L * U, where P is a permutation * matrix, L is unit lower triangular, and U is upper triangular. * The factored form of A is then used to solve the system of * equations A * X = B. */ namespace detail { inline void gesv (int const n, int const nrhs, float* a, int const lda, int* ipiv, float* b, int const ldb, int* info) { LAPACK_SGESV (&n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void gesv (int const n, int const nrhs, double* a, int const lda, int* ipiv, double* b, int const ldb, int* info) { LAPACK_DGESV (&n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void gesv (int const n, int const nrhs, traits::complex_f* a, int const lda, int* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CGESV (&n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } inline void gesv (int const n, int const nrhs, traits::complex_d* a, int const lda, int* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZGESV (&n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } } template inline int gesv (MatrA& a, IVec& ipiv, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (ipiv)); int info; detail::gesv (n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (ipiv), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } template inline int gesv (MatrA& a, MatrB& b) { // with 'internal' pivot vector // gesv() errors: // if (info == 0), successful // if (info < 0), the -info argument had an illegal value // -- we will use -101 if allocation fails // if (info > 0), U(i-1,i-1) is exactly zero int info = -101; traits::detail::array ipiv (traits::matrix_size1 (a)); if (ipiv.valid()) info = gesv (a, ipiv, b); return info; } /* * getrf() computes an LU factorization of a general M-by-N matrix A * using partial pivoting with row interchanges. The factorization * has the form A = P * L * U, where P is a permutation matrix, * L is lower triangular with unit diagonal elements (lower * trapezoidal if M > N), and U is upper triangular (upper * trapezoidal if M < N). */ namespace detail { inline void getrf (int const n, int const m, float* a, int const lda, int* ipiv, int* info) { LAPACK_SGETRF (&n, &m, a, &lda, ipiv, info); } inline void getrf (int const n, int const m, double* a, int const lda, int* ipiv, int* info) { LAPACK_DGETRF (&n, &m, a, &lda, ipiv, info); } inline void getrf (int const n, int const m, traits::complex_f* a, int const lda, int* ipiv, int* info) { LAPACK_CGETRF (&n, &m, traits::complex_ptr (a), &lda, ipiv, info); } inline void getrf (int const n, int const m, traits::complex_d* a, int const lda, int* ipiv, int* info) { LAPACK_ZGETRF (&n, &m, traits::complex_ptr (a), &lda, ipiv, info); } } template inline int getrf (MatrA& a, IVec& ipiv) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); int const m = traits::matrix_size2 (a); assert (traits::vector_size (ipiv) == (m < n ? m : n)); int info; detail::getrf (n, m, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (ipiv), &info); return info; } /* * getrs() solves a system of linear equations A * X = B * or A^T * X = B with a general N-by-N matrix A using * the LU factorization computed by getrf(). */ namespace detail { inline void getrs (char const trans, int const n, int const nrhs, float const* a, int const lda, int const* ipiv, float* b, int const ldb, int* info) { LAPACK_SGETRS (&trans, &n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void getrs (char const trans, int const n, int const nrhs, double const* a, int const lda, int const* ipiv, double* b, int const ldb, int* info) { LAPACK_DGETRS (&trans, &n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void getrs (char const trans, int const n, int const nrhs, traits::complex_f const* a, int const lda, int const* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CGETRS (&trans, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } inline void getrs (char const trans, int const n, int const nrhs, traits::complex_d const* a, int const lda, int const* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZGETRS (&trans, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } } template inline int getrs (char const trans, MatrA const& a, IVec const& ipiv, MatrB& b) { assert (trans == 'N' || trans == 'T' || trans == 'C'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (ipiv)); int info; detail::getrs (trans, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (ipiv), #else traits::vector_storage_const (ipiv), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } template inline int getrs (MatrA const& a, IVec const& ipiv, MatrB& b) { char const no_transpose = 'N'; return getrs (no_transpose, a, ipiv, b); } // TO DO: getri() } }}} #endif boost-bindings/boost/numeric/bindings/lapack/gesvd.hpp0000644000175000017500000004570507730066351023276 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_GESVD_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_GESVD_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // singular value decomposition // /////////////////////////////////////////////////////////////////// /* * (simple driver) * gesvd() computes the singular value decomposition (SVD) of * M-by-N matrix A, optionally computing the left and/or right * singular vectors. The SVD is written * * A = U * S * V^T or A = U * S * V^H * * where S is an M-by-N matrix which is zero except for its min(m,n) * diagonal elements, U is an M-by-M orthogonal/unitary matrix, and V * is an N-by-N orthogonal/unitary matrix. The diagonal elements of S * are the singular values of A; they are real and non-negative, and * are returnede in descending order. The first min(m,n) columns of * U and V are the left and right singular vectors of A. (Note that * the routine returns V^T or V^H, not V. */ namespace detail { inline void gesvd (char const jobu, char const jobvt, int const m, int const n, float* a, int const lda, float* s, float* u, int const ldu, float* vt, int const ldvt, float* work, int const lwork, float* /* dummy */, int* info) { LAPACK_SGESVD (&jobu, &jobvt, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, info); } inline void gesvd (char const jobu, char const jobvt, int const m, int const n, double* a, int const lda, double* s, double* u, int const ldu, double* vt, int const ldvt, double* work, int const lwork, double* /* dummy */, int* info) { LAPACK_DGESVD (&jobu, &jobvt, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, info); } inline void gesvd (char const jobu, char const jobvt, int const m, int const n, traits::complex_f* a, int const lda, float* s, traits::complex_f* u, int const ldu, traits::complex_f* vt, int const ldvt, traits::complex_f* work, int const lwork, float* rwork, int* info) { LAPACK_CGESVD (&jobu, &jobvt, &m, &n, traits::complex_ptr (a), &lda, s, traits::complex_ptr (u), &ldu, traits::complex_ptr (vt), &ldvt, traits::complex_ptr (work), &lwork, rwork, info); } inline void gesvd (char const jobu, char const jobvt, int const m, int const n, traits::complex_d* a, int const lda, double* s, traits::complex_d* u, int const ldu, traits::complex_d* vt, int const ldvt, traits::complex_d* work, int const lwork, double* rwork, int* info) { LAPACK_ZGESVD (&jobu, &jobvt, &m, &n, traits::complex_ptr (a), &lda, s, traits::complex_ptr (u), &ldu, traits::complex_ptr (vt), &ldvt, traits::complex_ptr (work), &lwork, rwork, info); } inline int gesvd_min_work (float, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m3x = 3 * minmn + maxmn; int m5 = 5 * minmn; return m3x < m5 ? m5 : m3x; } inline int gesvd_min_work (double, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; int m3x = 3 * minmn + maxmn; int m5 = 5 * minmn; return m3x < m5 ? m5 : m3x; } inline int gesvd_min_work (traits::complex_f, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; return 2 * minmn + maxmn; } inline int gesvd_min_work (traits::complex_d, int m, int n) { int minmn = m < n ? m : n; int maxmn = m < n ? n : m; return 2 * minmn + maxmn; } inline int gesvd_rwork (float, int, int) { return 1; } inline int gesvd_rwork (double, int, int) { return 1; } inline int gesvd_rwork (traits::complex_f, int m, int n) { return 5 * (m < n ? m : n); } inline int gesvd_rwork (traits::complex_d, int m, int n) { return 5 * (m < n ? m : n); } } // detail template inline int gesvd_work (char const q, char const jobu, char const jobvt, MatrA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif #ifdef BOOST_NUMERIC_BINDINGS_LAPACK_2 assert (q == 'M'); #else assert (q == 'M' || q == 'O'); #endif assert (jobu == 'N' || jobu == 'O' || jobu == 'A' || jobu == 'S'); assert (jobvt == 'N' || jobvt == 'O' || jobvt == 'A' || jobvt == 'S'); assert (!(jobu == 'O' && jobvt == 'O')); int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int lw = -13; #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif if (q == 'M') lw = detail::gesvd_min_work (val_t(), m, n); #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_2 MatrA& a2 = const_cast (a); if (q == 'O') { // traits::detail::array w (0); val_t w; int info; detail::gesvd (jobu, jobvt, m, n, traits::matrix_storage (a2), traits::leading_dimension (a2), 0, // traits::vector_storage (s), 0, // traits::matrix_storage (u), m, // traits::leading_dimension (u), 0, // traits::matrix_storage (vt), n, // traits::leading_dimension (vt), &w, // traits::vector_storage (w), -1, // traits::vector_size (w), 0, // traits::vector_storage (rw), &info); assert (info == 0); lw = traits::detail::to_int (w); // (w[0]); } #endif return lw; } template inline int gesvd_rwork (MatrA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif return detail::gesvd_rwork (val_t(), traits::matrix_size1 (a), traits::matrix_size2 (a)); } template inline int gesvd (char const jobu, char const jobvt, MatrA& a, VecS& s, MatrU& u, MatrV& vt, VecW& w) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT( (boost::is_same< typename traits::matrix_traits::value_type, float >::value || boost::is_same< typename traits::matrix_traits::value_type, double >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); assert (!(jobu == 'O' && jobvt == 'O')); assert ((jobu == 'N') || (jobu == 'O') || (jobu == 'A' && m == traits::matrix_size2 (u)) || (jobu == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobu == 'N' && traits::leading_dimension (u) >= 1) || (jobu == 'O' && traits::leading_dimension (u) >= 1) || (jobu == 'A' && traits::leading_dimension (u) >= m) || (jobu == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobvt == 'N' && traits::leading_dimension (vt) >= 1) || (jobvt == 'O' && traits::leading_dimension (vt) >= 1) || (jobvt == 'A' && traits::leading_dimension (vt) >= n) || (jobvt == 'S' && traits::leading_dimension (vt) >= minmn)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif assert (traits::vector_size(w) >= detail::gesvd_min_work(val_t(),m,n)); int info; detail::gesvd (jobu, jobvt, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), 0, // dummy argument &info); return info; } template inline int gesvd (char const jobu, char const jobvt, MatrA& a, VecS& s, MatrU& u, MatrV& vt, VecW& w, VecRW& rw) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); assert (!(jobu == 'O' && jobvt == 'O')); assert ((jobu == 'N') || (jobu == 'O') || (jobu == 'A' && m == traits::matrix_size2 (u)) || (jobu == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobu == 'N' && traits::leading_dimension (u) >= 1) || (jobu == 'O' && traits::leading_dimension (u) >= 1) || (jobu == 'A' && traits::leading_dimension (u) >= m) || (jobu == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobvt == 'N' && traits::leading_dimension (vt) >= 1) || (jobvt == 'O' && traits::leading_dimension (vt) >= 1) || (jobvt == 'A' && traits::leading_dimension (vt) >= n) || (jobvt == 'S' && traits::leading_dimension (vt) >= minmn)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif assert (traits::vector_size(w) >= detail::gesvd_min_work(val_t(),m,n)); assert (traits::vector_size(rw) >= detail::gesvd_rwork(val_t(),m,n)); int info; detail::gesvd (jobu, jobvt, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), traits::vector_storage (rw), &info); return info; } template inline int gesvd (char const opt, char const jobu, char const jobvt, MatrA& a, VecS& s, MatrU& u, MatrV& vt) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); assert (!(jobu == 'O' && jobvt == 'O')); assert ((jobu == 'N') || (jobu == 'O') || (jobu == 'A' && m == traits::matrix_size2 (u)) || (jobu == 'S' && minmn == traits::matrix_size2 (u))); assert ((jobu == 'N' && traits::leading_dimension (u) >= 1) || (jobu == 'O' && traits::leading_dimension (u) >= 1) || (jobu == 'A' && traits::leading_dimension (u) >= m) || (jobu == 'S' && traits::leading_dimension (u) >= m)); assert (n == traits::matrix_size2 (vt)); assert ((jobvt == 'N' && traits::leading_dimension (vt) >= 1) || (jobvt == 'O' && traits::leading_dimension (vt) >= 1) || (jobvt == 'A' && traits::leading_dimension (vt) >= n) || (jobvt == 'S' && traits::leading_dimension (vt) >= minmn)); #ifdef BOOST_NUMERIC_BINDINGS_LAPACK_2 assert (opt == 'M'); #else assert (opt == 'M' || opt == 'O'); #endif #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; int const lw = gesvd_work (opt, jobu, jobvt, a); traits::detail::array w (lw); if (!w.valid()) return -101; int const lrw = gesvd_rwork (a); traits::detail::array rw (lrw); if (!rw.valid()) return -102; int info; detail::gesvd (jobu, jobvt, m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), traits::matrix_storage (u), traits::leading_dimension (u), traits::matrix_storage (vt), traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), traits::vector_storage (rw), &info); return info; } #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_2 template inline int gesvd (char const jobu, char const jobvt, MatrA& a, VecS& s, MatrU& u, MatrV& vt) { return gesvd ('O', jobu, jobvt, a, s, u, vt); } template inline int gesvd (MatrA& a, VecS& s, MatrU& u, MatrV& vt) { return gesvd ('O', 'S', 'S', a, s, u, vt); } template inline int gesvd (MatrA& a, VecS& s) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (a); int const n = traits::matrix_size2 (a); int const minmn = m < n ? m : n; assert (minmn == traits::vector_size (s)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename MatrA::value_type val_t; #endif typedef typename traits::type_traits::real_type real_t; int const lw = gesvd_work ('O', 'N', 'N', a); traits::detail::array w (lw); if (!w.valid()) return -101; int const lrw = gesvd_rwork (a); traits::detail::array rw (lrw); if (!rw.valid()) return -102; int info; detail::gesvd ('N', 'N', m, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (s), 0, // traits::matrix_storage (u), 1, // traits::leading_dimension (u), 0, // traits::matrix_storage (vt), 1, // traits::leading_dimension (vt), traits::vector_storage (w), traits::vector_size (w), traits::vector_storage (rw), &info); return info; } #endif } // namespace lapack }}} #endif boost-bindings/boost/numeric/bindings/lapack/hbev.hpp0000644000175000017500000002713007752726113023105 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_HBEV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_HBEV_HPP #include #include #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Eigendecomposition of a banded Hermitian matrix. // /////////////////////////////////////////////////////////////////// /* * hbev() computes the eigenvalues and optionally the associated * eigenvectors of a banded Hermitian matrix A. A matrix is Hermitian * when herm( A ) == A. When A is real, a Hermitian matrix is also * called symmetric. * * The eigen decomposition is A = U S * herm(U) where U is a * unitary matrix and S is a diagonal matrix. The eigenvalues of A * are on the main diagonal of S. The eigenvalues are real. * * Workspace is organized following the arguments in the calling sequence. * optimal_workspace() : for optimizing use of blas 3 kernels * minimal_workspace() : minimum size of workarrays, but does not allow for optimization * of blas 3 kernels * workspace( work ) for real matrices where work is a real array with * vector_size( work ) >= 3*matrix_size1( a ) - 2 * workspace( work, rwork ) for complex matrices where work is a complex * array with vector_size( work ) >= matrix_size1( a ) * and rwork is a real array with * vector_size( rwork ) >= 3 * matrix_size1( a ) - 2. */ /* * If uplo=='L' only the lower triangular part is stored. * If uplo=='U' only the upper triangular part is stored. * * The matrix is assumed to be stored in LAPACK band format, i.e. * matrices are stored columnwise, in a compressed format so that when e.g. uplo=='U' * the (i,j) element with j>=i is in position (i-j) + j * (KD+1) + KD where KD is the * half bandwidth of the matrix. For a triadiagonal matrix, KD=1, for a diagonal matrix * KD=0. * When uplo=='L', the (i,j) element with j>=i is in position (i-j) + j * (KD+1). * * The matrix A is thus a rectangular matrix with KD+1 rows and N columns. */ namespace detail { inline void hbev (char const jobz, char const uplo, int const n, int const kd, float* ab, int const ldab, float* w, float* z, int const ldz, float* work, int& info) { //for (int i=0; i struct Hbev{}; /// Handling of workspace in the case of one workarray. template <> struct Hbev< 1 > { template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, minimal_workspace , int& info ) const { traits::detail::array work( 3*n-2 ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work ), info ); } template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, optimal_workspace , int& info ) const { traits::detail::array work( 3*n-2 ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work ), info ); } template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, detail::workspace1 work, int& info ) const { assert( traits::vector_size( work.w_ ) >= 3*n-2 ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work.w_ ), info ); } }; // Hbev< 1 > /// Handling of workspace in the case of two workarrays. template <> struct Hbev< 2 > { template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, minimal_workspace , int& info ) const { traits::detail::array work( n ); traits::detail::array rwork( 3*n-2 ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work ), traits::vector_storage( rwork ), info ); } template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, optimal_workspace , int& info ) const { traits::detail::array work( n ); traits::detail::array rwork( 3*n-2 ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work ), traits::vector_storage( rwork ), info ); } template void operator() (char const jobz, char const uplo, int const n, int const kd, T* ab, int const ldab, R* w, T* z, int const ldz, detail::workspace2 work, int& info ) const { assert( traits::vector_size( work.wr_ ) >= 3*n-2 ); assert( traits::vector_size( work.w_ ) >= n ); hbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, traits::vector_storage( work.w_ ), traits::vector_storage( work.wr_ ), info ); } }; // Hbev< 2 > /// Compute eigendecomposition of the banded Hermitian matrix ab. /// if jobz=='N' only the eigenvalues are computed. /// if jobz=='V' compute the eigenvalues a and the eigenvectors. /// /// Workspace is organized following the arguments in the calling sequence. /// optimal_workspace() : for optimizing use of blas 3 kernels /// minimal_workspace() : minimum size of workarrays, but does not allow for optimization /// of blas 3 kernels /// workspace( work ) for real matrices where work is a real array with /// vector_size( work ) >= 3*matrix_size1( a )-2 /// workspace( work, rwork ) for complex matrices where work is a complex /// array with vector_size( work ) >= matrix_size1( a ) /// and rwork is a real array with /// vector_size( rwork ) >= 3*matrix_size1( a )-2. template int hbev( char const jobz, AB& ab, W& w, Z& z, Work work ) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif typedef typename AB::value_type value_type ; int const n = traits::matrix_size2 (ab); assert (n == traits::matrix_size1 (z)); assert (n == traits::vector_size (w)); assert ( jobz=='N' || jobz=='V' ); int info ; detail::Hbev< n_workspace_args::value >() (jobz, traits::matrix_uplo_tag( ab ), n, traits::matrix_upper_bandwidth(ab), traits::matrix_storage (ab), traits::leading_dimension (ab), traits::vector_storage (w), traits::matrix_storage (z), traits::leading_dimension (z), work, info); return info ; } // hbev() } // namespace detail /// Compute eigendecomposition without eigenvectors template inline int hbev (AB& ab, W& w, Work work) { return detail::hbev( 'N', ab, w, ab, work ); } // hbev() /// Compute eigendecomposition with eigenvectors template inline int hbev (AB& ab, W& w, Z& z, Work work) { BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); int const n = traits::matrix_size2 (ab); assert (n == traits::matrix_size1 (z)); assert (n == traits::matrix_size2 (z)); return detail::hbev( 'V', ab, w, z, work ); } // hbev() } }}} #endif boost-bindings/boost/numeric/bindings/lapack/heev.hpp0000644000175000017500000001322410040710666023075 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_HEEV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_HEEV_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Eigendecomposition of a complex Hermitian matrix A = Q * D * Q' // /////////////////////////////////////////////////////////////////// /* * heev() computes the eigendecomposition of a N x N matrix * A = Q * D * Q', where Q is a N x N unitary matrix and * D is a diagonal matrix. The diagonal element D(i,i) is an * eigenvalue of A and Q(:,i) is a corresponding eigenvector. * The eigenvalues are stored in ascending order. * * On return of heev, A is overwritten by Q and w contains the main * diagonal of D. * * int heev (char jobz, char uplo, A& a, W& w, minimal_workspace ) ; * jobz : 'V' : compute eigenvectors * 'N' : do not compute eigenvectors * uplo : 'U' : only the upper triangular part of A is used on input. * 'L' : only the lower triangular part of A is used on input. */ namespace detail { inline void heev (char const jobz, char const uplo, int const n, traits::complex_f* a, int const lda, float* w, traits::complex_f* work, int const lwork, float* rwork, int& info) { LAPACK_CHEEV (&jobz, &uplo, &n, reinterpret_cast(a), &lda, w, reinterpret_cast(work), &lwork, rwork, &info); } inline void heev (char const jobz, char const uplo, int const n, traits::complex_d* a, int const lda, double* w, traits::complex_d* work, int const lwork, double* rwork, int& info) { LAPACK_ZHEEV (&jobz, &uplo, &n, reinterpret_cast(a), &lda, w, reinterpret_cast(work), &lwork, rwork, &info); } template inline int heev (char jobz, char uplo, A& a, W& w, Work& work, RWork& rwork) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (traits::matrix_size2 (a)==n); assert (traits::vector_size (w)==n); assert (2*n-1 <= traits::vector_size (work)); assert (3*n-2 <= traits::vector_size (rwork)); assert ( uplo=='U' || uplo=='L' ); assert ( jobz=='N' || jobz=='V' ); int info; detail::heev (jobz, uplo, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (w), traits::vector_storage (work), traits::vector_size (work), traits::vector_storage (rwork), info); return info; } } // namespace detail // Function that allocates temporary arrays template int heev (char jobz, char uplo, A& a, W& w, minimal_workspace ) { typedef typename A::value_type value_type ; typedef typename traits::type_traits::real_type real_type ; int const n = traits::matrix_size1 (a); traits::detail::array work( std::max(1,2*n-1) ); traits::detail::array rwork( std::max(3*n-1,1) ); return detail::heev( jobz, uplo, a, w, work, rwork ); } // Function that allocates temporary arrays template int heev (char jobz, char uplo, A& a, W& w, optimal_workspace ) { typedef typename A::value_type value_type ; typedef typename traits::type_traits::real_type real_type ; int const n = traits::matrix_size1 (a); traits::detail::array work( std::max(1,33*n) ); traits::detail::array rwork( std::max(3*n-1,1) ); return detail::heev( jobz, uplo, a, w, work, rwork ); } // Function that uses given workarrays template int heev (char jobz, char uplo, A& a, W& w, detail::workspace2 workspace ) { typedef typename A::value_type value_type ; typedef typename traits::type_traits::real_type real_type ; return detail::heev( jobz, uplo, a, w, workspace.w_, workspace.wr_ ); } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/hesv.hpp0000644000175000017500000004521210603223732023113 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_HESV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_HESV_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif #include namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B // with A Hermitian indefinite matrix // ///////////////////////////////////////////////////////////////////// namespace detail { inline int hetrf_block (traits::complex_f, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "CHETRF", ul2, n); } inline int hetrf_block (traits::complex_d, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "ZHETRF", ul2, n); } } template inline int hetrf_block (char const q, char const ul, HermA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (q == 'O' || q == 'M'); assert (ul == 'U' || ul == 'L'); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif int ispec = (q == 'O' ? 1 : 2); return detail::hetrf_block (val_t(), ispec, ul, n); } template inline int hetrf_block (char const q, HermA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif assert (q == 'O' || q == 'M'); char ul = traits::matrix_uplo_tag (a); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif int ispec = (q == 'O' ? 1 : 2); return detail::hetrf_block (val_t(), ispec, ul, n); } template inline int hetrf_work (char const q, char const ul, HermA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (q == 'O' || q == 'M'); assert (ul == 'U' || ul == 'L'); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif int lw = -13; if (q == 'M') lw = 1; if (q == 'O') lw = n * detail::hetrf_block (val_t(), 1, ul, n); return lw; } template inline int hetrf_work (char const q, HermA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif assert (q == 'O' || q == 'M'); char ul = traits::matrix_uplo_tag (a); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif int lw = -13; if (q == 'M') lw = 1; if (q == 'O') lw = n * detail::hetrf_block (val_t(), 1, ul, n); return lw; } template inline int hesv_work (char const q, char const ul, HermA const& a) { return hetrf_work (q, ul, a); } template inline int hesv_work (char const q, HermA const& a) { return hetrf_work (q, a); } /* * hesv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N Hermitian matrix and X and B * are N-by-NRHS matrices. * * The diagonal pivoting method is used to factor A as * A = U * D * U^H, if UPLO = 'U', * A = L * D * L^H, if UPLO = 'L', * where U (or L) is a product of permutation and unit upper * (lower) triangular matrices, and D is Hermitian and block * diagonal with 1-by-1 and 2-by-2 diagonal blocks. The factored * form of A is then used to solve the system of equations A * X = B. */ namespace detail { inline void hesv (char const uplo, int const n, int const nrhs, traits::complex_f* a, int const lda, int* ipiv, traits::complex_f* b, int const ldb, traits::complex_f* w, int const lw, int* info) { LAPACK_CHESV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, traits::complex_ptr (w), &lw, info); } inline void hesv (char const uplo, int const n, int const nrhs, traits::complex_d* a, int const lda, int* ipiv, traits::complex_d* b, int const ldb, traits::complex_d* w, int const lw, int* info) { LAPACK_ZHESV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, traits::complex_ptr (w), &lw, info); } template inline int hesv (char const ul, HermA& a, IVec& i, MatrB& b, Work& w) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); int info; hesv (ul, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (i), traits::matrix_storage (b), traits::leading_dimension (b), traits::vector_storage (w), traits::vector_size (w), &info); return info; } } template inline int hesv (char const ul, HermA& a, IVec& i, MatrB& b, Work& w) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const lw = traits::vector_size (w); assert (lw >= 1); return detail::hesv (ul, a, i, b, w); } template inline int hesv (HermA& a, IVec& i, MatrB& b, Work& w) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const lw = traits::vector_size (w); assert (lw >= 1); char uplo = traits::matrix_uplo_tag (a); return detail::hesv (uplo, a, i, b, w); } template inline int hesv (char const ul, HermA& a, MatrB& b) { // with 'internal' pivot and work vectors assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); int info = -101; traits::detail::array i (n); if (i.valid()) { info = -102; int lw = hetrf_work ('O', ul, a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::hesv (ul, a, i, b, w); } return info; } template inline int hesv (HermA& a, MatrB& b) { // with 'internal' pivot and work vectors #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); char uplo = traits::matrix_uplo_tag (a); int info = -101; traits::detail::array i (n); if (i.valid()) { info = -102; int lw = hetrf_work ('O', a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif traits::detail::array w (lw); w.resize (lw); if (w.valid()) info = detail::hesv (uplo, a, i, b, w); } return info; } /* * hetrf() computes the factorization of a Hermitian matrix A using * the Bunch-Kaufman diagonal pivoting method. The form of the * factorization is * A = U * D * U^H or A = L * D * L^H * where U (or L) is a product of permutation and unit upper (lower) * triangular matrices, and D is Hermitian and block diagonal with * 1-by-1 and 2-by-2 diagonal blocks. */ namespace detail { inline void hetrf (char const uplo, int const n, traits::complex_f* a, int const lda, int* ipiv, traits::complex_f* w, int const lw, int* info) { LAPACK_CHETRF (&uplo, &n, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (w), &lw, info); } inline void hetrf (char const uplo, int const n, traits::complex_d* a, int const lda, int* ipiv, traits::complex_d* w, int const lw, int* info) { LAPACK_ZHETRF (&uplo, &n, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (w), &lw, info); } template inline int hetrf (char const ul, HermA& a, IVec& i, Work& w) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::vector_size (i)); int info; hetrf (ul, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (i), traits::vector_storage (w), traits::vector_size (w), &info); return info; } } template inline int hetrf (char const ul, HermA& a, IVec& i, Work& w) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const lw = traits::vector_size (w); assert (lw >= 1); return detail::hetrf (ul, a, i, w); } template inline int hetrf (HermA& a, IVec& i, Work& w) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif int const lw = traits::vector_size (w); assert (lw >= 1); char uplo = traits::matrix_uplo_tag (a); return detail::hetrf (uplo, a, i, w); } template inline int hetrf (char const ul, HermA& a, Ivec& i) { // with 'internal' work vector assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int info = -101; int lw = hetrf_work ('O', ul, a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::hetrf (ul, a, i, w); return info; } template inline int hetrf (HermA& a, Ivec& i) { // with 'internal' work vector #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); int info = -101; int lw = hetrf_work ('O', a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename HermA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::hetrf (uplo, a, i, w); return info; } /* * hetrs() solves a system of linear equations A*X = B with * a Hermitian matrix A using the factorization * A = U * D * U^H or A = L * D * L^H * computed by hetrf(). */ namespace detail { inline void hetrs (char const uplo, int const n, int const nrhs, traits::complex_f const* a, int const lda, int const* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CHETRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } inline void hetrs (char const uplo, int const n, int const nrhs, traits::complex_d const* a, int const lda, int const* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZHETRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } template inline int hetrs (char const ul, HermA const& a, IVec const& i, MatrB& b) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); int info; hetrs (ul, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (i), #else traits::vector_storage_const (i), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int hetrs (char const ul, HermA const& a, IVec const& i, MatrB& b) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::hetrs (ul, a, i, b); } template inline int hetrs (HermA const& a, IVec const& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); return detail::hetrs (uplo, a, i, b); } // TO DO: hetri } }}} #endif boost-bindings/boost/numeric/bindings/lapack/hpsv.hpp0000644000175000017500000002026307725610427023141 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_HPSV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_HPSV_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B // with A Hermitian indefinite matrix stored in packed format // ///////////////////////////////////////////////////////////////////// /* * hpsv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N Hermitian matrix in packed * storage and X and B are N-by-NRHS matrices. * * The diagonal pivoting method is used to factor A as * A = U * D * U^H, if UPLO = 'U', * A = L * D * L^H, if UPLO = 'L', * where U (or L) is a product of permutation and unit upper * (lower) triangular matrices, and D is Hermitian and block * diagonal with 1-by-1 and 2-by-2 diagonal blocks. The factored * form of A is then used to solve the system of equations A * X = B. */ namespace detail { inline void hpsv (char const uplo, int const n, int const nrhs, traits::complex_f* ap, int* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CHPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } inline void hpsv (char const uplo, int const n, int const nrhs, traits::complex_d* ap, int* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZHPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } template inline int hpsv (HermA& a, IVec& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); char uplo = traits::matrix_uplo_tag (a); int info; hpsv (uplo, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::vector_storage (i), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int hpsv (HermA& a, IVec& i, MatrB& b) { assert (traits::matrix_size1 (a) == traits::vector_size (i)); return detail::hpsv (a, i, b); } template inline int hpsv (HermA& a, MatrB& b) { // with 'internal' pivot vector int info = -101; traits::detail::array i (traits::matrix_size1 (a)); if (i.valid()) info = detail::hpsv (a, i, b); return info; } /* * hptrf() computes the factorization of a Hermitian matrix A * in packed storage using the Bunch-Kaufman diagonal pivoting * method. The form of the factorization is * A = U * D * U^H or A = L * D * L^H * where U (or L) is a product of permutation and unit upper (lower) * triangular matrices, and D is Hermitian and block diagonal with * 1-by-1 and 2-by-2 diagonal blocks. */ namespace detail { inline void hptrf (char const uplo, int const n, traits::complex_f* ap, int* ipiv, int* info) { LAPACK_CHPTRF (&uplo, &n, traits::complex_ptr (ap), ipiv, info); } inline void hptrf (char const uplo, int const n, traits::complex_d* ap, int* ipiv, int* info) { LAPACK_ZHPTRF (&uplo, &n, traits::complex_ptr (ap), ipiv, info); } template inline int hptrf (char const ul, HermA& a, IVec& i, Work& w, int const lw) { } } template inline int hptrf (HermA& a, IVec& i) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::vector_size (i)); char uplo = traits::matrix_uplo_tag (a); int info; detail::hptrf (uplo, n, traits::matrix_storage (a), traits::vector_storage (i), &info); return info; } /* * hptrs() solves a system of linear equations A*X = B with * a Hermitian matrix A in packed storage using the factorization * A = U * D * U^H or A = L * D * L^H * computed by hptrf(). */ namespace detail { inline void hptrs (char const uplo, int const n, int const nrhs, traits::complex_f const* ap, int const* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CHPTRS (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } inline void hptrs (char const uplo, int const n, int const nrhs, traits::complex_d const* ap, int const* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZHPTRS (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } } template inline int hptrs (HermA const& a, IVec const& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::hermitian_packed_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); char uplo = traits::matrix_uplo_tag (a); int info; detail::hptrs (uplo, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), traits::vector_storage (i), #else traits::matrix_storage_const (a), traits::vector_storage_const (i), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } // TO DO: hptri } }}} #endif boost-bindings/boost/numeric/bindings/lapack/ilaenv.hpp0000644000175000017500000000240610037760525023431 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Kresimir Fresl and Matthias Troyer 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_ILAENV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_ILAENV_HPP #include #include namespace boost { namespace numeric { namespace bindings { namespace lapack { /* * ilaenv() is called from the LAPACK routines to choose * problem-dependent parameters such as the block sizes * for the local environment. */ inline int ilaenv (int const ispec, const char* name, const char* opts, int const n1 = -1, int const n2 = -1, int const n3 = -1, int const n4 = -1) { return ::LAPACK_ILAENV (&ispec, name, opts, &n1, &n2, &n3, &n4, std::strlen (name), std::strlen (opts)); } }}}} #endif boost-bindings/boost/numeric/bindings/lapack/lapack.h0000644000175000017500000006245210102407147023044 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_H #define BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_H #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # define BOOST_NUMERIC_BINDINGS_FORTRAN #endif extern "C" { /********************************************************************/ /* linear systems */ /********************************************************************/ /* general */ void LAPACK_SGESV (int const* n, int const* nrhs, float* a, int const* lda, int* ipiv, float* b, int const* ldb, int* info); void LAPACK_DGESV (int const* n, int const* nrhs, double* a, int const* lda, int* ipiv, double* b, int const* ldb, int* info); void LAPACK_CGESV (int const* n, int const* nrhs, fcomplex_t* a, int const* lda, int* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZGESV (int const* n, int const* nrhs, dcomplex_t* a, int const* lda, int* ipiv, dcomplex_t* b, int const* ldb, int* info); void LAPACK_SGETRF (int const* n, int const* nrhs, float* a, int const* lda, int* ipiv, int* info); void LAPACK_DGETRF (int const* n, int const* nrhs, double* a, int const* lda, int* ipiv, int* info); void LAPACK_CGETRF (int const* n, int const* nrhs, fcomplex_t* a, int const* lda, int* ipiv, int* info); void LAPACK_ZGETRF (int const* n, int const* nrhs, dcomplex_t* a, int const* lda, int* ipiv, int* info); void LAPACK_SGETRS (char const* trans, int const* n, int const* nrhs, float const* a, int const* lda, int const* ipiv, float* b, int const* ldb, int* info); void LAPACK_DGETRS (char const* trans, int const* n, int const* nrhs, double const* a, int const* lda, int const* ipiv, double* b, int const* ldb, int* info); void LAPACK_CGETRS (char const* trans, int const* n, int const* nrhs, fcomplex_t const* a, int const* lda, int const* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZGETRS (char const* trans, int const* n, int const* nrhs, dcomplex_t const* a, int const* lda, int const* ipiv, dcomplex_t* b, int const* ldb, int* info); /* symmetric/Hermitian positive definite */ void LAPACK_SPOSV (char const* uplo, int const* n, int const* nrhs, float* a, int const* lda, float* b, int const* ldb, int* info); void LAPACK_DPOSV (char const* uplo, int const* n, int const* nrhs, double* a, int const* lda, double* b, int const* ldb, int* info); void LAPACK_CPOSV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* a, int const* lda, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZPOSV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* a, int const* lda, dcomplex_t* b, int const* ldb, int* info); void LAPACK_SPOTRF (char const* uplo, int const* n, float* a, int const* lda, int* info); void LAPACK_DPOTRF (char const* uplo, int const* n, double* a, int const* lda, int* info); void LAPACK_CPOTRF (char const* uplo, int const* n, fcomplex_t* a, int const* lda, int* info); void LAPACK_ZPOTRF (char const* uplo, int const* n, dcomplex_t* a, int const* lda, int* info); void LAPACK_SPOTRS (char const* uplo, int const* n, int const* nrhs, float const* a, int const* lda, float* b, int const* ldb, int* info); void LAPACK_DPOTRS (char const* uplo, int const* n, int const* nrhs, double const* a, int const* lda, double* b, int const* ldb, int* info); void LAPACK_CPOTRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* a, int const* lda, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZPOTRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* a, int const* lda, dcomplex_t* b, int const* ldb, int* info); /* symmetric/Hermitian positive definite in packed storage */ void LAPACK_SPPSV (char const* uplo, int const* n, int const* nrhs, float* ap, float* b, int const* ldb, int* info); void LAPACK_DPPSV (char const* uplo, int const* n, int const* nrhs, double* ap, double* b, int const* ldb, int* info); void LAPACK_CPPSV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* ap, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZPPSV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* ap, dcomplex_t* b, int const* ldb, int* info); void LAPACK_SPPTRF (char const* uplo, int const* n, float* ap, int* info); void LAPACK_DPPTRF (char const* uplo, int const* n, double* ap, int* info); void LAPACK_CPPTRF (char const* uplo, int const* n, fcomplex_t* ap, int* info); void LAPACK_ZPPTRF (char const* uplo, int const* n, dcomplex_t* ap, int* info); void LAPACK_SPPTRS (char const* uplo, int const* n, int const* nrhs, float const* ap, float* b, int const* ldb, int* info); void LAPACK_DPPTRS (char const* uplo, int const* n, int const* nrhs, double const* ap, double* b, int const* ldb, int* info); void LAPACK_CPPTRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* ap, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZPPTRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* ap, dcomplex_t* b, int const* ldb, int* info); /* symmetric/Hermitian indefinite and complex symmetric */ void LAPACK_SSYSV (char const* uplo, int const* n, int const* nrhs, float* a, int const* lda, int* ipiv, float* b, int const* ldb, float* w, int const* lw, int* info); void LAPACK_DSYSV (char const* uplo, int const* n, int const* nrhs, double* a, int const* lda, int* ipiv, double* b, int const* ldb, double* w, int const* lw, int* info); void LAPACK_CSYSV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* a, int const* lda, int* ipiv, fcomplex_t* b, int const* ldb, fcomplex_t* w, int const* lw, int* info); void LAPACK_ZSYSV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* a, int const* lda, int* ipiv, dcomplex_t* b, int const* ldb, dcomplex_t* w, int const* lw, int* info); void LAPACK_CHESV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* a, int const* lda, int* ipiv, fcomplex_t* b, int const* ldb, fcomplex_t* w, int const* lw, int* info); void LAPACK_ZHESV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* a, int const* lda, int* ipiv, dcomplex_t* b, int const* ldb, dcomplex_t* w, int const* lw, int* info); void LAPACK_SSYTRF (char const* uplo, int const* n, float* a, int const* lda, int* ipiv, float* w, int const* lw, int* info); void LAPACK_DSYTRF (char const* uplo, int const* n, double* a, int const* lda, int* ipiv, double* w, int const* lw, int* info); void LAPACK_CSYTRF (char const* uplo, int const* n, fcomplex_t* a, int const* lda, int* ipiv, fcomplex_t* w, int const* lw, int* info); void LAPACK_ZSYTRF (char const* uplo, int const* n, dcomplex_t* a, int const* lda, int* ipiv, dcomplex_t* w, int const* lw, int* info); void LAPACK_CHETRF (char const* uplo, int const* n, fcomplex_t* a, int const* lda, int* ipiv, fcomplex_t* w, int const* lw, int* info); void LAPACK_ZHETRF (char const* uplo, int const* n, dcomplex_t* a, int const* lda, int* ipiv, dcomplex_t* w, int const* lw, int* info); void LAPACK_SSYTRS (char const* uplo, int const* n, int const* nrhs, float const* a, int const* lda, int const* ipiv, float* b, int const* ldb, int* info); void LAPACK_DSYTRS (char const* uplo, int const* n, int const* nrhs, double const* a, int const* lda, int const* ipiv, double* b, int const* ldb, int* info); void LAPACK_CSYTRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* a, int const* lda, int const* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZSYTRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* a, int const* lda, int const* ipiv, dcomplex_t* b, int const* ldb, int* info); void LAPACK_CHETRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* a, int const* lda, int const* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZHETRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* a, int const* lda, int const* ipiv, dcomplex_t* b, int const* ldb, int* info); /* symmetric/Hermitian indefinite and complex symmetric in packed storage */ void LAPACK_SSPSV (char const* uplo, int const* n, int const* nrhs, float* ap, int* ipiv, float* b, int const* ldb, int* info); void LAPACK_DSPSV (char const* uplo, int const* n, int const* nrhs, double* ap, int* ipiv, double* b, int const* ldb, int* info); void LAPACK_CSPSV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* ap, int* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZSPSV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* ap, int* ipiv, dcomplex_t* b, int const* ldb, int* info); void LAPACK_CHPSV (char const* uplo, int const* n, int const* nrhs, fcomplex_t* ap, int* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZHPSV (char const* uplo, int const* n, int const* nrhs, dcomplex_t* ap, int* ipiv, dcomplex_t* b, int const* ldb, int* info); void LAPACK_SSPTRF (char const* uplo, int const* n, float* ap, int* ipiv, int* info); void LAPACK_DSPTRF (char const* uplo, int const* n, double* ap, int* ipiv, int* info); void LAPACK_CSPTRF (char const* uplo, int const* n, fcomplex_t* ap, int* ipiv, int* info); void LAPACK_ZSPTRF (char const* uplo, int const* n, dcomplex_t* ap, int* ipiv, int* info); void LAPACK_CHPTRF (char const* uplo, int const* n, fcomplex_t* ap, int* ipiv, int* info); void LAPACK_ZHPTRF (char const* uplo, int const* n, dcomplex_t* ap, int* ipiv, int* info); void LAPACK_SSPTRS (char const* uplo, int const* n, int const* nrhs, float const* ap, int const* ipiv, float* b, int const* ldb, int* info); void LAPACK_DSPTRS (char const* uplo, int const* n, int const* nrhs, double const* ap, int const* ipiv, double* b, int const* ldb, int* info); void LAPACK_CSPTRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* ap, int const* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZSPTRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* ap, int const* ipiv, dcomplex_t* b, int const* ldb, int* info); void LAPACK_CHPTRS (char const* uplo, int const* n, int const* nrhs, fcomplex_t const* ap, int const* ipiv, fcomplex_t* b, int const* ldb, int* info); void LAPACK_ZHPTRS (char const* uplo, int const* n, int const* nrhs, dcomplex_t const* ap, int const* ipiv, dcomplex_t* b, int const* ldb, int* info); /**********************************************************************/ /* eigenproblems */ /**********************************************************************/ void LAPACK_SGEES (const char* jobvs, const char* sort, logical_t* select, const int* n, float* a, const int * lda, const int* sdim, float* wr, float* wi, float* vs, const int * ldvs, float* work, const int * lwork, bool* bwork, int* info); void LAPACK_DGEES (const char* jobvs, const char* sort, logical_t* select, const int* n, double* a, const int * lda, const int* sdim, double* wr, double* wi, double* vs, const int * ldvs, double* work, const int * lwork, bool* bwork, int* info); void LAPACK_CGEES( const char* jobvs, const char* sort, logical_t* select, const int *n, fcomplex_t* a, const int * lda, int * sdim, fcomplex_t* w, fcomplex_t* vs, const int * ldvs, fcomplex_t* work, const int * lwork, float* rwork, bool* bwork, int* info ); void LAPACK_ZGEES( const char* jobvs, const char* sort, const logical_t* select, const int *n, dcomplex_t* a, const int * lda, int * sdim, dcomplex_t* w, dcomplex_t* vs, const int * ldvs, dcomplex_t* work, const int * lwork, double* rwork, bool* bwork, int* info ); void LAPACK_SGEEV( const char* jobvl, const char* jobvr, const int* n, float* a, const int* lda, float* wr, float* wi, float* vl, const int* ldvl, float* vr, const int* ldvr, float* work, const int* lwork, int* info ); void LAPACK_DGEEV( const char* jobvl, const char* jobvr, const int* n, double* a, const int* lda, double* wr, double* wi, double* vl, const int* ldvl, double* vr, const int* ldvr, double* work, const int* lwork, int* info ); void LAPACK_CGEEV( const char* jobvl, const char* jobvr, const int* n, fcomplex_t* a, const int* lda, fcomplex_t* w, fcomplex_t* vl, const int* ldvl, fcomplex_t* vr, const int* ldvr, fcomplex_t* work, const int* lwork, float* rwork, int* info ); void LAPACK_ZGEEV( const char* jobvl, const char* jobvr, const int* n, dcomplex_t* a, const int* lda, dcomplex_t* w, dcomplex_t* vl, const int* ldvl, dcomplex_t* vr, const int* ldvr, dcomplex_t* work, const int* lwork, double* rwork, int* info ); void LAPACK_SSYEV( const char* jobz, const char* uplo, const int *n, float* a, const int * lda, float* w, float* work, const int * lwork, int* info ); void LAPACK_DSYEV( const char* jobz, const char* uplo, const int *n, double* a, const int * lda, double* w, double* work, const int * lwork, int* info ); void LAPACK_CHEEV( const char* jobz, const char* uplo, const int *n, fcomplex_t* a, const int * lda, float* w, fcomplex_t* work, const int * lwork, float* rwork, int* info ); void LAPACK_ZHEEV( const char* jobz, const char* uplo, const int *n, dcomplex_t* a, const int * lda, double* w, dcomplex_t* work, const int * lwork, double* rwork, int* info ); void LAPACK_CTREVC( const char* side, const char* howmny, const logical_t* select, const int *n, fcomplex_t* t, const int * ldt, fcomplex_t* vl, const int* ldvl, fcomplex_t* vr, const int * ldvr, const int * nm, int* m, fcomplex_t* work, float* rwork, int* info ); void LAPACK_ZTREVC( const char* side, const char* howmny, const logical_t* select, const int *n, dcomplex_t* t, const int * ldt, dcomplex_t* vl, const int* ldvl, dcomplex_t* vr, const int * ldvr, const int * nm, int* m, dcomplex_t* work, double* rwork, int* info ); void LAPACK_STREVC( const char* side, const char* howmny, const logical_t* select, const int *n, float* t, const int * ldt, float* vl, const int* ldvl, float* vr, const int * ldvr, const int * nm, int* m, float* work, int* info ); void LAPACK_DTREVC( const char* side, const char* howmny, const logical_t* select, const int *n, double* t, const int * ldt, double* vl, const int* ldvl, double* vr, const int * ldvr, const int * nm, int* m, double* work, int* info ); void LAPACK_STREXC( const char* compq, const int *n, float* t, const int * ldt, float* q, const int* ldq, int* ifst, const int * ilst, float* work, int* info ); void LAPACK_DTREXC( const char* compq, const int *n, double* t, const int * ldt, double* q, const int* ldq, int* ifst, const int * ilst, double* work, int* info ); void LAPACK_CTREXC( const char* compq, const int *n, fcomplex_t* t, const int * ldt, fcomplex_t* q, const int* ldq, int* ifst, const int * ilst, int* info ); void LAPACK_ZTREXC( const char* compq, const int *n, dcomplex_t* t, const int * ldt, dcomplex_t* q, const int* ldq, int* ifst, const int * ilst, int* info ); /* Hermitian banded matrices */ void LAPACK_SSBEV( char const* jobz, char const* uplo, int const* n, int const* kd, float* ab, int const* ldab, float* w, float* z, int const* ldz, float* work, int const* info ); void LAPACK_DSBEV( char const* jobz, char const* uplo, int const* n, int const* kd, double* ab, int const* ldab, double* w, double* z, int const* ldz, double* work, int const* info ); void LAPACK_CHBEV( char const* jobz, char const* uplo, int const* n, int const* kd, fcomplex_t* ab, int const* ldab, float* w, fcomplex_t* z, int const* ldz, fcomplex_t* work, float* rwork, int const* info ); void LAPACK_ZHBEV( char const* jobz, char const* uplo, int const* n, int const* kd, dcomplex_t* ab, int const* ldab, double* w, dcomplex_t* z, int const* ldz, dcomplex_t* work, double* rwork, int const* info ); /*********************************************************************/ /* SVD */ /*********************************************************************/ void LAPACK_SGESVD (char const* jobu, char const* jobvt, int const* m, int const* n, float* a, int const* lda, float* s, float* u, int const* ldu, float* vt, int const* ldvt, float* work, int const* lwork, int* info); void LAPACK_DGESVD (char const* jobu, char const* jobvt, int const* m, int const* n, double* a, int const* lda, double* s, double* u, int const* ldu, double* vt, int const* ldvt, double* work, int const* lwork, int* info); void LAPACK_CGESVD (char const* jobu, char const* jobvt, int const* m, int const* n, fcomplex_t* a, int const* lda, float* s, fcomplex_t* u, int const* ldu, fcomplex_t* vt, int const* ldvt, fcomplex_t* work, int const* lwork, float* rwork, int* info); void LAPACK_ZGESVD (char const* jobu, char const* jobvt, int const* m, int const* n, dcomplex_t* a, int const* lda, double* s, dcomplex_t* u, int const* ldu, dcomplex_t* vt, int const* ldvt, dcomplex_t* work, int const* lwork, double* rwork, int* info); void LAPACK_SGESDD (char const* jobz, int const* m, int const* n, float* a, int const* lda, float* s, float* u, int const* ldu, float* vt, int const* ldvt, float* work, int const* lwork, int* iwork, int* info); void LAPACK_DGESDD (char const* jobz, int const* m, int const* n, double* a, int const* lda, double* s, double* u, int const* ldu, double* vt, int const* ldvt, double* work, int const* lwork, int* iwork, int* info); void LAPACK_CGESDD (char const* jobz, int const* m, int const* n, fcomplex_t* a, int const* lda, float* s, fcomplex_t* u, int const* ldu, fcomplex_t* vt, int const* ldvt, fcomplex_t* work, int const* lwork, float* rwork, int* iwork, int* info); void LAPACK_ZGESDD (char const* jobz, int const* m, int const* n, dcomplex_t* a, int const* lda, double* s, dcomplex_t* u, int const* ldu, dcomplex_t* vt, int const* ldvt, dcomplex_t* work, int const* lwork, double* rwork, int* iwork, int* info); /*********************************************************************/ /* QR factorization */ /*********************************************************************/ void LAPACK_SGEQRF( const int* m, const int* n, float* a, const int* lda, float* tau, float* work, const int* lwork, int* info ); void LAPACK_DGEQRF( const int* m, const int* n, double* a, const int* lda, double* tau, double* work, const int* lwork, int* info ); void LAPACK_CGEQRF( const int* m, const int* n, fcomplex_t* a, const int* lda, fcomplex_t* tau, fcomplex_t* work, const int* lwork, int* info ); void LAPACK_ZGEQRF( const int* m, const int* n, dcomplex_t* a, const int* lda, dcomplex_t* tau, dcomplex_t* work, const int* lwork, int* info ); void LAPACK_SORMQR( const char* side, const char* trans, const int* m, const int* n, const int* k, const float* a, const int* lda, const float* tau, float* c, const int* ldc, float* work, const int* lwork, int* info ); void LAPACK_DORMQR( const char* side, const char* trans, const int* m, const int* n, const int* k, const double* a, const int* lda, const double* tau, double* c, const int* ldc, double* work, const int* lwork, int* info ); void LAPACK_CUNMQR( const char* side, const char* trans, const int* m, const int* n, const int* k, const fcomplex_t* a, const int* lda, const fcomplex_t* tau, fcomplex_t* c, const int* ldc, fcomplex_t* work, const int* lwork, int* info ); void LAPACK_ZUNMQR( const char* side, const char* trans, const int* m, const int* n, const int* k, const dcomplex_t* a, const int* lda, const dcomplex_t* tau, dcomplex_t* c, const int* ldc, dcomplex_t* work, const int* lwork, int* info ); /********************************************************************/ /* auxiliary */ /********************************************************************/ int LAPACK_ILAENV (int const* ispec, const char* name, const char* opt, int const* n1, int const* n2, int const* n3, int const* n4, int, int); } #endif boost-bindings/boost/numeric/bindings/lapack/lapack.hpp0000644000175000017500000000272607752726113023420 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_HPP // linear systems #include #include #include #include #include #include #include // eigenproblems #include #include #include #include // SVD #include #include // Miscellaneous #include #include #endif // BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_HPP boost-bindings/boost/numeric/bindings/lapack/lapack_names.h0000644000175000017500000001520010102407147024214 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_NAMES_H #define BOOST_NUMERIC_BINDINGS_LAPACK_LAPACK_NAMES_H #ifndef BOOST_NUMERIC_BINDINGS_USE_CLAPACK # include #else # define FORTRAN_ID( id ) id##_ #endif /* linear systems */ /* general */ #define LAPACK_SGESV FORTRAN_ID( sgesv ) #define LAPACK_DGESV FORTRAN_ID( dgesv ) #define LAPACK_CGESV FORTRAN_ID( cgesv ) #define LAPACK_ZGESV FORTRAN_ID( zgesv ) #define LAPACK_SGETRF FORTRAN_ID( sgetrf ) #define LAPACK_DGETRF FORTRAN_ID( dgetrf ) #define LAPACK_CGETRF FORTRAN_ID( cgetrf ) #define LAPACK_ZGETRF FORTRAN_ID( zgetrf ) #define LAPACK_SGETRS FORTRAN_ID( sgetrs ) #define LAPACK_DGETRS FORTRAN_ID( dgetrs ) #define LAPACK_CGETRS FORTRAN_ID( cgetrs ) #define LAPACK_ZGETRS FORTRAN_ID( zgetrs ) #define LAPACK_SGETRI FORTRAN_ID( sgetri ) #define LAPACK_DGETRI FORTRAN_ID( dgetri ) #define LAPACK_CGETRI FORTRAN_ID( cgetri ) #define LAPACK_ZGETRI FORTRAN_ID( zgetri ) /* symmetric/Hermitian positive definite */ #define LAPACK_SPOSV FORTRAN_ID( sposv ) #define LAPACK_DPOSV FORTRAN_ID( dposv ) #define LAPACK_CPOSV FORTRAN_ID( cposv ) #define LAPACK_ZPOSV FORTRAN_ID( zposv ) #define LAPACK_SPOTRF FORTRAN_ID( spotrf ) #define LAPACK_DPOTRF FORTRAN_ID( dpotrf ) #define LAPACK_CPOTRF FORTRAN_ID( cpotrf ) #define LAPACK_ZPOTRF FORTRAN_ID( zpotrf ) #define LAPACK_SPOTRS FORTRAN_ID( spotrs ) #define LAPACK_DPOTRS FORTRAN_ID( dpotrs ) #define LAPACK_CPOTRS FORTRAN_ID( cpotrs ) #define LAPACK_ZPOTRS FORTRAN_ID( zpotrs ) #define LAPACK_SPOTRI FORTRAN_ID( spotri ) #define LAPACK_DPOTRI FORTRAN_ID( dpotri ) #define LAPACK_CPOTRI FORTRAN_ID( cpotri ) #define LAPACK_ZPOTRI FORTRAN_ID( zpotri ) /* symmetric/Hermitian positive definite in packed storage */ #define LAPACK_SPPSV FORTRAN_ID( sppsv ) #define LAPACK_DPPSV FORTRAN_ID( dppsv ) #define LAPACK_CPPSV FORTRAN_ID( cppsv ) #define LAPACK_ZPPSV FORTRAN_ID( zppsv ) #define LAPACK_SPPTRF FORTRAN_ID( spptrf ) #define LAPACK_DPPTRF FORTRAN_ID( dpptrf ) #define LAPACK_CPPTRF FORTRAN_ID( cpptrf ) #define LAPACK_ZPPTRF FORTRAN_ID( zpptrf ) #define LAPACK_SPPTRS FORTRAN_ID( spptrs ) #define LAPACK_DPPTRS FORTRAN_ID( dpptrs ) #define LAPACK_CPPTRS FORTRAN_ID( cpptrs ) #define LAPACK_ZPPTRS FORTRAN_ID( zpptrs ) #define LAPACK_SPPTRI FORTRAN_ID( spptri ) #define LAPACK_DPPTRI FORTRAN_ID( dpptri ) #define LAPACK_CPPTRI FORTRAN_ID( cpptri ) #define LAPACK_ZPPTRI FORTRAN_ID( zpptri ) /* symmetric/Hermitian indefinite and complex symmetric */ #define LAPACK_SSYSV FORTRAN_ID( ssysv ) #define LAPACK_DSYSV FORTRAN_ID( dsysv ) #define LAPACK_CSYSV FORTRAN_ID( csysv ) #define LAPACK_ZSYSV FORTRAN_ID( zsysv ) #define LAPACK_CHESV FORTRAN_ID( chesv ) #define LAPACK_ZHESV FORTRAN_ID( zhesv ) #define LAPACK_SSYTRF FORTRAN_ID( ssytrf ) #define LAPACK_DSYTRF FORTRAN_ID( dsytrf ) #define LAPACK_CSYTRF FORTRAN_ID( csytrf ) #define LAPACK_ZSYTRF FORTRAN_ID( zsytrf ) #define LAPACK_CHETRF FORTRAN_ID( chetrf ) #define LAPACK_ZHETRF FORTRAN_ID( zhetrf ) #define LAPACK_SSYTRS FORTRAN_ID( ssytrs ) #define LAPACK_DSYTRS FORTRAN_ID( dsytrs ) #define LAPACK_CSYTRS FORTRAN_ID( csytrs ) #define LAPACK_ZSYTRS FORTRAN_ID( zsytrs ) #define LAPACK_CHETRS FORTRAN_ID( chetrs ) #define LAPACK_ZHETRS FORTRAN_ID( zhetrs ) /* symmetric/Hermitian indefinite and complex symmetric in packed storage */ #define LAPACK_SSPSV FORTRAN_ID( sspsv ) #define LAPACK_DSPSV FORTRAN_ID( dspsv ) #define LAPACK_CSPSV FORTRAN_ID( cspsv ) #define LAPACK_ZSPSV FORTRAN_ID( zspsv ) #define LAPACK_CHPSV FORTRAN_ID( chpsv ) #define LAPACK_ZHPSV FORTRAN_ID( zhpsv ) #define LAPACK_SSPTRF FORTRAN_ID( ssptrf ) #define LAPACK_DSPTRF FORTRAN_ID( dsptrf ) #define LAPACK_CSPTRF FORTRAN_ID( csptrf ) #define LAPACK_ZSPTRF FORTRAN_ID( zsptrf ) #define LAPACK_CHPTRF FORTRAN_ID( chptrf ) #define LAPACK_ZHPTRF FORTRAN_ID( zhptrf ) #define LAPACK_SSPTRS FORTRAN_ID( ssptrs ) #define LAPACK_DSPTRS FORTRAN_ID( dsptrs ) #define LAPACK_CSPTRS FORTRAN_ID( csptrs ) #define LAPACK_ZSPTRS FORTRAN_ID( zsptrs ) #define LAPACK_CHPTRS FORTRAN_ID( chptrs ) #define LAPACK_ZHPTRS FORTRAN_ID( zhptrs ) /********************************************/ /* eigenproblems */ #define LAPACK_SGEES FORTRAN_ID( sgees ) #define LAPACK_DGEES FORTRAN_ID( dgees ) #define LAPACK_CGEES FORTRAN_ID( cgees ) #define LAPACK_ZGEES FORTRAN_ID( zgees ) #define LAPACK_SGEEV FORTRAN_ID( sgeev ) #define LAPACK_DGEEV FORTRAN_ID( dgeev ) #define LAPACK_CGEEV FORTRAN_ID( cgeev ) #define LAPACK_ZGEEV FORTRAN_ID( zgeev ) #define LAPACK_SSYEV FORTRAN_ID( ssyev ) #define LAPACK_DSYEV FORTRAN_ID( dsyev ) #define LAPACK_CHEEV FORTRAN_ID( cheev ) #define LAPACK_ZHEEV FORTRAN_ID( zheev ) #define LAPACK_STREVC FORTRAN_ID( strevc ) #define LAPACK_DTREVC FORTRAN_ID( dtrevc ) #define LAPACK_CTREVC FORTRAN_ID( ctrevc ) #define LAPACK_ZTREVC FORTRAN_ID( ztrevc ) #define LAPACK_STREXC FORTRAN_ID( strexc ) #define LAPACK_DTREXC FORTRAN_ID( dtrexc ) #define LAPACK_CTREXC FORTRAN_ID( ctrexc ) #define LAPACK_ZTREXC FORTRAN_ID( ztrexc ) /********************************************/ /* eigenproblems for banded matrices */ #define LAPACK_SSBEV FORTRAN_ID( ssbev ) #define LAPACK_DSBEV FORTRAN_ID( dsbev ) #define LAPACK_CHBEV FORTRAN_ID( chbev ) #define LAPACK_ZHBEV FORTRAN_ID( zhbev ) /********************************************/ /* QR factorization */ #define LAPACK_SGEQRF FORTRAN_ID( sgeqrf ) #define LAPACK_DGEQRF FORTRAN_ID( dgeqrf ) #define LAPACK_CGEQRF FORTRAN_ID( cgeqrf ) #define LAPACK_ZGEQRF FORTRAN_ID( zgeqrf ) // Apply orthogonal transformation #define LAPACK_SORMQR FORTRAN_ID( sormqr ) #define LAPACK_DORMQR FORTRAN_ID( dormqr ) #define LAPACK_CUNMQR FORTRAN_ID( cunmqr ) #define LAPACK_ZUNMQR FORTRAN_ID( zunmqr ) /********************************************/ /* SVD */ #define LAPACK_SGESVD FORTRAN_ID( sgesvd ) #define LAPACK_DGESVD FORTRAN_ID( dgesvd ) #define LAPACK_CGESVD FORTRAN_ID( cgesvd ) #define LAPACK_ZGESVD FORTRAN_ID( zgesvd ) #define LAPACK_SGESDD FORTRAN_ID( sgesdd ) #define LAPACK_DGESDD FORTRAN_ID( dgesdd ) #define LAPACK_CGESDD FORTRAN_ID( cgesdd ) #define LAPACK_ZGESDD FORTRAN_ID( zgesdd ) /********************************************/ /* auxiliary */ #define LAPACK_ILAENV FORTRAN_ID( ilaenv ) #endif boost-bindings/boost/numeric/bindings/lapack/ormqr.hpp0000644000175000017500000001737607751671104023332 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_ORMQR_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_ORMQR_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Apply the orthogonal transformation abtained by geqrf() to // a general matrix. // /////////////////////////////////////////////////////////////////// /* * ormqr() overwrites the general M by N matrix C with * * SIDE = 'L' SIDE = 'R' * TRANS = 'N': Q * C C * Q * TRANS = 'C' || 'T': Q**H * C C * Q**H * * where Q is a complex unitary matrix defined as the product of k * elementary reflectors * * Q = H(1) H(2) . . . H(k) * * as returned by geqrf(). Q is of order M if SIDE = 'L' and of order N * if SIDE = 'R'. * * Workspace is organized following the arguments in the calling sequence. * optimal_workspace() : for optimizing use of blas 3 kernels * minimal_workspace() : minimum size of workarrays, but does not allow for optimization * of blas 3 kernels * workspace( work ) where is an array that is used as auxiliary memory with the same value_type * as C. * We must have that vector_size( work ) >= matrix_size2( c ) * if SIDE=='L' otherwise vector_size( work ) >= matrix_size1( c ) */ namespace detail { inline void ormqr (char const side, char const trans, int const m, int const n, int const k, const float* a, int const lda, const float* tau, float* c, int const ldc, float* work, int const lwork, int& info) { LAPACK_SORMQR (&side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork, &info); } inline void ormqr (char const side, char const trans, int const m, int const n, int const k, const double* a, int const lda, const double* tau, double* c, int const ldc, double* work, int const lwork, int& info) { LAPACK_DORMQR (&side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork, &info); } inline void ormqr (char const side, char const trans, int const m, int const n, int const k, const std::complex* a, int const lda, const std::complex* tau, std::complex* c, int const ldc, std::complex* work, int const lwork, int& info) { LAPACK_CUNMQR (&side, &trans, &m, &n, &k, reinterpret_cast(a), &lda, reinterpret_cast(tau), reinterpret_cast(c), &ldc, reinterpret_cast(work), &lwork, &info); } inline void ormqr (char const side, char const trans, int const m, int const n, int const k, const std::complex* a, int const lda, const std::complex* tau, std::complex* c, int const ldc, std::complex* work, int const lwork, int& info) { LAPACK_ZUNMQR (&side, &trans, &m, &n, &k, reinterpret_cast(a), &lda, reinterpret_cast(tau), reinterpret_cast(c), &ldc, reinterpret_cast(work), &lwork, &info); } template inline int ormqr (char side, char trans, const A& a, const Tau& tau, C& c, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const m = traits::matrix_size1 (c); int const n = traits::matrix_size2 (c); int const k = traits::vector_size (tau); int const lwork = traits::vector_size (work); assert ( side=='L' || side=='R' ); assert ( trans=='N' || trans=='C' || trans=='T' ); assert ( (side=='L' ? m >= k : n >= k ) ); assert ( (side=='L' ? m == traits::matrix_size1 (a) : n == traits::matrix_size1 (a) ) ); assert (traits::matrix_size2 (a)==k); assert ( (side=='L' ? lwork >= n : lwork >= m ) ); int info; ormqr (side, trans, m, n, k, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (tau), traits::matrix_storage (c), traits::leading_dimension (c), traits::vector_storage (work), lwork, info); return info; } } // namespace detail // Function that allocates temporary arrays for optimal execution time. template inline int ormqr (char side, char trans, const A& a, const Tau& tau, C& c, optimal_workspace ) { typedef typename A::value_type value_type ; int const n_w = (side=='L' ? traits::matrix_size2 (c) : traits::matrix_size1 (c) ); traits::detail::array work( std::max(1,n_w*32) ); return detail::ormqr( side, trans, a, tau, c, work ); } // Function that allocates temporary arrays with minimal size template inline int ormqr (char side, char trans, const A& a, const Tau& tau, C& c, minimal_workspace ) { typedef typename A::value_type value_type ; int const n_w = (side=='L' ? traits::matrix_size2 (c) : traits::matrix_size1 (c) ); traits::detail::array work( std::max(1,n_w) ); return detail::ormqr( side, trans, a, tau, c, work ); } // Function that uses auxiliary array in workspace // The calling sequence is ormqr(side, trans, a, tau, c, workspace( work_array ) ) // where work_array is an array with the same value_type as a and c . template inline int ormqr (char side, char trans, const A& a, const Tau& tau, C& c, detail::workspace1 workspace ) { typedef typename A::value_type value_type ; return detail::ormqr( side, trans, a, tau, c, workspace.w_ ); } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/posv.hpp0000644000175000017500000002617210204421115023131 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_POSV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_POSV_HPP #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B // with A symmetric or Hermitian positive definite matrix // ///////////////////////////////////////////////////////////////////// /* * posv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N symmetric or Hermitian positive * definite matrix and X and B are N-by-NRHS matrices. * * The Cholesky decomposition is used to factor A as * A = U^T * U or A = U^H * U, if UPLO = 'U', * A = L * L^T or A = L * L^H, if UPLO = 'L', * where U is an upper triangular matrix and L is a lower triangular * matrix. The factored form of A is then used to solve the system of * equations A * X = B. * * If UPLO = 'U', the leading N-by-N upper triangular part of A * contains the upper triangular part of the matrix A, and the * strictly lower triangular part of A is not referenced. * If UPLO = 'L', the leading N-by-N lower triangular part of A * contains the lower triangular part of the matrix A, and the * strictly upper triangular part of A is not referenced. */ namespace detail { inline void posv (char const uplo, int const n, int const nrhs, float* a, int const lda, float* b, int const ldb, int* info) { LAPACK_SPOSV (&uplo, &n, &nrhs, a, &lda, b, &ldb, info); } inline void posv (char const uplo, int const n, int const nrhs, double* a, int const lda, double* b, int const ldb, int* info) { LAPACK_DPOSV (&uplo, &n, &nrhs, a, &lda, b, &ldb, info); } inline void posv (char const uplo, int const n, int const nrhs, traits::complex_f* a, int const lda, traits::complex_f* b, int const ldb, int* info) { LAPACK_CPOSV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, traits::complex_ptr (b), &ldb, info); } inline void posv (char const uplo, int const n, int const nrhs, traits::complex_d* a, int const lda, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZPOSV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, traits::complex_ptr (b), &ldb, info); } template inline int posv (char const uplo, SymmMatrA& a, MatrB& b) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); int info; posv (uplo, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int posv (char const uplo, SymmMatrA& a, MatrB& b) { assert (uplo == 'U' || uplo == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::posv (uplo, a, b); } template inline int posv (SymmMatrA& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef traits::matrix_traits matraits; typedef typename matraits::value_type val_t; BOOST_STATIC_ASSERT( (traits::detail::symm_herm_compatible< val_t, typename matraits::matrix_structure >::value ) ) ; BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); return detail::posv (uplo, a, b); } /* * potrf() computes the Cholesky factorization of a symmetric * or Hermitian positive definite matrix A. The factorization has * the form * A = U^T * U or A = U^H * U, if UPLO = 'U', * A = L * L^T or A = L * L^H, if UPLO = 'L', * where U is an upper triangular matrix and L is lower triangular. */ namespace detail { inline void potrf (char const uplo, int const n, float* a, int const lda, int* info) { LAPACK_SPOTRF (&uplo, &n, a, &lda, info); } inline void potrf (char const uplo, int const n, double* a, int const lda, int* info) { LAPACK_DPOTRF (&uplo, &n, a, &lda, info); } inline void potrf (char const uplo, int const n, traits::complex_f* a, int const lda, int* info) { LAPACK_CPOTRF (&uplo, &n, traits::complex_ptr (a), &lda, info); } inline void potrf (char const uplo, int const n, traits::complex_d* a, int const lda, int* info) { LAPACK_ZPOTRF (&uplo, &n, traits::complex_ptr (a), &lda, info); } template inline int potrf (char const uplo, SymmMatrA& a) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); int info; potrf (uplo, n, traits::matrix_storage (a), traits::leading_dimension (a), &info); return info; } } template inline int potrf (char const uplo, SymmMatrA& a) { assert (uplo == 'U' || uplo == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::potrf (uplo, a); } template inline int potrf (SymmMatrA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef traits::matrix_traits matraits; typedef typename matraits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename matraits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); #endif char uplo = traits::matrix_uplo_tag (a); return detail::potrf (uplo, a); } /* * potrs() solves a system of linear equations A*X = B with * a symmetric or Hermitian positive definite matrix A using * the Cholesky factorization computed by potrf(). */ namespace detail { inline void potrs (char const uplo, int const n, int const nrhs, float const* a, int const lda, float* b, int const ldb, int* info) { LAPACK_SPOTRS (&uplo, &n, &nrhs, a, &lda, b, &ldb, info); } inline void potrs (char const uplo, int const n, int const nrhs, double const* a, int const lda, double* b, int const ldb, int* info) { LAPACK_DPOTRS (&uplo, &n, &nrhs, a, &lda, b, &ldb, info); } inline void potrs (char const uplo, int const n, int const nrhs, traits::complex_f const* a, int const lda, traits::complex_f* b, int const ldb, int* info) { LAPACK_CPOTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, traits::complex_ptr (b), &ldb, info); } inline void potrs (char const uplo, int const n, int const nrhs, traits::complex_d const* a, int const lda, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZPOTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, traits::complex_ptr (b), &ldb, info); } template inline int potrs (char const uplo, SymmMatrA const& a, MatrB& b) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); int info; potrs (uplo, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int potrs (char const uplo, SymmMatrA const& a, MatrB& b) { assert (uplo == 'U' || uplo == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::potrs (uplo, a, b); } template inline int potrs (SymmMatrA const& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK typedef traits::matrix_traits matraits; typedef traits::matrix_traits mbtraits; typedef typename matraits::value_type val_t; BOOST_STATIC_ASSERT((boost::is_same< typename matraits::matrix_structure, typename traits::detail::symm_herm_t::type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename mbtraits::matrix_structure, traits::general_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); return detail::potrs (uplo, a, b); } // TO DO: potri() } }}} #endif boost-bindings/boost/numeric/bindings/lapack/ppsv.hpp0000644000175000017500000002074007725610427023151 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl Toon Knapen 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_PPSV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_PPSV_HPP #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B // with A symmetric or Hermitian positive definite matrix // stored in packed format // ///////////////////////////////////////////////////////////////////// /* * ppsv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N symmetric or Hermitian positive * definite matrix stored in packed format and X and B are N-by-NRHS * matrices. * * The Cholesky decomposition is used to factor A as * A = U^T * U or A = U^H * U, if UPLO = 'U', * A = L * L^T or A = L * L^H, if UPLO = 'L', * where U is an upper triangular matrix and L is a lower triangular * matrix. The factored form of A is then used to solve the system of * equations A * X = B. * * Only upper or lower triangle of the symmetric matrix A is stored, * packed columnwise in a linear array AP. */ namespace detail { inline void ppsv (char const uplo, int const n, int const nrhs, float* ap, float* b, int const ldb, int* info) { LAPACK_SPPSV (&uplo, &n, &nrhs, ap, b, &ldb, info); } inline void ppsv (char const uplo, int const n, int const nrhs, double* ap, double* b, int const ldb, int* info) { LAPACK_DPPSV (&uplo, &n, &nrhs, ap, b, &ldb, info); } inline void ppsv (char const uplo, int const n, int const nrhs, traits::complex_f* ap, traits::complex_f* b, int const ldb, int* info) { LAPACK_CPPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), traits::complex_ptr (b), &ldb, info); } inline void ppsv (char const uplo, int const n, int const nrhs, traits::complex_d* ap, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZPPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), traits::complex_ptr (b), &ldb, info); } } template inline int ppsv (SymmMatrA& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_pack_t< typename traits::matrix_traits::value_type >::type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); char uplo = traits::matrix_uplo_tag (a); int info; detail::ppsv (uplo, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } /* * pptrf() computes the Cholesky factorization of a symmetric * or Hermitian positive definite matrix A in packed storage. * The factorization has the form * A = U^T * U or A = U^H * U, if UPLO = 'U', * A = L * L^T or A = L * L^H, if UPLO = 'L', * where U is an upper triangular matrix and L is lower triangular. */ namespace detail { inline void pptrf (char const uplo, int const n, float* ap, int* info) { LAPACK_SPPTRF (&uplo, &n, ap, info); } inline void pptrf (char const uplo, int const n, double* ap, int* info) { LAPACK_DPPTRF (&uplo, &n, ap, info); } inline void pptrf (char const uplo, int const n, traits::complex_f* ap, int* info) { LAPACK_CPPTRF (&uplo, &n, traits::complex_ptr (ap), info); } inline void pptrf (char const uplo, int const n, traits::complex_d* ap, int* info) { LAPACK_ZPPTRF (&uplo, &n, traits::complex_ptr (ap), info); } } template inline int pptrf (SymmMatrA& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_pack_t< typename traits::matrix_traits::value_type >::type >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); char uplo = traits::matrix_uplo_tag (a); int info; detail::pptrf (uplo, n, traits::matrix_storage (a), &info); return info; } /* * pptrs() solves a system of linear equations A*X = B with * a symmetric or Hermitian positive definite matrix A in packed * storage using the Cholesky factorization computed by pptrf(). */ namespace detail { inline void pptrs (char const uplo, int const n, int const nrhs, float const* ap, float* b, int const ldb, int* info) { LAPACK_SPPTRS (&uplo, &n, &nrhs, ap, b, &ldb, info); } inline void pptrs (char const uplo, int const n, int const nrhs, double const* ap, double* b, int const ldb, int* info) { LAPACK_DPPTRS (&uplo, &n, &nrhs, ap, b, &ldb, info); } inline void pptrs (char const uplo, int const n, int const nrhs, traits::complex_f const* ap, traits::complex_f* b, int const ldb, int* info) { LAPACK_CPPTRS (&uplo, &n, &nrhs, traits::complex_ptr (ap), traits::complex_ptr (b), &ldb, info); } inline void pptrs (char const uplo, int const n, int const nrhs, traits::complex_d const* ap, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZPPTRS (&uplo, &n, &nrhs, traits::complex_ptr (ap), traits::complex_ptr (b), &ldb, info); } } template inline int pptrs (SymmMatrA const& a, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, typename traits::detail::symm_herm_pack_t< typename traits::matrix_traits::value_type >::type >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); char uplo = traits::matrix_uplo_tag (a); int info; detail::pptrs (uplo, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } // TO DO: pptri() } }}} #endif boost-bindings/boost/numeric/bindings/lapack/spsv.hpp0000644000175000017500000002262607725610427023161 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl & Toon Knapen 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_SPSV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_SPSV_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B with A symmetric matrix // stored in packed format // ///////////////////////////////////////////////////////////////////// /* * spsv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N symmetric matrix stored in packed * format and X and B are N-by-NRHS matrices. * * The diagonal pivoting method is used to factor A as * A = U * D * U^T, if UPLO = 'U', * A = L * D * L^T, if UPLO = 'L', * where U (or L) is a product of permutation and unit upper * (lower) triangular matrices, and D is symmetric and block * diagonal with 1-by-1 and 2-by-2 diagonal blocks. * The factored form of A is then used to solve the system * of equations A * X = B. */ namespace detail { inline void spsv (char const uplo, int const n, int const nrhs, float* ap, int* ipiv, float* b, int const ldb, int* info) { LAPACK_SSPSV (&uplo, &n, &nrhs, ap, ipiv, b, &ldb, info); } inline void spsv (char const uplo, int const n, int const nrhs, double* ap, int* ipiv, double* b, int const ldb, int* info) { LAPACK_DSPSV (&uplo, &n, &nrhs, ap, ipiv, b, &ldb, info); } inline void spsv (char const uplo, int const n, int const nrhs, traits::complex_f* ap, int* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CSPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } inline void spsv (char const uplo, int const n, int const nrhs, traits::complex_d* ap, int* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZSPSV (&uplo, &n, &nrhs, traits::complex_ptr (ap), ipiv, traits::complex_ptr (b), &ldb, info); } template inline int spsv (SymmA& a, IVec& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); char uplo = traits::matrix_uplo_tag (a); int info; spsv (uplo, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::vector_storage (i), traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int spsv (SymmA& a, IVec& i, MatrB& b) { assert (traits::matrix_size1 (a) == traits::vector_size (i)); return detail::spsv (a, i, b); } template inline int spsv (SymmA& a, MatrB& b) { // with 'internal' pivot vector int info = -101; traits::detail::array i (traits::matrix_size1 (a)); if (i.valid()) info = detail::spsv (a, i, b); return info; } /* * sptrf() computes the factorization of a symmetric matrix A * in packed storage using the Bunch-Kaufman diagonal pivoting * method. The form of the factorization is * A = U * D * U^T or A = L * D * L^T * where U (or L) is a product of permutation and unit upper (lower) * triangular matrices, and D is symmetric and block diagonal with * 1-by-1 and 2-by-2 diagonal blocks. */ namespace detail { inline void sptrf (char const uplo, int const n, float* ap, int* ipiv, int* info) { LAPACK_SSPTRF (&uplo, &n, ap, ipiv, info); } inline void sptrf (char const uplo, int const n, double* ap, int* ipiv, int* info) { LAPACK_DSPTRF (&uplo, &n, ap, ipiv, info); } inline void sptrf (char const uplo, int const n, traits::complex_f* ap, int* ipiv, int* info) { LAPACK_CSPTRF (&uplo, &n, traits::complex_ptr (ap), ipiv, info); } inline void sptrf (char const uplo, int const n, traits::complex_d* ap, int* ipiv, int* info) { LAPACK_ZSPTRF (&uplo, &n, traits::complex_ptr (ap), ipiv, info); } } template inline int sptrf (SymmA& a, IVec& i) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::vector_size (i)); char uplo = traits::matrix_uplo_tag (a); int info; detail::sptrf (uplo, n, traits::matrix_storage (a), traits::vector_storage (i), &info); return info; } /* * sptrs() solves a system of linear equations A*X = B with * a symmetric matrix A in packed storage using the factorization * A = U * D * U^T or A = L * D * L^T * computed by sptrf(). */ namespace detail { inline void sptrs (char const uplo, int const n, int const nrhs, float const* a, int const* ipiv, float* b, int const ldb, int* info) { LAPACK_SSPTRS (&uplo, &n, &nrhs, a, ipiv, b, &ldb, info); } inline void sptrs (char const uplo, int const n, int const nrhs, double const* a, int const* ipiv, double* b, int const ldb, int* info) { LAPACK_DSPTRS (&uplo, &n, &nrhs, a, ipiv, b, &ldb, info); } inline void sptrs (char const uplo, int const n, int const nrhs, traits::complex_f const* a, int const* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CSPTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), ipiv, traits::complex_ptr (b), &ldb, info); } inline void sptrs (char const uplo, int const n, int const nrhs, traits::complex_d const* a, int const* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZSPTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), ipiv, traits::complex_ptr (b), &ldb, info); } } template inline int sptrs (SymmA const& a, IVec const& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_packed_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); char uplo = traits::matrix_uplo_tag (a); int info; detail::sptrs (uplo, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), traits::vector_storage (i), #else traits::matrix_storage_const (a), traits::vector_storage_const (i), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } // TO DO: sptri } }}} #endif boost-bindings/boost/numeric/bindings/lapack/syev.hpp0000644000175000017500000001146010215335074023134 0ustar andreasandreas/* * * Copyright (c) Toon Knapen, Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_SYEV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_SYEV_HPP #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif #include namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Eigendecomposition of a real symmetric matrix A = Q * D * Q' // /////////////////////////////////////////////////////////////////// /* * syev() computes the eigendecomposition of a N x N matrix * A = Q * D * Q', where Q is a N x N orthogonal matrix and * D is a diagonal matrix. The diagonal elements D(i,i) is an * eigenvalue of A and Q(:,i) is a corresponding eigenvector. * * On return of syev, A is overwritten by Q and w contains the main * diagonal of D. * * int syev (char jobz, char uplo, A& a, W& w, minimal_workspace ) ; * jobz : 'V' : compute eigenvectors * 'N' : do not compute eigenvectors * uplo : 'U' : only the upper triangular part of A is used on input. * 'L' : only the lower triangular part of A is used on input. */ namespace detail { inline void syev (char const jobz, char const uplo, int const n, float* a, int const lda, float* w, float* work, int const lwork, int& info) { LAPACK_SSYEV (&jobz, &uplo, &n, a, &lda, w, work, &lwork, &info); } inline void syev (char const jobz, char const uplo, int const n, double* a, int const lda, double* w, double* work, int const lwork, int& info) { LAPACK_DSYEV (&jobz, &uplo, &n, a, &lda, w, work, &lwork, &info); } template inline int syev (char jobz, char uplo, A& a, W& w, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); assert ( n>0 ); assert (traits::matrix_size2 (a)==n); assert (traits::leading_dimension (a)>=n); assert (traits::vector_size (w)==n); assert (3*n-1 <= traits::vector_size (work)); assert ( uplo=='U' || uplo=='L' ); assert ( jobz=='N' || jobz=='V' ); int info; detail::syev (jobz, uplo, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (w), traits::vector_storage (work), traits::vector_size (work), info); return info; } } // namespace detail // Function that allocates work arrays template inline int syev (char jobz, char uplo, A& a, W& w, optimal_workspace ) { typedef typename A::value_type value_type ; int const n = traits::matrix_size1 (a); traits::detail::array work( std::max(1,34*n) ); return detail::syev(jobz, uplo, a, w, work); } // syev() // Function that allocates work arrays template inline int syev (char jobz, char uplo, A& a, W& w, minimal_workspace ) { typedef typename A::value_type value_type ; int const n = traits::matrix_size1 (a); traits::detail::array work( std::max(1,3*n-1) ); return detail::syev(jobz, uplo, a, w, work); } // syev() // Function that allocates work arrays template inline int syev (char jobz, char uplo, A& a, W& w, detail::workspace1 workspace ) { typedef typename A::value_type value_type ; return detail::syev(jobz, uplo, a, w, workspace.w_); } // syev() } }}} #endif boost-bindings/boost/numeric/bindings/lapack/sysv.hpp0000644000175000017500000005106607730066351023167 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_SYSV_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_SYSV_HPP #include #include #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { ///////////////////////////////////////////////////////////////////// // // system of linear equations A * X = B with A symmetric matrix // ///////////////////////////////////////////////////////////////////// namespace detail { inline int sytrf_block (float, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "SSYTRF", ul2, n); } inline int sytrf_block (double, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "DSYTRF", ul2, n); } inline int sytrf_block (traits::complex_f, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "CSYTRF", ul2, n); } inline int sytrf_block (traits::complex_d, int const ispec, char const ul, int const n) { char ul2[2] = "x"; ul2[0] = ul; return ilaenv (ispec, "ZSYTRF", ul2, n); } } template inline int sytrf_block (char const q, char const ul, SymmA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (q == 'O' || q == 'M'); assert (ul == 'U' || ul == 'L'); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif int ispec = (q == 'O' ? 1 : 2); return detail::sytrf_block (val_t(), ispec, ul, n); } template inline int sytrf_block (char const q, SymmA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif assert (q == 'O' || q == 'M'); char ul = traits::matrix_uplo_tag (a); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif int ispec = (q == 'O' ? 1 : 2); return detail::sytrf_block (val_t(), ispec, ul, n); } template inline int sytrf_work (char const q, char const ul, SymmA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (q == 'O' || q == 'M'); assert (ul == 'U' || ul == 'L'); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif int lw = -13; if (q == 'M') lw = 1; if (q == 'O') lw = n * detail::sytrf_block (val_t(), 1, ul, n); return lw; } template inline int sytrf_work (char const q, SymmA const& a) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif assert (q == 'O' || q == 'M'); char ul = traits::matrix_uplo_tag (a); int n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif int lw = -13; if (q == 'M') lw = 1; if (q == 'O') lw = n * detail::sytrf_block (val_t(), 1, ul, n); return lw; } template inline int sysv_work (char const q, char const ul, SymmA const& a) { return sytrf_work (q, ul, a); } template inline int sysv_work (char const q, SymmA const& a) { return sytrf_work (q, a); } /* * sysv() computes the solution to a system of linear equations * A * X = B, where A is an N-by-N symmetric matrix and X and B * are N-by-NRHS matrices. * * The diagonal pivoting method is used to factor A as * A = U * D * U^T, if UPLO = 'U', * A = L * D * L^T, if UPLO = 'L', * where U (or L) is a product of permutation and unit upper * (lower) triangular matrices, and D is symmetric and block * diagonal with 1-by-1 and 2-by-2 diagonal blocks. * The factored form of A is then used to solve the system * of equations A * X = B. */ namespace detail { inline void sysv (char const uplo, int const n, int const nrhs, float* a, int const lda, int* ipiv, float* b, int const ldb, float* w, int const lw, int* info) { LAPACK_SSYSV (&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, w, &lw, info); } inline void sysv (char const uplo, int const n, int const nrhs, double* a, int const lda, int* ipiv, double* b, int const ldb, double* w, int const lw, int* info) { LAPACK_DSYSV (&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, w, &lw, info); } inline void sysv (char const uplo, int const n, int const nrhs, traits::complex_f* a, int const lda, int* ipiv, traits::complex_f* b, int const ldb, traits::complex_f* w, int const lw, int* info) { LAPACK_CSYSV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, traits::complex_ptr (w), &lw, info); } inline void sysv (char const uplo, int const n, int const nrhs, traits::complex_d* a, int const lda, int* ipiv, traits::complex_d* b, int const ldb, traits::complex_d* w, int const lw, int* info) { LAPACK_ZSYSV (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, traits::complex_ptr (w), &lw, info); } template inline int sysv (char const ul, SymmA& a, IVec& i, MatrB& b, Work& w) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); int info; sysv (ul, n, traits::matrix_size2 (b), traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (i), traits::matrix_storage (b), traits::leading_dimension (b), traits::vector_storage (w), traits::vector_size (w), &info); return info; } } template inline int sysv (char const ul, SymmA& a, IVec& i, MatrB& b, Work& w) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (traits::vector_size (w) >= 1); return detail::sysv (ul, a, i, b, w); } template inline int sysv (SymmA& a, IVec& i, MatrB& b, Work& w) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (traits::vector_size (w) >= 1); char uplo = traits::matrix_uplo_tag (a); return detail::sysv (uplo, a, i, b, w); } template inline int sysv (char const ul, SymmA& a, MatrB& b) { // with 'internal' pivot and work vectors assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); int info = -101; traits::detail::array i (n); if (i.valid()) { info = -102; int lw = sytrf_work ('O', ul, a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::sysv (ul, a, i, b, w); } return info; } template inline int sysv (SymmA& a, MatrB& b) { // with 'internal' pivot and work vectors #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (a); char uplo = traits::matrix_uplo_tag (a); int info = -101; traits::detail::array i (n); if (i.valid()) { info = -102; int lw = sytrf_work ('O', a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::sysv (uplo, a, i, b, w); } return info; } /* * sytrf() computes the factorization of a symmetric matrix A using * the Bunch-Kaufman diagonal pivoting method. The form of the * factorization is * A = U * D * U^T or A = L * D * L^T * where U (or L) is a product of permutation and unit upper (lower) * triangular matrices, and D is symmetric and block diagonal with * 1-by-1 and 2-by-2 diagonal blocks. */ namespace detail { inline void sytrf (char const uplo, int const n, float* a, int const lda, int* ipiv, float* w, int const lw, int* info) { LAPACK_SSYTRF (&uplo, &n, a, &lda, ipiv, w, &lw, info); } inline void sytrf (char const uplo, int const n, double* a, int const lda, int* ipiv, double* w, int const lw, int* info) { LAPACK_DSYTRF (&uplo, &n, a, &lda, ipiv, w, &lw, info); } inline void sytrf (char const uplo, int const n, traits::complex_f* a, int const lda, int* ipiv, traits::complex_f* w, int const lw, int* info) { LAPACK_CSYTRF (&uplo, &n, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (w), &lw, info); } inline void sytrf (char const uplo, int const n, traits::complex_d* a, int const lda, int* ipiv, traits::complex_d* w, int const lw, int* info) { LAPACK_ZSYTRF (&uplo, &n, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (w), &lw, info); } template inline int sytrf (char const ul, SymmA& a, IVec& i, Work& w) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::vector_size (i)); int info; sytrf (ul, n, traits::matrix_storage (a), traits::leading_dimension (a), traits::vector_storage (i), traits::vector_storage (w), traits::vector_size (w), &info); return info; } } template inline int sytrf (char const ul, SymmA& a, IVec& i, Work& w) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif assert (traits::vector_size (w) >= 1); return detail::sytrf (ul, a, i, w); } template inline int sytrf (SymmA& a, IVec& i, Work& w) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif assert (traits::vector_size (w) >= 1); char uplo = traits::matrix_uplo_tag (a); return detail::sytrf (uplo, a, i, w); } template inline int sytrf (char const ul, SymmA& a, Ivec& i) { // with 'internal' work vector assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int info = -101; int lw = sytrf_work ('O', ul, a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::sytrf (ul, a, i, w); return info; } template inline int sytrf (SymmA& a, Ivec& i) { // with 'internal' work vector #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); int info = -101; int lw = sytrf_work ('O', a); assert (lw >= 1); // paranoia ? #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef typename traits::matrix_traits::value_type val_t; #else typedef typename SymmA::value_type val_t; #endif traits::detail::array w (lw); if (w.valid()) info = detail::sytrf (uplo, a, i, w); return info; } /* * sytrs() solves a system of linear equations A*X = B with * a symmetric matrix A using the factorization * A = U * D * U^T or A = L * D * L^T * computed by sytrf(). */ namespace detail { inline void sytrs (char const uplo, int const n, int const nrhs, float const* a, int const lda, int const* ipiv, float* b, int const ldb, int* info) { LAPACK_SSYTRS (&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void sytrs (char const uplo, int const n, int const nrhs, double const* a, int const lda, int const* ipiv, double* b, int const ldb, int* info) { LAPACK_DSYTRS (&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, info); } inline void sytrs (char const uplo, int const n, int const nrhs, traits::complex_f const* a, int const lda, int const* ipiv, traits::complex_f* b, int const ldb, int* info) { LAPACK_CSYTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } inline void sytrs (char const uplo, int const n, int const nrhs, traits::complex_d const* a, int const lda, int const* ipiv, traits::complex_d* b, int const ldb, int* info) { LAPACK_ZSYTRS (&uplo, &n, &nrhs, traits::complex_ptr (a), &lda, ipiv, traits::complex_ptr (b), &ldb, info); } template inline int sytrs (char const ul, SymmA const& a, IVec const& i, MatrB& b) { int const n = traits::matrix_size1 (a); assert (n == traits::matrix_size2 (a)); assert (n == traits::matrix_size1 (b)); assert (n == traits::vector_size (i)); int info; sytrs (ul, n, traits::matrix_size2 (b), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::matrix_storage (a), #else traits::matrix_storage_const (a), #endif traits::leading_dimension (a), #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING traits::vector_storage (i), #else traits::vector_storage_const (i), #endif traits::matrix_storage (b), traits::leading_dimension (b), &info); return info; } } template inline int sytrs (char const ul, SymmA const& a, IVec const& i, MatrB& b) { assert (ul == 'U' || ul == 'L'); #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif return detail::sytrs (ul, a, i, b); } template inline int sytrs (SymmA const& a, IVec const& i, MatrB& b) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::symmetric_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif char uplo = traits::matrix_uplo_tag (a); return detail::sytrs (uplo, a, i, b); } // TO DO: sytri } }}} #endif boost-bindings/boost/numeric/bindings/lapack/trevc.hpp0000644000175000017500000001211107707751613023300 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_TREVC_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_TREVC_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Compute eigenvectors of Schur matrix (computed by gees). // /////////////////////////////////////////////////////////////////// /* * trevc() computes the eigenvectors using the Schur factorization * * Let A = U * S * herm(U), then trecv computes the eigenvectors of * S, and may optionally apply them to U. * * To compute the Schur factorization, see gees. */ namespace detail { inline void trevc (char const side, char const howmny, const logical_t* select, int const n, float* t, int const ldt, float* vl, int const ldvl, float* vr, int const ldvr, int const mm, int& m, float* work, int& info) { LAPACK_STREVC (&side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr, &mm, &m, work, &info); } inline void trevc (char const side, char const howmny, const logical_t* select, int const n, double* t, int const ldt, double* vl, int const ldvl, double* vr, int const ldvr, int const mm, int& m, double* work, int& info) { LAPACK_DTREVC (&side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr, &mm, &m, work, &info); } inline void trevc (char const side, char const howmny, const logical_t* select, int const n, std::complex* t, int const ldt, std::complex* vl, int const ldvl, std::complex* vr, int const ldvr, int const mm, int& m, std::complex* work, int& info) { LAPACK_CTREVC (&side, &howmny, select, &n, traits::complex_ptr(t), &ldt, traits::complex_ptr(vl), &ldvl, traits::complex_ptr(vr), &ldvr, &mm, &m, traits::complex_ptr(work+n), traits::complex_ptr(work), &info); } inline void trevc (char const side, char const howmny, const logical_t* select, int const n, std::complex* t, int const ldt, std::complex* vl, int const ldvl, std::complex* vr, int const ldvr, int const mm, int& m, std::complex* work, int& info) { LAPACK_ZTREVC (&side, &howmny, select, &n, traits::complex_ptr(t), &ldt, traits::complex_ptr(vl), &ldvl, traits::complex_ptr(vr), &ldvr, &mm, &m, traits::complex_ptr(work+n), traits::complex_ptr(work), &info); } } // Compute Schur factorization with Schur vectors template inline int trevc (char const side, char const howmny, MatrT& t, VL& vl, VR& vr, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (t); assert (n == traits::matrix_size2 (t)); assert (n == traits::matrix_size1 (vl)); assert (n == traits::matrix_size2 (vl)); assert (n == traits::matrix_size1 (vr)); assert (n == traits::matrix_size2 (vr)); assert (3*n <= traits::vector_size (work)); logical_t* select=0; int mm=n; int m; int info; detail::trevc (side, howmny, select, n, traits::matrix_storage (t), traits::leading_dimension (t), traits::matrix_storage (vl), traits::leading_dimension (vl), traits::matrix_storage (vr), traits::leading_dimension (vr), mm, m, traits::vector_storage (work), info); return info; } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/trexc.hpp0000644000175000017500000001076107707751613023313 0ustar andreasandreas/* * * Copyright (c) Toon Knapen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_TREXC_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_TREXC_HPP #include #include #include #include #include // #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace lapack { /////////////////////////////////////////////////////////////////// // // Reorder the Schur factorization of a matrix. // /////////////////////////////////////////////////////////////////// /* * trexc() reorders the Schur factorization of a matrix * A = Q*T*Q**T, so that the diagonal block of T with row * index IFST is moved to row ILST. */ namespace detail { inline int trexc_work_size( int const n, float ) {return n;} inline int trexc_work_size( int const n, double ) {return n;} inline int trexc_work_size( int const n, std::complex ) {return 0;} inline int trexc_work_size( int const n, std::complex ) {return 0;} } // Get the minimum size of the work array. template int trexc_work_size(const MatrT& t) { return detail::trexc_work_size( traits::matrix_size1(t), typename MatrT::value_type() ); } namespace detail { inline void trexc (char const compq, int const n, float* t, int const ldt, float* q, int const ldq, int& ifst, int& ilst, float* work, int& info) { LAPACK_STREXC (&compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, work, &info); } inline void trexc (char const compq, int const n, double* t, int const ldt, double* q, int const ldq, int& ifst, int& ilst, double* work, int& info) { LAPACK_DTREXC (&compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, work, &info); } inline void trexc (char const compq, int const n, std::complex* t, int const ldt, std::complex* q, int const ldq, int& ifst, int& ilst, float* work, int& info) { LAPACK_CTREXC (&compq, &n, traits::complex_ptr(t), &ldt, traits::complex_ptr(q), &ldq, &ifst, &ilst, &info); } inline void trexc (char const compq, int const n, std::complex* t, int const ldt, std::complex* q, int const ldq, int& ifst, int& ilst, double* work, int& info) { LAPACK_ZTREXC (&compq, &n, traits::complex_ptr(t), &ldt, traits::complex_ptr(q), &ldq, &ifst, &ilst, &info); } } // Reorder Schur factorization with Schur vectors template inline int trexc (char const compq, MatrT& t, Q& q, int& ifst, int& ilst, Work& work) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::matrix_traits::matrix_structure, traits::general_t >::value)); #endif int const n = traits::matrix_size1 (t); assert (n == traits::matrix_size2 (t)); assert (n == traits::matrix_size1 (q)); assert (n == traits::matrix_size2 (q)); assert (trexc_work_size(t) <= traits::vector_size (work)); int info; detail::trexc (compq, n, traits::matrix_storage (t), traits::leading_dimension (t), traits::matrix_storage (q), traits::leading_dimension (q), ifst, ilst, traits::vector_storage (work), info); return info; } } }}} #endif boost-bindings/boost/numeric/bindings/lapack/workspace.hpp0000644000175000017500000000613607752726043024164 0ustar andreasandreas/* * * Copyright (c) Karl Meerbergen & Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_LAPACK_WORKSPACE_HPP #define BOOST_NUMERIC_BINDINGS_LAPACK_WORKSPACE_HPP #include #include #include #include #include namespace boost { namespace numeric { namespace bindings { /* * Organization of workspace in Lapack. * We allow one of the following arguments in a number of Lapack functions * - minimal_workspace() : the function allocates the minimum workspace required for the function * - optimal_workspace() : the function allocates the amount of workspace that allows optimal * execution. * - workspace( work ) : the function uses the workspace array in work. * - workspace( rwork, work ) : the function uses a real array rwork and a compolex array work as * workspace. (There are Lapack functions for complex matrices * that require two workarrays) * */ namespace lapack { // Four classes are introduced to distinguish between the different type of memory allocations struct minimal_workspace {} ; struct optimal_workspace {} ; namespace detail { template struct workspace1 { W& w_ ; workspace1(W& w) : w_( w ) {} }; // struct workspace1 template struct workspace2 { W& w_ ; WR& wr_ ; workspace2(W& w, WR& wr) : w_(w) , wr_(wr) {} }; // struct workspace2 } template detail::workspace1 workspace(W& w) { return detail::workspace1(w) ; } // workspace() template detail::workspace2 workspace(W& w, WR& wr) { return detail::workspace2(w, wr) ; } // workspace() /// Select the number of workspaces depending on the value_type template struct n_workspace_args { }; template <> struct n_workspace_args< float > { static const int value = 1 ; }; template <> struct n_workspace_args< double > { static const int value = 1 ; }; template <> struct n_workspace_args< traits::complex_f > { static const int value = 2 ; }; template <> struct n_workspace_args< traits::complex_d > { static const int value = 2 ; }; } }}} #endif boost-bindings/boost/numeric/bindings/traits/0000755000175000017500000000000010664335723021517 5ustar andreasandreasboost-bindings/boost/numeric/bindings/traits/detail/0000755000175000017500000000000010664335723022761 5ustar andreasandreasboost-bindings/boost/numeric/bindings/traits/detail/array.hpp0000644000175000017500000000234507725614060024612 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_ARRAY_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_ARRAY_HPP #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include namespace boost { namespace numeric { namespace bindings { namespace traits { template struct vector_traits > { typedef T value_type; typedef T* pointer; static pointer storage (detail::array& a) { return a.storage(); } static int size (detail::array& a) { return a.size(); } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_ARRAY_HPP boost-bindings/boost/numeric/bindings/traits/detail/array_impl.hpp0000644000175000017500000000466107725614060025636 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_ARRAY_IMPL_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_ARRAY_IMPL_HPP /* very simple dynamic array class which is used in `higher level' bindings functions for pivot and work arrays Namely, there are (at least) two versions of all bindings functions where called LAPACK function expects work and/or pivot array, e.g. `lower' level (user should provide work and pivot arrays): int sysv (SymmA& a, IVec& i, MatrB& b, Work& w); `higher' level (with `internal' work and pivot arrays): int sysv (SymmA& a, MatrB& b); Probably you ask why I didn't use std::vector. There are two reasons. First is efficiency -- std::vector's constructor initialises vector elements. Second is consistency. LAPACK functions use `info' parameter as an error indicator. On the other hand, std::vector's allocator can throw an exception if memory allocation fails. detail::array's constructor uses `new (nothrow)' which returns 0 if allocation fails. So I can check whether array::storage == 0 and return appropriate error in `info'. */ #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { template class array : private noncopyable { public: array (int n) { stg = new (std::nothrow) T[n]; sz = (stg != 0) ? n : 0; } ~array() { delete[] stg; } int size() const { return sz; } bool valid() const { return stg != 0; } void resize (int n) { delete[] stg; stg = new (std::nothrow) T[n]; sz = (stg != 0) ? n : 0; } T* storage() { return stg; } T const* storage() const { return stg; } T& operator[] (int i) { return stg[i]; } T const& operator[] (int i) const { return stg[i]; } private: int sz; T* stg; }; }} }}} #endif boost-bindings/boost/numeric/bindings/traits/detail/generate_const.hpp0000644000175000017500000000252407707720121026467 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * First author acknowledges the support of the Faculty of Civil * Engineering, University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_GENERATE_CONST_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_GENERATE_CONST_HPP #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { /// Copy const from V to X if present template struct generate_const { typedef X type; }; template struct generate_const< const V, X > { typedef X const type; }; template struct generate_const< V const, X const > { typedef X const type; }; }}}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_GENERATE_CONST_HPP boost-bindings/boost/numeric/bindings/traits/detail/symm_herm_traits.hpp0000644000175000017500000000472310204421116027044 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_SYMM_HERM_TRAITS_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_SYMM_HERM_TRAITS_HPP #include #include #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { // select symmetric or hermitian matrix structure template struct symm_herm_t {}; template<> struct symm_herm_t { typedef symmetric_t type; }; template<> struct symm_herm_t { typedef symmetric_t type; }; template<> struct symm_herm_t { typedef hermitian_t type; }; template<> struct symm_herm_t { typedef hermitian_t type; }; template struct symm_herm_pack_t {}; template<> struct symm_herm_pack_t { typedef symmetric_packed_t type; }; template<> struct symm_herm_pack_t { typedef symmetric_packed_t type; }; template<> struct symm_herm_pack_t { typedef hermitian_packed_t type; }; template<> struct symm_herm_pack_t { typedef hermitian_packed_t type; }; template struct symm_herm_compatible { BOOST_STATIC_CONSTANT( bool, value=false ) ; }; template struct symm_herm_compatible< T, hermitian_t > { BOOST_STATIC_CONSTANT( bool, value=true ) ; }; template struct symm_herm_compatible< T, symmetric_t > { BOOST_STATIC_CONSTANT( bool, value=true ) ; }; template struct symm_herm_compatible< std::complex, symmetric_t > { BOOST_STATIC_CONSTANT( bool, value=false ) ; }; } }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_SYMM_HERM_TRAITS_HPP boost-bindings/boost/numeric/bindings/traits/detail/ublas_ordering.hpp0000644000175000017500000000361110602750274026464 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_UBLAS_ORDERING_H #define BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_UBLAS_ORDERING_H #include namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { template struct ublas_ordering {}; template<> struct ublas_ordering { typedef row_major_t type; typedef boost::numeric::ublas::row_major functor_type; template static int leading_dimension( M const& m ) { return m.size2() ; } template static int stride1( M const& m ) { return m.size2() ; } template static int stride2( M const& m ) { return 1 ; } }; template<> struct ublas_ordering { typedef column_major_t type; typedef boost::numeric::ublas::column_major functor_type; template static int leading_dimension( M const& m ) { return m.size1() ; } template static int stride1( M const& m ) { return 1 ; } template static int stride2( M const& m ) { return m.size1() ; } }; } }}}} #endif boost-bindings/boost/numeric/bindings/traits/detail/ublas_uplo.hpp0000644000175000017500000000203010142140556025617 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2002 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_UPLO_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_UPLO_H #include namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { template struct ublas_uplo {}; template<> struct ublas_uplo { typedef lower_t type; }; template<> struct ublas_uplo { typedef upper_t type; }; } }}}} #endif boost-bindings/boost/numeric/bindings/traits/detail/utils.hpp0000644000175000017500000000406607725614177024647 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_UTILS_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_DETAIL_UTILS_HPP // #include #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { namespace detail { // complex array => real & imaginary arrays template inline void disentangle (CIt c, CIt c_end, RIt rr, RIt ri) { for (; c != c_end; ++c, ++rr, ++ri) { *rr = traits::real (*c); *ri = traits::imag (*c); } } // real & imaginary arrays => complex array template inline void interlace (RIt r, RIt r_end, RIt ri, CIt c) { typedef typename std::iterator_traits::value_type cmplx_t; #ifdef BOOST_NUMERIC_BINDINGS_BY_THE_BOOK for (; r != r_end; ++r, ++ri, ++c) *c = cmplx_t (*r, *ri); #else typedef typename type_traits::real_type real_t; real_t *cp = reinterpret_cast (&*c); for (; r != r_end; ++r, ++ri) { *cp = *r; ++cp; *cp = *ri; ++cp; } #endif } // converts real/complex to int inline int to_int (float f) { return static_cast (f); } inline int to_int (double d) { return static_cast (d); } inline int to_int (traits::complex_f const& cf) { return static_cast (traits::real (cf)); } inline int to_int (traits::complex_d const& cd) { return static_cast (traits::real (cd)); } } }}}} #endif boost-bindings/boost/numeric/bindings/traits/algorithm.hpp0000644000175000017500000000167507707741602024230 0ustar andreasandreas#ifndef boost_numeric_bindings_traits_algorithm_hpp #define boost_numeric_bindings_traits_algorithm_hpp #include namespace boost { namespace numeric { namespace bindings { namespace traits { /// /// To be used instead of operator== for numeric types /// Implemented as functor instead of free function because of specialisation /// rationale: operator== on builtin types can not be overloaded. template < typename T > struct is_equal { is_equal(typename type_traits< T >::real_type tolerance) : tolerance_( tolerance ) {} bool operator()(const T& a, const T& b) { return std::abs( a - b ) < tolerance_ ; } // bool operator()(const T& a, const T& b, typename value_traits< T >::value_type tolerance) // { return std::abs( a - b ) < tolerance ; } typename type_traits< T >::real_type tolerance_ ; } ; }}}} #endif // boost_numeric_bindings_traits_algorithm_hpp boost-bindings/boost/numeric/bindings/traits/boost_array.hpp0000644000175000017500000000164307725612472024563 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_BOOST_ARRAY_H #define BOOST_NUMERIC_BINDINGS_TRAITS_BOOST_ARRAY_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #include #else #error with your compiler boost::array<> cannot be used in bindings #endif #endif boost-bindings/boost/numeric/bindings/traits/c_array.hpp0000644000175000017500000000331607725612472023656 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_C_ARRAY_H #define BOOST_NUMERIC_BINDINGS_TRAITS_C_ARRAY_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include namespace boost { namespace numeric { namespace bindings { namespace traits { // built-in array template struct vector_detail_traits { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same::type>::value) ); #endif typedef T identifier_type [N]; // C++ syntax is amazing ;o) typedef V vector_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (vector_type& v) { return v; } static int size (vector_type&) { return N; } static int stride (vector_type&) { return 1; } }; }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #error with your compiler plain C array cannot be used in bindings #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_C_ARRAY_H boost-bindings/boost/numeric/bindings/traits/config.hpp0000644000175000017500000000242010117046442023461 0ustar andreasandreas// // Copyright (c) 2002-2003 // Toon Knapen, Kresimir Fresl, Joerg Walter // // Permission to use, copy, modify, distribute and sell this software // and its documentation for any purpose is hereby granted without fee, // provided that the above copyright notice appear in all copies and // that both that copyright notice and this permission notice appear // in supporting documentation. The authors make no representations // about the suitability of this software for any purpose. // It is provided "as is" without express or implied warranty. // // #ifndef BOOST_NUMERIC_BINDINGS_CONFIG_HPP #define BOOST_NUMERIC_BINDINGS_CONFIG_HPP #include // Microsoft Visual C++ #if defined (BOOST_MSVC) // .. version 6.0 & 7.0 # if BOOST_MSVC <= 1300 # define BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS # endif #elif defined(__ICC) #elif defined(__IBMCPP__) #elif defined(__GNUC__) #elif defined(__COMO__) #elif defined(__KCC) #elif defined(__sgi) #else #error bindings do not recognise compiler #endif #if defined (BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS) // structure checks require proper traits # define BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK // type checks require proper traits # define BOOST_NUMERIC_BINDINGS_NO_TYPE_CHECK #endif #endif boost-bindings/boost/numeric/bindings/traits/fortran.h0000644000175000017500000000226207730573153023346 0ustar andreasandreas// Permission to copy, use, modify, sell and // distribute this software is granted provided this copyright notice appears // in all copies. This software is provided "as is" without express or implied // warranty, and with no claim as to its suitability for any purpose. // Copyright (C) 2002, 2003 Si-Lab b.v.b.a., Toon Knapen and Kresimir Fresl #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H #define BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H // First we need to know what the conventions for linking // C with Fortran is on this platform/toolset #if defined(__GNUC__) || defined(__ICC) || defined(__sgi) || defined(__COMO__) || defined(__KCC) #define BIND_FORTRAN_LOWERCASE_UNDERSCORE #elif defined(__IBMCPP__) || defined(_MSC_VER) #define BIND_FORTRAN_LOWERCASE #else #error do not know how to link with fortran for the given platform #endif // Next we define macro's to convert our symbols to // the current convention #if defined(BIND_FORTRAN_LOWERCASE_UNDERSCORE) #define FORTRAN_ID( id ) id##_ #elif defined(BIND_FORTRAN_LOWERCASE) #define FORTRAN_ID( id ) id #else #error do not know how to bind to fortran calling convention #endif #endif // BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H boost-bindings/boost/numeric/bindings/traits/matrix_raw.hpp0000644000175000017500000002706307725612606024417 0ustar andreasandreas// // Copyright (c) 2002-2003 // Toon Knapen, Kresimir Fresl, Joerg Walter // // Permission to use, copy, modify, distribute and sell this software // and its documentation for any purpose is hereby granted without fee, // provided that the above copyright notice appear in all copies and // that both that copyright notice and this permission notice appear // in supporting documentation. The authors make no representations // about the suitability of this software for any purpose. // It is provided "as is" without express or implied warranty. // // #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_RAW_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_RAW_HPP #include #include #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { namespace ublas = boost::numeric::ublas; // size: template BOOST_UBLAS_INLINE int matrix_size1 (const M &m) { return (int) m.size1(); } template BOOST_UBLAS_INLINE int matrix_size2 (const M &m) { return (int) m.size2(); } #if 0 // MSVC seems to dislike overloads if there is 'generic' template template BOOST_UBLAS_INLINE int matrix_size1 (const ublas::matrix_reference &m) { return matrix_size1 (m.expression()); } template BOOST_UBLAS_INLINE int matrix_size2 (const ublas::matrix_reference &m) { return matrix_size2 (m.expression()); } #endif // 0 template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::matrix& m) { return (int) (m.size1() * m.size2()); } template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::c_matrix &m) { return (int) (M * N); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::matrix &m, ublas::row_major_tag) { return (int) m.size2(); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::matrix &m, ublas::column_major_tag) { return (int) m.size1(); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::matrix &m) { typedef ublas::matrix matrix_t; return bindings::traits::leading_dimension (m, BOOST_UBLAS_TYPENAME matrix_t::orientation_category()); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::matrix_reference &m) { return bindings::traits::leading_dimension (m.expression()); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::matrix_range &m) { return bindings::traits::leading_dimension (m.data()); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::c_matrix &m) { return (int) N; } // stride: #if 0 // MSVC seems to dislike overloads if there is 'generic' template template BOOST_UBLAS_INLINE int matrix_stride1 (const M &m) { typedef typename M::functor_type functor_type; return (int) functor_type::one1 (m.size1(), m.size2()); } template BOOST_UBLAS_INLINE int matrix_stride2 (const M &m) { typedef typename M::functor_type functor_type; return (int) functor_type::one2 (m.size1(), m.size2()); } #endif // 0 template BOOST_UBLAS_INLINE int matrix_stride1 (const ublas::matrix &m) { return (int) F::one1 (m.size1(), m.size2()); } template BOOST_UBLAS_INLINE int matrix_stride2 (const ublas::matrix &m) { return (int) F::one2 (m.size1(), m.size2()); } template BOOST_UBLAS_INLINE int matrix_stride1 (const ublas::matrix_reference &m) { return matrix_stride1 (m.expression()); } template BOOST_UBLAS_INLINE int matrix_stride2 (const ublas::matrix_reference &m) { return matrix_stride2 (m.expression()); } template BOOST_UBLAS_INLINE int matrix_stride1 (const ublas::c_matrix &m) { return (int) N; } template BOOST_UBLAS_INLINE int matrix_stride2 (const ublas::c_matrix &m) { return 1; } template BOOST_UBLAS_INLINE int matrix_stride1 (const ublas::matrix_range &m) { return matrix_stride1 (m.data()); } template BOOST_UBLAS_INLINE int matrix_stride2 (const ublas::matrix_range &m) { return matrix_stride2 (m.data()); } template BOOST_UBLAS_INLINE int matrix_stride1 (const ublas::matrix_slice &m) { return (int) (m.stride1() * matrix_stride1 (m.data())); } template BOOST_UBLAS_INLINE int matrix_stride2 (const ublas::matrix_slice &m) { return (int) (m.stride2() * matrix_stride2 (m.data())); } template BOOST_UBLAS_INLINE int vector_stride (const ublas::matrix_row &v) { return matrix_stride2 (v.data()); } template BOOST_UBLAS_INLINE int vector_stride (const ublas::matrix_column &v) { return matrix_stride1 (v.data()); } // storage: #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::matrix::const_pointer matrix_storage (const ublas::matrix &m) { return &m.data().begin()[0]; } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::matrix::const_pointer matrix_storage_const (const ublas::matrix &m) { return &m.data().begin()[0]; } template BOOST_UBLAS_INLINE typename ublas::matrix::pointer matrix_storage (ublas::matrix &m) { return &m.data().begin()[0]; } #if 0 // MSVC seems to dislike overloads if there is 'generic' template #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const M &m) { return &m.data().begin()[0]; } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const M &m) { return &m.data().begin()[0]; } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (M &m) { return &m.data().begin()[0]; } #endif // 0 #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const ublas::matrix_reference &m) { return matrix_storage (m.expression ()); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const ublas::matrix_reference &m) { return matrix_storage_const (m.expression ()); } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (ublas::matrix_reference &m) { return matrix_storage (m.expression ()); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::c_matrix::const_pointer matrix_storage (const ublas::c_matrix &m) { return m.data(); } #endif #ifndef BOOST_MSVC // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::c_matrix::const_pointer matrix_storage_const (const ublas::c_matrix &m) { return m.data(); } template BOOST_UBLAS_INLINE typename ublas::c_matrix::pointer matrix_storage (ublas::c_matrix &m) { return m.data(); } #endif #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const ublas::matrix_range &m) { return matrix_storage (m.data()) + m.start1() * matrix_stride1 (m.data()) + m.start2() * matrix_stride2 (m.data()); } template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const ublas::matrix_slice &m) { return matrix_storage (m.data()) + m.start1() * matrix_stride1 (m.data ()) + m.start2() * matrix_stride2 (m.data ()); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const ublas::matrix_range &m) { return matrix_storage_const (m.data()) + m.start1() * matrix_stride1 (m.data ()) + m.start2() * matrix_stride2 (m.data ()); } template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const ublas::matrix_slice &m) { return matrix_storage_const (m.data()) + m.start1() * matrix_stride1 (m.data ()) + m.start2() * matrix_stride2 (m.data ()); } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (ublas::matrix_range &m) { return matrix_storage (m.data()) + m.start1() * matrix_stride1 (m.data ()) + m.start2() * matrix_stride2 (m.data ()); } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (ublas::matrix_slice &m) { return matrix_storage (m.data()) + m.start1() * matrix_stride1 (m.data ()) + m.start2() * matrix_stride2 (m.data ()); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer vector_storage (const ublas::matrix_row &v) { return matrix_storage (v.data()) + v.index() * matrix_stride1 (v.data()); } template BOOST_UBLAS_INLINE typename M::const_pointer vector_storage (const ublas::matrix_column &v) { return matrix_storage (v.data()) + v.index() * matrix_stride2 (v.data()); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer vector_storage_const (const ublas::matrix_row &v) { return matrix_storage_const (v.data()) + v.index() * matrix_stride1 (v.data()); } template BOOST_UBLAS_INLINE typename M::const_pointer vector_storage_const (const ublas::matrix_column &v) { return matrix_storage_const (v.data()) + v.index() * matrix_stride2 (v.data()); } template BOOST_UBLAS_INLINE typename M::pointer vector_storage (ublas::matrix_row &v) { return matrix_storage (v.data()) + v.index() * matrix_stride1 (v.data()); } template BOOST_UBLAS_INLINE typename M::pointer vector_storage (ublas::matrix_column &v) { return matrix_storage (v.data()) + v.index() * matrix_stride2 (v.data()); } }}}} #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_NO_SYMMETRIC_TRAITS #include #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_NO_SYMMETRIC_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_RAW_HPP boost-bindings/boost/numeric/bindings/traits/matrix_traits.hpp0000644000175000017500000001100307752725703025122 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_TRAITS_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_TRAITS_HPP #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { /// There is no default implementation since there is no reasonable default. /// Most matrix libraries provide totally different functions. /// Auxiliary traits class to reduce the number of specializations. /// MType is the actual matrix type. /// MIdentifier is used to specialize the traits for a specific matrix type, e.g. /// matrix_detail_traits< ublas::matrix, ublas::matrix const > /// matrix_detail_traits< ublas::matrix, ublas::matrix > /// Note that remove_const::type == MIdentifier template struct matrix_detail_traits { typedef MIdentifier identifier_type; typedef MType matrix_type; }; /// matrix_traits<> generic version: template struct matrix_traits : matrix_detail_traits< typename boost::remove_const::type, M> { // typedefs: // matrix_structure // ordering_type // value_type // pointer // symmetric/hermitian typedefs: // uplo_type // static functions: // pointer storage() // int size1() // int size2() // int lower_bandwidth() // only banded matrix types // int upper_bandwidth() // only banded matrix types // int storage_size() // not all matrix types // int leading_dimension() // not all matrix types }; // matrix structure tags: struct general_t {}; struct symmetric_t {}; struct symmetric_packed_t {}; struct hermitian_t {}; struct hermitian_packed_t {}; struct banded_t {}; // TO DO: add triangular, etc. struct unknown_structure_t {}; // storage ordering tags: struct row_major_t {}; struct column_major_t {}; // upper/lower triangular part tags: struct upper_t {}; struct lower_t {}; /////////////////////////// // // free accessor functions // /////////////////////////// template inline typename matrix_traits::pointer matrix_storage (M& m) { return matrix_traits::storage (m); } template inline int matrix_size1 (M& m) { return matrix_traits::size1 (m); } template inline int matrix_size2 (M& m) { return matrix_traits::size2 (m); } template inline int matrix_storage_size (M& m) { return matrix_traits::storage_size (m); } template inline int matrix_stride1 (M& m) { return matrix_traits::stride1 (m); } template inline int matrix_stride2 (M& m) { return matrix_traits::stride2 (m); } template inline int matrix_upper_bandwidth (M& m) { return matrix_traits::upper_bandwidth (m); } template inline int matrix_lower_bandwidth (M& m) { return matrix_traits::lower_bandwidth (m); } template inline int leading_dimension (M& m) { return matrix_traits::leading_dimension (m); } namespace detail { inline char matrix_uplo_tag (upper_t const&) { return 'U'; } inline char matrix_uplo_tag (lower_t const&) { return 'L'; } } template inline char matrix_uplo_tag (SymmM&) { typedef typename matrix_traits::uplo_type uplo_t; return detail::matrix_uplo_tag (uplo_t()); } }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_MATRIX_TRAITS_HPP boost-bindings/boost/numeric/bindings/traits/sparse_traits.hpp0000644000175000017500000000726007725613452025122 0ustar andreasandreas/* * * Copyright (c) 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_SPARSE_TRAITS_H #define BOOST_NUMERIC_BINDINGS_TRAITS_SPARSE_TRAITS_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include namespace boost { namespace numeric { namespace bindings { namespace traits { /// There is no default implementation since there is no reasonable default. /// Most matrix libraries provide totally different functions. /// Auxiliary traits class to reduce the number of specializations. template struct sparse_matrix_detail_traits { typedef MIdentifier identifier_type; typedef MType matrix_type; }; /// sparse_matrix_traits<> generic version: template struct sparse_matrix_traits : sparse_matrix_detail_traits ::type, M> { // typedefs: // matrix_structure // storage_format // ordering_type // value_type // value_pointer // index_pointer // enum (or static size_t const): // index_base // static functions: // index_pointer index1_storage() // - compressed column: array of column start locations // - compressed row: array of row start locations // - coordinate, column major: column indices of nonzeros // - coordinate, row major: row indices of nonzeros // index_pointer index2_storage() // - compressed column: array of row indices of nonzeros // - compressed row: array of column indices of nonzeros // - coordinate, column major: row indices of nonzeros // - coordinate, row major: column indices of nonzeros // value_pointer value_storage() // - array of nonzeros // int size1() // int size2() // int num_nonzeros() }; // storage format tags struct compressed_t {}; struct coordinate_t {}; /////////////////////////// // // free accessor functions // /////////////////////////// template inline typename sparse_matrix_traits::index_pointer spmatrix_index1_storage (M& m) { return sparse_matrix_traits::index1_storage (m); } template inline typename sparse_matrix_traits::index_pointer spmatrix_index2_storage (M& m) { return sparse_matrix_traits::index2_storage (m); } template inline typename sparse_matrix_traits::value_pointer spmatrix_value_storage (M& m) { return sparse_matrix_traits::value_storage (m); } template inline int spmatrix_size1 (M& m) { return sparse_matrix_traits::size1 (m); } template inline int spmatrix_size2 (M& m) { return sparse_matrix_traits::size2 (m); } template inline int spmatrix_num_nonzeros (M& m) { return sparse_matrix_traits::num_nonzeros (m); } }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #error with your compiler sparse matrices cannot be used in bindings #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_SPARSE_TRAITS_H boost-bindings/boost/numeric/bindings/traits/std_valarray.hpp0000644000175000017500000000337207725612473024734 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_STD_VALARRAY_H #define BOOST_NUMERIC_BINDINGS_TRAITS_STD_VALARRAY_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { // std::valarray<> template struct vector_detail_traits, V> : default_vector_traits { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< std::valarray, typename boost::remove_const::type >::value) ); #endif typedef std::valarray identifier_type; typedef V vector_type; typedef typename default_vector_traits::pointer pointer; static pointer storage (vector_type& va) { std::valarray& ncva = const_cast&> (va); return &ncva[0]; } }; }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #error with your compiler std::valarray<> cannot be used in bindings #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_STD_VALARRAY_H boost-bindings/boost/numeric/bindings/traits/std_vector.hpp0000644000175000017500000000310107725612473024403 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_STD_VECTOR_H #define BOOST_NUMERIC_BINDINGS_TRAITS_STD_VECTOR_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include namespace boost { namespace numeric { namespace bindings { namespace traits { // std::vector<> template struct vector_detail_traits, V> : default_vector_traits< V, T > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< std::vector, typename boost::remove_const::type >::value) ); #endif typedef std::vector identifier_type; typedef V vector_type; typedef typename default_vector_traits< V, T >::pointer pointer; static pointer storage (vector_type& v) { return &v.front(); } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_STD_VECTOR_H boost-bindings/boost/numeric/bindings/traits/symm_herm_raw.hpp0000644000175000017500000001316007725612606025104 0ustar andreasandreas// // Copyright (c) 2002-2003 // Toon Knapen, Kresimir Fresl, Joerg Walter // // Permission to use, copy, modify, distribute and sell this software // and its documentation for any purpose is hereby granted without fee, // provided that the above copyright notice appear in all copies and // that both that copyright notice and this permission notice appear // in supporting documentation. The authors make no representations // about the suitability of this software for any purpose. // It is provided "as is" without express or implied warranty. // // #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_SYMM_HERM_RAW_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_SYMM_HERM_RAW_HPP #include #ifndef BOOST_UBLAS_HAVE_BINDINGS # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { namespace ublas = boost::numeric::ublas; template BOOST_UBLAS_INLINE int leading_dimension (const ublas::symmetric_adaptor &m) { return bindings::traits::leading_dimension (m.data()); } template BOOST_UBLAS_INLINE int leading_dimension (const ublas::hermitian_adaptor &m) { return bindings::traits::leading_dimension (m.data()); } template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::symmetric_adaptor &m) { return matrix_storage_size (m.data()); } template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::hermitian_adaptor &m) { return matrix_storage_size (m.data()); } template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::symmetric_matrix &m) { return (int) ((m.size1() * (m.size1() + 1)) / 2); } template BOOST_UBLAS_INLINE int matrix_storage_size (const ublas::hermitian_matrix &m) { return (int) ((m.size1() * (m.size1() + 1)) / 2); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::symmetric_matrix::const_pointer matrix_storage (const ublas::symmetric_matrix &m) { return &m.data().begin()[0]; } #endif // We need data_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::symmetric_matrix::const_pointer matrix_storage_const (const ublas::symmetric_matrix &m) { return &m.data().begin()[0]; } template BOOST_UBLAS_INLINE typename ublas::symmetric_matrix::pointer matrix_storage (ublas::symmetric_matrix &m) { return &m.data().begin()[0]; } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const ublas::symmetric_adaptor &m) { return matrix_storage (m.data()); } #endif // We need data_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const ublas::symmetric_adaptor &m) { return matrix_storage_const (m.data()); } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (ublas::symmetric_adaptor &m) { return matrix_storage (m.data()); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::hermitian_matrix::const_pointer matrix_storage (const ublas::hermitian_matrix &m) { return &m.data().begin()[0]; } #endif // We need data_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::hermitian_matrix::const_pointer matrix_storage_const (const ublas::hermitian_matrix &m) { return &m.data().begin()[0]; } template BOOST_UBLAS_INLINE typename ublas::hermitian_matrix::pointer matrix_storage (ublas::hermitian_matrix &m) { return &m.data().begin()[0]; } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage (const ublas::hermitian_adaptor &m) { return matrix_storage (m.data()); } #endif // We need data_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename M::const_pointer matrix_storage_const (const ublas::hermitian_adaptor &m) { return matrix_storage_const (m.data()); } template BOOST_UBLAS_INLINE typename M::pointer matrix_storage (ublas::hermitian_adaptor &m) { return matrix_storage (m.data()); } namespace detail { inline char m_uplo_tag (ublas::upper_tag const&) { return 'U'; } inline char m_uplo_tag (ublas::lower_tag const&) { return 'L'; } } template inline char matrix_uplo_tag (SymmM&) { typedef typename SymmM::packed_category uplo_t; return detail::m_uplo_tag (uplo_t()); } }}}} #endif boost-bindings/boost/numeric/bindings/traits/tnt.hpp0000644000175000017500000001057607725612473023052 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_TNT_H #define BOOST_NUMERIC_BINDINGS_TRAITS_TNT_H // Roldan Pozo's TNT (Template Numerical Toolkit) // see: http://math.nist.gov/tnt/index.html #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { // TNT::Array1D<> template struct vector_detail_traits, V> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< TNT::Array1D, typename boost::remove_const::type >::value) ); #endif typedef TNT::Array1D identifier_type; typedef V vector_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (vector_type& v) { return &v[0]; } static int size (vector_type& v) { return v.dim(); } static int stride (vector_type& v) { return 1; } }; // TNT::Fortran_Array1D<> template struct vector_detail_traits, V> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< TNT::Fortran_Array1D, typename boost::remove_const::type >::value) ); #endif typedef TNT::Fortran_Array1D identifier_type; typedef V vector_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (vector_type& v) { return &v(1); } static int size (vector_type& v) { return v.dim(); } static int stride (vector_type& v) { return 1; } }; // TNT::Array2D<> template struct matrix_detail_traits, M> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< TNT::Array2D, typename boost::remove_const::type >::value) ); #endif typedef TNT::Array2D identifier_type; typedef M matrix_type; typedef general_t matrix_structure; typedef row_major_t ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& m) { return m[0]; } static int size1 (matrix_type& m) { return m.dim1(); } static int size2 (matrix_type& m) { return m.dim2(); } static int storage_size (matrix_type& m) { return size1 (m) * size2 (m); } static int leading_dimension (matrix_type& m) { return m.dim2(); } }; // TNT::Fortran_Array2D<> template struct matrix_detail_traits, M> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< TNT::Fortran_Array2D, typename boost::remove_const::type >::value) ); #endif typedef TNT::Fortran_Array2D identifier_type; typedef M matrix_type; typedef general_t matrix_structure; typedef column_major_t ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& m) { return &m(1, 1); } static int size1 (matrix_type& m) { return m.dim1(); } static int size2 (matrix_type& m) { return m.dim2(); } static int storage_size (matrix_type& m) { return size1 (m) * size2 (m); } static int leading_dimension (matrix_type& m) { return m.dim1(); } }; }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #error with your compiler TNT cannot be used in bindings #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_TNT_H boost-bindings/boost/numeric/bindings/traits/traits.hpp0000644000175000017500000000135607725612771023550 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_H #define BOOST_NUMERIC_BINDINGS_TRAITS_H #include #include #endif boost-bindings/boost/numeric/bindings/traits/transpose.hpp0000644000175000017500000000041707563272065024253 0ustar andreasandreas#ifndef BOOST_BINDINGS_TRANSPOSE_HPP #define BOOST_BINDINGS_TRANSPOSE_HPP namespace boost { namespace numeric { namespace bindings { namespace traits { const char NO_TRANSPOSE = 'N' ; const char TRANSPOSE = 'T' ; const char CONJUGATE = 'C' ; }}}} #endif boost-bindings/boost/numeric/bindings/traits/type.h0000644000175000017500000000164410555120524022644 0ustar andreasandreas/* * Copyright (C) 2000,2001,2002,2003 Si-Lab b.v.b.a. and Toon Knapen * * License is hereby granted to use and modify this software * as long as this copyright notice is retained and modifications * are clearly marked. * This License does not permit you to redistribute this software. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_H #define BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_H /* * This header defines the C types that will be mapped to * COMPLEX and COMPLEX*16 of Fortran */ #ifndef BOOST_NUMERIC_BINDINGS_USE_COMPLEX_STRUCT typedef float fcomplex_t ; typedef double dcomplex_t ; #else typedef union { float cmplx[2] ; double align_struct_ ; } fcomplex_t ; typedef struct { double cmplx[2] ; } dcomplex_t ; #endif /* BOOST_NUMERIC_BINDINGS_USE_COMPLEX_STRUCT */ /* * Define a fortran LOGICAL as a void (for now). */ typedef void logical_t ; #endif /* BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_H */ boost-bindings/boost/numeric/bindings/traits/type.hpp0000644000175000017500000000117207725613200023203 0ustar andreasandreas#ifndef boost_numeric_bindings_type_hpp #define boost_numeric_bindings_type_hpp // This header provides typedefs to float complex and double complex. // This makes it possible to redefine the complex class being used. #include namespace boost { namespace numeric { namespace bindings { namespace traits { typedef std::complex< float > complex_f ; typedef std::complex< double > complex_d ; template T real (std::complex const& c) { return std::real (c); } template T imag (std::complex const& c) { return std::imag (c); } }}}} #endif // boost_numeric_bindings_type_hpp boost-bindings/boost/numeric/bindings/traits/type_traits.hpp0000644000175000017500000000372207725613237024606 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl and Toon Knapen 2002, 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * First author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_TRAITS_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_TRAITS_HPP #include #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { template struct type_traits { #ifdef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS typedef Real type; typedef Real real_type; #endif }; template<> struct type_traits { typedef float type; typedef float real_type; }; template<> struct type_traits { typedef double type; typedef double real_type; }; template<> struct type_traits { typedef complex_f type; typedef float real_type; }; template<> struct type_traits { typedef complex_d type; typedef double real_type; }; inline const fcomplex_t* complex_ptr(const complex_f* c) { return reinterpret_cast( c ) ; } inline const dcomplex_t* complex_ptr(const complex_d* c) { return reinterpret_cast( c ) ; } inline fcomplex_t* complex_ptr( complex_f* c) { return reinterpret_cast< fcomplex_t*>( c ) ; } inline dcomplex_t* complex_ptr( complex_d* c) { return reinterpret_cast< dcomplex_t*>( c ) ; } }}}} #endif // BOOST_NUMERIC_BINDINGS_TRAITS_TYPE_TRAITS_HPP boost-bindings/boost/numeric/bindings/traits/ublas_banded.hpp0000644000175000017500000001027110132453274024624 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_BANDED_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_BANDED_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #if defined (BOOST_NUMERIC_BINDINGS_FORTRAN) || !defined (BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK) # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::matrix_banded<> // When orientation_category==row_major_tag then the ublas banded format corresponds to // the LAPACK band format. // Specialization using matrix_detail_traits so that we can specialize for // matrix_detail_traits< banded, banded > // matrix_detail_traits< banded, banded const > // at once. template struct matrix_detail_traits< boost::numeric::ublas::banded_matrix, M > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif #ifdef BOOST_NUMERIC_BINDINGS_FORTRAN BOOST_STATIC_ASSERT((boost::is_same< typename F::orientation_category, boost::numeric::ublas::row_major_tag >::value)); #endif typedef boost::numeric::ublas::banded_matrix identifier_type ; typedef M matrix_type; typedef banded_t matrix_structure; typedef typename detail::ublas_ordering< typename F::orientation_category >::type ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& m) { typedef typename detail::generate_const::type array_type ; return vector_traits::storage (m.data()); } static int size1 (matrix_type& m) { return m.size1(); } static int size2 (matrix_type& m) { return m.size2(); } static int lower_bandwidth (matrix_type& m) { return m.lower() ; } static int upper_bandwidth (matrix_type& m) { return m.upper() ; } static int storage_size (matrix_type& m) { return size1 (m) * size2 (m); } static int leading_dimension (matrix_type& m) { // g++ 2.95.4 and 3.0.4 (with -pedantic) dislike // identifier_type::functor_type::size2() return lower_bandwidth(m) + upper_bandwidth(m) + 1 ; } // stride1 == distance (m (i, j), m (i+1, j)) static int stride1 (matrix_type& m) { typedef typename identifier_type::orientation_category orientation_category; typedef typename detail::ublas_ordering::functor_type functor_t ; return functor_t::one2 ( std::max(m.size1(), m.size2()), leading_dimension(m)-1 ) ; } // stride2 == distance (m (i, j), m (i, j+1)) static int stride2 (matrix_type& m) { typedef typename identifier_type::orientation_category orientation_category; typedef typename detail::ublas_ordering::functor_type functor_t ; return functor_t::one1 ( std::max(m.size1(), m.size2()), leading_dimension(m)-1 ) ; } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_BANDED_H boost-bindings/boost/numeric/bindings/traits/ublas_hermitian.hpp0000644000175000017500000001152310142140555025364 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_HERMITIAN_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_HERMITIAN_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::hermitian_matrix<> template struct matrix_detail_traits, M> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif #ifdef BOOST_BINDINGS_FORTRAN BOOST_STATIC_ASSERT((boost::is_same< typename F2::orientation_category, boost::numeric::ublas::column_major_tag >::value)); #endif typedef boost::numeric::ublas::hermitian_matrix identifier_type; typedef M matrix_type; typedef hermitian_packed_t matrix_structure; typedef typename detail::ublas_ordering< typename F2::orientation_category >::type ordering_type; typedef typename detail::ublas_uplo< F1 >::type uplo_type; typedef T value_type ; typedef typename detail::generate_const::type* pointer ; static pointer storage (matrix_type& hm) { typedef typename detail::generate_const::type array_type ; return vector_traits::storage (hm.data()); } static int size1 (matrix_type& hm) { return hm.size1(); } static int size2 (matrix_type& hm) { return hm.size2(); } static int storage_size (matrix_type& hm) { return (size1 (hm) + 1) * size2 (hm) / 2; } }; namespace detail { template int matrix_bandwidth( M const& m, upper_t ) { return matrix_traits::upper_bandwidth( m ) ; } template int matrix_bandwidth( M const& m, lower_t ) { // When the lower triangular band matrix is stored the // upper bandwidth must be zero assert( 0 == matrix_traits::upper_bandwidth( m ) ) ; return matrix_traits::lower_bandwidth( m ) ; } } // namespace detail // ublas::hermitian_adaptor<> template struct matrix_detail_traits, MA> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif typedef boost::numeric::ublas::hermitian_adaptor identifier_type; typedef MA matrix_type; typedef hermitian_t matrix_structure; typedef typename matrix_traits::ordering_type ordering_type; typedef typename detail::ublas_uplo< F1 >::type uplo_type; typedef typename M::value_type value_type; typedef typename detail::generate_const::type* pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (matrix_type& hm) { return matrix_traits::storage (hm.data()); } static int size1 (matrix_type& hm) { return hm.size1(); } static int size2 (matrix_type& hm) { return hm.size2(); } static int storage_size (matrix_type& hm) { return size1 (hm) * size2 (hm); } static int leading_dimension (matrix_type& hm) { return matrix_traits::leading_dimension (hm.data()); } // For banded M static int upper_bandwidth(matrix_type& hm) { return detail::matrix_bandwidth( hm.data(), uplo_type() ); } static int lower_bandwidth(matrix_type& hm) { return detail::matrix_bandwidth( hm.data(), uplo_type() ); } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_HERMITIAN_H boost-bindings/boost/numeric/bindings/traits/ublas_matrix.hpp0000644000175000017500000003235210602750274024721 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_MATRIX_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_MATRIX_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #if defined (BOOST_NUMERIC_BINDINGS_FORTRAN) || !defined (BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK) # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::matrix<> // Specialization using matrix_detail_traits so that we can specialize for // matrix_detail_traits< matrix, matrix > // matrix_detail_traits< matrix, matrix const > // at once. template struct matrix_detail_traits< boost::numeric::ublas::matrix, M > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif #ifdef BOOST_NUMERIC_BINDINGS_FORTRAN BOOST_STATIC_ASSERT((boost::is_same< typename F::orientation_category, boost::numeric::ublas::column_major_tag >::value)); #endif typedef boost::numeric::ublas::matrix identifier_type ; typedef M matrix_type; typedef general_t matrix_structure; typedef typename detail::ublas_ordering< typename F::orientation_category >::type ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; typedef typename identifier_type::orientation_category orientation_category; typedef typename detail::ublas_ordering::functor_type functor_t ; static pointer storage (matrix_type& m) { typedef typename detail::generate_const::type array_type ; return vector_traits::storage (m.data()); } static int size1 (matrix_type& m) { return m.size1(); } static int size2 (matrix_type& m) { return m.size2(); } static int storage_size (matrix_type& m) { return size1 (m) * size2 (m); } static int leading_dimension (matrix_type& m) { // g++ 2.95.4 and 3.0.4 (with -pedantic) dislike // identifier_type::functor_type::size2() //return functor_t::size_m (m.size1(), m.size2()); return detail::ublas_ordering::leading_dimension( m ) ; } // stride1 == distance (m (i, j), m (i+1, j)) static int stride1 (matrix_type& m) { //return functor_t::one1 (m.size1(), m.size2()); return detail::ublas_ordering::stride1( m ) ; } // stride2 == distance (m (i, j), m (i, j+1)) static int stride2 (matrix_type& m) { //return functor_t::one2 (m.size1(), m.size2()); return detail::ublas_ordering::stride2( m ) ; } }; // ublas::matrix_reference<> template struct matrix_detail_traits, MR > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::matrix_reference, typename boost::remove_const::type>::value) ) ; #endif typedef boost::numeric::ublas::matrix_reference identifier_type; typedef MR matrix_type; typedef typename matrix_traits::matrix_structure matrix_structure; typedef typename matrix_traits::ordering_type ordering_type; typedef typename M::value_type value_type; typedef typename detail::generate_const::type* pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (matrix_type& mr) { return matrix_traits::storage (mr.expression()); } static int size1 (matrix_type& mr) { return mr.size1(); } static int size2 (matrix_type& mr) { return mr.size2(); } static int leading_dimension (matrix_type& mr) { return matrix_traits::leading_dimension (mr.expression()); } static int stride1 (matrix_type& mr) { return matrix_traits::stride1 (mr.expression()); } static int stride2 (matrix_type& mr) { return matrix_traits::stride2 (mr.expression()); } // Only for banded matrices static int upper_bandwidth(matrix_type& mr) { return matrix_traits::upper_bandwidth(mr.expression()); } static int lower_bandwidth(matrix_type& mr) { return matrix_traits::lower_bandwidth(mr.expression()); } }; // ublas::matrix_range<> template struct matrix_detail_traits, MR > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::matrix_range, typename boost::remove_const::type>::value) ) ; #endif typedef boost::numeric::ublas::matrix_range identifier_type; typedef MR matrix_type; typedef typename matrix_traits::matrix_structure matrix_structure; typedef typename matrix_traits::ordering_type ordering_type; private: typedef typename detail::generate_const::type m_type; public: typedef typename matrix_traits::value_type value_type; typedef typename matrix_traits::pointer pointer ; public: static pointer storage (matrix_type& mr) { m_type& mt = mr.data(); pointer ptr = matrix_traits::storage (mt); ptr += mr.start1() * matrix_traits::stride1 (mt); ptr += mr.start2() * matrix_traits::stride2 (mt); return ptr; } static int size1 (matrix_type& mr) { return mr.size1(); } static int size2 (matrix_type& mr) { return mr.size2(); } static int leading_dimension (matrix_type& mr) { return matrix_traits::leading_dimension (mr.data()); } static int stride1 (matrix_type& mr) { return matrix_traits::stride1 (mr.data()); } static int stride2 (matrix_type& mr) { return matrix_traits::stride2 (mr.data()); } // For band matrices only static int upper_bandwidth (matrix_type& mr) { return matrix_traits::upper_bandwidth(mr.data()); } static int lower_bandwidth (matrix_type& mr) { return matrix_traits::lower_bandwidth(mr.data()); } }; // ublas::matrix_slice<> template struct matrix_detail_traits, MS > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::matrix_slice, typename boost::remove_const::type>::value) ) ; #endif typedef boost::numeric::ublas::matrix_slice identifier_type; typedef MS matrix_type; typedef unknown_structure_t matrix_structure; typedef typename matrix_traits::ordering_type ordering_type; typedef typename M::value_type value_type; typedef typename detail::generate_const::type* pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (matrix_type& ms) { m_type& mt = ms.data(); pointer ptr = matrix_traits::storage (mt); ptr += ms.start1() * matrix_traits::stride1 (mt); ptr += ms.start2() * matrix_traits::stride2 (mt); return ptr; } static int size1 (matrix_type& ms) { return ms.size1(); } static int size2 (matrix_type& ms) { return ms.size2(); } private: static int ld (int s1, int s2, boost::numeric::ublas::row_major_tag) { return s1; } static int ld (int s1, int s2, boost::numeric::ublas::column_major_tag) { return s2; } public: static int leading_dimension (matrix_type& ms) { typedef typename identifier_type::orientation_category oc_t; return ld (ms.stride1(), ms.stride2(), oc_t()) * matrix_traits::leading_dimension (ms.data()); } static int stride1 (matrix_type& ms) { return ms.stride1() * matrix_traits::stride1 (ms.data()); } static int stride2 (matrix_type& ms) { return ms.stride2() * matrix_traits::stride2 (ms.data()); } }; // matrix_row<> and matrix_column<> are vectors: // ublas::matrix_row<> template struct vector_detail_traits< boost::numeric::ublas::matrix_row, MR > : default_vector_traits< MR, typename M::value_type > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::matrix_row, typename boost::remove_const::type>::value) ) ; #endif typedef boost::numeric::ublas::matrix_row identifier_type; typedef MR vector_type; typedef typename M::value_type value_type; typedef typename default_vector_traits::pointer pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (vector_type& mr) { m_type& mt = mr.data(); pointer ptr = matrix_traits::storage (mt); ptr += mr.index() * matrix_traits::stride1 (mt); return ptr; } static int stride (vector_type& mr) { return matrix_traits::stride2 (mr.data()); } }; // ublas::matrix_column<> template struct vector_detail_traits< boost::numeric::ublas::matrix_column, MC > : default_vector_traits< MC, typename M::value_type > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::matrix_column, typename boost::remove_const::type>::value) ) ; #endif typedef boost::numeric::ublas::matrix_column identifier_type; typedef MC vector_type; typedef typename M::value_type value_type ; typedef typename default_vector_traits::pointer pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (vector_type& mc) { m_type& mt = mc.data(); pointer ptr = matrix_traits::storage (mt); ptr += mc.index() * matrix_traits::stride2 (mt); return ptr; } static int stride (vector_type& mc) { return matrix_traits::stride1 (mc.data()); } }; #ifndef BOOST_NUMERIC_BINDINGS_FORTRAN // (undocumented) ublas::c_matrix<> template struct matrix_detail_traits< boost::numeric::ublas::c_matrix, Matr > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif typedef boost::numeric::ublas::c_matrix identifier_type ; typedef Matr matrix_type; typedef general_t matrix_structure; typedef row_major_t ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& m) { return m.data(); } static int size1 (matrix_type& m) { return m.size1(); } static int size2 (matrix_type& m) { return m.size2(); } static int storage_size (matrix_type& m) { return M * N; } static int leading_dimension (matrix_type& m) { return N; } // stride1 == distance (m (i, j), m (i+1, j)) static int stride1 (matrix_type& m) { return N; } // stride2 == distance (m (i, j), m (i, j+1)) static int stride2 (matrix_type& m) { return 1; } }; #endif // BOOST_NUMERIC_BINDINGS_FORTRAN // TO DO: matrix_vector_range<>, matrix_vector_slice<> }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_MATRIX_H boost-bindings/boost/numeric/bindings/traits/ublas_sparse.hpp0000644000175000017500000001166710226750103024711 0ustar andreasandreas/* * * Copyright (c) 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SPARSE_MATRIX_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SPARSE_MATRIX_H #include #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::compressed_matrix<> template struct sparse_matrix_detail_traits< boost::numeric::ublas::compressed_matrix, MType > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::compressed_matrix, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::compressed_matrix identifier_type; typedef MType matrix_type; typedef general_t matrix_structure; typedef compressed_t storage_format; typedef typename detail::ublas_ordering< typename F::orientation_category >::type ordering_type; typedef F layout_type; typedef T value_type; private: typedef typename detail::generate_const::type val_array_t; typedef typename detail::generate_const::type idx_array_t; public: typedef typename vector_traits::pointer value_pointer; typedef typename vector_traits::pointer index_pointer; BOOST_STATIC_CONSTANT (std::size_t, index_base = IB); static index_pointer index1_storage (matrix_type& cm) { assert (cm.filled1() == layout_type::size1 (cm.size1(), cm.size2()) + 1); return vector_traits::storage (cm.index1_data()); } static index_pointer index2_storage (matrix_type& cm) { return vector_traits::storage (cm.index2_data()); } static value_pointer value_storage (matrix_type& cm) { return vector_traits::storage (cm.value_data()); } static int size1 (matrix_type& cm) { return cm.size1(); } static int size2 (matrix_type& cm) { return cm.size2(); } static int num_nonzeros (matrix_type& cm) { return cm.nnz(); // Joerg, this isn't very intuitive :o( // return cm.non_zeros(); } }; // ublas::coordinate_matrix<> template struct sparse_matrix_detail_traits< boost::numeric::ublas::coordinate_matrix, MType > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::coordinate_matrix, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::coordinate_matrix identifier_type; typedef MType matrix_type; typedef general_t matrix_structure; typedef coordinate_t storage_format; typedef typename detail::ublas_ordering< typename F::orientation_category >::type ordering_type; typedef T value_type; private: typedef typename detail::generate_const::type val_array_t; typedef typename detail::generate_const::type idx_array_t; public: typedef typename vector_traits::pointer value_pointer; typedef typename vector_traits::pointer index_pointer; BOOST_STATIC_CONSTANT (std::size_t, index_base = IB); static index_pointer index1_storage (matrix_type& cm) { return vector_traits::storage (cm.index1_data()); } static index_pointer index2_storage (matrix_type& cm) { return vector_traits::storage (cm.index2_data()); } static value_pointer value_storage (matrix_type& cm) { return vector_traits::storage (cm.value_data()); } static int size1 (matrix_type& cm) { return cm.size1(); } static int size2 (matrix_type& cm) { return cm.size2(); } static int num_nonzeros (matrix_type& cm) { return cm.nnz(); // Joerg, this isn't very intuitive :o( // return cm.non_zeros(); } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SPARSE_MATRIX_H boost-bindings/boost/numeric/bindings/traits/ublas_symmetric.hpp0000644000175000017500000001012610142140555025416 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SYMMETRIC_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SYMMETRIC_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::symmetric_matrix<> template struct matrix_detail_traits, M> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif #ifdef BOOST_BINDINGS_FORTRAN BOOST_STATIC_ASSERT((boost::is_same< typename F2::orientation_category, boost::numeric::ublas::column_major_tag >::value)); #endif typedef boost::numeric::ublas::symmetric_matrix identifier_type; typedef M matrix_type; typedef symmetric_packed_t matrix_structure; typedef typename detail::ublas_ordering< typename F2::orientation_category >::type ordering_type; typedef typename detail::ublas_uplo< F1 >::type uplo_type; typedef T value_type ; typedef typename detail::generate_const::type* pointer ; static pointer storage (matrix_type& sm) { typedef typename detail::generate_const::type array_type ; return vector_traits::storage (sm.data()); } static int size1 (matrix_type& sm) { return sm.size1(); } static int size2 (matrix_type& sm) { return sm.size2(); } static int storage_size (matrix_type& sm) { return (size1 (sm) + 1) * size2 (sm) / 2; } }; // ublas::symmetric_adaptor<> template struct matrix_detail_traits, MA> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same, typename boost::remove_const::type>::value) ); #endif typedef boost::numeric::ublas::symmetric_adaptor identifier_type; typedef MA matrix_type; typedef symmetric_t matrix_structure; typedef typename matrix_traits::ordering_type ordering_type; typedef typename detail::ublas_uplo< F1 >::type uplo_type; typedef typename M::value_type value_type; typedef typename detail::generate_const::type* pointer; private: typedef typename detail::generate_const::type m_type; public: static pointer storage (matrix_type& sm) { return matrix_traits::storage (sm.data()); } static int size1 (matrix_type& sm) { return sm.size1(); } static int size2 (matrix_type& sm) { return sm.size2(); } static int storage_size (matrix_type& sm) { return size1 (sm) * size2 (sm); } static int leading_dimension (matrix_type& sm) { return matrix_traits::leading_dimension (sm.data()); } }; }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_SYMMETRIC_H boost-bindings/boost/numeric/bindings/traits/ublas_vector.hpp0000644000175000017500000001347107725613132024723 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::vector<> template struct vector_detail_traits< boost::numeric::ublas::vector, V > : default_vector_traits< V, T > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector identifier_type; typedef V vector_type; typedef typename default_vector_traits< V, T >::pointer pointer; static pointer storage (vector_type& v) { typedef typename detail::generate_const::type array_type ; return vector_traits::storage (v.data()); } }; // ublas::vector_reference<> template struct vector_detail_traits< boost::numeric::ublas::vector_reference, VR > : default_vector_traits< VR, typename V::value_type > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector_reference, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector_reference identifier_type; typedef VR vector_type; typedef typename V::value_type value_type ; typedef typename default_vector_traits::pointer pointer; private: typedef typename detail::generate_const::type vct_t; public: static pointer storage (vector_type& v) { return vector_traits::storage (v.expression()); } static int stride (vector_type& v) { return vector_traits::stride (v.expression()); } }; // ublas::vector_range<> template struct vector_detail_traits< boost::numeric::ublas::vector_range, VR > : default_vector_traits< VR, typename V::value_type > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector_range, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector_range identifier_type; typedef VR vector_type; typedef typename V::value_type value_type ; typedef typename default_vector_traits::pointer pointer; private: typedef typename detail::generate_const::type v_type; public: static pointer storage (vector_type& vr) { pointer ptr = vector_traits::storage (vr.data()); ptr += vr.start() * vector_traits::stride (vr.data()); return ptr; } static int stride (vector_type& vr) { return vector_traits::stride (vr.data()); } }; // ublas::vector_slice<> template struct vector_detail_traits, VS > : default_vector_traits< VS, typename V::value_type > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector_slice, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector_slice identifier_type; typedef VS vector_type; typedef typename V::value_type value_type ; typedef typename default_vector_traits::pointer pointer; private: typedef typename detail::generate_const::type v_type; public: static pointer storage (vector_type& vs) { pointer ptr = vector_traits::storage (vs.data()); ptr += vs.start() * vector_traits::stride (vs.data()); return ptr; } static int stride (vector_type& vs) { return vs.stride() * vector_traits::stride (vs.data()); } }; #ifndef BOOST_NUMERIC_BINDINGS_FORTRAN // (undocumented) ublas::c_vector<> template struct vector_detail_traits< boost::numeric::ublas::c_vector, V > : default_vector_traits< V, T > { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::c_vector, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::c_vector identifier_type; typedef V vector_type; typedef typename default_vector_traits::pointer pointer; static pointer storage (vector_type& v) { return v.data(); } }; #endif // BOOST_NUMERIC_BINDINGS_FORTRAN }}}} #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_H boost-bindings/boost/numeric/bindings/traits/ublas_vector2.hpp0000644000175000017500000001106210040734374024773 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_AS_MATRIX_H #define BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_AS_MATRIX_H #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK # include # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { // ublas::vector<> treated as matrix (nx1) template struct matrix_detail_traits, V> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector identifier_type; typedef V matrix_type; typedef general_t matrix_structure; typedef column_major_t ordering_type; typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& v) { typedef typename detail::generate_const::type array_type; return vector_traits::storage (v.data()); } static int size1 (matrix_type& v) { return v.size(); } static int size2 (matrix_type&) { return 1; } static int storage_size (matrix_type& v) { return v.size(); } static int leading_dimension (matrix_type& v) { return v.size(); } }; // ublas::vector_range<> treated as matrix (nx1) template struct matrix_detail_traits, V> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::vector_range, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::vector_range identifier_type; typedef V matrix_type; typedef general_t matrix_structure; typedef column_major_t ordering_type; typedef typename T::value_type value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& v) { return vector_traits::storage (v); } static int size1 (matrix_type& v) { return v.size(); } static int size2 (matrix_type&) { return 1; } static int storage_size (matrix_type& v) { return v.size(); } static int leading_dimension (matrix_type& v) { return v.size(); } }; #ifndef BOOST_NUMERIC_BINDINGS_FORTRAN // (undocumented) ublas::c_vector<> template struct matrix_detail_traits, V> { #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK BOOST_STATIC_ASSERT( (boost::is_same< boost::numeric::ublas::c_vector, typename boost::remove_const::type >::value) ); #endif typedef boost::numeric::ublas::c_vector identifier_type; typedef V matrix_type; typedef general_t matrix_structure; typedef row_major_t ordering_type; // consistent with c_matrix<> typedef T value_type; typedef typename detail::generate_const::type* pointer; static pointer storage (matrix_type& v) { return v.data(); } static int size1 (matrix_type&) { return 1; } static int size2 (matrix_type& v) { return v.size(); } static int storage_size (matrix_type&) { return N; } static int leading_dimension (matrix_type&) { return N; } }; #endif // BOOST_NUMERIC_BINDINGS_FORTRAN }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #error with your compiler ublas::vector<> cannot be used as matrix #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_UBLAS_VECTOR_AS_MATRIX_H boost-bindings/boost/numeric/bindings/traits/vector_raw.hpp0000644000175000017500000002144710116011311024363 0ustar andreasandreas// // Copyright (c) 2002,2003,2004 // Toon Knapen, Kresimir Fresl, Joerg Walter, Karl Meerbergen // // Permission to use, copy, modify, distribute and sell this software // and its documentation for any purpose is hereby granted without fee, // provided that the above copyright notice appear in all copies and // that both that copyright notice and this permission notice appear // in supporting documentation. The authors make no representations // about the suitability of this software for any purpose. // It is provided "as is" without express or implied warranty. // // #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_VECTOR_RAW_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_VECTOR_RAW_HPP #include #include #ifndef BOOST_UBLAS_HAVE_BINDINGS # include #endif #include #include namespace boost { namespace numeric { namespace bindings { namespace traits { template BOOST_UBLAS_INLINE int vector_size (const V &v) { return (int) v.size(); } //////////////////////////////////////////////////////////////// // ublas::vector<> etc. namespace ublas = boost::numeric::ublas; #if 0 // MSVC seems to dislike overloads if there is `generic' template template BOOST_UBLAS_INLINE int vector_size (const ublas::vector_reference &v) { return vector_size (v.expression()); } #endif #if 0 // MSVC seems to dislike overloads if there is `generic' template template BOOST_UBLAS_INLINE int vector_stride (const V &v) { return 1; } #endif template BOOST_UBLAS_INLINE int vector_stride (const ublas::vector &v) { return 1; } template BOOST_UBLAS_INLINE int vector_stride (const ublas::vector_reference &v) { return (int) vector_stride (v.expression()); } template BOOST_UBLAS_INLINE int vector_stride (const ublas::c_vector &v) { return 1; } template int vector_stride (const ublas::vector_slice&); template BOOST_UBLAS_INLINE int vector_stride (const ublas::vector_range &v) { return (int) vector_stride (v.data()); } template BOOST_UBLAS_INLINE int vector_stride (const ublas::vector_slice &v) { return (int) (v.stride() * vector_stride (v.data())); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::vector::value_type const* vector_storage (const ublas::vector &v) { return &v.data().begin()[0]; } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::vector::value_type const* vector_storage_const (const ublas::vector &v) { return &v.data().begin()[0]; } template BOOST_UBLAS_INLINE typename ublas::vector::value_type* vector_storage (ublas::vector &v) { return &v.data().begin()[0]; } #if 0 // MSVC seems to dislike overloads if there is `generic' template #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename V::const_pointer vector_storage (const V &v) { return &v.data().begin()[0]; } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename V::const_pointer vector_storage_const (const V &v) { return &v.data().begin()[0]; } template BOOST_UBLAS_INLINE typename V::pointer vector_storage (V &v) { return &v.data().begin()[0]; } #endif #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage (const ublas::vector_reference &v) { return vector_storage (v.expression()); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage_const (const ublas::vector_reference &v) { return vector_storage_const (v.expression()); } template BOOST_UBLAS_INLINE typename V::value_type* vector_storage (ublas::vector_reference &v) { return vector_storage (v.expression()); } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename ublas::c_vector::value_type const* vector_storage (const ublas::c_vector &v) { return v.data(); } #endif #ifndef BOOST_MSVC // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename ublas::c_vector::value_type const* vector_storage_const (const ublas::c_vector &v) { return v.data(); } template BOOST_UBLAS_INLINE typename ublas::c_vector::value_type* vector_storage (ublas::c_vector &v) { return v.data(); } #endif #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template typename V::value_type const* vector_storage (const ublas::vector_slice&); template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage (const ublas::vector_range &v) { typename V::value_type const* ptr = vector_storage (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage (const ublas::vector_slice &v) { typename V::value_type const* ptr = vector_storage (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template typename V::value_type const* vector_storage_const (const ublas::vector_slice&); template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage_const (const ublas::vector_range &v) { typename V::value_type const* ptr = vector_storage_const (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } template BOOST_UBLAS_INLINE typename V::value_type const* vector_storage_const (const ublas::vector_slice &v) { typename V::value_type const* ptr = vector_storage_const (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } template typename V::value_type* vector_storage (ublas::vector_slice&); template BOOST_UBLAS_INLINE typename V::value_type* vector_storage (ublas::vector_range &v) { typename V::value_type* ptr = vector_storage (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } template BOOST_UBLAS_INLINE typename V::value_type* vector_storage (ublas::vector_slice &v) { typename V::value_type* ptr = vector_storage (v.data()); ptr += v.start() * vector_stride (v.data()); return ptr; } ////////////////////////////////////////////////////////////////// // std::vector<> template BOOST_UBLAS_INLINE int vector_stride (const std::vector &v) { return 1; } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE typename std::vector::value_type const* vector_storage (const std::vector &v) { return &v.front(); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE typename std::vector::value_type const* vector_storage_const (const std::vector &v) { return &v.front(); } template BOOST_UBLAS_INLINE typename std::vector::value_type* vector_storage (std::vector &v) { return &v.front(); } ////////////////////////////////////////////////////////////////// // bindings::traits::detail::array<> template BOOST_UBLAS_INLINE int vector_stride (const detail::array &a) { return 1; } #ifndef BOOST_NO_FUNCTION_TEMPLATE_ORDERING template BOOST_UBLAS_INLINE const T* vector_storage (const detail::array &a) { return a.storage(); } #endif // We need storage_const() mostly due to MSVC 6.0. // But how shall we write portable code otherwise? template BOOST_UBLAS_INLINE const T* vector_storage_const (const detail::array &a) { return a.storage(); } template BOOST_UBLAS_INLINE T* vector_storage (detail::array &a) { return a.storage(); } }}}} #endif boost-bindings/boost/numeric/bindings/traits/vector_traits.hpp0000644000175000017500000000633510360750652025122 0ustar andreasandreas/* * * Copyright (c) 2002, 2003 Kresimir Fresl, Toon Knapen and Karl Meerbergen * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Authors assume no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * KF acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ #ifndef BOOST_NUMERIC_BINDINGS_TRAITS_VECTOR_TRAITS_HPP #define BOOST_NUMERIC_BINDINGS_TRAITS_VECTOR_TRAITS_HPP #include #ifndef BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #include #ifndef BOOST_NUMERIC_BINDINGS_NO_SANITY_CHECK # include # include #endif namespace boost { namespace numeric { namespace bindings { namespace traits { /// default_vector_traits is just a base-class that can be /// used as the default vector_traits and the different /// specialisation to automatically define most of the /// functions. template struct default_vector_traits { typedef T value_type; typedef typename detail::generate_const::type* pointer; // if V is const, pointer will be a const value_type* static pointer storage (V& v) { return &v[0]; } static int size (V& v) { return static_cast(v.size()); } static int stride (V&) { return 1; } }; // vector_detail_traits is used to implement specializations of vector_traits. // VIdentifier is the vector_type without const, while VType can have a const. // VIdentifier is used to write template specializations for VType and const VType. // e.g. vector_detail_traits< std::vector, std::vector const > // e.g. vector_detail_traits< std::vector, std::vector > // Note that boost::remove_const::type == VIdentifier. template struct vector_detail_traits : default_vector_traits { typedef VIdentifier identifier_type; typedef VType vector_type; }; // vector_traits<> generic version: template struct vector_traits : vector_detail_traits< typename boost::remove_const::type, V > {}; /////////////////////////// // // free accessor functions: // /////////////////////////// template inline typename vector_traits::pointer vector_storage (V& v) { return vector_traits::storage (v); } template inline int vector_size (V& v) { return vector_traits::size (v); } template inline int vector_stride (V& v) { return vector_traits::stride (v); } }}}} #else // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #include #endif // BOOST_NUMERIC_BINDINGS_POOR_MANS_TRAITS #endif // BOOST_NUMERIC_BINDINGS_TRAITS_VECTOR_TRAITS_HPP boost-bindings/boost/numeric/bindings/umfpack/0000755000175000017500000000000010664336556021644 5ustar andreasandreasboost-bindings/boost/numeric/bindings/umfpack/umfpack.hpp0000644000175000017500000011475007725611464024011 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ /* for UMFPACK Copyright, License and Availability see umfpack_inc.hpp */ #ifndef BOOST_NUMERIC_BINDINGS_UMFPACK_HPP #define BOOST_NUMERIC_BINDINGS_UMFPACK_HPP #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace umfpack { template struct symbolic_type : private noncopyable { void *ptr; ~symbolic_type() { if (ptr) detail::free_symbolic (T(), 0, &ptr); } void free() { if (ptr) detail::free_symbolic (T(), 0, &ptr); ptr = 0; } }; template void free (symbolic_type& s) { s.free(); } template struct numeric_type : private noncopyable { void *ptr; ~numeric_type() { if (ptr) detail::free_numeric (T(), 0, &ptr); } void free() { if (ptr) detail::free_numeric (T(), 0, &ptr); ptr = 0; } }; template void free (numeric_type& n) { n.free(); } template struct control_type : private noncopyable { double ptr[UMFPACK_CONTROL]; control_type() { detail::defaults (T(), 0, ptr); } double operator[] (int i) const { return ptr[i]; } double& operator[] (int i) { return ptr[i]; } void defaults() { detail::defaults (T(), 0, ptr); } }; template void defaults (control_type& c) { c.defaults(); } template struct info_type : private noncopyable { double ptr[UMFPACK_INFO]; double operator[] (int i) const { return ptr[i]; } double& operator[] (int i) { return ptr[i]; } }; ///////////////////////////////////// // solving system of linear equations ///////////////////////////////////// // symbolic /* * Given nonzero pattern of a sparse matrix A in column-oriented form, * umfpack_*_symbolic performs a column pre-ordering to reduce fill-in * (using COLAMD or AMD) and a symbolic factorisation. This is required * before the matrix can be numerically factorised with umfpack_*_numeric. */ namespace detail { template inline int symbolic (traits::compressed_t, MatrA const& A, void **Symbolic, double const* Control = 0, double* Info = 0) { return detail::symbolic (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), Symbolic, Control, Info); } template inline int symbolic (traits::compressed_t, MatrA const& A, QVec const& Qinit, void **Symbolic, double const* Control = 0, double* Info = 0) { return detail::qsymbolic (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), traits::vector_storage (Qinit), Symbolic, Control, Info); } template inline int symbolic (traits::coordinate_t, MatrA const& A, void **Symbolic, double const* Control = 0, double* Info = 0) { int n_row = traits::spmatrix_size1 (A); int n_col = traits::spmatrix_size2 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n_col+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n_row, n_col, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; return detail::symbolic (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), Symbolic, Control, Info); } template inline int symbolic (traits::coordinate_t, MatrA const& A, QVec const& Qinit, void **Symbolic, double const* Control = 0, double* Info = 0) { int n_row = traits::spmatrix_size1 (A); int n_col = traits::spmatrix_size2 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n_col+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n_row, n_col, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; return detail::qsymbolic (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), traits::vector_storage (Qinit), Symbolic, Control, Info); } } // detail template inline int symbolic (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif return detail::symbolic (storage_f(), A, &Symbolic.ptr, Control, Info); } template inline int symbolic (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return symbolic (A, Symbolic, Control.ptr, Info.ptr); } template inline int symbolic (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return symbolic (A, Symbolic, Control.ptr); } template inline int symbolic (MatrA const& A, QVec const& Qinit, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif assert (traits::spmatrix_size2 (A) == traits::vector_size (Qinit)); return detail::symbolic (storage_f(), A, Qinit, &Symbolic.ptr, Control, Info); } template inline int symbolic (MatrA const& A, QVec const& Qinit, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return symbolic (A, Qinit, Symbolic, Control.ptr, Info.ptr); } template inline int symbolic (MatrA const& A, QVec const& Qinit, symbolic_type< typename traits::sparse_matrix_traits::value_type >& Symbolic, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return symbolic (A, Qinit, Symbolic, Control.ptr); } // numeric /* * Given a sparse matrix A in column-oriented form, and a symbolic analysis * computed by umfpack_*_*symbolic, the umfpack_*_numeric routine performs * the numerical factorisation, PAQ=LU, PRAQ=LU, or P(R\A)Q=LU, where P * and Q are permutation matrices (represented as permutation vectors), * R is the row scaling, L is unit-lower triangular, and U is upper * triangular. This is required before the system Ax=b (or other related * linear systems) can be solved. */ namespace detail { template inline int numeric (traits::compressed_t, MatrA const& A, void *Symbolic, void** Numeric, double const* Control = 0, double* Info = 0) { return detail::numeric (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), Symbolic, Numeric, Control, Info); } template inline int numeric (traits::coordinate_t, MatrA const& A, void *Symbolic, void** Numeric, double const* Control = 0, double* Info = 0) { int n_row = traits::spmatrix_size1 (A); int n_col = traits::spmatrix_size2 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n_col+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n_row, n_col, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; return detail::numeric (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), Symbolic, Numeric, Control, Info); } } // detail template inline int numeric (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type > const& Symbolic, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif return detail::numeric (storage_f(), A, Symbolic.ptr, &Numeric.ptr, Control, Info); } template inline int numeric (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type > const& Symbolic, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { // g++ (3.2) is unable to distinguish // function numeric() and namespace boost::numeric ;o) return umfpack::numeric (A, Symbolic, Numeric, Control.ptr, Info.ptr); } template inline int numeric (MatrA const& A, symbolic_type< typename traits::sparse_matrix_traits::value_type > const& Symbolic, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return umfpack::numeric (A, Symbolic, Numeric, Control.ptr); } // factor /* * symbolic and numeric */ namespace detail { template inline int factor (traits::compressed_t, MatrA const& A, void** Numeric, double const* Control = 0, double* Info = 0) { symbolic_type::value_type> Symbolic; int status; status = detail::symbolic (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), &Symbolic.ptr, Control, Info); if (status != UMFPACK_OK) return status; return detail::numeric (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), Symbolic.ptr, Numeric, Control, Info); } template inline int factor (traits::coordinate_t, MatrA const& A, void** Numeric, double const* Control = 0, double* Info = 0) { int n_row = traits::spmatrix_size1 (A); int n_col = traits::spmatrix_size2 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n_col+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n_row, n_col, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; symbolic_type::value_type> Symbolic; status = detail::symbolic (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), &Symbolic.ptr, Control, Info); if (status != UMFPACK_OK) return status; return detail::numeric (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), Symbolic.ptr, Numeric, Control, Info); } } // detail template inline int factor (MatrA const& A, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif return detail::factor (storage_f(), A, &Numeric.ptr, Control, Info); } template inline int factor (MatrA const& A, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return factor (A, Numeric, Control.ptr, Info.ptr); } template inline int factor (MatrA const& A, numeric_type< typename traits::sparse_matrix_traits::value_type >& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return factor (A, Numeric, Control.ptr); } // solve /* * Given LU factors computed by umfpack_*_numeric and the right-hand-side, * B, solve a linear system for the solution X. Iterative refinement is * optionally performed. Only square systems are handled. */ namespace detail { template inline int solve (traits::compressed_t, int sys, MatrA const& A, VecX& X, VecB const& B, void *Numeric, double const* Control = 0, double* Info = 0) { return detail::solve (sys, traits::spmatrix_size1 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), traits::vector_storage (X), traits::vector_storage (B), Numeric, Control, Info); } template inline int solve (traits::coordinate_t, int sys, MatrA const& A, VecX& X, VecB const& B, void *Numeric, double const* Control = 0, double* Info = 0) { int n = traits::spmatrix_size1 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n, n, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; return detail::solve (sys, n, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), traits::vector_storage (X), traits::vector_storage (B), Numeric, Control, Info); } } // detail template inline int solve (int sys, MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif assert (traits::spmatrix_size1 (A) == traits::spmatrix_size1 (A)); assert (traits::spmatrix_size2 (A) == traits::vector_size (X)); assert (traits::spmatrix_size2 (A) == traits::vector_size (B)); return detail::solve (storage_f(), sys, A, X, B, Numeric.ptr, Control, Info); } template inline int solve (int sys, MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return solve (sys, A, X, B, Numeric, Control.ptr, Info.ptr); } template inline int solve (int sys, MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return solve (sys, A, X, B, Numeric, Control.ptr); } template inline int solve (MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, double const* Control = 0, double* Info = 0) { return solve (UMFPACK_A, A, X, B, Numeric, Control, Info); } template inline int solve (MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return solve (UMFPACK_A, A, X, B, Numeric, Control.ptr, Info.ptr); } template inline int solve (MatrA const& A, VecX& X, VecB const& B, numeric_type< typename traits::sparse_matrix_traits::value_type > const& Numeric, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return solve (UMFPACK_A, A, X, B, Numeric, Control.ptr); } // umf_solve /* * symbolic, numeric and solve */ namespace detail { template inline int umf_solve (traits::compressed_t, MatrA const& A, VecX& X, VecB const& B, double const* Control = 0, double* Info = 0) { symbolic_type::value_type> Symbolic; numeric_type::value_type> Numeric; int status; status = detail::symbolic (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), &Symbolic.ptr, Control, Info); if (status != UMFPACK_OK) return status; status = detail::numeric (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), Symbolic.ptr, &Numeric.ptr, Control, Info); if (status != UMFPACK_OK) return status; return detail::solve (UMFPACK_A, traits::spmatrix_size1 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), traits::vector_storage (X), traits::vector_storage (B), Numeric.ptr, Control, Info); } template inline int umf_solve (traits::coordinate_t, MatrA const& A, VecX& X, VecB const& B, double const* Control = 0, double* Info = 0) { int n_row = traits::spmatrix_size1 (A); int n_col = traits::spmatrix_size2 (A); int nnz = traits::spmatrix_num_nonzeros (A); typedef typename traits::sparse_matrix_traits::value_type val_t; int const* Ti = traits::spmatrix_index2_storage (A); int const* Tj = traits::spmatrix_index1_storage (A); traits::detail::array Ap (n_col+1); if (!Ap.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Ai (nnz); if (!Ai.valid()) return UMFPACK_ERROR_out_of_memory; int status = detail::triplet_to_col (n_row, n_col, nnz, Ti, Tj, static_cast (0), Ap.storage(), Ai.storage(), static_cast (0), 0); if (status != UMFPACK_OK) return status; symbolic_type::value_type> Symbolic; numeric_type::value_type> Numeric; status = detail::symbolic (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), &Symbolic.ptr, Control, Info); if (status != UMFPACK_OK) return status; status = detail::numeric (n_row, n_col, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), Symbolic.ptr, &Numeric.ptr, Control, Info); if (status != UMFPACK_OK) return status; return detail::solve (UMFPACK_A, n_row, Ap.storage(), Ai.storage(), traits::spmatrix_value_storage (A), traits::vector_storage (X), traits::vector_storage (B), Numeric.ptr, Control, Info); } } // detail template inline int umf_solve (MatrA const& A, VecX& X, VecB const& B, double const* Control = 0, double* Info = 0) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif assert (traits::spmatrix_size1 (A) == traits::spmatrix_size1 (A)); assert (traits::spmatrix_size2 (A) == traits::vector_size (X)); assert (traits::spmatrix_size2 (A) == traits::vector_size (B)); return detail::umf_solve (storage_f(), A, X, B, Control, Info); } template inline int umf_solve (MatrA const& A, VecX& X, VecB const& B, control_type< typename traits::sparse_matrix_traits::value_type > const& Control, info_type< typename traits::sparse_matrix_traits::value_type >& Info) { return umf_solve (A, X, B, Control.ptr, Info.ptr); } template inline int umf_solve (MatrA const& A, VecX& X, VecB const& B, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { return umf_solve (A, X, B, Control.ptr); } /////////////////////// // matrix manipulations /////////////////////// // scale template inline int scale (VecX& X, VecB const& B, numeric_type< typename traits::vector_traits::value_type > const& Numeric) { return detail::scale (traits::vector_size (B), traits::vector_storage (X), traits::vector_storage (B), Numeric.ptr); } //////////// // reporting //////////// // report status template inline void report_status (control_type const& Control, int status) { detail::report_status (T(), 0, Control.ptr, status); } #if 0 template inline void report_status (int printing_level, int status) { control_type Control; Control[UMFPACK_PRL] = printing_level; detail::report_status (T(), 0, Control.ptr, status); } template inline void report_status (int status) { control_type Control; detail::report_status (T(), 0, Control.ptr, status); } #endif // report control template inline void report_control (control_type const& Control) { detail::report_control (T(), 0, Control.ptr); } // report info template inline void report_info (control_type const& Control, info_type const& Info) { detail::report_info (T(), 0, Control.ptr, Info.ptr); } #if 0 template inline void report_info (int printing_level, info_type const& Info) { control_type Control; Control[UMFPACK_PRL] = printing_level; detail::report_info (T(), 0, Control.ptr, Info.ptr); } template inline void report_info (info_type const& Info) { control_type Control; detail::report_info (T(), 0, Control.ptr, Info.ptr); } #endif // report matrix (compressed column and coordinate) namespace detail { template inline int report_matrix (traits::compressed_t, MatrA const& A, double const* Control) { return detail::report_matrix (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), 1, Control); } template inline int report_matrix (traits::coordinate_t, MatrA const& A, double const* Control) { return detail::report_triplet (traits::spmatrix_size1 (A), traits::spmatrix_size2 (A), traits::spmatrix_num_nonzeros (A), traits::spmatrix_index1_storage (A), traits::spmatrix_index2_storage (A), traits::spmatrix_value_storage (A), Control); } } // detail template inline int report_matrix (MatrA const& A, control_type< typename traits::sparse_matrix_traits::value_type > const& Control) { #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::matrix_structure, traits::general_t >::value)); BOOST_STATIC_ASSERT((boost::is_same< typename traits::sparse_matrix_traits::ordering_type, traits::column_major_t >::value)); BOOST_STATIC_ASSERT(traits::sparse_matrix_traits::index_base == 0); #endif typedef typename traits::sparse_matrix_traits::storage_format storage_f; #ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK BOOST_STATIC_ASSERT( (boost::is_same::value || boost::is_same::value )); #endif return detail::report_matrix (storage_f(), A, Control.ptr); } // report vector template inline int report_vector (VecX const& X, control_type< typename traits::vector_traits::value_type > const& Control) { return detail::report_vector (traits::vector_size (X), traits::vector_storage (X), Control.ptr); } // report numeric template inline int report_numeric (numeric_type const& Numeric, control_type const& Control) { return detail::report_numeric (T(), 0, Numeric.ptr, Control.ptr); } // report symbolic template inline int report_symbolic (symbolic_type const& Symbolic, control_type const& Control) { return detail::report_symbolic (T(), 0, Symbolic.ptr, Control.ptr); } // report permutation vector template inline int report_permutation (VecP const& Perm, control_type const& Control) { return detail::report_perm (T(), 0, traits::vector_storage (Perm), Control.ptr); } }}}} #endif // BOOST_NUMERIC_BINDINGS_UMFPACK_HPP boost-bindings/boost/numeric/bindings/umfpack/umfpack_inc.hpp0000644000175000017500000000405610664336554024637 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ /***********************************************************************/ /* UMFPACK Copyright, License and Availability */ /***********************************************************************/ /* * * UMFPACK Version 4.1 (Apr. 30, 2003), Copyright (c) 2003 by Timothy A. * Davis. All Rights Reserved. * * UMFPACK License: * * Your use or distribution of UMFPACK or any modified version of * UMFPACK implies that you agree to this License. * * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. * * Permission is hereby granted to use or copy this program, provided * that the Copyright, this License, and the Availability of the original * version is retained on all copies. User documentation of any code that * uses UMFPACK or any modified version of UMFPACK code must cite the * Copyright, this License, the Availability note, and "Used by permission." * Permission to modify the code and to distribute modified code is granted, * provided the Copyright, this License, and the Availability note are * retained, and a notice that the code was modified is included. This * software was developed with support from the National Science Foundation, * and is provided to you free of charge. * * Availability: * * http://www.cise.ufl.edu/research/sparse/umfpack * */ /* Used by permission. */ #ifndef BOOST_NUMERIC_BINDINGS_UMFPACK_INC_H #define BOOST_NUMERIC_BINDINGS_UMFPACK_INC_H extern "C" { #include } #endif boost-bindings/boost/numeric/bindings/umfpack/umfpack_overloads.hpp0000644000175000017500000003740307725611464026066 0ustar andreasandreas/* * * Copyright (c) Kresimir Fresl 2003 * * Permission to copy, modify, use and distribute this software * for any non-commercial or commercial purpose is granted provided * that this license appear on all copies of the software source code. * * Author assumes no responsibility whatsoever for its use and makes * no guarantees about its quality, correctness or reliability. * * Author acknowledges the support of the Faculty of Civil Engineering, * University of Zagreb, Croatia. * */ /* for UMFPACK Copyright, License and Availability see umfpack_inc.hpp */ #ifndef BOOST_NUMERIC_BINDINGS_UMFPACK_OVERLOADS_HPP #define BOOST_NUMERIC_BINDINGS_UMFPACK_OVERLOADS_HPP #include #include #include #include namespace boost { namespace numeric { namespace bindings { namespace umfpack { namespace detail { //////////////////////////// // UMFPACK primary routines: //////////////////////////// // symbolic inline int symbolic (int n_row, int n_col, int const* Ap, int const* Ai, double const* Ax, void **Symbolic, double const* Control, double* Info) { return umfpack_di_symbolic (n_row, n_col, Ap, Ai, Ax, Symbolic, Control, Info); } inline int symbolic (int n_row, int n_col, int const* Ap, int const* Ai, traits::complex_d const* Ax, void **Symbolic, double const* Control, double* Info) { int nnz = Ap[n_col]; traits::detail::array Axr (nnz); if (!Axr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Axi (nnz); if (!Axi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Ax, Ax+nnz, Axr.storage(), Axi.storage()); return umfpack_zi_symbolic (n_row, n_col, Ap, Ai, Axr.storage(), Axi.storage(), Symbolic, Control, Info); } // numeric inline int numeric (int, int, int const* Ap, int const* Ai, double const* Ax, void *Symbolic, void **Numeric, double const* Control, double* Info) { return umfpack_di_numeric (Ap, Ai, Ax, Symbolic, Numeric, Control, Info); } inline int numeric (int, int n_col, int const* Ap, int const* Ai, traits::complex_d const* Ax, void *Symbolic, void **Numeric, double const* Control, double* Info) { int nnz = Ap[n_col]; traits::detail::array Axr (nnz); if (!Axr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Axi (nnz); if (!Axi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Ax, Ax+nnz, Axr.storage(), Axi.storage()); return umfpack_zi_numeric (Ap, Ai, Axr.storage(), Axi.storage(), Symbolic, Numeric, Control, Info); } // solve inline int solve (int sys, int, int const* Ap, int const* Ai, double const* Ax, double* X, double const* B, void *Numeric, double const* Control, double* Info) { return umfpack_di_solve (sys, Ap, Ai, Ax, X, B, Numeric, Control, Info); } inline int solve (int sys, int n, int const* Ap, int const* Ai, traits::complex_d const* Ax, traits::complex_d* X, traits::complex_d const* B, void *Numeric, double const* Control, double* Info) { int nnz = Ap[n]; traits::detail::array Axr (nnz); if (!Axr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Axi (nnz); if (!Axi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Ax, Ax+nnz, Axr.storage(), Axi.storage()); traits::detail::array Br (n); if (!Br.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Bi (n); if (!Bi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (B, B+n, Br.storage(), Bi.storage()); traits::detail::array Xr (n); if (!Xr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Xi (n); if (!Xi.valid()) return UMFPACK_ERROR_out_of_memory; int status = umfpack_zi_solve (sys, Ap, Ai, Axr.storage(), Axi.storage(), Xr.storage(), Xi.storage(), Br.storage(), Bi.storage(), Numeric, Control, Info); if (status != UMFPACK_OK) return status; traits::detail::interlace (Xr.storage(), Xr.storage() + n, Xi.storage(), X); return status; } // free_symbolic inline void free_symbolic (double, int, void **Symbolic) { umfpack_di_free_symbolic (Symbolic); } inline void free_symbolic (traits::complex_d const&, int, void **Symbolic) { umfpack_zi_free_symbolic (Symbolic); } // free_numeric inline void free_numeric (double, int, void **Numeric) { umfpack_di_free_numeric (Numeric); } inline void free_numeric (traits::complex_d const&, int, void **Numeric) { umfpack_zi_free_numeric (Numeric); } //////////////////////////////// // UMFPACK alternative routines: //////////////////////////////// // default control inline void defaults (double, int, double* Control) { umfpack_di_defaults (Control); } inline void defaults (traits::complex_d const&, int, double* Control) { umfpack_zi_defaults (Control); } // symbolic with specified column preordering inline int qsymbolic (int n_row, int n_col, int const* Ap, int const* Ai, double const* Ax, int const* Qinit, void **Symbolic, double const* Control, double* Info) { return umfpack_di_qsymbolic (n_row, n_col, Ap, Ai, Ax, Qinit, Symbolic, Control, Info); } inline int qsymbolic (int n_row, int n_col, int const* Ap, int const* Ai, traits::complex_d const* Ax, int const* Qinit, void **Symbolic, double const* Control, double* Info) { int nnz = Ap[n_col]; traits::detail::array Axr (nnz); if (!Axr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Axi (nnz); if (!Axi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Ax, Ax+nnz, Axr.storage(), Axi.storage()); return umfpack_zi_qsymbolic (n_row, n_col, Ap, Ai, Axr.storage(), Axi.storage(), Qinit, Symbolic, Control, Info); } /////////////////////////////////////// // UMFPACK matrix manipulation routines /////////////////////////////////////// // triplet (coordinate) to compressed column inline int triplet_to_col (int n_row, int n_col, int nz, int const* Ti, int const* Tj, double const* Tx, int* Ap, int* Ai, double* Ax, int* Map) { return umfpack_di_triplet_to_col (n_row, n_col, nz, Ti, Tj, Tx, Ap, Ai, Ax, Map); } inline int triplet_to_col (int n_row, int n_col, int nz, int const* Ti, int const* Tj, traits::complex_d const* Tx, int* Ap, int* Ai, traits::complex_d* Ax, int* Map) { assert (Tx == 0 && Ax == 0 || Tx != 0 && Ax != 0); double *Txr = 0, *Txi = 0; if (Tx != 0) { traits::detail::array ATxr (nz); if (!ATxr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array ATxi (nz); if (!ATxi.valid()) return UMFPACK_ERROR_out_of_memory; Txr = ATxr.storage(); Txi = ATxi.storage(); traits::detail::disentangle (Tx, Tx+nz, Txr, Txi); } double *Axr = 0, *Axi = 0; if (Ax != 0) { traits::detail::array AAxr (nz); if (!AAxr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array AAxi (nz); if (!AAxi.valid()) return UMFPACK_ERROR_out_of_memory; Axr = AAxr.storage(); Axi = AAxi.storage(); } int status; status = umfpack_zi_triplet_to_col (n_row, n_col, nz, Ti, Tj, Txr, Txi, Ap, Ai, Axr, Axi, Map); if (Ax != 0) { if (status != UMFPACK_OK) return status; traits::detail::interlace (Axr, Axr + nz, Axi, Ax); } return status; } // scale inline int scale (int, double* X, double const* B, void* Numeric) { return umfpack_di_scale (X, B, Numeric); } inline int scale (int n, traits::complex_d* X, traits::complex_d const* B, void* Numeric) { traits::detail::array Br (n); if (!Br.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Bi (n); if (!Bi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (B, B+n, Br.storage(), Bi.storage()); traits::detail::array Xr (n); if (!Xr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Xi (n); if (!Xi.valid()) return UMFPACK_ERROR_out_of_memory; int status = umfpack_zi_scale (Xr.storage(), Xi.storage(), Br.storage(), Bi.storage(), Numeric); if (status != UMFPACK_OK) return status; traits::detail::interlace (Xr.storage(), Xr.storage() + n, Xi.storage(), X); return status; } ////////////////////////////// // UMFPACK reporting routines: ////////////////////////////// // report status inline void report_status (double, int, double const* Control, int status) { umfpack_di_report_status (Control, status); } inline void report_status (traits::complex_d const&, int, double const* Control, int status) { umfpack_zi_report_status (Control, status); } // report control inline void report_control (double, int, double const* Control) { umfpack_di_report_control (Control); } inline void report_control (traits::complex_d const&, int, double const* Control) { umfpack_zi_report_control (Control); } // report info inline void report_info (double, int, double const* Control, double const* Info) { umfpack_di_report_info (Control, Info); } inline void report_info (traits::complex_d const&, int, double const* Control, double const* Info) { umfpack_zi_report_info (Control, Info); } // report matrix inline int report_matrix (int n_row, int n_col, int const* Ap, int const* Ai, double const* Ax, int col_form, double const* Control) { return umfpack_di_report_matrix (n_row, n_col, Ap, Ai, Ax, col_form, Control); } inline int report_matrix (int n_row, int n_col, int const* Ap, int const* Ai, traits::complex_d const* Ax, int col_form, double const* Control) { int nnz = Ap[n_col]; traits::detail::array Axr (nnz); if (!Axr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Axi (nnz); if (!Axi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Ax, Ax+nnz, Axr.storage(), Axi.storage()); return umfpack_zi_report_matrix (n_row, n_col, Ap, Ai, Axr.storage(), Axi.storage(), col_form, Control); } // report triplet (coordinate) int report_triplet (int n_row, int n_col, int nz, int const* Ti, int const* Tj, double const* Tx, double const* Control) { return umfpack_di_report_triplet (n_row, n_col, nz, Ti, Tj, Tx, Control); } int report_triplet (int n_row, int n_col, int nz, int const* Ti, int const* Tj, traits::complex_d const* Tx, double const* Control) { traits::detail::array Txr (nz); if (!Txr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Txi (nz); if (!Txi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (Tx, Tx+nz, Txr.storage(), Txi.storage()); return umfpack_zi_report_triplet (n_row, n_col, nz, Ti, Tj, Txr.storage(), Txi.storage(), Control); } // report vector int report_vector (int n, double const* X, double const* Control) { return umfpack_di_report_vector (n, X, Control); } int report_vector (int n, traits::complex_d const* X, double const* Control) { #if 0 // see UMFPACK v 4.1 User Guide traits::detail::array Xr (n); if (!Xr.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::array Xi (n); if (!Xi.valid()) return UMFPACK_ERROR_out_of_memory; traits::detail::disentangle (X, X+n, Xr.storage(), Xi.storage()); return umfpack_zi_report_vector (n, Xr.storage(), Xi.storage(), Control); #endif return umfpack_zi_report_vector (n, reinterpret_cast (X), reinterpret_cast (0), Control); } // report numeric inline int report_numeric (double, int, void* Numeric, double const* Control) { return umfpack_di_report_numeric (Numeric, Control); } inline int report_numeric (traits::complex_d const&, int, void* Numeric, double const* Control) { return umfpack_zi_report_numeric (Numeric, Control); } // report symbolic inline int report_symbolic (double, int, void* Symbolic, double const* Control) { return umfpack_di_report_symbolic (Symbolic, Control); } inline int report_symbolic (traits::complex_d const&, int, void* Symbolic, double const* Control) { return umfpack_zi_report_symbolic (Symbolic, Control); } // report permutation vector inline int report_perm (double, int, int np, int const* Perm, double const* Control) { return umfpack_di_report_perm (np, Perm, Control); } inline int report_perm (traits::complex_d const&, int, int np, int const* Perm, double const* Control) { return umfpack_zi_report_perm (np, Perm, Control); } }} }}} #endif // BOOST_NUMERIC_BINDINGS_UMFPACK_OVERLOADS_HPP boost-bindings/LICENSE_1_0.txt0000644000175000017500000000247210025376415016105 0ustar andreasandreasBoost Software License - Version 1.0 - August 17th, 2003 Permission is hereby granted, free of charge, to any person or organization obtaining a copy of the software and accompanying documentation covered by this license (the "Software") to use, reproduce, display, distribute, execute, and transmit the Software, and to prepare derivative works of the Software, and to permit third-parties to whom the Software is furnished to do so, all subject to the following: The copyright notices in the Software and this entire statement, including the above license grant, this restriction and the following disclaimer, must be included in all copies of the Software, in whole or in part, and all derivative works of the Software, unless such copies or derivative works are solely in the form of machine-executable object code generated by a source language processor. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. boost-bindings/Makefile.in0000644000175000017500000000024510714455203015662 0ustar andreasandreasall: true install: for header in `find boost -name '*.hpp' -o -name '*.h'`; do \ install -D $$header ${PREFIX}/include/boost-bindings/$$header ; \ done