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