// ------------------------------------------------------------
// lapack_cwrap.c
// Wrapping LAPACK FORTRAN-function to C-Functions
// Libraries needed:
// lapack.a blas.a and libg2c.a (if available)
//
// 26.02.2005, J.Ahrensfeld
// ------------------------------------------------------------

// ------------------------------------------------------------
// LAPACK functions
// ------------------------------------------------------------
// SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
extern
void dgesv_(int *N, int *NHRS, double *A, int *LDA,
			int *IPIV, double *B, int *LDB, int *INFO);

int dgesv(int N, int NHRS, double *A, int LDA, int *IPIV,
			double *B, int LDB)
{
	int info;

	dgesv_(&N, &NHRS, A, &LDA, IPIV, B, &LDB, &info);

	return info;
}

// ------------------------------------------------------------
// SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
extern
void dsyev_(char *JOBZ, char *UPLO, int *N, double *A, int *LDA,
		   double *W, double *WORK, int *LWORK, int *INFO);

int dsyev(char JOBZ, char UPLO, int N, double *A, int LDA,
		  double *W, double *WORK, int LWORK)
{
	int info;

	dsyev_(&JOBZ, &UPLO, &N, A, &LDA, W, WORK, &LWORK, &info);

	return info;
}

// ------------------------------------------------------------
// Extern declaration of FORTRAN routine
extern
void dgtsv_(int *Np, int *NRHSp, double *DL, double *D, double *DU,
				   double *B, int *LDBp, int *INFOp);

// C-Wrapper function
int dgtsv(int N, int NRHS, double *DL, double *D, double *DU,
       double *B, int ldb)
{
	int info;
	dgtsv_ (&N, &NRHS, DL, D, DU, B, &ldb, &info);

	return info;
}


// ------------------------------------------------------------
// SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO )
extern
void dgebrd_(int *M, int *N, double *A, int *LDA, double *D, double *E,
			double *TAUQ, double *TAUP, double *WORK, int *LWORK, int *INFO);

int dgebrd(int M, int N, double *A, int LDA, double *D, double *E,
			double *TAUQ, double *TAUP, double *WORK, int LWORK)

{
	int info;
	dgebrd_(&M, &N, A, &LDA, D, E, TAUQ, TAUP, WORK, &LWORK, &info);

	return info;
}

// ------------------------------------------------------------
// SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
//                    LDU, C, LDC, WORK, INFO )
extern
void dbdsqr_(char *UPLO, int *N, int *NCVT, int *NRU, int *NCC, double *D,
			double *E, double *VT, int *LDVT, double *U, int *LDU,
			double *C, int *LDC, double *WORK, int *INFO);

int dbdsqr(char UPLO, int N, int NCVT, int NRU, int NCC, double *D,
			double *E, double *VT, int LDVT, double *U, int LDU,
			double *C, int LDC, double *WORK)
{
	int info;
	dbdsqr_(&UPLO, &N, &NCVT, &NRU, &NCC, D, E, VT, &LDVT, U, &LDU,
			C, &LDC, WORK, &info);

	return info;
}

int dgesvd(char JOBU, char JOBVT, int M, int N, double *A, int LDA, double *S,
			double *U, int LDU, double *VT, int LDVT, double *WORK, int LWORK);

// ------------------------------------------------------------
// SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
//                    WORK, LWORK, INFO )
extern
void dgesvd_(char *JOBU, char *JOBVT, int *M, int *N, double *A, int *LDA,
			 double *S, double *U, int *LDU, double *VT, int *LDVT,
			 double *WORK, int *LWORK, int *INFO);

int dgesvd(char JOBU, char JOBVT, int M, int N, double *A, int LDA, double *S,
			double *U, int LDU, double *VT, int LDVT, double *WORK, int LWORK)
{
	int info;
	dgesvd_(&JOBU, &JOBVT, &M, &N, A, &LDA, S, U, &LDU, VT, &LDVT,
			 WORK, &LWORK, &info);


	return info;
}

