cblas.h

// -*- C++ -*-

// ============================================= //
//  die double-Versionen der BLAS Level 1 und 2  //
// ============================================= //

#ifndef CBLAS1_H
// ============================================================================

// generate a plane rotation
void drotg( double *a, double *b, double *c, double *s );


#if 0
// generate a modified plane rotation
void drotmg( double *d1, double *d2, double *a, double b, double *param );
#endif

// apply a plane rotation
void drot( int n, double *x, int incx, double *y, int incy, double c,
	    double s );


#if 0
// apply a modified plane rotation
void drotm( int n, double *x, int incx, double *y, int incy, double *param );
#endif


// x <=> y
void dswap( int n, double *x, int incx, double *y, int incy );


// x <= a*x
void dscal( int n, double alpha, double *x, int incx );


// y <= x
void dcopy( int n, const double *x, int incx, double *y, int incy );


// y <= a*x+y
void daxpy( int n, double alpha, const double *x, int incx, double *y,
	    int incy );


// dot <= x^T*y
double ddot( int n, const double *x, int incx, const double *y, int incy );


// dnrm2 <= |x|_2
double dnrm2( int n, const double *x, int incx );


// asum <= |x|_1
double dasum( int n, const double *x, int incx );


// idamax <= first k such that |x_k| = max|x_i|
int idamax( int n, const double *x, int incx );

// ============================================================================
#endif // CBLAS1_H


#ifndef CBLAS2_H
// ============================================================================


enum MatrixTranspose { NoTranspose=0, Transpose=1, ConjugateTranspose=2 };
enum MatrixTriangle { UpperTriangle=0, LowerTriangle=1 };
enum MatrixUnitTriangular { UnitTriangular=0, NotUnitTriangular=1 };


// ============================================================================


// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
void dgemv( MatrixTranspose trans, int m, int n, double alpha,
	    const double *A, int ldA, const double *x, int incx,
	    double beta, double *y, int incy );


// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
void dgbmv( MatrixTranspose trans, int m, int n, int kl, int ku, double alpha,
	    const double *A, int ldA, const double *x, int incx, double *beta,
	    double *y, int incy );


// y <= alpha*A*x + beta*y
void dsymv( MatrixTriangle uplo, int n, double alpha, const double *A, int ldA,
	    const double *x, int incx, double beta, double *y, int incy );


// y <= alpha*A*x + beta*y
void dsbmv( MatrixTriangle uplo, int n, int k, double alpha, double *A,
	    int ldA, const double *x, int incx, double beta, double *y,
	    int *incy );


// y <= alpha*A*x + beta*y
void dspmv( MatrixTriangle uplo, int n, double alpha, const double *AP,
	    const double *x, int incx, double beta, double *y, int incy );


// x <= A*x,  x <= A^T*x
void dtrmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *A, int ldA,
	    double *x, int incx );


// x <= A*x,  x <= A^T*x
void dtbmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *A, int ldA,
	    double *x, int incx );


// x <= A*x,  x <= A^T*x
void dtpmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *AP,
	    double *x, int incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
void dtrsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *A, int ldA,
	    double *x, int incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
void dtbsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *A, int ldA,
	    double *x, int incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
void dtpsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *AP,
	    double *x, int incx );


// A <= alpha*x*y^T + A,   A-(m,n)
void dger( int m, int n, double alpha, const double *x, int incx,
	   const double *y, int incy, double *A, int ldA );


// A <= alpha*x*x^T + A
void dsyr( MatrixTriangle uplo, int n, double alpha, const double *x,
	   int incx, double *A, int ldA );


// A <= alpha*x*x^T + A
void dspr( MatrixTriangle uplo, int n, double alpha, const double *x,
	   int incx, double *AP );


// A <= alpha*x*y^T + alpha*y*x^T + A
void dsyr2( MatrixTriangle uplo, int n, double alpha, const double *x,
	    int incx, const double *y, int incy, double *A, int ldA );


// A <= alpha*x*y^T + alpha*y*x^T + A
void dspr2( MatrixTriangle uplo, int n, double alpha, const double *x,
	    int incx, const double *y, int incy, double *AP );

