STK_lapack_Util.h

Go to the documentation of this file.

/*--------------------------------------------------------------------*/
/*     Copyright (C) 2004-2016  Serge Iovleff, Université Lille 1, Inria
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as
    published by the Free Software Foundation; either version 2 of the
    License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.
 
    You should have received a copy of the GNU Lesser General Public
    License along with this program; if not, write to the
    Free Software Foundation, Inc.,
    59 Temple Place,
    Suite 330,
    Boston, MA 02111-1307
    USA
 
    Contact : S..._Dot_I..._At_stkpp_Dot_org (see copyright for ...)
*/
 
/*
 * Project:  stkpp::Algebra
 * created on: 10 avr. 2015
 * Author:   iovleff, S..._Dot_I..._At_stkpp_Dot_org (see copyright for ...)
 **/
 
#ifndef STK_LAPACK_UTIL_H
#define STK_LAPACK_UTIL_H
 
#ifdef STKUSELAPACK
 
extern "C"
{
int ilaenv_(int *, char *, char *, int *, int *,int *, int *);
 
#ifdef STKREALAREFLOAT
 
void sgesdd_( char *jobz, int *M, int *N, float *A, int *lda, float *S, float *U, int* ldu
            , float *vt, int *ldvt, float *work, int *lWork, int *iwork, int *info);
extern void sgeqrf_(int* M, int* N, float* A, int* lda, float* TAU, float* work, int* lWork, int* info );
extern void ssyevr_( char *, char *, char *, int *, float *, int *, float *,
                     float *, int *, int *, float *, int *, float *, float *, int *,
                    int *, float *, int *, int *, int *, int *);
extern int sgelsd_( int *m, int *n, int *nrhs
                  , float *a, int *lda, float *b, int *ldb, float *s, float *rcond
                  , int *rank, float *work, int *lWork
                  , int *iwork, int *info);
 
#else /* double */
 
void dgesdd_( char *jobz, int *M, int *N, double *A, int *lda, double *S, double *U, int* ldu
            , double *vt, int *ldvt, double *work, int *lWork, int *iwork, int *info);
extern void dgeqrf_(int* M, int* N, double* A, int* lda, double* TAU, double* work, int* lWork, int* info );
extern void dsyevr_( char *, char *, char *, int *, double *, int *, double *,
                     double *, int *, int *, double *, int *, double *, double *, int *,
                    int *, double *, int *, int *, int *, int *);
extern int dgelsd_( int *m, int *n, int *nrhs
                  , double *a, int *lda, double *b, int *ldb, double *s, double *rcond
                  , int *rank, double *work, int *lWork
                  , int *iwork, int *info);
 
#endif
 
} // extern "C"
 
#endif // STKUSELAPACK
 
namespace STK
{
namespace lapack
{
inline int gelsd( int m, int n, int nrhs
                , Real * a, int lda
                , Real * b, int ldb
                , Real * s
                , Real *rcond, int *rank
                , Real *work, int lWork, int* iwork)
{
  int info = 1;
#ifdef STKUSELAPACK
#ifdef STKREALAREFLOAT
  sgelsd_( &m, &n, &nrhs, a, &lda, b, &ldb, s, rcond, rank, work, &lWork, iwork, &info);
#else
  dgelsd_( &m, &n, &nrhs, a, &lda, b, &ldb, s, rcond, rank, work, &lWork, iwork, &info);
#endif
#endif
  return info;
}
 
inline int geqrf(int m, int n, Real* a, int lda, Real* tau, Real *work, int lWork)
{
  int info = 1;
 
#ifdef STKUSELAPACK
#ifdef STKREALAREFLOAT
  sgeqrf_(&m, &n, a, &lda, tau, work, &lWork, &info);
#else
  dgeqrf_(&m, &n, a, &lda, tau, work, &lWork, &info);
#endif
#endif
 
  return info;
}
 
inline int gesdd( char jobz, int m, int n, Real *a, int lda
                , Real *s, Real *u, int ldu, Real *vt, int ldvt
                , Real *work, int lWork, int *iWork
                )
{
  int info = 1;
#ifdef STKUSELAPACK
#ifdef STKREALAREFLOAT
  sgesdd_( &jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lWork, iWork, &info);
#else
  dgesdd_( &jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lWork, iWork, &info);
#endif
#endif
  return info;
}
 
inline int syevr( char jobz, char range, char uplo
                , int n, Real* a, int lda
                , Real vl, Real vu, int il, int iu
                , Real abstol, int *m, Real *w
                , Real *z, int ldz, int *isuppz
                , Real *work, int lWork, int *iwork, int liwork
                )
{
  int info = 0;
#ifdef STKUSELAPACK
#ifdef STKREALAREFLOAT
  ssyevr_(&jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il,
          &iu, &abstol, m, w, z, &ldz, isuppz, work,
          &lWork, iwork, &liwork, &info);
#else
  dsyevr_(&jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il,
          &iu, &abstol, m, w, z, &ldz, isuppz, work,
          &lWork, iwork, &liwork, &info);
#endif
#endif
  return info;
}
 
} // namespace lapack
 
} // namespace STK
 
 
#endif /* STK_LAPACK_UTIL_H */