/* ------------------------------------------------------------------------------- */
double
residError (const MAT * A, double *x, const double *b, const double *z)
{
int i;
ptrdiff_t mBlas = A->m, nBlas = A->n, incx = 1, incy = 1;
double dbl_one = 1, minus_one = -1;
double *Ax = (double *) malloc (A->m * sizeof (double));
memcpy (Ax, b, A->m * sizeof (double)); // Ax = b;
for (i = 0; i < A->m; i++)
Ax[i] -= z[i];
// Ax = (b - z);
DGEMV ("N", &mBlas, &nBlas, &dbl_one, A->val, &mBlas, x, &incx, &minus_one,
Ax, &incy);
// Ax = A * x - b + z;
free (Ax);
return DNRM2 (&mBlas, Ax, &incx) / DNRM2 (&nBlas, x, &incx);
}
void
F77_NAME(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)
{
DGEMV(trans, m, n, alpha, a, lda, x, incx, beta, y, incy);
}
void GEMV<double>(const char* transA,
const int m , const int n,
const double& a1 , const double* A, const int ldA,
const double* x, const int incX,
const double& a2 , double* y, const int incY)
{
ASSERT((transA[0] == 'N') || (transA[0] == 'T'));
DGEMV(F77_CHARACTER(transA[0]),
&m, &n, &a1, A, &ldA, x, &incX, &a2, y, &incY);
}
int
main()
{
int i, j;
DGEMV('N', 3, 3, 1.0, m, 3, x, 1, 0.0, y, 1);
for (i=0; i<3; ++i) {
printf( "%5.1f\n", y[i] );
}
return 0;
}
void ProtoMol::Lapack::dgemv(char *transA, int *m, int *n, double *alpha,
double *A, int *lda, double *x, int *incx,
double *beta, double *Y, int *incY) {
FAHCheckIn();
#if defined(HAVE_LAPACK)
dgemv_(transA, m, n, alpha, A, lda, x, incx, beta, Y, incY);
#elif defined(HAVE_SIMTK_LAPACK)
dgemv_(*transA, *m, *n, *alpha, A, *lda, x, *incx, *beta, Y, *incY, 1);
#elif defined(HAVE_MKL_LAPACK)
DGEMV(transA, m, n, alpha, A, lda, x, incx, beta, Y, incY);
#else
THROW(std::string(__func__) + " not supported");
#endif
}
void IpBlasDgemv(bool trans, Index nRows, Index nCols, Number alpha,
const Number* A, Index ldA, const Number* x,
Index incX, Number beta, Number* y, Index incY)
{
ipfint M=nCols, N=nRows, LDA=ldA, INCX=incX, INCY=incY;
char TRANS;
if (trans) {
TRANS = 'T';
}
else {
TRANS = 'N';
}
DGEMV(&TRANS, &M, &N, &alpha, A, &LDA, x,
&INCX, &beta, y, &INCY, 1);
}
void mexFunction(int nargout, mxArray *argout[], int nargin, const mxArray *argin[])
{
double tol;
double *A, *b, *L, *x, *u, *ut, *v, *vt, *d, *z;
double beta, alpha, normr;
double c, s, phibar, phi, nn;
double thet, rhot, rho;
double mbeta;
double *resvec, *xvec, *Atr, *r;
long m, n;
long maxit, it, i;
long int_zero = 0;
long int_one = 1;
double dbl_one = 1.0;
double dbl_mone = -1.0;
double dbl_zero = 0.0;
A = mxGetPr(argin[0]);
b = mxGetPr(argin[1]);
L = mxIsEmpty(argin[2]) ? NULL : mxGetPr(argin[2]);
m = mxGetM(argin[0]);
n = mxGetN(argin[0]);
tol = mxGetScalar(argin[3]) * DNRM2(&m, b, &int_one);
maxit = (int)mxGetScalar(argin[4]);
u = malloc(m * sizeof(double));
ut = malloc(m * sizeof(double));
v = malloc(n * sizeof(double));
vt = malloc(n * sizeof(double));
d = malloc(n * sizeof(double));
z = malloc(n * sizeof(double));
argout[0] = mxCreateDoubleMatrix(n, 1, mxREAL);
x = mxGetPr(argout[0]);
if (nargout > 2) {
argout[2] = mxCreateDoubleMatrix(maxit+1, 1, mxREAL);
resvec = mxGetPr(argout[2]);
argout[3] = mxCreateDoubleMatrix(maxit+1, 1, mxREAL);
xvec = mxGetPr(argout[3]);
r = malloc(m * sizeof(double));
memcpy(r, b, m * sizeof(double));
resvec[0] = DNRM2(&m, r, &int_one);
xvec[0] = DNRM2(&n, x, &int_one);
}
memset(x, 0, n * sizeof(double));
memset(d, 0, n * sizeof(double));
memcpy(u, b, m * sizeof(double));
if (L != NULL)
DTRSV("L", "N", "Not Unit", &m, L, &m, u, &int_one);
beta = DNRM2(&m, u, &int_one);
normr = beta;
scale(u, m, 1/beta);
c = 1; s = 0; phibar = beta;
memcpy(z, u, m * sizeof(double));
if (L != NULL)
DTRSV("L", "T", "Not Unit", &m, L, &m, z, &int_one);
DGEMV("T", &m, &n, &dbl_one, A, &m, z, &int_one, &dbl_zero, v, &int_one);
alpha = DNRM2(&n, v, &int_one);
scale(v, n, 1/alpha);
it = 0;
while (it < maxit) {
DGEMV("N", &m, &n, &dbl_one, A, &m, v, &int_one, &dbl_zero, ut, &int_one);
if (L != NULL)
DTRSV("L", "N", "Not Unit", &m, L, &m, ut, &int_one);
for (i = 0; i < m; i++)
u[i] = ut[i] - alpha * u[i];
beta = DNRM2(&m, u, &int_one);
scale(u, m, 1/beta);
thet = - s * alpha;
rhot = c * alpha;
rho = sqrt(rhot * rhot + beta * beta);
c = rhot / rho;
s = - beta / rho;
phi = c * phibar;
phibar = s * phibar;
for (i = 0; i < n; i++) {
d[i] = (v[i] - thet * d[i]) / rho;
x[i] = x[i] + phi * d[i];
}
it++;
if (nargout > 2) {
memcpy(r, b, m * sizeof(double));
DGEMV("N", &m, &n, &dbl_mone, A, &m, x, &int_one, &dbl_one, r, &int_one);
resvec[it] = DNRM2(&m, r, &int_one);
xvec[it] = DNRM2(&n, x, &int_one);
}
normr = fabs(s) * normr;
if (normr < tol)
break;
mbeta = -beta;
memcpy(z, u, m * sizeof(double));
if (L != NULL)
DTRSV("L", "T", "Not Unit", &m, L, &m, z, &int_one);
DGEMV("T", &m, &n, &dbl_one, A, &m, z, &int_one, &mbeta, v, &int_one);
alpha = DNRM2(&n, v, &int_one);
scale(v, n, 1/alpha);
}
if (nargout > 2){
mxSetM(argout[2] , it + 1);
mxSetM(argout[3] , it + 1);
}
if (nargout > 1)
argout[1] = mxCreateScalarDouble(it);
if (nn > tol)
mexPrintf("dense_lsqr: did not converge\n");
else
mexPrintf("dense_lsqr: converged at iteration %d\n", it);
free(u);
free(ut);
free(v);
free(d);
free(z);
if (nargout > 2)
free(r);
}