// ============================================================================
#endif // CBLAS2_H


#ifndef BLAS1_H
#define BLAS1_H
// ============================================================================

// generate a plane rotation
extern "C"
void drotg_( double *a, double *b, double *c, double *s );


#if 0
// generate a modified plane rotation
extern "C"
void drotmg_( double *d1, double *d2, double *a, double *b, double *param );
#endif


// apply a plane rotation
extern "C"
void drot_( int *n, double *x, int *incx, double *y, int *incy,
	    double *c, double *s );


#if 0
// apply a modified plane rotation
extern "C"
void drotm_( int *n, double *x, int *incx, double *y, int *incy,
	     double *param );
#endif


// x <=> y
extern "C"
void dswap_( const int *n, double *x, const int *incx, double *y,
	     const int *incy );

// x <= a*x
extern "C"
void dscal_( const int *n, const double *alpha, double *x, const int *incx );


// y <= x
extern "C"
void dcopy_( const int *n, const double *x, const int *incx, double *y,
	     const int *incy );


// y <= a*x+y
extern "C"
void daxpy_( const int *n, const double *alpha, const double *x,
	     const int *incx, double *y, const int *incy );


// dot <= x^T*y
extern "C"
double ddot_( const int *n, const double *x, const int *incx, const double *y,
	      const int *incy );


// dnrm2 <= |x|_2
extern "C"
double dnrm2_( const int *n, const double *x, const int *incx );


// asum <= |x|_1
extern "C"
double dasum_( const int *n, const double *x, const int *incx );


// idamax <= first k such that |x_k| = max|x_i|
extern "C"
int idamax_( const int *n, const double *x, const int *incx );


// ============================================================================
#endif // BLAS1_H



#ifndef CBLAS1_H
#define CBLAS1_H
// ============================================================================


#ifdef __linux__ // muss dnorm2 f"ur linux neu implementieren
#  include <math.h>
#endif

inline
void drotg( double *a, double *b, double *c, double *s ) {
  drotg_(a,b,c,s);
}

#if 0
inline
void drotmg( double *d1, double *d2, double *a, double b, double *param ) {
  drotmg_(d1,d2,a,&b,param);
}
#endif

inline
void drot( int n, double *x, int incx, double *y, int incy, double c,
	   double s ) {
  drot_(&n,x,&incx,y,&incy,&c,&s);
}

#if 0
inline
void drotm( int n, double *x, int incx, double *y, int incy, double *param ) {
  drotm_(&n,x,&incx,y,&incy,param);
}
#endif

inline
void dswap( int n, double *x, int incx, double *y, int incy ) {
  dswap_(&n,x,&incx,y,&incy);
}

inline
void dscal( int n, double alpha, double *x, int incx ) {
  dscal_(&n,&alpha,x,&incx);
}

inline
void dcopy( int n, const double *x, int incx, double *y, int incy ) {
  dcopy_(&n,x,&incx,y,&incy);
}

inline
void daxpy( int n, double alpha, const double *x, int incx, double *y,
	    int incy ) {
  daxpy_(&n,&alpha,x,&incx,y,&incy);
}

inline
double ddot( int n, const double *x, int incx, const double *y, int incy ) {
  return ddot_(&n,x,&incx,y,&incy);
}

inline
double dnrm2( int n, const double *x, int incx ) {
#ifdef __linux__ //  fehlerhafte Berechnung
  double d=0.;
  while ( n-- )
    d+=(*x)*(*x), x+=incx;
  return sqrt(d);
#else            // unter nicht-Linux korrekt
  return dnrm2_(&n,x,&incx);
#endif
}

inline
double dasum( int n, const double *x, int incx ) {
  return dasum_(&n,x,&incx);
}

inline
int idamax( int n, const double *x, int incx ) {
  return idamax_(&n,x,&incx);
}


// ============================================================================
#endif // CBLAS1_H


#ifndef BLAS2_H
#define BLAS2_H
// ============================================================================

// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
extern "C"
void 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 );


// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
extern "C"
void dgbmv_( const char *trans, const int *m, const int *n, const int *kl,
	     const int *ku, const double *alpha, const double *A,
	     const int *ldA, const double *x, const int *incx,
	     const double *beta, double *y, const int *incy );


// y <= alpha*A*x + beta*y
extern "C"
void dsymv_( const char *uplo, 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 );


// y <= alpha*A*x + beta*y
extern "C"
void dsbmv_( const char *uplo, const int *n, const int *k, const double *alpha,
	     const double *A, const int *ldA, const double *x, const int *incx,
	     const double *beta, double *y, const int *incy );


// y <= alpha*A*x + beta*y
extern "C"
void dspmv_( const char *uplo, const int *n, const double *alpha,
	     const double *AP, const double *x, const int *incx,
	     const double *beta, double *y, const int *incy );


// x <= A*x,  x <= A^T*x
extern "C"
void dtrmv_( const char *uplo, const char *trans, const char *diag,
	     const int *n, const double *A, const int *ldA,
	     double *x, const int *incx );


// x <= A*x,  x <= A^T*x
extern "C"
void dtbmv_( const char *uplo, const char *trans, const char *diag,
	     const int *n, const int *k, const double *A, const int *ldA,
	     double *x, const int *incx );


// x <= A*x,  x <= A^T*x
extern "C"
void dtpmv_( const char *uplo, const char *trans, const char *diag,
	    const int *n, const double *AP, double *x, const int *incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
extern "C"
void dtrsv_( const char *uplo, const char *trans, const char *diag,
	     const int *n, const double *A, const int *ldA,
	     double *x, const int *incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
extern "C"
void dtbsv_( const char *uplo, const char *trans, const char *diag,
	     const int *n, const int *k, const double *A, const int *ldA,
	     double *x, const int *incx );


// x <= A^{-1}*x,  x <= A^{-T}*x
extern "C"
void dtpsv_( const char *uplo, const char *trans, const char *diag,
	     const int *n, const double *AP, double *x, const int *incx );


// A <= alpha*x*y^T + A,   A-(m,n)
extern "C"
void 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 );


// A <= alpha*x*x^T + A
extern "C"
void dsyr_( const char *uplo, const int *n, const double *alpha,
	    const double *x, const int *incx, double *A, const int *ldA );


// A <= alpha*x*x^T + A
extern "C"
void dspr_( const char *uplo, const int *n, const double *alpha,
	    const double *x, const int *incx, double *AP );


// A <= alpha*x*y^T + alpha*y*x^T + A
extern "C"
void dsyr2_( const char *uplo, const int *n, const double *alpha,
	     const double *x, const int *incx, const double *y,
	     const int *incy, double *A, const int *ldA );


// A <= alpha*x*y^T + alpha*y*x^T + A
extern "C"
void dspr2_( const char *uplo, const int *n, const double *alpha,
	     const double *x, const int *incx, const double *y,
	     const int *incy, double *AP );

// ============================================================================
#endif // BLAS2_H


#ifndef CBLAS2_H
#define CBLAS2_H
// ============================================================================


// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
inline
void dgemv( MatrixTranspose trans, int m, int n, double alpha,
	    const double *A, int ldA, const double *x, int incx,
	    double beta, double *y, int incy ) {
  const char *T[3] = { "N", "T", 0 };
  dgemv_(T[(int)trans],&m,&n,&alpha,A,&ldA,x,&incx,&beta,y,&incy);
}


// y <= alpha*A*x + beta*y,  y <= alpha*A^T*x + beta*y,   A-(m,n)
inline
void dgbmv( MatrixTranspose trans, int m, int n, int kl, int ku, double alpha,
	    const double *A, int ldA, const double *x, int incx, double beta,
	    double *y, int incy ) {
  const char *T[3] = { "N", "T" };
  dgbmv_(T[(int)trans],&m,&n,&kl,&ku,&alpha,A,&ldA,x,&incx,&beta,y,&incy);
}

// y <= alpha*A*x + beta*y
inline
void dsymv( MatrixTriangle uplo, int n, double alpha, const double *A, int ldA,
	    const double *x, int incx, double beta, double *y, int incy ) {
  const char *UL[2] = { "U", "L" };
  dsymv_(UL[(int)uplo],&n,&alpha,A,&ldA,x,&incx,&beta,y,&incy);
}


// y <= alpha*A*x + beta*y
inline
void dsbmv( MatrixTriangle uplo, int n, int k, double alpha, double *A,
	    int ldA, const double *x, int incx, double beta, double *y,
	    int incy ) {
  const char *UL[2] = { "U", "L" };
  dsbmv_(UL[(int)uplo],&n,&k,&alpha,A,&ldA,x,&incx,&beta,y,&incy);
}


// y <= alpha*A*x + beta*y
inline
void dspmv( MatrixTriangle uplo, int n, double alpha, const double *AP,
	    const double *x, int incx, double beta, double *y, int incy ) {
  const char *UL[2] = { "U", "L" };
  dspmv_(UL[(int)uplo],&n,&alpha,AP,x,&incx,&beta,y,&incy);
}


// x <= A*x,  x <= A^T*x
inline
void dtrmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *A, int ldA,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtrmv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,A,&ldA,x,&incx);
}


// x <= A*x,  x <= A^T*x
inline
void dtbmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *A, int ldA,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtbmv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,&k,A,&ldA,x,&incx);
}


// x <= A*x,  x <= A^T*x
inline
void dtpmv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *AP,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtpmv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,AP,x,&incx);
}


// x <= A^{-1}*x,  x <= A^{-T}*x
inline
void dtrsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *A, int ldA,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtrsv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,A,&ldA,x,&incx);
}


// x <= A^{-1}*x,  x <= A^{-T}*x
inline
void dtbsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, int k, const double *A, int ldA,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtbsv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,&k,A,&ldA,x,&incx);
}


// x <= A^{-1}*x,  x <= A^{-T}*x
inline
void dtpsv( MatrixTriangle uplo, MatrixTranspose trans,
	    MatrixUnitTriangular diag, int n, const double *AP,
	    double *x, int incx ) {
  const char *UL[2] = { "U", "L" };
  const char *T[3]  = { "N", "T", 0 };
  const char *D[2]  = { "U", "N" };
  dtpsv_(UL[(int)uplo],T[(int)trans],D[(int)diag],&n,AP,x,&incx);
}


// A <= alpha*x*y^T + A,   A-(m,n)
inline
void dger( int m, int n, double alpha, const double *x, int incx,
	   const double *y, int incy, double *A, int ldA ) {
  dger_(&m,&n,&alpha,x,&incx,y,&incy,A,&ldA);
}


// A <= alpha*x*x^T + A
inline
void dsyr( MatrixTriangle uplo, int n, double alpha, const double *x,
	   int incx, double *A, int ldA ) {
  const char *UL[2] = { "U", "L" };
  dsyr_(UL[(int)uplo],&n,&alpha,x,&incx,A,&ldA);
}


// A <= alpha*x*x^T + A
inline
void dspr( MatrixTriangle uplo, int n, double alpha, const double *x,
	   int incx, double *AP ) {
  const char *UL[2] = { "U", "L" };
  dspr_(UL[(int)uplo],&n,&alpha,x,&incx,AP);
}


// A <= alpha*x*y^T + alpha*y*x^T + A
inline
void dsyr2( MatrixTriangle uplo, int n, double alpha, const double *x,
	    int incx, const double *y, int incy, double *A, int ldA ) {
  const char *UL[2] = { "U", "L" };
  dsyr2_(UL[(int)uplo],&n,&alpha,x,&incx,y,&incy,A,&ldA);
}


// A <= alpha*x*y^T + alpha*y*x^T + A
inline
void dspr2( MatrixTriangle uplo, int n, double alpha, const double *x,
	    int incx, const double *y, int incy, double *AP ) {
  const char *UL[2] = { "U", "L" };
  dspr2_(UL[(int)uplo],&n,&alpha,x,&incx,y,&incy,AP);
}


// ============================================================================


#endif // CBLAS2_H