#
# This file contains the formal problem description for
# a subset of the LAPACK library (including some simplified versions)
#
# Content :
#              linsol (wrapper around LAPACK routine dgesv) 
#              dgesv 
#              eig    (wrapper around LAPACK routine dgeev) 
#              dgeev
#              dlacpy
##############
# linsol
#   Simplified version of dgesv
##############
@PROBLEM linsol
@FUNCTION dgesv
@LIB $(NETSOLVE_ROOT)/lib/$(NETSOLVE_ARCH)/liblapack.a
@LIB $(BLAS_LIB_LINK)
@LANGUAGE FORTRAN
@MAJOR COL
@PATH /LAPACK-wrapper/Simple/Linear_Equations/
@DESCRIPTION
Wrapper around the LAPACK routine DGESV --

Compute the solution to a real system of linear equations
  A * X = b
where A is an N-by-B matrix and X and B are N-by-NRHS matrices.

MATLAB Example : [x] = netsolve('linsol',a,b)

@INPUT 2
@OBJECT MATRIX D A
Matrix A
@OBJECT MATRIX D RHS
Right hand side

@OUTPUT 1
@OBJECT MATRIX D SOLUTION
Solution

@COMPLEXITY 2,3

@CALLINGSEQUENCE
@ARG mI0,nI0,mI1
@ARG nI1
@ARG I0
@ARG lI0
@ARG I1,O0
@ARG lI1
@CODE
extern void dgesv(int *n, int *nrhs, double *a, int *lda, int *ipiv,
                  double *b, int *ldb, int *info);

int info;
int *ipiv=NULL;

int lda, ldb;

lda = (*@mI0@ > 1) ? *@mI0@ : 1;
ldb = (*@mI0@ > 1) ? *@mI0@ : 1;

if (*@nI0@ != *@mI0@)
  return NS_PROT_DIM_MISMATCH;
if (*@mI0@ != *@mI1@)
  return NS_PROT_DIM_MISMATCH;

ipiv = (int *)malloc(sizeof(int)*(*@mI0@));

dgesv(@nI0@, @nI1@, @I0@, &lda, ipiv, @I1@, &ldb, &info);

@O0@ = @I1@;
*@mO0@ = *@mI1@;
*@nO0@ = *@nI1@;

if (info >0)
  return NS_PROT_NO_SOLUTION;
if (info <0)
  return NS_PROT_SV_FAILURE;

@END_CODE

##############
# dgesv
#   Linear system solve
##############

@PROBLEM dgesv
@FUNCTION dgesv
@LANGUAGE FORTRAN
@MAJOR COL
@PATH /LAPACK/Simple/Linear_Equations/
@DESCRIPTION
From LAPACK -

Compute the solution to a real system of linear equations
  A * X = b
where A is an N-by-B matrix and X and B are N-by-NRHS matrices.

MATLAB Example : [x y z info ] = netsolve('dgesv',a,b)

http://www.netlib.org/lapack/
@INPUT 2
@OBJECT MATRIX D a
Matrix A
@OBJECT MATRIX D b
Right hand side

@OUTPUT 4
@OBJECT MATRIX D lu
LU factors ( A = P*L*U)
@OBJECT VECTOR I ipiv
Vector of pivots (defines the P matrix)
@OBJECT MATRIX D x
Solution
@OBJECT SCALAR I info
INFO
  0  successful
  <0 error on calling ?
  >0 QR algorithm failed

@COMPLEXITY 2,3

@CALLINGSEQUENCE
@ARG mI0,nI0,mI1
@ARG nI1
@ARG I0,O0
@ARG lI0
@ARG O1
@ARG I1,O2
@ARG lI1
@ARG O3
@CODE
extern void dgesv(int *n, int *nrhs, double *a, int *lda, int *ipiv,
                  double *b, int *ldb, int *info);

int lda, ldb;

lda =ldb = (*@mI0@ > 1) ? *@mI0@ : 1;

if (*@nI0@ != *@mI0@)
  return NS_PROT_DIM_MISMATCH;
if (*@mI0@ != *@mI1@)
  return NS_PROT_DIM_MISMATCH;

@O1@ = (int *)malloc(sizeof(int)*(*@mI0@));
*@mO1@ = *@mI1@;
@O3@ = (int *)malloc(sizeof(int));

dgesv(@nI0@, @nI1@, @I0@, &lda, @O1@, @I1@, &ldb, @O3@);

