*** empty log message ***
This commit is contained in:
jiri
231
noncblas.cc
231
noncblas.cc
@@ -20,106 +20,186 @@
|
||||
#include "noncblas.h"
|
||||
#include "laerror.h"
|
||||
#include "mat.h"
|
||||
#include "fortran.h"
|
||||
|
||||
|
||||
#ifdef FORTRAN_
|
||||
#define FORNAME(x) x##_
|
||||
#else
|
||||
#define FORNAME(x) x
|
||||
#endif
|
||||
|
||||
#ifdef NONCBLAS
|
||||
//Level 1 - straightforward wrappers
|
||||
|
||||
extern "C" double FORNAME(ddot) (const int *n, const double *x, const int *incx, const double *y, const int *incy);
|
||||
extern "C" double FORNAME(ddot) (const FINT *n, const double *x, const FINT *incx, const double *y, const FINT *incy);
|
||||
double cblas_ddot(const int N, const double *X, const int incX,
|
||||
const double *Y, const int incY)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
return FORNAME(ddot)(&ntmp,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
return FORNAME(ddot)(&N,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(dscal) (const int *n, const double *a, double *x, const int *incx);
|
||||
extern "C" void FORNAME(dscal) (const FINT *n, const double *a, double *x, const FINT *incx);
|
||||
void cblas_dscal(const int N, const double alpha, double *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
FORNAME(dscal) (&ntmp,&alpha,X,&incxtmp);
|
||||
#else
|
||||
FORNAME(dscal) (&N,&alpha,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(dcopy) (const int *n, const double *x, const int *incx, double *y, const int *incy);
|
||||
extern "C" void FORNAME(dcopy) (const FINT *n, const double *x, const FINT *incx, double *y, const FINT *incy);
|
||||
void cblas_dcopy(const int N, const double *X, const int incX,
|
||||
double *Y, const int incY)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(dcopy) (&ntmp,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(dcopy) (&N,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(daxpy) (const int *n, const double *a, const double *x, const int *incx, double *y, const int *incy);
|
||||
extern "C" void FORNAME(daxpy) (const FINT *n, const double *a, const double *x, const FINT *incx, double *y, const FINT *incy);
|
||||
void cblas_daxpy(const int N, const double alpha, const double *X,
|
||||
const int incX, double *Y, const int incY)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(daxpy) (&ntmp,&alpha,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(daxpy) (&N,&alpha,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" double FORNAME(dnrm2) (const int *n, const double *x, const int *incx);
|
||||
extern "C" double FORNAME(dnrm2) (const FINT *n, const double *x, const FINT *incx);
|
||||
double cblas_dnrm2(const int N, const double *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
return FORNAME(dnrm2) (&ntmp,X,&incxtmp);
|
||||
#else
|
||||
return FORNAME(dnrm2) (&N,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" double FORNAME(dasum) (const int *n, const double *x, const int *incx);
|
||||
extern "C" double FORNAME(dasum) (const FINT *n, const double *x, const FINT *incx);
|
||||
double cblas_dasum(const int N, const double *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
return FORNAME(dasum) (&ntmp,X,&incxtmp);
|
||||
#else
|
||||
return FORNAME(dasum) (&N,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(zcopy) (const int *n, const void *x, const int *incx, void *y, const int *incy);
|
||||
extern "C" void FORNAME(zcopy) (const FINT *n, const void *x, const FINT *incx, void *y, const FINT *incy);
|
||||
void cblas_zcopy(const int N, const void *X, const int incX,
|
||||
void *Y, const int incY)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zcopy) (&ntmp,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(zcopy) (&N,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(zaxpy) (const int *n, const void *a, const void *x, const int *incx, void *y, const int *incy);
|
||||
extern "C" void FORNAME(zaxpy) (const FINT *n, const void *a, const void *x, const FINT *incx, void *y, const FINT *incy);
|
||||
void cblas_zaxpy(const int N, const void *alpha, const void *X,
|
||||
const int incX, void *Y, const int incY)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zaxpy) (&ntmp,alpha,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(zaxpy) (&N,alpha,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(zscal) (const int *n, const void *a, void *x, const int *incx);
|
||||
extern "C" void FORNAME(zscal) (const FINT *n, const void *a, void *x, const FINT *incx);
|
||||
void cblas_zscal(const int N, const void *alpha, void *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
FORNAME(zscal)(&ntmp,alpha,X,&incxtmp);
|
||||
#else
|
||||
FORNAME(zscal)(&N,alpha,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(zdscal) (const int *n, const double *a, void *x, const int *incx);
|
||||
extern "C" void FORNAME(zdscal) (const FINT *n, const double *a, void *x, const FINT *incx);
|
||||
void cblas_zdscal(const int N, const double alpha, void *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
FORNAME(zdscal)(&ntmp,&alpha,X,&incxtmp);
|
||||
#else
|
||||
FORNAME(zdscal)(&N,&alpha,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
extern "C" double FORNAME(dznrm2) (const int *n, const void *x, const int *incx);
|
||||
extern "C" double FORNAME(dznrm2) (const FINT *n, const void *x, const FINT *incx);
|
||||
double cblas_dznrm2(const int N, const void *X, const int incX)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
return FORNAME(dznrm2) (&ntmp,X,&incxtmp);
|
||||
#else
|
||||
return FORNAME(dznrm2) (&N,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
//the following ones are f2c-compatible, but is it truly portable???
|
||||
|
||||
extern "C" void FORNAME(zdotu) (void *retval, const int *n, const void *x, const int *incx, const void *y, const int *incy);
|
||||
extern "C" void FORNAME(zdotu) (void *retval, const FINT *n, const void *x, const FINT *incx, const void *y, const FINT *incy);
|
||||
|
||||
void cblas_zdotu_sub(const int N, const void *X, const int incX,
|
||||
const void *Y, const int incY, void *dotu)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zdotu) (dotu,&ntmp,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(zdotu) (dotu,&N,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
extern "C" void FORNAME(zdotc) (void *retval, const int *n, const void *x, const int *incx, const void *y, const int *incy);
|
||||
extern "C" void FORNAME(zdotc) (void *retval, const FINT *n, const void *x, const FINT *incx, const void *y, const FINT *incy);
|
||||
void cblas_zdotc_sub(const int N, const void *X, const int incX,
|
||||
const void *Y, const int incY, void *dotc)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zdotc) (dotc,&ntmp,X,&incxtmp,Y,&incytmp);
|
||||
#else
|
||||
FORNAME(zdotc) (dotc,&N,X,&incX,Y,&incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
@@ -129,7 +209,7 @@ FORNAME(zdotc) (dotc,&N,X,&incX,Y,&incY);
|
||||
//enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113, AtlasConj=114};
|
||||
|
||||
|
||||
extern "C" void FORNAME(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);
|
||||
extern "C" void FORNAME(dspmv) (const char *uplo, const FINT *n, const double *alpha, const double *ap, const double *x, const FINT *incx, const double *beta, double *y, const FINT *incy);
|
||||
void cblas_dspmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
const int N, const double alpha, const double *Ap,
|
||||
const double *X, const int incX,
|
||||
@@ -137,11 +217,18 @@ void cblas_dspmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
{
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
if(Uplo!=CblasLower) LA::laerror("CblasLower uplo asserted");
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(dspmv) ("U",&ntmp, &alpha, Ap, X, &incxtmp, &beta, Y, &incytmp);
|
||||
#else
|
||||
FORNAME(dspmv) ("U",&N, &alpha, Ap, X, &incX, &beta, Y, &incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
extern "C" void FORNAME(zhpmv) (const char *uplo, const int *n, const void *alpha, const void *ap, const void *x, const int *incx, const void *beta, void *y, const int *incy);
|
||||
extern "C" void FORNAME(zhpmv) (const char *uplo, const FINT *n, const void *alpha, const void *ap, const void *x, const FINT *incx, const void *beta, void *y, const FINT *incy);
|
||||
void cblas_zhpmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
const int N, const void *alpha, const void *Ap,
|
||||
const void *X, const int incX,
|
||||
@@ -149,20 +236,36 @@ void cblas_zhpmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
{
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
if(Uplo!=CblasLower) LA::laerror("CblasLower uplo asserted");
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zhpmv) ("U",&ntmp, alpha, Ap, X, &incxtmp, beta, Y, &incytmp);
|
||||
#else
|
||||
FORNAME(zhpmv) ("U",&N, alpha, Ap, X, &incX, beta, Y, &incY);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
//Level 2 and Level 3 on general matrices - take into account the transposed storage of matrices in Fortran and C
|
||||
|
||||
extern "C" void FORNAME(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);
|
||||
extern "C" void FORNAME(dger) (const FINT *m, const FINT *n, const double *alpha, const double *x, const FINT *incx, const double *y, const FINT *incy, double *a, const FINT *lda);
|
||||
void cblas_dger(const enum CBLAS_ORDER Order, 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)
|
||||
{
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
//swap m-n, y-x
|
||||
#ifdef FORINT
|
||||
const FINT mtmp=M;
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
const FINT ldatmp=lda;
|
||||
FORNAME(dger) (&ntmp, &mtmp, &alpha, Y, &incytmp, X, &incxtmp, A, &ldatmp);
|
||||
#else
|
||||
FORNAME(dger) (&N, &M, &alpha, Y, &incY, X, &incX, A, &lda);
|
||||
#endif
|
||||
}
|
||||
|
||||
void cblas_zgerc(const enum CBLAS_ORDER Order, const int M, const int N,
|
||||
@@ -179,7 +282,7 @@ void cblas_zgeru(const enum CBLAS_ORDER Order, const int M, const int N,
|
||||
LA::laerror("cblas_zgeru cannot be simply converted to fortran order");
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(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);
|
||||
extern "C" void FORNAME(dgemm) (const char *transa, const char *transb, const FINT *m, const FINT *n, const FINT *k, const double *alpha, const double *a, const FINT *lda, const double *b, const FINT *ldb, const double *beta, double *c, const FINT *ldc);
|
||||
void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
|
||||
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
|
||||
const int K, const double alpha, const double *A,
|
||||
@@ -188,11 +291,22 @@ void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA
|
||||
{
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
//swap a-b, m-n
|
||||
#ifdef FORINT
|
||||
const FINT mtmp=M;
|
||||
const FINT ntmp=N;
|
||||
const FINT ktmp=K;
|
||||
const FINT ldatmp=lda;
|
||||
const FINT ldbtmp=ldb;
|
||||
const FINT ldctmp=ldc;
|
||||
FORNAME(dgemm) (TransB==CblasNoTrans?"N":"T", TransA==CblasNoTrans?"N":"T",
|
||||
&ntmp, &mtmp, &ktmp, &alpha, B, &ldbtmp, A, &ldatmp, &beta, C, &ldctmp);
|
||||
#else
|
||||
FORNAME(dgemm) (TransB==CblasNoTrans?"N":"T", TransA==CblasNoTrans?"N":"T",
|
||||
&N, &M, &K, &alpha, B, &ldb, A, &lda, &beta, C, &ldc);
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" void FORNAME(zgemm) (const char *transa, const char *transb, const int *m, const int *n, const int *k, const void *alpha, const void *a, const int *lda, const void *b, const int *ldb, const void *beta, void *c, const int *ldc);
|
||||
extern "C" void FORNAME(zgemm) (const char *transa, const char *transb, const FINT *m, const FINT *n, const FINT *k, const void *alpha, const void *a, const FINT *lda, const void *b, const FINT *ldb, const void *beta, void *c, const FINT *ldc);
|
||||
void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
|
||||
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
|
||||
const int K, const void *alpha, const void *A,
|
||||
@@ -201,26 +315,49 @@ void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA
|
||||
{
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
//swap a-b, m-n
|
||||
#ifdef FORINT
|
||||
const FINT mtmp=M;
|
||||
const FINT ntmp=N;
|
||||
const FINT ktmp=K;
|
||||
const FINT ldatmp=lda;
|
||||
const FINT ldbtmp=ldb;
|
||||
const FINT ldctmp=ldc;
|
||||
FORNAME(zgemm) ( TransB==CblasConjTrans?"C":(TransB==CblasNoTrans?"N":"T"),
|
||||
TransA==CblasConjTrans?"C":(TransB==CblasNoTrans?"N":"T"),
|
||||
&ntmp, &mtmp, &ktmp, alpha, B, &ldbtmp, A, &ldatmp, beta, C, &ldctmp);
|
||||
#else
|
||||
FORNAME(zgemm) ( TransB==CblasConjTrans?"C":(TransB==CblasNoTrans?"N":"T"),
|
||||
TransA==CblasConjTrans?"C":(TransB==CblasNoTrans?"N":"T"),
|
||||
&N, &M, &K, alpha, B, &ldb, A, &lda, beta, C, &ldc);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
extern "C" void FORNAME(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);
|
||||
extern "C" void FORNAME(dgemv) (const char *TRANS, const FINT *M, const FINT *N, const double *ALPHA, const double *A, const FINT *LDA, const double *X, const FINT *INCX, const double *BETA, double *Y, const FINT *INCY);
|
||||
void cblas_dgemv(const enum CBLAS_ORDER Order,
|
||||
const enum CBLAS_TRANSPOSE TransA, 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)
|
||||
{
|
||||
#ifdef FORINT
|
||||
const FINT mtmp=M;
|
||||
const FINT ntmp=N;
|
||||
const FINT ldatmp=lda;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
if(Order!=CblasRowMajor) FORNAME(dgemv) (TransA==CblasNoTrans?"N":"T", &ntmp, &mtmp, &alpha, A, &ldatmp, X, &incxtmp, &beta, Y, &incytmp );
|
||||
//swap n-m and toggle transposition
|
||||
else FORNAME(dgemv) (TransA==CblasNoTrans?"T":"N", &ntmp, &mtmp, &alpha, A, &ldatmp, X, &incxtmp, &beta, Y, &incytmp );
|
||||
#else
|
||||
if(Order!=CblasRowMajor) FORNAME(dgemv) (TransA==CblasNoTrans?"N":"T", &N, &M, &alpha, A, &lda, X, &incX, &beta, Y, &incY );
|
||||
//swap n-m and toggle transposition
|
||||
else FORNAME(dgemv) (TransA==CblasNoTrans?"T":"N", &N, &M, &alpha, A, &lda, X, &incX, &beta, Y, &incY );
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
extern "C" void FORNAME(zgemv) (const char *TRANS, const int *M, const int *N, const void *ALPHA, const void *A, const int *LDA, const void *X, const int *INCX, const void *BETA, void *Y, const int *INCY);
|
||||
extern "C" void FORNAME(zgemv) (const char *TRANS, const FINT *M, const FINT *N, const void *ALPHA, const void *A, const FINT *LDA, const void *X, const FINT *INCX, const void *BETA, void *Y, const FINT *INCY);
|
||||
void cblas_zgemv(const enum CBLAS_ORDER Order,
|
||||
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
|
||||
const void *alpha, const void *A, const int lda,
|
||||
@@ -230,14 +367,29 @@ void cblas_zgemv(const enum CBLAS_ORDER Order,
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
if(TransA == CblasConjTrans) LA::laerror("zgemv with CblasConjTrans not supportted");
|
||||
//swap n-m and toggle transposition
|
||||
#ifdef FORINT
|
||||
const FINT mtmp=M;
|
||||
const FINT ntmp=N;
|
||||
const FINT ldatmp=lda;
|
||||
const FINT incxtmp=incX;
|
||||
const FINT incytmp=incY;
|
||||
FORNAME(zgemv) (TransA==CblasNoTrans?"T":"N", &ntmp, &mtmp, alpha, A, &ldatmp, X, &incxtmp, beta, Y, &incytmp );
|
||||
#else
|
||||
FORNAME(zgemv) (TransA==CblasNoTrans?"T":"N", &N, &M, alpha, A, &lda, X, &incX, beta, Y, &incY );
|
||||
#endif
|
||||
}
|
||||
|
||||
extern "C" int FORNAME(idamax) (const int *N, const double *DX, const int *INCX);
|
||||
extern "C" FINT FORNAME(idamax) (const FINT *N, const double *DX, const FINT *INCX);
|
||||
|
||||
CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX)
|
||||
{
|
||||
return FORNAME(idamax)(&N,X,&incX);
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT incxtmp=incX;
|
||||
return (CBLAS_INDEX)FORNAME(idamax)(&ntmp,X,&incxtmp);
|
||||
#else
|
||||
return (CBLAS_INDEX)FORNAME(idamax)(&N,X,&incX);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
@@ -246,21 +398,38 @@ return FORNAME(idamax)(&N,X,&incX);
|
||||
#ifdef NONCLAPACK
|
||||
//clapack_dgesv
|
||||
//allocate auxiliary storage and transpose input and output quantities to fortran/C order
|
||||
extern "C" void FORNAME(dgesv) (const int *N, const int *NRHS, double *A, const int *LDA, int *IPIV, double *B, const int *LDB, int *INFO);
|
||||
extern "C" void FORNAME(dgesv) (const FINT *N, const FINT *NRHS, double *A, const FINT *LDA, FINT *IPIV, double *B, const FINT *LDB, FINT *INFO);
|
||||
|
||||
int clapack_dgesv(const enum CBLAS_ORDER Order, const int N, const int NRHS,
|
||||
double *A, const int lda, int *ipiv,
|
||||
double *B, const int ldb)
|
||||
{
|
||||
int INFO=0;
|
||||
FINT INFO=0;
|
||||
if(Order!=CblasRowMajor) LA::laerror("CblasRowMajor order asserted");
|
||||
//B should be in the same physical order, just transpose A in place and the LU result on output
|
||||
for(int i=1; i<N; ++i) for(int j=0; j<i; ++j) {double t=A[j*lda+i]; A[j*lda+i]=A[i*lda+j]; A[i*lda+j]=t;}
|
||||
#ifdef FORINT
|
||||
const FINT ntmp=N;
|
||||
const FINT nrhstmp=NRHS;
|
||||
const FINT ldatmp=lda;
|
||||
const FINT ldbtmp=ldb;
|
||||
FINT ipivtmp=*ipiv;
|
||||
FORNAME(dgesv) (&ntmp,&nrhstmp,A,&ldatmp,&ipivtmp,B,&ldbtmp,&INFO);
|
||||
#else
|
||||
FORNAME(dgesv) (&N,&NRHS,A,&lda,ipiv,B,&ldb,&INFO);
|
||||
#endif
|
||||
for(int i=1; i<N; ++i) for(int j=0; j<i; ++j) {double t=A[j*lda+i]; A[j*lda+i]=A[i*lda+j]; A[i*lda+j]=t;}
|
||||
return INFO;
|
||||
return (int)INFO;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
void cblas_dswap(const int N, double *X, const int incX,
|
||||
double *Y, const int incY){
|
||||
LA::laerror("cblas_dswap is not available... (-DNONCBLAS)");
|
||||
}
|
||||
|
||||
void cblas_zswap(const int N, void *X, const int incX,
|
||||
void *Y, const int incY){
|
||||
LA::laerror("cblas_zswap is not available... (-DNONCBLAS)");
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user