boost-sandbox/0000755000175000017500000000000010267772167013473 5ustar andreasandreasboost-sandbox/boost/0000755000175000017500000000000010267765754014625 5ustar andreasandreasboost-sandbox/boost/numeric/0000755000175000017500000000000010267765754016267 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/0000755000175000017500000000000010267765755020065 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/amos/0000755000175000017500000000000010267765754021023 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/amos/amos.hpp0000644000175000017500000000721007707750440022462 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-sandbox/boost/numeric/bindings/amos/amos.h0000644000175000017500000000374507676532711022137 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-sandbox/boost/numeric/bindings/amos/amos_names.h0000644000175000017500000000154307676532711023314 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-sandbox/boost/numeric/bindings/amos/amos_overloads.hpp0000644000175000017500000000405607707750440024545 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-sandbox/boost/numeric/bindings/atlas/0000755000175000017500000000000010267765755021171 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/atlas/cblas.hpp0000644000175000017500000000136107725607601022755 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-sandbox/boost/numeric/bindings/atlas/cblas1.hpp0000644000175000017500000003013507725607602023040 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-sandbox/boost/numeric/bindings/atlas/cblas1_overloads.hpp0000644000175000017500000002763307725607602025127 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-sandbox/boost/numeric/bindings/atlas/cblas2.hpp0000644000175000017500000012513307725607602023044 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-sandbox/boost/numeric/bindings/atlas/cblas2_overloads.hpp0000644000175000017500000004421307725607602025121 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-sandbox/boost/numeric/bindings/atlas/cblas3.hpp0000644000175000017500000011735707725607602023056 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-sandbox/boost/numeric/bindings/atlas/cblas3_overloads.hpp0000644000175000017500000003461107725607602025123 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-sandbox/boost/numeric/bindings/atlas/cblas_enum.hpp0000644000175000017500000000444707725607602024012 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-sandbox/boost/numeric/bindings/atlas/cblas_inc.hpp0000644000175000017500000000203607725607602023607 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-sandbox/boost/numeric/bindings/atlas/clapack.hpp0000644000175000017500000006420307725607602023274 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-sandbox/boost/numeric/bindings/atlas/clapack_inc.hpp0000644000175000017500000000221607725607602024121 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-sandbox/boost/numeric/bindings/atlas/clapack_overloads.hpp0000644000175000017500000003067407725607602025357 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-sandbox/boost/numeric/bindings/blas/0000755000175000017500000000000010425034147020762 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/blas/blas.hpp0000644000175000017500000000043407675623321022430 0ustar andreasandreas#ifndef boost_blasbindings_blasbindings_hpp #define boost_blasbindings_blasbindings_hpp #include #include #include #endif // boost_blasbindings_blasbindings_hpp boost-sandbox/boost/numeric/bindings/blas/blas.h0000644000175000017500000002051210201624745022055 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-sandbox/boost/numeric/bindings/blas/blas1.hpp0000644000175000017500000001660107751433751022515 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-sandbox/boost/numeric/bindings/blas/blas1_overloads.hpp0000644000175000017500000001210210425034147024547 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-sandbox/boost/numeric/bindings/blas/blas2.hpp0000644000175000017500000001331307707750440022511 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-sandbox/boost/numeric/bindings/blas/blas2_overloads.hpp0000644000175000017500000000661507707750440024576 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-sandbox/boost/numeric/bindings/blas/blas3.hpp0000644000175000017500000001324210201624745022502 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-sandbox/boost/numeric/bindings/blas/blas3_overloads.hpp0000644000175000017500000001441610201624745024564 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-sandbox/boost/numeric/bindings/blas/blas_names.h0000644000175000017500000000500010201624745023233 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-sandbox/boost/numeric/bindings/lapack/0000755000175000017500000000000010267765755021320 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/lapack/gees.hpp0000644000175000017500000003354707752726051022757 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-sandbox/boost/numeric/bindings/lapack/geev.hpp0000644000175000017500000002713510102407147022737 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(vecttraits::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-sandbox/boost/numeric/bindings/lapack/geqrf.hpp0000644000175000017500000001361607751671103023127 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-sandbox/boost/numeric/bindings/lapack/gesdd.hpp0000644000175000017500000006130510101715755023102 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-sandbox/boost/numeric/bindings/lapack/gesv.hpp0000644000175000017500000002337307725610427022773 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 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-sandbox/boost/numeric/bindings/lapack/gesvd.hpp0000644000175000017500000004570507730066351023137 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-sandbox/boost/numeric/bindings/lapack/hbev.hpp0000644000175000017500000002713007752726113022746 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-sandbox/boost/numeric/bindings/lapack/heev.hpp0000644000175000017500000001322410040710666022736 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-sandbox/boost/numeric/bindings/lapack/hesv.hpp0000644000175000017500000004516607730066351022775 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 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-sandbox/boost/numeric/bindings/lapack/hpsv.hpp0000644000175000017500000002026307725610427023002 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-sandbox/boost/numeric/bindings/lapack/ilaenv.hpp0000644000175000017500000000240610037760525023272 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-sandbox/boost/numeric/bindings/lapack/lapack.h0000644000175000017500000006245210102407147022705 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-sandbox/boost/numeric/bindings/lapack/lapack.hpp0000644000175000017500000000272607752726113023261 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-sandbox/boost/numeric/bindings/lapack/lapack_names.h0000644000175000017500000001520010102407147024055 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-sandbox/boost/numeric/bindings/lapack/ormqr.hpp0000644000175000017500000001737607751671104023173 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-sandbox/boost/numeric/bindings/lapack/posv.hpp0000644000175000017500000002617210204421115022772 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-sandbox/boost/numeric/bindings/lapack/ppsv.hpp0000644000175000017500000002074007725610427023012 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-sandbox/boost/numeric/bindings/lapack/spsv.hpp0000644000175000017500000002262607725610427023022 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-sandbox/boost/numeric/bindings/lapack/syev.hpp0000644000175000017500000001146010215335074022775 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-sandbox/boost/numeric/bindings/lapack/sysv.hpp0000644000175000017500000005106607730066351023030 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-sandbox/boost/numeric/bindings/lapack/trevc.hpp0000644000175000017500000001211107707751613023141 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-sandbox/boost/numeric/bindings/lapack/trexc.hpp0000644000175000017500000001076107707751613023154 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-sandbox/boost/numeric/bindings/lapack/workspace.hpp0000644000175000017500000000613607752726043024025 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-sandbox/boost/numeric/bindings/traits/0000755000175000017500000000000010364344172021353 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/traits/detail/0000755000175000017500000000000010267765755022635 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/traits/detail/array.hpp0000644000175000017500000000234507725614060024453 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-sandbox/boost/numeric/bindings/traits/detail/array_impl.hpp0000644000175000017500000000466107725614060025477 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-sandbox/boost/numeric/bindings/traits/detail/generate_const.hpp0000644000175000017500000000252407707720121026330 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-sandbox/boost/numeric/bindings/traits/detail/symm_herm_traits.hpp0000644000175000017500000000472310204421116026705 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-sandbox/boost/numeric/bindings/traits/detail/ublas_ordering.hpp0000644000175000017500000000241210142105504026310 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<> struct ublas_ordering { typedef column_major_t type; typedef boost::numeric::ublas::column_major functor_type; }; } }}}} #endif boost-sandbox/boost/numeric/bindings/traits/detail/ublas_uplo.hpp0000644000175000017500000000203010142140556025460 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-sandbox/boost/numeric/bindings/traits/detail/utils.hpp0000644000175000017500000000406607725614177024510 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-sandbox/boost/numeric/bindings/traits/algorithm.hpp0000644000175000017500000000167507707741602024071 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-sandbox/boost/numeric/bindings/traits/boost_array.hpp0000644000175000017500000000164307725612472024424 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-sandbox/boost/numeric/bindings/traits/c_array.hpp0000644000175000017500000000331607725612472023517 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-sandbox/boost/numeric/bindings/traits/config.hpp0000644000175000017500000000242010117046442023322 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-sandbox/boost/numeric/bindings/traits/fortran.h0000644000175000017500000000226207730573153023207 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-sandbox/boost/numeric/bindings/traits/matrix_raw.hpp0000644000175000017500000002706307725612606024260 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-sandbox/boost/numeric/bindings/traits/matrix_traits.hpp0000644000175000017500000001100307752725703024763 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-sandbox/boost/numeric/bindings/traits/sparse_traits.hpp0000644000175000017500000000726007725613452024763 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-sandbox/boost/numeric/bindings/traits/std_valarray.hpp0000644000175000017500000000337207725612473024575 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-sandbox/boost/numeric/bindings/traits/std_vector.hpp0000644000175000017500000000310107725612473024244 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-sandbox/boost/numeric/bindings/traits/symm_herm_raw.hpp0000644000175000017500000001316007725612606024745 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-sandbox/boost/numeric/bindings/traits/tnt.hpp0000644000175000017500000001057607725612473022713 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-sandbox/boost/numeric/bindings/traits/traits.hpp0000644000175000017500000000135607725612771023411 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-sandbox/boost/numeric/bindings/traits/transpose.hpp0000644000175000017500000000041707563272065024114 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-sandbox/boost/numeric/bindings/traits/type.h0000644000175000017500000000164207707740502022514 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-sandbox/boost/numeric/bindings/traits/type.hpp0000644000175000017500000000117207725613200023044 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-sandbox/boost/numeric/bindings/traits/type_traits.hpp0000644000175000017500000000372207725613237024447 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-sandbox/boost/numeric/bindings/traits/ublas_banded.hpp0000644000175000017500000001027110132453274024465 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-sandbox/boost/numeric/bindings/traits/ublas_hermitian.hpp0000644000175000017500000001152310142140555025225 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-sandbox/boost/numeric/bindings/traits/ublas_matrix.hpp0000644000175000017500000003177310211566326024567 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::size2 (m.size1(), m.size2()); } // stride1 == distance (m (i, j), m (i+1, j)) static int stride1 (matrix_type& m) { return functor_t::one1 (m.size1(), m.size2()); } // stride2 == distance (m (i, j), m (i, j+1)) static int stride2 (matrix_type& m) { return functor_t::one2 (m.size1(), m.size2()); } }; // 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-sandbox/boost/numeric/bindings/traits/ublas_sparse.hpp0000644000175000017500000001166710226750103024552 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-sandbox/boost/numeric/bindings/traits/ublas_symmetric.hpp0000644000175000017500000001012610142140555025257 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-sandbox/boost/numeric/bindings/traits/ublas_vector.hpp0000644000175000017500000001347107725613132024564 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-sandbox/boost/numeric/bindings/traits/ublas_vector2.hpp0000644000175000017500000001106210040734374024634 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-sandbox/boost/numeric/bindings/traits/vector_raw.hpp0000644000175000017500000002144710116011311024224 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-sandbox/boost/numeric/bindings/traits/vector_traits.hpp0000644000175000017500000000633510364344172024763 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-sandbox/boost/numeric/bindings/umfpack/0000755000175000017500000000000010425034242021463 5ustar andreasandreasboost-sandbox/boost/numeric/bindings/umfpack/umfpack.hpp0000644000175000017500000011475007725611464023652 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-sandbox/boost/numeric/bindings/umfpack/umfpack_inc.hpp0000644000175000017500000000405610425034241024457 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-sandbox/boost/numeric/bindings/umfpack/umfpack_overloads.hpp0000644000175000017500000003740307725611464025727 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