@O0@ = @I0@;
*@mO0@ = *@mI0@;
*@nO0@ = *@nI0@;
@O2@ = @I1@;
*@mO2@ = *@mI1@;
*@nO2@ = *@nI1@;
@END_CODE

##############
# eig
#   Simplified version of dgeev
##############

@PROBLEM eig
@FUNCTION dgeev
@LANGUAGE FORTRAN
@MAJOR COL
@PATH /LAPACK-wrapper/Simple/Eig_and_Singular/
@DESCRIPTION
Wrapper around the LAPACK routine DGEEV --

Simplified version of DGEEV.
Computes the eigenvalues of a double precision real
matrix A. Returns two double precision real
vectors containing respectively the real parts and
the imaginary parts of the eigenvalues.

MATLAB Example : [r i ] = netsolve('eig',a)
@INPUT 1
@OBJECT MATRIX D A
Matrix A
@OUTPUT 2
@OBJECT VECTOR D R
Real parts of the eigen values
@OBJECT VECTOR D I
Imaginary parts of the eigen values

@MATLAB_MERGE 0 1

@COMPLEXITY 3,2

@CALLINGSEQUENCE
@ARG I0
@ARG nI0,mI0
@ARG lI0
@ARG O0
@ARG O1
@ARG ?
@ARG ?

@CODE
extern void dgeev(char *jobvl, char *jobvr, int *n, double *a, int *lda,
                  double *wr, double *wi, double *vl, int *ldvl, 
                  double *vr, int *ldvr, double *work, int *lwork,
                  int *info);

int info;
double *work = NULL;
double *vr,*vl;
int lwork;
char c1,c2;

if (*@mI0@ != *@nI0@)
  return NS_PROT_DIM_MISMATCH;

*@mO0@ = *@mI0@;
*@mO1@ = *@mI0@;

@O0@ = (double *)malloc(sizeof(double)*(*@mI0@));
@O1@ = (double *)malloc(sizeof(double)*(*@mI0@));
vl = NULL;
vr = NULL;

lwork = 3*(*@mI0@);

work = (double *)malloc(sizeof(double)*lwork);
c1 = 'N'; c2 = 'N';

dgeev(&c1,&c2,@mI0@,@I0@,@mI0@,@O0@,@O1@,(double *)vl,
      @mI0@,(double *)vr,@mI0@,
     (double *)work,&lwork,&info);

if (info >0)
  return NS_PROT_NO_SOLUTION;
if (info <0)
  return NS_PROT_SV_FAILURE;

@END_CODE


#
# DGEEV
#
@PROBLEM dgeev
@FUNCTION dgeev
@LANGUAGE FORTRAN
@MAJOR COL
@PATH /LAPACK/Simple/Eig_and_Singular/
@DESCRIPTION
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.
http://www.netlib.org/lapack/
@INPUT 3
@OBJECT SCALAR CHAR jobvl
JOBVL   (input) CHARACTER*1
        = 'N': left eigenvectors of A are not computed;
        = 'V': left eigenvectors of A are computed.
@OBJECT SCALAR CHAR jobvr
JOBVR   (input) CHARACTER*1
        = 'N': right eigenvectors of A are not computed;
        = 'V': right eigenvectors of A are computed.
@OBJECT MATRIX D a
A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
        On entry, the N-by-N matrix A.
@OUTPUT 6
@OBJECT MATRIX D a
A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
        On exit, A has been overwritten.
@OBJECT VECTOR D wr
WR      (output) DOUBLE PRECISION array, dimension (N)
@OBJECT VECTOR D wi
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.
@OBJECT MATRIX D vl
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).
@OBJECT MATRIX D vr
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).
@OBJECT SCALAR I info
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.
@COMPLEXITY 2,3
@CALLINGSEQUENCE
# char, jobvl
@ARG I0
# char, jobvr
@ARG I1
# int, N, size of A
@ARG nI2,mI2
# A, matrix (LDA, N)
@ARG I2,O0
# LDA
@ARG lI2,lO0
# WR, (N)
@ARG O1
# WI (N)
@ARG O2
# VL (LDVL, N)
@ARG O3
# LDVL
@ARG lO3
# VR (LDVR, N)
@ARG O4
# LDVR
@ARG lO4
# work
@ARG ?
# lwork
@ARG ?
# INFO
@ARG O5
@CODE
extern void dgeev(char *jobvl, char *jobvr, int *n, double *a, int *lda,
                  double *wr, double *wi, double *vl, int *ldvl, double *vr, 
                  int *ldvr, double *work, int *lwork, int *info);