// ------------------------------------------------------------
// SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
extern
void dgetri_(int *N, double *A, int *LDA, int *IPIV, double *WORK, int *LWORK, int *INFO);

int dgetri(int N, double *A, int LDA, int *IPIV, double *WORK, int LWORK)
{

	int info;
	dgetri_(&N, A, &LDA, IPIV, WORK, &LWORK, &info);

	return info;
}

// ------------------------------------------------------------
// SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO )
extern
void dpotri_(char *UPLO, int *N, double *A, int *LDA, int *INFO);

int dpotri(char UPLO, int N, double *A, int LDA)
{

	int info;
	dpotri_(&UPLO, &N, A, &LDA, &info);

	return info;
}

// ------------------------------------------------------------
// SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO )
extern
void dgecon_(char *NORM, int *N, double *A, int *LDA, double *ANORM, double *RCOND,
			double *DWORK, int *IWORK, int *INFO);

int dgecon(char NORM, int N, double *A, int LDA, double ANORM, double *RCOND,
			double *DWORK, int *IWORK)
{
	int info;
	dgecon_(&NORM, &N, A, &LDA, &ANORM, RCOND, DWORK, IWORK, &info);

	return info;
}

// ------------------------------------------------------------
// BLAS functions LEVEL 1
// ------------------------------------------------------------
// subroutine dswap(n,dx,incx,dy,incy)
// interchanges two vectors.
extern
void dswap_ (int *n, double *dx, int *incx, double *dy, int *incy);

void dswap (int n, double *dx, int incx, double *dy, int incy)
{
	dswap_ (&n, dx, &incx, dy, &incy);
}

// ------------------------------------------------------------
// subroutine dcopy(n,dx,incx,dy,incy)
// copies a vector, x, to a vector, y.
extern
void dcopy_ (int *n, double *dx, int *incx, double *dy, int *incy);

void dcopy (int n, double *dx, int incx, double *dy, int incy)
{
	dcopy_ (&n, dx, &incx, dy, &incy);
}

// ------------------------------------------------------------
// subroutine dscal(n,da,dx,incx)
// scales a vector by a constant.
extern
void dscal_ (int *n, double *da, double *dx, int *incx);

void dscal (int n, double da, double *dx, int incx)
{
	dscal_ (&n, &da, dx, &incx);
}

// ------------------------------------------------------------
// subroutine daxpy(n,da,dx,incx,dy,incy)
// constant times a vector plus a vector.
extern
void daxpy_ (int *n, double *da, double *dx, int *incx, double *dy, int *incy);

void daxpy (int n, double da, double *dx, int incx, double *dy, int incy)
{
	daxpy_ (&n, &da, dx, &incx, dy, &incy);
}

// ------------------------------------------------------------
// function ddot(n,dx,incx,dy,incy)
// forms the dot product of two vectors.
extern
double ddot_ (int *n, double *dx, int *incx, double *dy, int *incy);

double ddot (int n, double *dx, int incx, double *dy, int incy)
{
	return ddot_ (&n, dx, &incx, dy, &incy);
}

// ------------------------------------------------------------
// function DNRM2 ( N, X, INCX )
// DNRM2 returns the euclidean norm of a vector via the function
// DNRM2 := sqrt( x'*x )
extern
double dnrm2_ (int *n, double *dx, int *incx);

double dnrm2 (int n, double *dx, int incx)
{
	return dnrm2_ (&n, dx, &incx);
}

// ------------------------------------------------------------
// function dasum(n,dx,incx)
// takes the sum of the absolute values.
extern
double dasum_ (int *n, double *dx, int *incx);

double dasum (int n, double *dx, int incx)
{
	return dasum_ (&n, dx, &incx);
}

// ------------------------------------------------------------
// function idamax(n,dx,incx)
// finds the index of element having max. absolute value.
extern
int idamax_ (int *n, double *dx, int *incx);

