|
|
Boost-Commit : |
From: thomas.klimpel_at_[hidden]
Date: 2008-07-06 07:56:54
Author: klimpel
Date: 2008-07-06 07:56:54 EDT (Sun, 06 Jul 2008)
New Revision: 47129
URL: http://svn.boost.org/trac/boost/changeset/47129
Log:
Add orgqr from Fabien Dekeyser, Quoc-Cuong Pham (and possibly others) at CEA.
Added:
sandbox/boost/numeric/bindings/lapack/orgqr.hpp (contents, props changed)
Text files modified:
sandbox/boost/numeric/bindings/lapack/lapack.h | 13 +++++++++++++
sandbox/boost/numeric/bindings/lapack/lapack_names.h | 5 +++++
2 files changed, 18 insertions(+), 0 deletions(-)
Modified: sandbox/boost/numeric/bindings/lapack/lapack.h
==============================================================================
--- sandbox/boost/numeric/bindings/lapack/lapack.h (original)
+++ sandbox/boost/numeric/bindings/lapack/lapack.h 2008-07-06 07:56:54 EDT (Sun, 06 Jul 2008)
@@ -586,6 +586,19 @@
dcomplex_t* c, const int* ldc, dcomplex_t* work,
const int* lwork, int* info );
+ void LAPACK_SORGQR( const int* m, const int* n, const int* k,
+ float* a, const int* lda, float* tau,
+ float* work, const int* lwork, const int* info);
+ void LAPACK_DORGQR( const int* m, const int* n, const int* k,
+ double* a, const int* lda, double* tau,
+ double* work, const int* lwork, const int* info);
+ void LAPACK_CUNGQR( const int* m, const int* n, const int* k,
+ fcomplex_t* a, const int* lda, fcomplex_t* tau,
+ fcomplex_t* work, const int* lwork, const int* info);
+ void LAPACK_ZUNGQR( const int* m, const int* n, const int* k,
+ dcomplex_t* a, const int* lda, dcomplex_t* tau,
+ dcomplex_t* work, const int* lwork, const int* info);
+
/********************************************************************/
Modified: sandbox/boost/numeric/bindings/lapack/lapack_names.h
==============================================================================
--- sandbox/boost/numeric/bindings/lapack/lapack_names.h (original)
+++ sandbox/boost/numeric/bindings/lapack/lapack_names.h 2008-07-06 07:56:54 EDT (Sun, 06 Jul 2008)
@@ -223,6 +223,11 @@
#define LAPACK_CUNMQR FORTRAN_ID( cunmqr )
#define LAPACK_ZUNMQR FORTRAN_ID( zunmqr )
+#define LAPACK_SORGQR FORTRAN_ID( sorgqr )
+#define LAPACK_DORGQR FORTRAN_ID( dorgqr )
+#define LAPACK_CUNGQR FORTRAN_ID( cungqr )
+#define LAPACK_ZUNGQR FORTRAN_ID( zungqr )
+
#define LAPACK_SSYTRD FORTRAN_ID( ssytrd )
#define LAPACK_DSYTRD FORTRAN_ID( dsytrd )
Added: sandbox/boost/numeric/bindings/lapack/orgqr.hpp
==============================================================================
--- (empty file)
+++ sandbox/boost/numeric/bindings/lapack/orgqr.hpp 2008-07-06 07:56:54 EDT (Sun, 06 Jul 2008)
@@ -0,0 +1,174 @@
+//
+// Copyright Fabien Dekeyser, Quoc-Cuong Pham 2008
+//
+// Distributed under the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at
+// http://www.boost.org/LICENSE_1_0.txt)
+//
+
+/**
+ *
+ * \brief Generates an M-by-N real matrix Q with orthonormal columns,
+ * which is defined as the first N columns of a product of K elementary
+ * reflectors of order M
+ * Q = H(1) H(2) . . . H(k)
+ *
+ * \warning
+ * \todo
+ * \date 2005
+ * \author CEA/DRT/DTSI/SARC
+ * \author Q.C. PHAM
+ *
+ **/
+
+
+#ifndef BOOST_NUMERIC_BINDINGS_LAPACK_ORGQR_HPP
+#define BOOST_NUMERIC_BINDINGS_LAPACK_ORGQR_HPP
+
+#include <complex>
+#include <boost/numeric/bindings/traits/traits.hpp>
+#include <boost/numeric/bindings/lapack/lapack.h>
+#include <boost/numeric/bindings/lapack/workspace.hpp>
+#include <boost/numeric/bindings/traits/detail/array.hpp>
+// #include <boost/numeric/bindings/traits/std_vector.hpp>
+
+#ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK
+# include <boost/static_assert.hpp>
+# include <boost/type_traits.hpp>
+#endif
+
+
+namespace boost { namespace numeric { namespace bindings {
+
+ namespace lapack {
+
+
+ ///////////////////////////////////////////////////////////////////
+ /*
+ * Generates an M-by-N real matrix Q with orthonormal columns,
+ * which is defined as the first N columns of a product of K elementary
+ * reflectors of order M
+ * Q = H(1) H(2) . . . H(k)
+ * as returned by geqrf().
+ * The init value of matrix Q is the matrix A returned by geqrf()
+ */
+ ///////////////////////////////////////////////////////////////////
+ namespace detail {
+
+
+ inline
+ void orgqr(int const m, int const n, int const k,
+ float* a, int const lda,
+ float* tau, float* work, int const lwork, int& info)
+ {
+ LAPACK_SORGQR (&m, &n, &k, a, &lda, tau, work, &lwork, &info);
+ }
+
+ inline
+ void orgqr(int const m, int const n, int const k,
+ double* a, int const lda,
+ double* tau, double* work, int const lwork, int& info)
+ {
+ LAPACK_DORGQR (&m, &n, &k, a, &lda, tau, work, &lwork, &info);
+ }
+
+ inline
+ void orgqr(int const m, int const n, int const k,
+ traits::complex_f* a, int const lda,
+ traits::complex_f* tau, traits::complex_f* work, int const lwork, int& info)
+ {
+ LAPACK_CUNGQR (&m, &n, &k, traits::complex_ptr(a), &lda, traits::complex_ptr(tau),
+ traits::complex_ptr(work), &lwork, &info);
+ }
+
+ inline
+ void orgqr(int const m, int const n, int const k,
+ traits::complex_d* a, int const lda,
+ traits::complex_d* tau, traits::complex_d* work, int const lwork, int& info)
+ {
+ LAPACK_ZUNGQR (&m, &n, &k, traits::complex_ptr(a), &lda, traits::complex_ptr(tau),
+ traits::complex_ptr(work), &lwork, &info);
+ }
+
+ } // fin namespace detail
+
+
+ //--------------------------------------------
+
+ template <typename A, typename Tau, typename Work>
+ inline int orgqr(A& a, Tau& tau, Work &work) {
+
+#ifndef BOOST_NUMERIC_BINDINGS_NO_STRUCTURE_CHECK
+ BOOST_STATIC_ASSERT((boost::is_same<
+ typename traits::matrix_traits<A>::matrix_structure,
+ traits::general_t
+ >::value));
+#endif
+
+ const int m = traits::matrix_size1 (a);
+ const int n = traits::matrix_size2 (a);
+ const int k = n;
+
+ assert (std::min<int>(m,n) <= traits::vector_size (tau));
+ assert (n <= traits::vector_size (work));
+
+ int info;
+ detail::orgqr (m, n, k,
+ 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 Q.
+ // Workspace is allocated dynamically so that the optimization of
+ // blas 3 calls is optimal.
+ template <typename A, typename Tau>
+ inline
+ int orgqr (A& a, Tau& tau, optimal_workspace ) {
+ typedef typename A::value_type value_type ;
+ const int n = traits::matrix_size2 (a);
+ traits::detail::array<value_type> work(std::max<int>(1, n*32));
+ return orgqr( a, tau, work );
+
+ }
+
+ // Computation of Q
+ // Workspace is allocated dynamically to its minimum size.
+ // Blas 3 calls are not optimal.
+ template <typename A, typename Tau>
+ inline
+ int orgqr (A& a, Tau& tau, minimal_workspace ) {
+ typedef typename A::value_type value_type ;
+ const int n = traits::matrix_size2 (a);
+ traits::detail::array<value_type> work(std::max<int>(1, n));
+ return orgqr( a, tau, work );
+ }
+
+ // Computation of the Q
+ // Workspace is taken from the array in workspace.
+
+ template <typename A, typename Tau, typename Work>
+ inline
+ int orgqr (A& a, Tau& tau, detail::workspace1<Work> workspace ) {
+ typedef typename A::value_type value_type ;
+ const int n = traits::matrix_size2 (a);
+ traits::detail::array<value_type> work(std::max<int>(1, n));
+ return orgqr( a, tau, workspace.w_ );
+ }
+
+ // Function without workarray as argument
+ template <typename A, typename Tau>
+ inline
+ int orgqr (A& a, Tau& tau) {
+ return orgqr( a, tau, optimal_workspace() );
+ }
+
+ }
+
+}}}
+
+#endif
Boost-Commit list run by bdawes at acm.org, david.abrahams at rcn.com, gregod at cs.rpi.edu, cpdaniel at pacbell.net, john at johnmaddock.co.uk