Skip to content

D
dlib
Commit 16e910c3 authored by Davis King's avatar Davis King
Browse files
Options

Added a bunch of LAPACK bindings. 

--HG--
extra : convert_revision : svn%3Afdd8eb12-d10e-0410-9acb-85c331704f74/trunk%403817
parent fb542d70
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 932 additions and 0 deletions
dlib/matrix/lapack/fortran_id.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H
#define DLIB_BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H
// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------
// FORTRAN BINDING STUFF FROM BOOST
// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------
// 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
// 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 DLIB_BIND_FORTRAN_LOWERCASE_UNDERSCORE
#elif defined(__IBMCPP__) || defined(_MSC_VER)
#define DLIB_BIND_FORTRAN_LOWERCASE
#else
#error do not know how to link with fortran for the given platform
#endif
// Next we define macros to convert our symbols to
// the current convention
#if defined(DLIB_BIND_FORTRAN_LOWERCASE_UNDERSCORE)
#define DLIB_FORTRAN_ID( id ) id##_
#elif defined(DLIB_BIND_FORTRAN_LOWERCASE)
#define DLIB_FORTRAN_ID( id ) id
#else
#error do not know how to bind to fortran calling convention
#endif
namespace dlib
{
namespace lapack
{
// stuff from f2c used to define what exactly is an integer in fortran
#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
typedef int integer;
typedef unsigned int uinteger;
#else
typedef long int integer;
typedef unsigned long int uinteger;
#endif
}
}
#endif // DLIB_BOOST_NUMERIC_BINDINGS_TRAITS_FORTRAN_H
dlib/matrix/lapack/gees.h 0 → 100644
View file @ 16e910c3
This diff is collapsed.
dlib/matrix/lapack/geev.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_LAPACk_GEEV_H__
#define DLIB_LAPACk_GEEV_H__
#include "fortran_id.h"
#include "../matrix.h"
namespace dlib
{
namespace lapack
{
namespace binding
{
extern "C"
{
void DLIB_FORTRAN_ID(dgeev) (char *jobvl, char *jobvr, integer *n, double * a,
integer *lda, double *wr, double *wi, double *vl,
integer *ldvl, double *vr, integer *ldvr, double *work,
integer *lwork, integer *info);
void DLIB_FORTRAN_ID(sgeev) (char *jobvl, char *jobvr, integer *n, float * a,
integer *lda, float *wr, float *wi, float *vl,
integer *ldvl, float *vr, integer *ldvr, float *work,
integer *lwork, integer *info);
}
inline int geev (char jobvl, char jobvr, integer n, double *a,
integer lda, double *wr, double *wi, double *vl,
integer ldvl, double *vr, integer ldvr, double *work,
integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(dgeev)(&jobvl, &jobvr, &n, a,
&lda, wr, wi, vl,
&ldvl, vr, &ldvr, work,
&lwork, &info);
return info;
}
inline int geev (char jobvl, char jobvr, integer n, float *a,
integer lda, float *wr, float *wi, float *vl,
integer ldvl, float *vr, integer ldvr, float *work,
integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(sgeev)(&jobvl, &jobvr, &n, a,
&lda, wr, wi, vl,
&ldvl, vr, &ldvr, work,
&lwork, &info);
return info;
}
}
// ------------------------------------------------------------------------------------
/* -- LAPACK driver routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DGEEV computes for an N-by-N real nonsymmetric matrix A, the */
/* eigenvalues and, optionally, the left and/or right eigenvectors. */
/* The right eigenvector v(j) of A satisfies */
/* A * v(j) = lambda(j) * v(j) */
/* where lambda(j) is its eigenvalue. */
/* The left eigenvector u(j) of A satisfies */
/* u(j)**H * A = lambda(j) * u(j)**H */
/* where u(j)**H denotes the conjugate transpose of u(j). */
/* The computed eigenvectors are normalized to have Euclidean norm */
/* equal to 1 and largest component real. */
/* Arguments */
/* ========= */
/* JOBVL (input) CHARACTER*1 */
/* = 'N': left eigenvectors of A are not computed; */
/* = 'V': left eigenvectors of A are computed. */
/* JOBVR (input) CHARACTER*1 */
/* = 'N': right eigenvectors of A are not computed; */
/* = 'V': right eigenvectors of A are computed. */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
/* On entry, the N-by-N matrix A. */
/* On exit, A has been overwritten. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* WR (output) DOUBLE PRECISION array, dimension (N) */
/* WI (output) DOUBLE PRECISION array, dimension (N) */
/* WR and WI contain the real and imaginary parts, */
/* respectively, of the computed eigenvalues. Complex */
/* conjugate pairs of eigenvalues appear consecutively */
/* with the eigenvalue having the positive imaginary part */
/* first. */
/* VL (output) DOUBLE PRECISION array, dimension (LDVL,N) */
/* If JOBVL = 'V', the left eigenvectors u(j) are stored one */
/* after another in the columns of VL, in the same order */
/* as their eigenvalues. */
/* If JOBVL = 'N', VL is not referenced. */
/* If the j-th eigenvalue is real, then u(j) = VL(:,j), */
/* the j-th column of VL. */
/* If the j-th and (j+1)-st eigenvalues form a complex */
/* conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and */
/* u(j+1) = VL(:,j) - i*VL(:,j+1). */
/* LDVL (input) INTEGER */
/* The leading dimension of the array VL. LDVL >= 1; if */
/* JOBVL = 'V', LDVL >= N. */
/* VR (output) DOUBLE PRECISION array, dimension (LDVR,N) */
/* If JOBVR = 'V', the right eigenvectors v(j) are stored one */
/* after another in the columns of VR, in the same order */
/* as their eigenvalues. */
/* If JOBVR = 'N', VR is not referenced. */
/* If the j-th eigenvalue is real, then v(j) = VR(:,j), */
/* the j-th column of VR. */
/* If the j-th and (j+1)-st eigenvalues form a complex */
/* conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and */
/* v(j+1) = VR(:,j) - i*VR(:,j+1). */
/* LDVR (input) INTEGER */
/* The leading dimension of the array VR. LDVR >= 1; if */
/* JOBVR = 'V', LDVR >= N. */
/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK. LWORK >= max(1,3*N), and */
/* if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good */
/* performance, LWORK must generally be larger. */
/* If LWORK = -1, then a workspace query is assumed; the routine */
/* only calculates the optimal size of the WORK array, returns */
/* this value as the first entry of the WORK array, and no error */
/* message related to LWORK is issued by XERBLA. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value. */
/* > 0: if INFO = i, the QR algorithm failed to compute all the */
/* eigenvalues, and no eigenvectors have been computed; */
/* elements i+1:N of WR and WI contain eigenvalues which */
/* have converged. */
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1, long NR2, long NR3, long NR4, long NR5, long NR6,
long NC1, long NC2, long NC3, long NC4, long NC5, long NC6,
typename MM
>
int geev (
const char jobvl,
const char jobvr,
matrix<T,NR1,NC1,MM,column_major_layout>& a,
matrix<T,NR2,NC2,MM,column_major_layout>& wr,
matrix<T,NR3,NC3,MM,column_major_layout>& wi,
matrix<T,NR4,NC4,MM,column_major_layout>& vl,
matrix<T,NR5,NC5,MM,column_major_layout>& vr,
matrix<T,NR6,NC6,MM,column_major_layout>& work
)
{
const long n = a.nr();
wr.set_size(n,1);
wi.set_size(n,1);
if (jobvl == 'V')
vl.set_size(n,n);
else
vl.set_size(1,1);
if (jobvr == 'V')
vr.set_size(n,n);
else
vr.set_size(1,1);
// figure out how big the workspace needs to be.
T work_size = 1;
int info = binding::geev(jobvl, jobvr, n, &a(0,0),
a.nr(), &wr(0,0), &wi(0,0), &vl(0,0),
vl.nr(), &vr(0,0), vr.nr(), &work_size,
-1);
if (info != 0)
return info;
if (work.size() < work_size)
work.set_size(work_size, 1);
// compute the actual decomposition
info = binding::geev(jobvl, jobvr, n, &a(0,0),
a.nr(), &wr(0,0), &wi(0,0), &vl(0,0),
vl.nr(), &vr(0,0), vr.nr(), &work(0,0),
work.size());
return info;
}
// ------------------------------------------------------------------------------------
}
}
// ----------------------------------------------------------------------------------------
#endif // DLIB_LAPACk_GEEV_H__
dlib/matrix/lapack/geqrf.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_LAPACk_GEQRF_H__
#define DLIB_LAPACk_GEQRF_H__
#include "fortran_id.h"
#include "../matrix.h"
namespace dlib
{
namespace lapack
{
namespace binding
{
extern "C"
{
void DLIB_FORTRAN_ID(dgeqrf) (integer *m, integer *n, double *a, integer *
lda, double *tau, double *work, integer *lwork,
integer *info);
void DLIB_FORTRAN_ID(sgeqrf) (integer *m, integer *n, float *a, integer *
lda, float *tau, float *work, integer *lwork,
integer *info);
}
inline int geqrf (integer m, integer n, double *a, integer lda,
double *tau, double *work, integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(dgeqrf)(&m, &n, a, &lda,
tau, work, &lwork, &info);
return info;
}
inline int geqrf (integer m, integer n, float *a, integer lda,
float *tau, float *work, integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(sgeqrf)(&m, &n, a, &lda,
tau, work, &lwork, &info);
return info;
}
}
// ------------------------------------------------------------------------------------
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DGEQRF computes a QR factorization of a real M-by-N matrix A: */
/* A = Q * R. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix A. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix A. N >= 0. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
/* On entry, the M-by-N matrix A. */
/* On exit, the elements on and above the diagonal of the array */
/* contain the min(M,N)-by-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 (see Further */
/* Details). */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,M). */
/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
/* The scalar factors of the elementary reflectors (see Further */
/* Details). */
/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK. LWORK >= max(1,N). */
/* For optimum performance LWORK >= N*NB, where NB is */
/* the optimal blocksize. */
/* If LWORK = -1, then a workspace query is assumed; the routine */
/* only calculates the optimal size of the WORK array, returns */
/* this value as the first entry of the WORK array, and no error */
/* message related to LWORK is issued by XERBLA. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* Further Details */
/* =============== */
/* The matrix Q is represented as a product of elementary reflectors */
/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
/* Each H(i) has the form */
/* H(i) = I - tau * v * v' */
/* where tau is a real scalar, and v is a real vector with */
/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
/* and tau in TAU(i). */
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1, long NR2, long NR3,
long NC1, long NC2, long NC3,
typename MM
>
int geqrf (
matrix<T,NR1,NC1,MM,column_major_layout>& a,
matrix<T,NR2,NC2,MM,column_major_layout>& tau,
matrix<T,NR3,NC3,MM,column_major_layout>& work
)
{
tau.set_size(std::min(a.nr(), a.nc()), 1);
// figure out how big the workspace needs to be.
T work_size = 1;
int info = binding::geqrf(a.nr(), a.nc(), &a(0,0), a.nr(),
&tau(0,0), &work_size, -1);
if (info != 0)
return info;
if (work.size() < work_size)
work.set_size(work_size, 1);
// compute the actual decomposition
info = binding::geqrf(a.nr(), a.nc(), &a(0,0), a.nr(),
&tau(0,0), &work(0,0), work.size());
return info;
}
// ------------------------------------------------------------------------------------
}
}
// ----------------------------------------------------------------------------------------
#endif // DLIB_LAPACk_GEQRF_H__
dlib/matrix/lapack/gesdd.h 0 → 100644
View file @ 16e910c3
This diff is collapsed.
dlib/matrix/lapack/gesvd.h 0 → 100644
View file @ 16e910c3
This diff is collapsed.
dlib/matrix/lapack/getrf.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_LAPACk_GETRF_H__
#define DLIB_LAPACk_GETRF_H__
#include "fortran_id.h"
#include "../matrix.h"
namespace dlib
{
namespace lapack
{
namespace binding
{
extern "C"
{
void DLIB_FORTRAN_ID(dgetrf) (integer* m, integer *n, double *a,
integer* lda, integer *ipiv, integer *info);
void DLIB_FORTRAN_ID(sgetrf) (integer* m, integer *n, float *a,
integer* lda, integer *ipiv, integer *info);
}
inline int getrf (integer m, integer n, double *a,
integer lda, integer *ipiv)
{
integer info = 0;
DLIB_FORTRAN_ID(dgetrf)(&m, &n, a, &lda, ipiv, &info);
return info;
}
inline int getrf (integer m, integer n, float *a,
integer lda, integer *ipiv)
{
integer info = 0;
DLIB_FORTRAN_ID(sgetrf)(&m, &n, a, &lda, ipiv, &info);
return info;
}
}
// ------------------------------------------------------------------------------------
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DGETRF 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). */
/* This is the right-looking Level 3 BLAS version of the algorithm. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix A. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix A. N >= 0. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
/* On entry, the M-by-N matrix to be factored. */
/* On exit, the factors L and U from the factorization */
/* A = P*L*U; the unit diagonal elements of L are not stored. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,M). */
/* IPIV (output) INTEGER array, dimension (min(M,N)) */
/* The pivot indices; for 1 <= i <= min(M,N), row i of the */
/* matrix was interchanged with row IPIV(i). */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: if INFO = i, U(i,i) is exactly zero. The factorization */
/* has been completed, but the factor U is exactly */
/* singular, and division by zero will occur if it is used */
/* to solve a system of equations. */
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1, long NR2,
long NC1, long NC2,
typename MM,
typename layout
>
int getrf (
matrix<T,NR1,NC1,MM,column_major_layout>& a,
matrix<long,NR2,NC2,MM,layout>& ipiv
)
{
const long m = a.nr();
const long n = a.nc();
matrix<integer,NR2,NC2,MM,column_major_layout> ipiv_temp(std::min(m,n), 1);
// compute the actual decomposition
int info = binding::getrf(m, n, &a(0,0), a.nr(), &ipiv_temp(0,0));
// Turn the P vector into a more useful form. This way we will have the identity
// a == rowm(L*U, ipiv). The permutation vector that comes out of LAPACK is somewhat
// different.
ipiv = trans(range(0, a.nr()-1));
for (long i = ipiv_temp.size()-1; i >= 0; --i)
{
// -1 because FORTRAN is indexed starting with 1 instead of 0
std::swap(ipiv(i), ipiv(ipiv_temp(i)-1));
}
return info;
}
// ------------------------------------------------------------------------------------
}
}
// ----------------------------------------------------------------------------------------
#endif // DLIB_LAPACk_GETRF_H__
dlib/matrix/lapack/potrf.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_LAPACk_POTRF_H__
#define DLIB_LAPACk_POTRF_H__
#include "fortran_id.h"
#include "../matrix.h"
namespace dlib
{
namespace lapack
{
namespace binding
{
extern "C"
{
void DLIB_FORTRAN_ID(dpotrf) (char *uplo, integer *n, double *a,
integer* lda, integer *info);
void DLIB_FORTRAN_ID(spotrf) (char *uplo, integer *n, float *a,
integer* lda, integer *info);
}
inline int potrf (char uplo, integer n, double *a, integer lda)
{
integer info = 0;
DLIB_FORTRAN_ID(dpotrf)(&uplo, &n, a, &lda, &info);
return info;
}
inline int potrf (char uplo, integer n, float *a, integer lda)
{
integer info = 0;
DLIB_FORTRAN_ID(spotrf)(&uplo, &n, a, &lda, &info);
return info;
}
}
// ------------------------------------------------------------------------------------
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DPOTRF computes the Cholesky factorization of a real symmetric */
/* positive definite matrix A. */
/* The factorization has the form */
/* A = U**T * U, if UPLO = 'U', or */
/* A = L * L**T, if UPLO = 'L', */
/* where U is an upper triangular matrix and L is lower triangular. */
/* This is the block version of the algorithm, calling Level 3 BLAS. */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A is stored; */
/* = 'L': Lower triangle of A is stored. */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
/* On entry, the symmetric 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. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: if INFO = i, the leading minor of order i is not */
/* positive definite, and the factorization could not be */
/* completed. */
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1,
long NC1,
typename MM
>
int getrf (
char uplo,
matrix<T,NR1,NC1,MM,column_major_layout>& a
)
{
// compute the actual decomposition
int info = binding::potrf(uplo, a.nr(), &a(0,0), a.nr());
// If it fails part way though the factorization then make sure
// the end of the matrix gets properly initialized with zeros.
if (info > 0)
{
if (uplo == 'L')
set_colm(a, range(info-1, a.nc()-1)) = 0;
else
set_rowm(a, range(info-1, a.nr()-1)) = 0;
}
return info;
}
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1,
long NC1,
typename MM
>
int getrf (
char uplo,
matrix<T,NR1,NC1,MM,row_major_layout>& a
)
{
// since we are working on a row major order matrix we need to ask
// LAPACK for the transpose of whatever the user asked for.
if (uplo == 'L')
uplo = 'U';
else
uplo = 'L';
// compute the actual decomposition
int info = binding::potrf(uplo, a.nr(), &a(0,0), a.nr());
// If it fails part way though the factorization then make sure
// the end of the matrix gets properly initialized with zeros.
if (info > 0)
{
if (uplo == 'U')
set_colm(a, range(info-1, a.nc()-1)) = 0;
else
set_rowm(a, range(info-1, a.nr()-1)) = 0;
}
return info;
}
// ------------------------------------------------------------------------------------
}
}
// ----------------------------------------------------------------------------------------
#endif // DLIB_LAPACk_POTRF_H__
dlib/matrix/lapack/syev.h 0 → 100644
View file @ 16e910c3
#ifndef DLIB_LAPACk_EV_H__
#define DLIB_LAPACk_EV_H__
#include "fortran_id.h"
#include "../matrix.h"
namespace dlib
{
namespace lapack
{
namespace binding
{
extern "C"
{
void DLIB_FORTRAN_ID(dsyev) (char *jobz, char *uplo, integer *n, double *a,
integer *lda, double *w, double *work, integer *lwork,
integer *info);
void DLIB_FORTRAN_ID(ssyev) (char *jobz, char *uplo, integer *n, float *a,
integer *lda, float *w, float *work, integer *lwork,
integer *info);
}
inline int syev (char jobz, char uplo, integer n, double *a,
integer lda, double *w, double *work, integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(dsyev)(&jobz, &uplo, &n, a,
&lda, w, work, &lwork, &info);
return info;
}
inline int syev (char jobz, char uplo, integer n, float *a,
integer lda, float *w, float *work, integer lwork)
{
integer info = 0;
DLIB_FORTRAN_ID(ssyev)(&jobz, &uplo, &n, a,
&lda, w, work, &lwork, &info);
return info;
}
}
// ------------------------------------------------------------------------------------
/* -- LAPACK driver routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DSYEV computes all eigenvalues and, optionally, eigenvectors of a */
/* real symmetric matrix A. */
/* Arguments */
/* ========= */
/* JOBZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only; */
/* = 'V': Compute eigenvalues and eigenvectors. */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A is stored; */
/* = 'L': Lower triangle of A is stored. */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
/* On entry, the symmetric matrix A. If UPLO = 'U', the */
/* leading N-by-N upper triangular part of A contains the */
/* upper triangular part of the matrix A. If UPLO = 'L', */
/* the leading N-by-N lower triangular part of A contains */
/* the lower triangular part of the matrix A. */
/* On exit, if JOBZ = 'V', then if INFO = 0, A contains the */
/* orthonormal eigenvectors of the matrix A. */
/* If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') */
/* or the upper triangle (if UPLO='U') of A, including the */
/* diagonal, is destroyed. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* W (output) DOUBLE PRECISION array, dimension (N) */
/* If INFO = 0, the eigenvalues in ascending order. */
/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
/* LWORK (input) INTEGER */
/* The length of the array WORK. LWORK >= max(1,3*N-1). */
/* For optimal efficiency, LWORK >= (NB+2)*N, */
/* where NB is the blocksize for DSYTRD returned by ILAENV. */
/* If LWORK = -1, then a workspace query is assumed; the routine */
/* only calculates the optimal size of the WORK array, returns */
/* this value as the first entry of the WORK array, and no error */
/* message related to LWORK is issued by XERBLA. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: if INFO = i, the algorithm failed to converge; i */
/* off-diagonal elements of an intermediate tridiagonal */
/* form did not converge to zero. */
// ------------------------------------------------------------------------------------
template <
typename T,
long NR1, long NR2, long NR3,
long NC1, long NC2, long NC3,
typename MM
>
int syev (
const char jobz,
const char uplo,
matrix<T,NR1,NC1,MM,column_major_layout>& a,
matrix<T,NR2,NC2,MM,column_major_layout>& w,
matrix<T,NR3,NC3,MM,column_major_layout>& work
)
{
const long n = a.nr();
w.set_size(n,1);
// figure out how big the workspace needs to be.
T work_size = 1;
int info = binding::syev(jobz, uplo, n, &a(0,0),
a.nr(), &w(0,0), &work_size, -1);
if (info != 0)
return info;
if (work.size() < work_size)
work.set_size(work_size, 1);
// compute the actual decomposition
info = binding::syev(jobz, uplo, n, &a(0,0),
a.nr(), &w(0,0), &work(0,0), work.size());
return info;
}
// ------------------------------------------------------------------------------------
}
}
// ----------------------------------------------------------------------------------------
#endif // DLIB_LAPACk_EV_H__
dlib/matrix/lapack/syevr.h 0 → 100644
View file @ 16e910c3
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment