void
taucs_ccs_order(taucs_ccs_matrix* m,
int** perm, int** invperm,
char* which)
{
if (!strcmp(which,"mmd") || !strcmp(which,"amd") || !strcmp(which,"md"))
taucs_ccs_amd(m,perm,invperm,which);
else if (!strcmp(which,"metis"))
taucs_ccs_metis(m,perm,invperm,which);
else if (!strcmp(which,"genmmd"))
taucs_ccs_genmmd(m,perm,invperm,which);
else if (!strcmp(which,"colamd"))
taucs_ccs_colamd(m,perm,invperm,which);
else if (!strcmp(which,"random"))
taucs_ccs_randomperm(m->n,perm,invperm);
else if (!strcmp(which,"tree")) {
taucs_ccs_treeorder(m,perm,invperm);
if (*perm == NULL) /* perhaps the graph of the matrix is not a tree */
taucs_ccs_metis(m,perm,invperm,"metis");
}
else if (!strcmp(which,"identity")) {
int i;
*perm = (int*) taucs_malloc((m->n) * sizeof(int));
*invperm = (int*) taucs_malloc((m->n) * sizeof(int));
if (!(*perm) || !(*invperm)) {
taucs_free(*perm); taucs_free(*invperm);
*perm = *invperm = NULL;
taucs_printf("taucs_ccs_order: out of memory for identity permutation\n");
return;
}
for (i=0; i<m->n; i++) (*perm)[i] = (*invperm)[i] = i;
return;
}
else {
taucs_printf("taucs_ccs_order: invalid ordering requested (%s)\n",which);
*perm = *invperm = NULL;
}
}
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;
}
