CAMLprim value c_densematrix_geqrf(value va, value vbeta, value vwork)
{
CAMLparam3(va, vbeta, vwork);
DenseGEQRF(DLSMAT(va), REAL_ARRAY(vbeta), REAL_ARRAY(vwork));
CAMLreturn (Val_unit);
}
static int cpDenseProjSetup(CPodeMem cp_mem, N_Vector y, N_Vector cy,
N_Vector c_tmp1, N_Vector c_tmp2, N_Vector s_tmp1)
{
long int ier;
CPDlsProjMem cpdlsP_mem;
realtype **g_mat, *col_i, *s_tmpd;
long int i, j, k;
int retval;
cpdlsP_mem = (CPDlsProjMem) lmemP;
g_mat = G->cols;
/*
* Initialize Jacobian matrix to 0 and call Jacobian function
* G will contain the Jacobian transposed.
*/
DenseZero(G);
retval = jacP(nc, ny, tn, y, cy, G, JP_data, c_tmp1, c_tmp2);
njeP++;
if (retval < 0) {
cpProcessError(cp_mem, CPDIRECT_JACFUNC_UNRECVR, "CPDENSE", "cpDenseProjSetup", MSGD_JACFUNC_FAILED);
return(-1);
} else if (retval > 0) {
return(1);
}
/* Save Jacobian before factorization for possible use by lmultP */
DenseCopy(G, savedG);
/* Factorize G, depending on ftype */
switch (ftype) {
case CPDIRECT_LU:
/*
* LU factorization of G^T
*
* P*G^T = | U1^T | * L^T
* | U2^T |
*
* After factorization, P is encoded in pivotsP and
* G^T is overwritten with U1 (nc by nc unit upper triangular),
* U2 ( nc by ny-nc rectangular), and L (nc by nc lower triangular).
*
* Return 1 if factorization failed.
*/
ier = DenseGETRF(G, pivotsP);
if (ier > 0) return(1);
/*
* Build S = U1^{-1} * U2 (in place, S overwrites U2)
* For each row j of G, j = nc,...,ny-1, perform
* a backward substitution (row version).
*
* After this step, G^T contains U1, S, and L.
*/
for (j=nc; j<ny; j++) {
for (i=nc-2; i>=0; i--) {
col_i = g_mat[i];
for (k=i+1; k<nc; k++) g_mat[i][j] -= col_i[k]*g_mat[k][j];
}
}
/*
* Build K = D1 + S^T * D2 * S
* Compute and store only the lower triangular part of K.
*/
if (pnorm == CP_PROJ_L2NORM) cpdLUcomputeKI(cp_mem);
else cpdLUcomputeKD(cp_mem, s_tmp1);
/*
* Perform Cholesky decomposition of K (in place, gaxpy version)
*
* K = C*C^T
*
* After factorization, the lower triangular part of K contains C.
*
* Return 1 if factorization failed.
*/
ier = DensePOTRF(K);
if (ier > 0) return(1);
break;
case CPDIRECT_QR:
/*
* Thin QR factorization of G^T
*
* G^T = Q * R
*
* After factorization, the upper trianguler part of G^T
* contains the matrix R. The lower trapezoidal part of
* G^T, together with the array beta, encodes the orthonormal
* columns of Q as elementary reflectors.
*/
/* Use s_tmp1 as workspace */
s_tmpd = N_VGetArrayPointer(s_tmp1);
ier = DenseGEQRF(G, beta, s_tmpd);
/* If projecting in WRMS norm */
if (pnorm == CP_PROJ_ERRNORM) {
/* Build K = Q^T * D^(-1) * Q */
cpdQRcomputeKD(cp_mem, s_tmp1);
/* Perform Cholesky decomposition of K */
ier = DensePOTRF(K);
if (ier > 0) return(1);
}
break;
case CPDIRECT_SC:
/*
* Build K = G*D^(-1)*G^T
* Compute and store only the lower triangular part of K.
*/
if (pnorm == CP_PROJ_L2NORM) cpdSCcomputeKI(cp_mem);
else cpdSCcomputeKD(cp_mem, s_tmp1);
/*
* Perform Cholesky decomposition of K (in place, gaxpy version)
*
* K = C*C^T
*
* After factorization, the lower triangular part of K contains C.
*
* Return 1 if factorization failed.
*/
ier = DensePOTRF(K);
if (ier > 0) return(1);
break;
}
return(0);
}
