void mexFunction
(
int nargout,
mxArray *pargout[ ],
int nargin,
const mxArray *pargin[ ]
)
{
Long i, n, *Pattern, *Flag, *Li, *Lp, *Ap, *Ai, *Lnz, *Parent,
lnz, do_num_only, *P, *Pinv, nn, k, j, permute, *Dp = NULL, *Di,
d, psrc, pdst ;
double *Y, *D, *Lx, *Ax, *p, *lp ;
/* ---------------------------------------------------------------------- */
/* get inputs and allocate workspace */
/* ---------------------------------------------------------------------- */
do_num_only = ((nargin == 5) || (nargin == 7)) && (nargout <= 2) ;
if (!do_num_only)
{
mexErrMsgTxt ("Usage:\n"
" [L, D] = ldlsparse (A, Lp, Lnz, Parent, Flag) ;\n"
" [L, D] = ldlsparse (A, Lp, Lnz, Parent, Flag, P, PInv)") ;
}
n = mxGetM (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetN (pargin [0])
|| mxIsComplex (pargin [0]))
{
mexErrMsgTxt ("ldl: A must be sparse, square, and real") ;
}
nn = (n == 0) ? 1 : n ;
/* get sparse matrix A */
Ap = (Long *) mxGetJc (pargin [0]) ;
Ai = (Long *) mxGetIr (pargin [0]) ;
Ax = mxGetPr (pargin [0]) ;
/* get Lp */
if (mxGetM (pargin [1]) * mxGetN (pargin [1]) != (n+1) ||
mxIsSparse (pargin [1]))
{
mexErrMsgTxt ("ldl: invalid input Lp\n") ;
}
Lp = (Long *) mxMalloc ((n+1) * sizeof (Long)) ;
lp = mxGetPr (pargin [1]) ;
for (k = 0 ; k < (n+1) ; k++)
{
Lp [k] = lp [k];
}
/* get Lnz */
/* if (mxGetM (pargin [2]) * mxGetN (pargin [2]) != n ||
mxIsSparse (pargin [2]))
{
mexErrMsgTxt ("ldl: invalid input Lnz\n") ;
}*/
Lnz = (Long *) mxMalloc (nn * sizeof (Long)) ;
/*p = mxGetPr (pargin [2]) ;
for (k = 0 ; k < n ; k++)
{
Lnz [k] = p [k];
}*/
/* get Parent */
if (mxGetM (pargin [3]) * mxGetN (pargin [3]) != n ||
mxIsSparse (pargin [3]))
{
mexErrMsgTxt ("ldl: invalid input Parent\n") ;
}
Parent = (Long *) mxMalloc (nn * sizeof (Long)) ;
p = mxGetPr (pargin [3]) ;
for (k = 0 ; k < n ; k++)
{
Parent [k] = p [k];
}
/* get Flag */
/*if (mxGetM (pargin [4]) * mxGetN (pargin [4]) != n ||
mxIsSparse (pargin [4]))
{
mexErrMsgTxt ("ldl: invalid input Flag\n") ;
}*/
Flag = (Long *) mxMalloc (nn * sizeof (Long)) ;
/*p = mxGetPr (pargin [4]) ;
for (k = 0 ; k < n ; k++)
{
Flag [k] = p [k];
}*/
/* get fill-reducing ordering, if present */
permute = ((nargin == 7) && !mxIsEmpty (pargin [5])) ;
if (permute)
{
if (mxGetM (pargin [5]) * mxGetN (pargin [5]) != n ||
mxIsSparse (pargin [5]))
{
mexErrMsgTxt ("ldl: invalid input permutation\n") ;
}
P = (Long *) mxMalloc (nn * sizeof (Long)) ;
p = mxGetPr (pargin [5]) ;
for (k = 0 ; k < n ; k++)
{
P [k] = p [k]; /*p[k]-1 convert to 0-based */
}
if (mxGetM (pargin [6]) * mxGetN (pargin [6]) != n ||
mxIsSparse (pargin [6]))
{
mexErrMsgTxt ("ldl: invalid input permutation inverse\n") ;
}
Pinv = (Long *) mxMalloc (nn * sizeof (Long)) ;
p = mxGetPr (pargin [6]) ;
for (k = 0 ; k < n ; k++)
{
Pinv [k] = p [k]; /*p[k]-1 convert to 0-based */
}
}
else
{
P = (Long *) NULL ;
Pinv = (Long *) NULL ;
}
/* get workspace */
Y = (double *) mxMalloc (nn * sizeof (double)) ;
Pattern = (Long *) mxMalloc (nn * sizeof (Long)) ;
/* make sure the input P is valid */
if (permute && !ldl_l_valid_perm (n, P, Flag))
{
mexErrMsgTxt ("ldl: invalid input permutation\n") ;
}
/* note that we assume that the input matrix is valid */
/* ---------------------------------------------------------------------- */
/* symbolic factorization to get Lp, Parent, Lnz, and optionally Pinv */
/* ---------------------------------------------------------------------- */
/*ldl_l_symbolic (n, Ap, Ai, Lp, Parent, Lnz, Flag, P, Pinv) ;*/
lnz = Lp [n] ;
printf ("lnz: %d\n", lnz) ;
/* ---------------------------------------------------------------------- */
/* create outputs */
/* ---------------------------------------------------------------------- */
/* create the output matrix L, using the Lp array from ldl_l_symbolic */
pargout [0] = mxCreateSparse (n, n, lnz+1, mxREAL) ;
mxFree (mxGetJc (pargout [0])) ;
mxSetJc (pargout [0], (void *) Lp) ; /* Lp is not mxFree'd */
Li = (Long *) mxGetIr (pargout [0]) ;
Lx = mxGetPr (pargout [0]) ;
/* create sparse diagonal matrix D */
if (nargout > 1)
{
pargout [1] = mxCreateSparse (n, n, nn, mxREAL) ;
Dp = (Long *) mxGetJc (pargout [1]) ;
Di = (Long *) mxGetIr (pargout [1]) ;
for (j = 0 ; j < n ; j++)
{
Dp [j] = j ;
Di [j] = j ;
}
Dp [n] = n ;
D = mxGetPr (pargout [1]) ;
}
else
{
D = (double *) mxMalloc (nn * sizeof (double)) ;
}
/* ---------------------------------------------------------------------- */
/* numeric factorization to get Li, Lx, and D */
/* ---------------------------------------------------------------------- */
/*d=n;
printf ("n: %d\n", n) ;
printf ("Y: ") ;
for (k = 0 ; k < n ; k++)
{
Y[k]=k;
printf ("%f", Y[k]) ;
}
printf ("Pattern: ") ;
for (k = 0 ; k < n ; k++)
{
Pattern[k]=k;
printf ("%d", Pattern[k]) ;
}
printf ("Lnz: ") ;
for (k = 0 ; k < n ; k++)
{
Lnz[k]=k;
printf ("%d", Lnz[k]) ;
}*/
d = ldl_l_numeric (n, Ap, Ai, Ax, Lp, Parent, Lnz, Li, Lx, D, Y, Flag,
Pattern, P, Pinv) ;
printf ("d: %d\n", d) ;
/* ---------------------------------------------------------------------- */
/* singular case : truncate the factorization */
/* ---------------------------------------------------------------------- */
if (d != n)
{
/* D [d] is zero: report error, or clean up */
mexErrMsgTxt ("ldl: zero pivot encountered\n") ;
}
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
if (nargout < 2)
{
mxFree (D) ;
}
if (permute)
{
mxFree (P) ;
mxFree (Pinv) ;
}
mxFree (Parent) ;
mxFree (Y) ;
mxFree (Flag) ;
mxFree (Pattern) ;
mxFree (Lnz) ;
}
void mexFunction
(
int nargout,
mxArray *pargout[ ],
int nargin,
const mxArray *pargin[ ]
)
{
UF_long i, n, *Pattern, *Flag, *Li, *Lp, *Ap, *Ai, *Lnz, *Parent, do_chol,
nrhs = 0, lnz, do_solve, *P, *Pinv, nn, k, j, permute, *Dp = NULL, *Di,
d, do_flops, psrc, pdst ;
double *Y, *D, *Lx, *Ax, flops, *X = NULL, *B = NULL, *p ;
/* ---------------------------------------------------------------------- */
/* get inputs and allocate workspace */
/* ---------------------------------------------------------------------- */
do_chol = (nargin > 0) && (nargin <= 2) && (nargout <= 4) ;
do_solve = (nargin == 3) && (nargout <= 2) ;
if (!(do_chol || do_solve))
{
mexErrMsgTxt ("Usage:\n"
" [L, D, etree, flopcount] = ldl (A) ;\n"
" [L, D, etree, flopcount] = ldl (A, P) ;\n"
" [x, flopcount] = ldl (A, [ ], b) ;\n"
" [x, flopcount] = ldl (A, P, b) ;\n"
"The etree and flopcount arguments are optional.") ;
}
n = mxGetM (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetN (pargin [0])
|| mxIsComplex (pargin [0]))
{
mexErrMsgTxt ("ldl: A must be sparse, square, and real") ;
}
if (do_solve)
{
if (mxIsSparse (pargin [2]) || n != mxGetM (pargin [2])
|| !mxIsDouble (pargin [2]) || mxIsComplex (pargin [2]))
{
mexErrMsgTxt (
"ldl: b must be dense, real, and with proper dimension") ;
}
}
nn = (n == 0) ? 1 : n ;
/* get sparse matrix A */
Ap = (UF_long *) mxGetJc (pargin [0]) ;
Ai = (UF_long *) mxGetIr (pargin [0]) ;
Ax = mxGetPr (pargin [0]) ;
/* get fill-reducing ordering, if present */
permute = ((nargin > 1) && !mxIsEmpty (pargin [1])) ;
if (permute)
{
if (mxGetM (pargin [1]) * mxGetN (pargin [1]) != n ||
mxIsSparse (pargin [1]))
{
mexErrMsgTxt ("ldl: invalid input permutation\n") ;
}
P = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
Pinv = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
p = mxGetPr (pargin [1]) ;
for (k = 0 ; k < n ; k++)
{
P [k] = p [k] - 1 ; /* convert to 0-based */
}
}
else
{
P = (UF_long *) NULL ;
Pinv = (UF_long *) NULL ;
}
/* allocate first part of L */
Lp = (UF_long *) mxMalloc ((n+1) * sizeof (UF_long)) ;
Parent = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
/* get workspace */
Y = (double *) mxMalloc (nn * sizeof (double)) ;
Flag = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
Pattern = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
Lnz = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
/* make sure the input P is valid */
if (permute && !ldl_l_valid_perm (n, P, Flag))
{
mexErrMsgTxt ("ldl: invalid input permutation\n") ;
}
/* note that we assume that the input matrix is valid */
/* ---------------------------------------------------------------------- */
/* symbolic factorization to get Lp, Parent, Lnz, and optionally Pinv */
/* ---------------------------------------------------------------------- */
ldl_l_symbolic (n, Ap, Ai, Lp, Parent, Lnz, Flag, P, Pinv) ;
lnz = Lp [n] ;
/* ---------------------------------------------------------------------- */
/* create outputs */
/* ---------------------------------------------------------------------- */
if (do_chol)
{
/* create the output matrix L, using the Lp array from ldl_l_symbolic */
pargout [0] = mxCreateSparse (n, n, lnz+1, mxREAL) ;
mxFree (mxGetJc (pargout [0])) ;
mxSetJc (pargout [0], (void *) Lp) ; /* Lp is not mxFree'd */
Li = (UF_long *) mxGetIr (pargout [0]) ;
Lx = mxGetPr (pargout [0]) ;
/* create sparse diagonal matrix D */
if (nargout > 1)
{
pargout [1] = mxCreateSparse (n, n, nn, mxREAL) ;
Dp = (UF_long *) mxGetJc (pargout [1]) ;
Di = (UF_long *) mxGetIr (pargout [1]) ;
for (j = 0 ; j < n ; j++)
{
Dp [j] = j ;
Di [j] = j ;
}
Dp [n] = n ;
D = mxGetPr (pargout [1]) ;
}
else
{
D = (double *) mxMalloc (nn * sizeof (double)) ;
}
/* return elimination tree (add 1 to change from 0-based to 1-based) */
if (nargout > 2)
{
pargout [2] = mxCreateDoubleMatrix (1, n, mxREAL) ;
p = mxGetPr (pargout [2]) ;
for (i = 0 ; i < n ; i++)
{
p [i] = Parent [i] + 1 ;
}
}
do_flops = (nargout == 4) ? (3) : (-1) ;
}
else
{
/* create L and D as temporary matrices */
Li = (UF_long *) mxMalloc ((lnz+1) * sizeof (UF_long)) ;
Lx = (double *) mxMalloc ((lnz+1) * sizeof (double)) ;
D = (double *) mxMalloc (nn * sizeof (double)) ;
/* create solution x */
nrhs = mxGetN (pargin [2]) ;
pargout [0] = mxCreateDoubleMatrix (n, nrhs, mxREAL) ;
X = mxGetPr (pargout [0]) ;
B = mxGetPr (pargin [2]) ;
do_flops = (nargout == 2) ? (1) : (-1) ;
}
if (do_flops >= 0)
{
/* find flop count for ldl_l_numeric */
flops = 0 ;
for (k = 0 ; k < n ; k++)
{
flops += ((double) Lnz [k]) * (Lnz [k] + 2) ;
}
if (do_solve)
{
/* add flop count for solve */
for (k = 0 ; k < n ; k++)
{
flops += 4 * ((double) Lnz [k]) + 1 ;
}
}
pargout [do_flops] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
p = mxGetPr (pargout [do_flops]) ;
p [0] = flops ;
}
/* ---------------------------------------------------------------------- */
/* numeric factorization to get Li, Lx, and D */
/* ---------------------------------------------------------------------- */
d = ldl_l_numeric (n, Ap, Ai, Ax, Lp, Parent, Lnz, Li, Lx, D, Y, Flag,
Pattern, P, Pinv) ;
/* ---------------------------------------------------------------------- */
/* singular case : truncate the factorization */
/* ---------------------------------------------------------------------- */
if (d != n)
{
/* D [d] is zero: report error, or clean up */
if (do_chol && do_flops < 0)
{
mexErrMsgTxt ("ldl: zero pivot encountered\n") ;
}
else
{
/* L and D are incomplete, compact them */
if (do_chol)
{
for (k = d ; k < n ; k++)
{
Dp [k] = d ;
}
Dp [n] = d ;
}
for (k = d ; k < n ; k++)
{
D [k] = 0 ;
}
pdst = 0 ;
for (k = 0 ; k < d ; k++)
{
for (psrc = Lp [k] ; psrc < Lp [k] + Lnz [k] ; psrc++)
{
Li [pdst] = Li [psrc] ;
Lx [pdst] = Lx [psrc] ;
pdst++ ;
}
}
for (k = 0 ; k < d ; k++)
{
Lp [k+1] = Lp [k] + Lnz [k] ;
}
for (k = d ; k <= n ; k++)
{
Lp [k] = pdst ;
}
if (do_flops >= 0)
{
/* return -d instead of the flop count (convert to 1-based) */
p = mxGetPr (pargout [do_flops]) ;
p [0] = -(1+d) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* solve Ax=b, if requested */
/* ---------------------------------------------------------------------- */
if (do_solve)
{
if (permute)
{
for (j = 0 ; j < nrhs ; j++)
{
ldl_l_perm (n, Y, B, P) ; /* y = Pb */
ldl_l_lsolve (n, Y, Lp, Li, Lx) ; /* y = L\y */
ldl_l_dsolve (n, Y, D) ; /* y = D\y */
ldl_l_ltsolve (n, Y, Lp, Li, Lx) ; /* y = L'\y */
ldl_l_permt (n, X, Y, P) ; /* x = P'y */
X += n ;
B += n ;
}
}
else
{
for (j = 0 ; j < nrhs ; j++)
{
for (k = 0 ; k < n ; k++) /* x = b */
{
X [k] = B [k] ;
}
ldl_l_lsolve (n, X, Lp, Li, Lx) ; /* x = L\x */
ldl_l_dsolve (n, X, D) ; /* x = D\x */
ldl_l_ltsolve (n, X, Lp, Li, Lx) ; /* x = L'\x */
X += n ;
B += n ;
}
}
/* free the matrix L */
mxFree (Lp) ;
mxFree (Li) ;
mxFree (Lx) ;
mxFree (D) ;
}
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
if (do_chol && nargout < 2)
{
mxFree (D) ;
}
if (permute)
{
mxFree (P) ;
mxFree (Pinv) ;
}
mxFree (Parent) ;
mxFree (Y) ;
mxFree (Flag) ;
mxFree (Pattern) ;
mxFree (Lnz) ;
}