int idamax (int n, double *dx, int incx)
{
	int i;

	i = idamax_ (&n, dx, &incx);

	if (i > 0)
		return i - 1;
	else
		return i;

}

// ------------------------------------------------------------
// BLAS functions LEVEL 2
// ------------------------------------------------------------

// SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
extern
void dgemv_(char *TRANS, int *M, int *N, double *ALPHA, double *A, int *LDA,
		   double *X, int *INCX, double *BETA, double *Y, int *INCY);

void dgemv(char TRANS, int M, int N, double ALPHA, double *A, int LDA,
		   double *X, int INCX, double BETA, double *Y, int INCY)
{

	dgemv_(&TRANS, &M, &N, &ALPHA, A, &LDA, X, &INCX, &BETA, Y, &INCY);
}

// ------------------------------------------------------------
// SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
extern void dger_(int *m,int *n, double *alpha, double *x, int *incx,
				  double *y, int *incy, double *A, int *lda);

void dger(int m,int n, double alpha, double *x, int incx,
				  double *y, int incy, double *A, int lda)
{
	dger_(&m, &n, &alpha, x, &incx, y, &incy, A, &lda);
}

// ------------------------------------------------------------
// SUBROUTINE DSYR  ( UPLO, N, ALPHA, X, INCX, A, LDA )
extern void dsyr_(char *UPLO, int *n, double *alpha, double *x, int *incx,
					double *A, int *lda);

void dsyr(char UPLO, int n, double alpha, double *x, int incx, double *A, int lda)
{
	dsyr_(&UPLO, &n, &alpha, x, &incx, A, &lda);
}

// ------------------------------------------------------------
// BLAS functions LEVEL 3
// ------------------------------------------------------------

//     SUBROUTINE DSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,
extern
void dsyrk_(char *UPLO, char *TRANS, int *N, int *K, double *ALPHA,
			double *A, int *LDA, double *BETA, double *C, int *LDC);

void dsyrk(char UPLO, char TRANS, int N, int K, double ALPHA,
			double *A, int LDA, double BETA, double *C, int LDC)
{
	dsyrk_(&UPLO, &TRANS, &N, &K, &ALPHA, A, &LDA, &BETA, C, &LDC);
}

// SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
extern
void dgemm_(char *TRANSA, char *TRANSB, int *M, int *N, int *K,	double *ALPHA,
			double *A, int *LDA, double *B, int *LDB, double *BETA, double *C, int *LDC);

void dgemm(char TRANSA, char TRANSB, int M, int N, int K, double ALPHA,
			double *A, int LDA, double *B, int LDB, double BETA, double *C, int LDC)
{

	dgemm_(&TRANSA, &TRANSB, &M, &N, &K, &ALPHA, A, &LDA, B, &LDB, &BETA, C, &LDC);

}

// SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
extern
void dtrmm_(char *SIDE, char *UPLO, char *TRANSA, char *DIAG, int *M, int *N,
			double *ALPHA, double *A, int *LDA, double *B, int *LDB);

void dtrmm(char SIDE, char UPLO, char TRANSA, char DIAG, int M, int N,
			double ALPHA, double *A, int LDA, double *B, int LDB)
{

	dtrmm_(&SIDE, &UPLO, &TRANSA, &DIAG, &M, &N, &ALPHA, A, &LDA, B, &LDB);

}

// SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
extern
void dtrsm_(char *SIDE, char *UPLO, char *TRANSA, char *DIAG, int *M, int *N,
			double *ALPHA, double *A, int *LDA, double *B, int *LDB);

void dtrsm(char SIDE, char UPLO, char TRANSA, char DIAG, int M, int N,
			double ALPHA, double *A, int LDA, double *B, int LDB)
{

	dtrsm_(&SIDE, &UPLO, &TRANSA, &DIAG, &M, &N, &ALPHA, A, &LDA, B, &LDB);

}