int lda, ldvl = 1, ldvr = 1, lwork;
int mvl, mvr;
double *work;

if (*@I0@ == 'n' || *@I0@ == 'N') 
   *@I0@ = 'N';
else if (*@I0@ == 'v' || *@I0@ == 'V') 
   *@I0@ = 'V';
else
   return NS_PROT_BAD_VALUES;

if (*@I1@ == 'n' || *@I1@ == 'N') 
   *@I1@ = 'N';
else if (*@I1@ == 'v' || *@I1@ == 'V') 
   *@I1@ = 'V';
else
   return NS_PROT_BAD_VALUES;

if (*@mI2@ != *@nI2@) return NS_PROT_DIM_MISMATCH;

lda = (*@nI2@ > 1) ? *@nI2@ : 1;
if (*@I0@ == 'V') {
    ldvl = (*@nI2@ > 1) ? *@nI2@ : 1;
} 
if (*@I1@ == 'V') {
    ldvr = (*@nI2@ > 1) ? *@nI2@ : 1;
}

if (*@I0@ == 'V' || *@I1@ == 'V')
  lwork = 4 * (*@mI2@);
else
  lwork = 3 * (*@mI2@);
if (lwork < 1)
  lwork = 1;
work = (double *) malloc(sizeof(double) * lwork);

if (*@I0@ == 'V') {
   mvl =  (*@mI2@ > 1) ? *@mI2@ : 1;
} else {
   mvl = 1;
}

if (*@I1@ == 'V') {
   mvr = (*@mI2@ > 1) ? *@mI2@ : 1;
} else {
   mvr = 1;
}

@O1@ = (double *) malloc(sizeof(double) * *@mI2@);
@O2@ = (double *) malloc(sizeof(double) * *@mI2@);
@O3@ = (double *) malloc(sizeof(double) * mvl * ldvl);
@O4@ = (double *) malloc(sizeof(double) * mvr * ldvr);
@O5@ = (int *) malloc(sizeof(int));

dgeev(@I0@, @I1@, @nI2@, @I2@, &lda, @O1@, @O2@, @O3@, &ldvl,
      @O4@, &ldvr, work, &lwork, @O5@);

@O0@ = @I2@;
*@mO0@ = *@mI2@;
*@nO0@ = *@mI2@;

*@mO1@ = *@mI2@;
*@mO2@ = *@mI2@;

*@mO3@ = ldvl;
*@nO3@ = mvl;

*@mO4@ = ldvr;
*@nO4@ = mvr;

@END_CODE
#
# LAPACK Auxiliary routines
# 
# This file includes problem specifications for the following
# auxiliary routines:
#
# DLACPY
#

@PROBLEM dlacpy

@FUNCTION dlacpy

@LANGUAGE FORTRAN

@MAJOR COL

@PATH /LAPACK/Auxiliary/

@DESCRIPTION
DLACPY copies an M-by-N matrix B to A

    A = B

You can specify "U" or "L" if you want either the
upper or lower triangle copied only.

@INPUT 3

@OBJECT SCALAR CHAR uplo
uplo	(input) CHARACTER*1
	Specifies which part of the matrix to copy:
	= 'U':  Upper triangle only
	= 'L':  Lower triangle only
	otherwise:  All of the matrix

@OBJECT MATRIX D b
B	(input)	DOUBLE PRECISION array, source of data

@OBJECT MATRIX D a
A	(output) DOUBLE PRECISION array, destination for data

@OUTPUT 1

@OBJECT MATRIX D a
A	(output) DOUBLE PRECISION array, destination for data

@COMPLEXITY 2,2

@CALLINGSEQUENCE
@ARG I0
@ARG O0,I2
@ARG I1
@ARG mI1,mI2,lI1,lI2
@ARG nI1,nI2

@CODE
extern void dlacpy(const char * uplo, int *m, int *n, 
			double * a, int *lda, double * b, int *ldb);

dlacpy(@I0@, @mI1@, @nI1@, @I1@, @mI1@, @I2@, @mI1@);

@O0@ = @I1@;
*@mO0@ = *@mI1@;
*@nO0@ = *@nI1@;

@END_CODE

