int sci_umf_lufact(char* fname, void* pvApiCtx) { SciErr sciErr; int stat = 0; SciSparse AA; CcsSparse A; int mA = 0; // rows int nA = 0; // cols int iNbItem = 0; int* piNbItemRow = NULL; int* piColPos = NULL; double* pdblSpReal = NULL; double* pdblSpImg = NULL; /* umfpack stuff */ double* Control = NULL; double* Info = NULL; void* Symbolic = NULL; void* Numeric = NULL; int* piAddr1 = NULL; int iComplex = 0; int iType1 = 0; /* Check numbers of input/output arguments */ CheckInputArgument(pvApiCtx, 1, 1); CheckOutputArgument(pvApiCtx, 1, 1); /* get A the sparse matrix to factorize */ sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } /* check if the first argument is a sparse matrix */ sciErr = getVarType(pvApiCtx, piAddr1, &iType1); if (sciErr.iErr || iType1 != sci_sparse) { printError(&sciErr, 0); Scierror(999, _("%s: Wrong type for input argument #%d: A sparse matrix expected.\n"), fname, 1); return 1; } if (isVarComplex(pvApiCtx, piAddr1)) { iComplex = 1; sciErr = getComplexSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg); } else { sciErr = getSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal); } if (sciErr.iErr) { FREE(piNbItemRow); FREE(piColPos); FREE(pdblSpReal); if (pdblSpImg) { FREE(pdblSpImg); } printError(&sciErr, 0); return 1; } // fill struct sparse AA.m = mA; AA.n = nA; AA.it = iComplex; AA.nel = iNbItem; AA.mnel = piNbItemRow; AA.icol = piColPos; AA.R = pdblSpReal; AA.I = pdblSpImg; if (nA <= 0 || mA <= 0) { FREE(piNbItemRow); FREE(piColPos); FREE(pdblSpReal); if (pdblSpImg) { FREE(pdblSpImg); } Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 1); return 1; } SciSparseToCcsSparse(&AA, &A); FREE(piNbItemRow); FREE(piColPos); FREE(pdblSpReal); if (pdblSpImg) { FREE(pdblSpImg); } /* symbolic factorization */ if (A.it == 1) { stat = umfpack_zi_symbolic(nA, mA, A.p, A.irow, A.R, A.I, &Symbolic, Control, Info); } else { stat = umfpack_di_symbolic(nA, mA, A.p, A.irow, A.R, &Symbolic, Control, Info); } if (stat != UMFPACK_OK) { freeCcsSparse(A); Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat)); return 1; } /* numeric factorization */ if (A.it == 1) { stat = umfpack_zi_numeric(A.p, A.irow, A.R, A.I, Symbolic, &Numeric, Control, Info); } else { stat = umfpack_di_numeric(A.p, A.irow, A.R, Symbolic, &Numeric, Control, Info); } if (A.it == 1) { umfpack_zi_free_symbolic(&Symbolic); } else { umfpack_di_free_symbolic(&Symbolic); } if ( stat != UMFPACK_OK && stat != UMFPACK_WARNING_singular_matrix ) { freeCcsSparse(A); Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat)); return 1; } if ( stat == UMFPACK_WARNING_singular_matrix && mA == nA ) { if (getWarningMode()) { Sciwarning("\n%s:%s\n", _("Warning"), _("The (square) matrix appears to be singular.")); } } /* add the pointer in the list ListNumeric */ if (! AddAdrToList(Numeric, A.it, &ListNumeric)) { /* AddAdrToList return 0 if malloc have failed : as it is just for storing 2 pointers this is unlikely to occurs but ... */ if (A.it == 1) { umfpack_zi_free_numeric(&Numeric); } else { umfpack_di_free_numeric(&Numeric); } freeCcsSparse(A); Scierror(999, _("%s: An error occurred: %s\n"), fname, _("no place to store the LU pointer in ListNumeric.")); return 1; } freeCcsSparse(A); /* create the scilab object to store the pointer onto the LU factors */ sciErr = createPointer(pvApiCtx, 2, Numeric); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } /* return the pointer */ AssignOutputVariable(pvApiCtx, 1) = 2; ReturnArguments(pvApiCtx); return 0; }
int sci_taucs_chfact(char* fname, void* pvApiCtx) { SciErr sciErr; int stat = 0; int* perm = NULL; int* invperm = NULL; taucs_ccs_matrix *PAPT; taucs_ccs_matrix B; void *C = NULL; taucs_handle_factors *pC; SciSparse A; int mA = 0; // rows int nA = 0; // cols int iNbItem = 0; int* piNbItemRow = NULL; int* piColPos = NULL; double* pdblSpReal = NULL; double* pdblSpImg = NULL; int iComplex = 0; int* piAddr1 = NULL; /* Check numbers of input/output arguments */ CheckInputArgument(pvApiCtx, 1, 1); CheckOutputArgument(pvApiCtx, 1, 1); /* get A the sparse matrix to factorize */ sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } if (isVarComplex(pvApiCtx, piAddr1)) { iComplex = 1; sciErr = getComplexSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg); } else { sciErr = getSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal); } if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // fill struct sparse A.m = mA; A.n = nA; A.it = iComplex; A.nel = iNbItem; A.mnel = piNbItemRow; A.icol = piColPos; A.R = pdblSpReal; A.I = pdblSpImg; stat = spd_sci_sparse_to_taucs_sparse(&A, &B); if ( stat != A_PRIORI_OK ) { if ( stat == MAT_IS_NOT_SPD ) { freeTaucsSparse(B); Scierror(999, _("%s: Wrong value for input argument #%d: Must be symmetric positive definite matrix."), fname, 1); } /* the message for the other problem (not enough memory in stk) is treated automaticaly */ return 1; } /* find the permutation */ taucs_ccs_genmmd(&B, &perm, &invperm); if ( !perm ) { freeTaucsSparse(B); Scierror(999, _("%s: No more memory.\n") , fname); return 1; } /* apply permutation */ PAPT = taucs_ccs_permute_symmetrically(&B, perm, invperm); FREE(invperm); freeTaucsSparse(B); /* factor */ C = taucs_ccs_factor_llt_mf(PAPT); taucs_ccs_free(PAPT); if (C == NULL) { /* Note : an error indicator is given in the main scilab window * (out of memory, no positive definite matrix , etc ...) */ Scierror(999, _("%s: An error occurred: %s\n"), fname, _("factorization")); return 1; } /* put in an handle (Chol fact + perm + size) */ pC = (taucs_handle_factors*)MALLOC( sizeof(taucs_handle_factors) ); pC->p = perm; pC->C = C; pC->n = A.n; /* add in the list of Chol Factors */ AddAdrToList((Adr) pC, 0, &ListCholFactors); /* FIXME add a test here .. */ /* create the scilab object to store the pointer onto the Chol handle */ sciErr = createPointer(pvApiCtx, 2, (void *)pC); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } /* return the pointer */ AssignOutputVariable(pvApiCtx, 1) = 2; ReturnArguments(pvApiCtx); return 0; }