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); }