~logan/ubuntu/trusty/suitesparse/4.2.1-3ubuntu1

« back to all changes in this revision

Viewing changes to LDL/MATLAB/ldlmex.c

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Prud'homme
  • Date: 2007-05-29 09:36:29 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20070529093629-zowquo0b7slkk6nc
Tags: 3.0.0-2
* suitesparse builds properly twice in a row
* Bug fix: "suitesparse - FTBFS: Broken build depens: libgfortran1-dev",
  thanks to Bastian Blank (Closes: #426349).
* Bug fix: "suitesparse_3.0.0-1: FTBFS: build-depends on
  libgfortran1-dev", thanks to Steve Langasek (Closes: #426354).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/* ========================================================================== */
 
2
/* === ldlmex.c:  LDL mexFunction =========================================== */
 
3
/* ========================================================================== */
 
4
 
 
5
/* MATLAB interface for numerical LDL' factorization using the LDL sparse matrix
 
6
 * package.
 
7
 *
 
8
 * MATLAB calling syntax is:
 
9
 *
 
10
 *       [L, D, Parent, flops] = ldl (A)
 
11
 *       [L, D, Parent, flops] = ldl (A, P)
 
12
 *       [x, flops] = ldl (A, [ ], b)
 
13
 *       [x, flops] = ldl (A, P,   b)
 
14
 *
 
15
 * The factorization is L*D*L' = A or L*D*L' = A(P,P).   A must be sparse,
 
16
 * square, and real.  L is lower triangular with unit diagonal, but the diagonal
 
17
 * is not returned.  D is diagonal sparse matrix.  Let n = size (A,1).   If P is
 
18
 * not present or empty, the factorization is:
 
19
 *
 
20
 *      (L + speye (n)) * D * (L + speye (n))' = A
 
21
 *
 
22
 * otherwise, the factorization is
 
23
 *
 
24
 *      (L + speye (n)) * D * (L + speye (n))' = A(P,P)
 
25
 *
 
26
 * P is a permutation of 1:n, an output of AMD, SYMAMD, or SYMRCM, for example.
 
27
 * Only the diagonal and upper triangular part of A or A(P,P) is accessed; the
 
28
 * lower triangular part is ignored.
 
29
 *
 
30
 * The elimination tree is returned in the Parent array.
 
31
 *
 
32
 * In the x = ldl (A, P, b) usage, the LDL' factorization is not returned.
 
33
 * Instead, the system A*x=b is solved for x, where b is a dense n-by-m matrix,
 
34
 * using P as the fill-reducing ordering for the LDL' factorization of A(P,P).
 
35
 * If P is not present or equal to [ ], it is assumed to be the identity
 
36
 * permutation.
 
37
 *
 
38
 * If no zero entry on the diagonal of D is encountered, then the flops argument
 
39
 * is the floating point count.
 
40
 *
 
41
 * If any entry on the diagonal of D is zero, then the LDL' factorization is
 
42
 * terminated at that point.  If there is no flops output argument, an error
 
43
 * message is printed and no outputs are returned.  Otherwise, flops is
 
44
 * negative, d = -flops, and D (d,d) is the first zero entry on the diagonal of
 
45
 * D.  A partial factorization is returned.  Let B = A if P is not present or
 
46
 * empty, or B = A(P,P) otherwise.  Then the factorization is
 
47
 *
 
48
 *      LDL = (L + speye (n)) * D * (L + speye (n))'
 
49
 *      LDL (1:d, 1:d) = B (1:d,1:d)
 
50
 *
 
51
 * That is, the LDL' factorization of B (1:d,1:d) is in the first d rows and
 
52
 * columns of L and D.  The rest of L and D are zero.
 
53
 *
 
54
 * LDL Copyright (c) by Timothy A Davis,
 
55
 * University of Florida.  All Rights Reserved.  See README for the License.
 
56
 */
 
57
 
 
58
#ifndef LDL_LONG
 
59
#define LDL_LONG
 
60
#endif
 
61
 
 
62
#include "ldl.h"
 
63
#include "mex.h"
 
64
 
 
65
/* ========================================================================== */
 
66
/* === LDL mexFunction ====================================================== */
 
67
/* ========================================================================== */
 
68
 
 
69
void mexFunction
 
70
(
 
71
    int nargout,
 
72
    mxArray *pargout[ ],
 
73
    int nargin,
 
74
    const mxArray *pargin[ ]
 
75
)
 
76
{
 
77
    UF_long i, n, *Pattern, *Flag, *Li, *Lp, *Ap, *Ai, *Lnz, *Parent, do_chol,
 
78
        nrhs, lnz, do_solve, *P, *Pinv, nn, k, j, permute, *Dp, *Di, d,
 
79
        do_flops, psrc, pdst, p2 ;
 
80
    double *Y, *D, *Lx, *Ax, flops, *X, *B, *p ;
 
81
 
 
82
    /* ---------------------------------------------------------------------- */
 
83
    /* get inputs and allocate workspace */
 
84
    /* ---------------------------------------------------------------------- */
 
85
 
 
86
    do_chol  = (nargin > 0) && (nargin <= 2) && (nargout <= 4) ;
 
87
    do_solve = (nargin == 3) && (nargout <= 2) ;
 
88
    if (!(do_chol || do_solve))
 
89
    {
 
90
        mexErrMsgTxt ("Usage:\n"
 
91
            "  [L, D, etree, flopcount] = ldl (A) ;\n"
 
92
            "  [L, D, etree, flopcount] = ldl (A, P) ;\n"
 
93
            "  [x, flopcount] = ldl (A, [ ], b) ;\n"
 
94
            "  [x, flopcount] = ldl (A, P, b) ;\n"
 
95
            "The etree and flopcount arguments are optional.") ;
 
96
    }
 
97
    n = mxGetM (pargin [0]) ;
 
98
    if (!mxIsSparse (pargin [0]) || n != mxGetN (pargin [0])
 
99
            || mxIsComplex (pargin [0]))
 
100
    {
 
101
        mexErrMsgTxt ("ldl: A must be sparse, square, and real") ;
 
102
    }
 
103
    if (do_solve)
 
104
    {
 
105
        if (mxIsSparse (pargin [2]) || n != mxGetM (pargin [2])
 
106
            || !mxIsDouble (pargin [2]) || mxIsComplex (pargin [2]))
 
107
        {
 
108
            mexErrMsgTxt (
 
109
                "ldl: b must be dense, real, and with proper dimension") ;
 
110
        }
 
111
    }
 
112
    nn = (n == 0) ? 1 : n ;
 
113
 
 
114
    /* get sparse matrix A */
 
115
    Ap = (UF_long *) mxGetJc (pargin [0]) ;
 
116
    Ai = (UF_long *) mxGetIr (pargin [0]) ;
 
117
    Ax = mxGetPr (pargin [0]) ;
 
118
 
 
119
    /* get fill-reducing ordering, if present */
 
120
    permute = ((nargin > 1) && !mxIsEmpty (pargin [1])) ;
 
121
    if (permute)
 
122
    {
 
123
        if (mxGetM (pargin [1]) * mxGetN (pargin [1]) != n ||
 
124
                mxIsSparse (pargin [1]))
 
125
        {
 
126
            mexErrMsgTxt ("ldl: invalid input permutation\n") ;
 
127
        }
 
128
        P    = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
129
        Pinv = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
130
        p = mxGetPr (pargin [1]) ;
 
131
        for (k = 0 ; k < n ; k++)
 
132
        {
 
133
            P [k] = p [k] - 1 ; /* convert to 0-based */
 
134
        }
 
135
    }
 
136
    else
 
137
    {
 
138
        P    = (UF_long *) NULL ;
 
139
        Pinv = (UF_long *) NULL ;
 
140
    }
 
141
 
 
142
    /* allocate first part of L */
 
143
    Lp      = (UF_long *) mxMalloc ((n+1) * sizeof (UF_long)) ;
 
144
    Parent  = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
145
 
 
146
    /* get workspace */
 
147
    Y       = (double *)  mxMalloc (nn * sizeof (double)) ;
 
148
    Flag    = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
149
    Pattern = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
150
    Lnz     = (UF_long *) mxMalloc (nn * sizeof (UF_long)) ;
 
151
 
 
152
    /* make sure the input P is valid */
 
153
    if (permute && !ldl_l_valid_perm (n, P, Flag))
 
154
    {
 
155
        mexErrMsgTxt ("ldl: invalid input permutation\n") ;
 
156
    }
 
157
 
 
158
    /* note that we assume that the input matrix is valid */
 
159
 
 
160
    /* ---------------------------------------------------------------------- */
 
161
    /* symbolic factorization to get Lp, Parent, Lnz, and optionally Pinv */
 
162
    /* ---------------------------------------------------------------------- */
 
163
 
 
164
    ldl_l_symbolic (n, Ap, Ai, Lp, Parent, Lnz, Flag, P, Pinv) ;
 
165
    lnz = Lp [n] ;
 
166
 
 
167
    /* ---------------------------------------------------------------------- */
 
168
    /* create outputs */
 
169
    /* ---------------------------------------------------------------------- */
 
170
 
 
171
    if (do_chol)
 
172
    {
 
173
        /* create the output matrix L, using the Lp array from ldl_l_symbolic */
 
174
        pargout [0] = mxCreateSparse (n, n, lnz+1, mxREAL) ;
 
175
        mxFree (mxGetJc (pargout [0])) ;
 
176
        mxSetJc (pargout [0], (void *) Lp) ;    /* Lp is not mxFree'd */
 
177
        Li = (UF_long *) mxGetIr (pargout [0]) ;
 
178
        Lx = mxGetPr (pargout [0]) ;
 
179
 
 
180
        /* create sparse diagonal matrix D */
 
181
        if (nargout > 1)
 
182
        {
 
183
            pargout [1] = mxCreateSparse (n, n, nn, mxREAL) ;
 
184
            Dp = (UF_long *) mxGetJc (pargout [1]) ;
 
185
            Di = (UF_long *) mxGetIr (pargout [1]) ;
 
186
            for (j = 0 ; j < n ; j++)
 
187
            {
 
188
                Dp [j] = j ;
 
189
                Di [j] = j ;
 
190
            }
 
191
            Dp [n] = n ;
 
192
            D = mxGetPr (pargout [1])  ;
 
193
        }
 
194
        else
 
195
        {
 
196
            D  = (double *) mxMalloc (nn * sizeof (double)) ;
 
197
        }
 
198
 
 
199
        /* return elimination tree (add 1 to change from 0-based to 1-based) */
 
200
        if (nargout > 2)
 
201
        {
 
202
            pargout [2] = mxCreateDoubleMatrix (1, n, mxREAL) ;
 
203
            p = mxGetPr (pargout [2]) ;
 
204
            for (i = 0 ; i < n ; i++)
 
205
            {
 
206
                p [i] = Parent [i] + 1 ;
 
207
            }
 
208
        }
 
209
 
 
210
        do_flops = (nargout == 4) ? (3) : (-1) ;
 
211
    }
 
212
    else
 
213
    {
 
214
        /* create L and D as temporary matrices */
 
215
        Li = (UF_long *)    mxMalloc ((lnz+1) * sizeof (UF_long)) ;
 
216
        Lx = (double *) mxMalloc ((lnz+1) * sizeof (double)) ;
 
217
        D  = (double *) mxMalloc (nn * sizeof (double)) ;
 
218
 
 
219
        /* create solution x */
 
220
        nrhs = mxGetN (pargin [2]) ;
 
221
        pargout [0] = mxCreateDoubleMatrix (n, nrhs, mxREAL) ;
 
222
        X = mxGetPr (pargout [0]) ;
 
223
        B = mxGetPr (pargin [2]) ;
 
224
 
 
225
        do_flops = (nargout == 2) ? (1) : (-1) ;
 
226
    }
 
227
 
 
228
    if (do_flops >= 0)
 
229
    {
 
230
        /* find flop count for ldl_l_numeric */
 
231
        flops = 0 ;
 
232
        for (k = 0 ; k < n ; k++)
 
233
        {
 
234
            flops += ((double) Lnz [k]) * (Lnz [k] + 2) ;
 
235
        }
 
236
        if (do_solve)
 
237
        {
 
238
            /* add flop count for solve */
 
239
            for (k = 0 ; k < n ; k++)
 
240
            {
 
241
                flops += 4 * ((double) Lnz [k]) + 1 ;
 
242
            }
 
243
        }
 
244
        pargout [do_flops] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
 
245
        p = mxGetPr (pargout [do_flops]) ;
 
246
        p [0] = flops ;
 
247
    }
 
248
 
 
249
    /* ---------------------------------------------------------------------- */
 
250
    /* numeric factorization to get Li, Lx, and D */
 
251
    /* ---------------------------------------------------------------------- */
 
252
 
 
253
    d = ldl_l_numeric (n, Ap, Ai, Ax, Lp, Parent, Lnz, Li, Lx, D, Y, Flag,
 
254
        Pattern, P, Pinv) ;
 
255
 
 
256
    /* ---------------------------------------------------------------------- */
 
257
    /* singular case : truncate the factorization */
 
258
    /* ---------------------------------------------------------------------- */
 
259
 
 
260
    if (d != n)
 
261
    {
 
262
        /* D [d] is zero:  report error, or clean up */
 
263
        if (do_chol && do_flops < 0)
 
264
        {
 
265
            mexErrMsgTxt ("ldl: zero pivot encountered\n") ;
 
266
        }
 
267
        else
 
268
        {
 
269
            /* L and D are incomplete, compact them */
 
270
            if (do_chol)
 
271
            {
 
272
                for (k = d ; k < n ; k++)
 
273
                {
 
274
                    Dp [k] = d ;
 
275
                }
 
276
                Dp [n] = d ;
 
277
            }
 
278
            for (k = d ; k < n ; k++)
 
279
            {
 
280
                D [k] = 0 ;
 
281
            }
 
282
            pdst = 0 ;
 
283
            for (k = 0 ; k < d ; k++)
 
284
            {
 
285
                for (psrc = Lp [k] ; psrc < Lp [k] + Lnz [k] ; psrc++)
 
286
                {
 
287
                    Li [pdst] = Li [psrc] ;
 
288
                    Lx [pdst] = Lx [psrc] ;
 
289
                    pdst++ ;
 
290
                }
 
291
            }
 
292
            for (k = 0 ; k < d  ; k++)
 
293
            {
 
294
                Lp [k+1] = Lp [k] + Lnz [k] ;
 
295
            }
 
296
            for (k = d ; k <= n ; k++)
 
297
            {
 
298
                Lp [k] = pdst ;
 
299
            }
 
300
            if (do_flops >= 0)
 
301
            {
 
302
                /* return -d instead of the flop count (convert to 1-based) */
 
303
                p = mxGetPr (pargout [do_flops]) ;
 
304
                p [0] = -(1+d) ;
 
305
            }
 
306
        }
 
307
    }
 
308
 
 
309
    /* ---------------------------------------------------------------------- */
 
310
    /* solve Ax=b, if requested */
 
311
    /* ---------------------------------------------------------------------- */
 
312
 
 
313
    if (do_solve)
 
314
    {
 
315
        if (permute)
 
316
        {
 
317
            for (j = 0 ; j < nrhs ; j++)
 
318
            {
 
319
                ldl_l_perm (n, Y, B, P) ;                   /* y = Pb */
 
320
                ldl_l_lsolve (n, Y, Lp, Li, Lx) ;           /* y = L\y */
 
321
                ldl_l_dsolve (n, Y, D) ;                    /* y = D\y */
 
322
                ldl_l_ltsolve (n, Y, Lp, Li, Lx) ;          /* y = L'\y */
 
323
                ldl_l_permt (n, X, Y, P) ;                  /* x = P'y */
 
324
                X += n ;
 
325
                B += n ;
 
326
            }
 
327
        }
 
328
        else
 
329
        {
 
330
            for (j = 0 ; j < nrhs ; j++)
 
331
            {
 
332
                for (k = 0 ; k < n ; k++)                   /* x = b */
 
333
                {
 
334
                    X [k] = B [k] ;
 
335
                }
 
336
                ldl_l_lsolve (n, X, Lp, Li, Lx) ;           /* x = L\x */
 
337
                ldl_l_dsolve (n, X, D) ;                    /* x = D\x */
 
338
                ldl_l_ltsolve (n, X, Lp, Li, Lx) ;          /* x = L'\x */
 
339
                X += n ;
 
340
                B += n ;
 
341
            }
 
342
        }
 
343
        /* free the matrix L */
 
344
        mxFree (Lp) ;
 
345
        mxFree (Li) ;
 
346
        mxFree (Lx) ;
 
347
        mxFree (D) ;
 
348
    }
 
349
 
 
350
    /* ---------------------------------------------------------------------- */
 
351
    /* free workspace */
 
352
    /* ---------------------------------------------------------------------- */
 
353
 
 
354
    if (do_chol && nargout < 2)
 
355
    {
 
356
        mxFree (D) ;
 
357
    }
 
358
    if (permute)
 
359
    {
 
360
        mxFree (P) ;
 
361
        mxFree (Pinv) ;
 
362
    }
 
363
    mxFree (Parent) ;
 
364
    mxFree (Y) ;
 
365
    mxFree (Flag) ;
 
366
    mxFree (Pattern) ;
 
367
    mxFree (Lnz) ;
 
368
}