Actual source code: lusol.c
1: /*$Id: lusol.c,v 1.11 2001/08/06 21:15:14 bsmith Exp $*/
2: /*
3: Provides an interface to the LUSOL package of ....
5: */
6: #include src/mat/impls/aij/seq/aij.h
8: EXTERN int MatDestroy_SeqAIJ(Mat);
10: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
11: #define LU1FAC lu1fac_
12: #define LU6SOL lu6sol_
13: #define M1PAGE m1page_
14: #define M5SETX m5setx_
15: #define M6RDEL m6rdel_
16: #elif !defined(PETSC_HAVE_FORTRAN_CAPS)
17: #define LU1FAC lu1fac
18: #define LU6SOL lu6sol
19: #define M1PAGE m1page
20: #define M5SETX m5setx
21: #define M6RDEL m6rdel
22: #endif
24: EXTERN_C_BEGIN
25: /*
26: Dummy symbols that the MINOS files mi25bfac.f and mi15blas.f may require
27: */
28: void PETSC_STDCALL M1PAGE() {
29: ;
30: }
31: void PETSC_STDCALL M5SETX() {
32: ;
33: }
35: void PETSC_STDCALL M6RDEL() {
36: ;
37: }
38: EXTERN_C_END
40: #if defined(PETSC_HAVE_LUSOL) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
42: EXTERN_C_BEGIN
43: extern void PETSC_STDCALL LU1FAC (int *m, int *n, int *nnz, int *size, int *luparm,
44: double *parmlu, double *data, int *indc, int *indr,
45: int *rowperm, int *colperm, int *collen, int *rowlen,
46: int *colstart, int *rowstart, int *rploc, int *cploc,
47: int *rpinv, int *cpinv, double *w, int *inform);
49: extern void PETSC_STDCALL LU6SOL (int *mode, int *m, int *n, double *rhs, double *x,
50: int *size, int *luparm, double *parmlu, double *data,
51: int *indc, int *indr, int *rowperm, int *colperm,
52: int *collen, int *rowlen, int *colstart, int *rowstart,
53: int *inform);
55: typedef struct
56: {
57: double *data;
58: int *indc;
59: int *indr;
61: int *ip;
62: int *iq;
63: int *lenc;
64: int *lenr;
65: int *locc;
66: int *locr;
67: int *iploc;
68: int *iqloc;
69: int *ipinv;
70: int *iqinv;
71: double *mnsw;
72: double *mnsv;
74: double elbowroom;
75: double luroom; /* Extra space allocated when factor fails */
76: double parmlu[30]; /* Input/output to LUSOL */
78: int n; /* Number of rows/columns in matrix */
79: int nz; /* Number of nonzeros */
80: int nnz; /* Number of nonzeros allocated for factors */
81: int luparm[30]; /* Input/output to LUSOL */
83: } Mat_SeqAIJ_LUSOL;
85: /* LUSOL input/Output Parameters (Description uses C-style indexes
86: *
87: * Input parameters Typical value
88: *
89: * luparm(0) = nout File number for printed messages. 6
90: * luparm(1) = lprint Print level. 0
91: * < 0 suppresses output.
92: * = 0 gives error messages.
93: * = 1 gives debug output from some of the
94: * other routines in LUSOL.
95: * >= 2 gives the pivot row and column and the
96: * no. of rows and columns involved at
97: * each elimination step in lu1fac.
98: * luparm(2) = maxcol lu1fac: maximum number of columns 5
99: * searched allowed in a Markowitz-type
100: * search for the next pivot element.
101: * For some of the factorization, the
102: * number of rows searched is
103: * maxrow = maxcol - 1.
104: *
105: *
106: * Output parameters
107: *
108: * luparm(9) = inform Return code from last call to any LU routine.
109: * luparm(10) = nsing No. of singularities marked in the
110: * output array w(*).
111: * luparm(11) = jsing Column index of last singularity.
112: * luparm(12) = minlen Minimum recommended value for lena.
113: * luparm(13) = maxlen ?
114: * luparm(14) = nupdat No. of updates performed by the lu8 routines.
115: * luparm(15) = nrank No. of nonempty rows of U.
116: * luparm(16) = ndens1 No. of columns remaining when the density of
117: * the matrix being factorized reached dens1.
118: * luparm(17) = ndens2 No. of columns remaining when the density of
119: * the matrix being factorized reached dens2.
120: * luparm(18) = jumin The column index associated with dumin.
121: * luparm(19) = numl0 No. of columns in initial L.
122: * luparm(20) = lenl0 Size of initial L (no. of nonzeros).
123: * luparm(21) = lenu0 Size of initial U.
124: * luparm(22) = lenl Size of current L.
125: * luparm(23) = lenu Size of current U.
126: * luparm(24) = lrow Length of row file.
127: * luparm(25) = ncp No. of compressions of LU data structures.
128: * luparm(26) = mersum lu1fac: sum of Markowitz merit counts.
129: * luparm(27) = nutri lu1fac: triangular rows in U.
130: * luparm(28) = nltri lu1fac: triangular rows in L.
131: * luparm(29) =
132: *
133: *
134: * Input parameters Typical value
135: *
136: * parmlu(0) = elmax1 Max multiplier allowed in L 10.0
137: * during factor.
138: * parmlu(1) = elmax2 Max multiplier allowed in L 10.0
139: * during updates.
140: * parmlu(2) = small Absolute tolerance for eps**0.8
141: * treating reals as zero. IBM double: 3.0d-13
142: * parmlu(3) = utol1 Absolute tol for flagging eps**0.66667
143: * small diagonals of U. IBM double: 3.7d-11
144: * parmlu(4) = utol2 Relative tol for flagging eps**0.66667
145: * small diagonals of U. IBM double: 3.7d-11
146: * parmlu(5) = uspace Factor limiting waste space in U. 3.0
147: * In lu1fac, the row or column lists
148: * are compressed if their length
149: * exceeds uspace times the length of
150: * either file after the last compression.
151: * parmlu(6) = dens1 The density at which the Markowitz 0.3
152: * strategy should search maxcol columns
153: * and no rows.
154: * parmlu(7) = dens2 the density at which the Markowitz 0.6
155: * strategy should search only 1 column
156: * or (preferably) use a dense LU for
157: * all the remaining rows and columns.
158: *
159: *
160: * Output parameters
161: *
162: * parmlu(9) = amax Maximum element in A.
163: * parmlu(10) = elmax Maximum multiplier in current L.
164: * parmlu(11) = umax Maximum element in current U.
165: * parmlu(12) = dumax Maximum diagonal in U.
166: * parmlu(13) = dumin Minimum diagonal in U.
167: * parmlu(14) =
168: * parmlu(15) =
169: * parmlu(16) =
170: * parmlu(17) =
171: * parmlu(18) =
172: * parmlu(19) = resid lu6sol: residual after solve with U or U'.
173: * ...
174: * parmlu(29) =
175: */
177: #define Factorization_Tolerance 1e-1
178: #define Factorization_Pivot_Tolerance pow(2.2204460492503131E-16, 2.0 / 3.0)
179: #define Factorization_Small_Tolerance 1e-15 /* pow(DBL_EPSILON, 0.8) */
182: int MatDestroy_SeqAIJ_LUSOL(Mat A)
183: {
184: Mat_SeqAIJ *a;
185: Mat_SeqAIJ_LUSOL *lusol;
186: int ierr;
190: a = (Mat_SeqAIJ *)A->data;
191: lusol = (Mat_SeqAIJ_LUSOL *)a->spptr;
193: PetscFree(lusol->ip);
194: PetscFree(lusol->iq);
195: PetscFree(lusol->lenc);
196: PetscFree(lusol->lenr);
197: PetscFree(lusol->locc);
198: PetscFree(lusol->locr);
199: PetscFree(lusol->iploc);
200: PetscFree(lusol->iqloc);
201: PetscFree(lusol->ipinv);
202: PetscFree(lusol->iqinv);
203: PetscFree(lusol->mnsw);
204: PetscFree(lusol->mnsv);
206: PetscFree(lusol->indc);
207: PetscFree(lusol);
209: MatDestroy_SeqAIJ(A);
210: return(0);
211: }
213: int MatSolve_SeqAIJ_LUSOL(Mat A,Vec b,Vec x)
214: {
215: Mat_SeqAIJ_LUSOL *lusol =
216: (Mat_SeqAIJ_LUSOL *)((Mat_SeqAIJ*)A->data)->spptr;
217: double *bb, *xx;
218: int mode = 5;
219: int i, m, n, nnz, status, ierr;
222: VecGetArray(x, &xx);
223: VecGetArray(b, &bb);
225: m = n = lusol->n;
226: nnz = lusol->nnz;
228: for (i = 0; i < m; i++)
229: {
230: lusol->mnsv[i] = bb[i];
231: }
233: LU6SOL(&mode, &m, &n, lusol->mnsv, xx, &nnz,
234: lusol->luparm, lusol->parmlu, lusol->data,
235: lusol->indc, lusol->indr, lusol->ip, lusol->iq,
236: lusol->lenc, lusol->lenr, lusol->locc, lusol->locr, &status);
238: if (status != 0)
239: {
240: SETERRQ(PETSC_ERR_ARG_SIZ,"solve failed");
241: }
243: VecRestoreArray(x, &xx);
244: VecRestoreArray(b, &bb);
245: return(0);
246: }
248: int MatLUFactorNumeric_SeqAIJ_LUSOL(Mat A, Mat *F)
249: {
250: Mat_SeqAIJ *a;
251: Mat_SeqAIJ_LUSOL *lusol = (Mat_SeqAIJ_LUSOL *)((Mat_SeqAIJ *)(*F)->data)->spptr;
252: int m, n, nz, nnz, status;
253: int i, rs, re,ierr;
254: int factorizations;
257: MatGetSize(A,&m,&n);
258: a = (Mat_SeqAIJ *)A->data;
260: if (m != lusol->n) {
261: SETERRQ(PETSC_ERR_ARG_SIZ,"factorization struct inconsistent");
262: }
264: factorizations = 0;
265: do
266: {
267: /*******************************************************************/
268: /* Check the workspace allocation. */
269: /*******************************************************************/
271: nz = a->nz;
272: nnz = PetscMax(lusol->nnz, (int)(lusol->elbowroom*nz));
273: nnz = PetscMax(nnz, 5*n);
275: if (nnz < lusol->luparm[12]){
276: nnz = (int)(lusol->luroom * lusol->luparm[12]);
277: } else if ((factorizations > 0) && (lusol->luroom < 6)){
278: lusol->luroom += 0.1;
279: }
281: nnz = PetscMax(nnz, (int)(lusol->luroom*(lusol->luparm[22] + lusol->luparm[23])));
283: if (nnz > lusol->nnz){
284: PetscFree(lusol->indc);
285: ierr = PetscMalloc((sizeof(double)+2*sizeof(int))*nnz,&lusol->indc);
286: lusol->indr = lusol->indc + nnz;
287: lusol->data = (double *)(lusol->indr + nnz);
288: lusol->nnz = nnz;
289: }
291: /*******************************************************************/
292: /* Fill in the data for the problem. */
293: /*******************************************************************/
295: nz = 0;
296: if (a->indexshift)
297: {
298: for (i = 0; i < n; i++)
299: {
300: rs = a->i[i] - 1;
301: re = a->i[i+1] - 1;
303: while (rs < re)
304: {
305: if (a->a[rs] != 0.0)
306: {
307: lusol->indc[nz] = i + 1;
308: lusol->indr[nz] = a->j[rs];
309: lusol->data[nz] = a->a[rs];
310: nz++;
311: }
312: rs++;
313: }
314: }
315: } else
316: {
317: for (i = 0; i < n; i++)
318: {
319: rs = a->i[i];
320: re = a->i[i+1];
322: while (rs < re)
323: {
324: if (a->a[rs] != 0.0)
325: {
326: lusol->indc[nz] = i + 1;
327: lusol->indr[nz] = a->j[rs] + 1;
328: lusol->data[nz] = a->a[rs];
329: nz++;
330: }
331: rs++;
332: }
333: }
334: }
336: /*******************************************************************/
337: /* Do the factorization. */
338: /*******************************************************************/
340: LU1FAC(&m, &n, &nz, &nnz,
341: lusol->luparm, lusol->parmlu, lusol->data,
342: lusol->indc, lusol->indr, lusol->ip, lusol->iq,
343: lusol->lenc, lusol->lenr, lusol->locc, lusol->locr,
344: lusol->iploc, lusol->iqloc, lusol->ipinv,
345: lusol->iqinv, lusol->mnsw, &status);
346:
347: switch(status)
348: {
349: case 0: /* factored */
350: break;
352: case 7: /* insufficient memory */
353: break;
355: case 1:
356: case -1: /* singular */
357: SETERRQ(PETSC_ERR_ARG_SIZ,"singular matrix");
359: case 3:
360: case 4: /* error conditions */
361: SETERRQ(PETSC_ERR_ARG_SIZ,"matrix error");
363: default: /* unknown condition */
364: SETERRQ(PETSC_ERR_ARG_SIZ,"matrix unknown return code");
365: }
367: factorizations++;
368: } while (status == 7);
369: return(0);
370: }
372: int MatLUFactorSymbolic_SeqAIJ_LUSOL(Mat A, IS r, IS c,MatLUInfo *info, Mat *F)
373: {
374: /************************************************************************/
375: /* Input */
376: /* A - matrix to factor */
377: /* r - row permutation (ignored) */
378: /* c - column permutation (ignored) */
379: /* */
380: /* Output */
381: /* F - matrix storing the factorization; */
382: /************************************************************************/
384: Mat_SeqAIJ_LUSOL *lusol;
385: int ierr,i, m, n, nz, nnz;
388:
389: /************************************************************************/
390: /* Check the arguments. */
391: /************************************************************************/
393: MatGetSize(A, &m, &n);
394: nz = ((Mat_SeqAIJ *)A->data)->nz;
396: /************************************************************************/
397: /* Create the factorization. */
398: /************************************************************************/
400: MatCreateSeqAIJ(A->comm, m, n, 0, PETSC_NULL, F);
402: (*F)->ops->destroy = MatDestroy_SeqAIJ_LUSOL;
403: (*F)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_LUSOL;
404: (*F)->ops->solve = MatSolve_SeqAIJ_LUSOL;
405: (*F)->factor = FACTOR_LU;
407: PetscNew(Mat_SeqAIJ_LUSOL,&lusol);
408: ((Mat_SeqAIJ *)(*F)->data)->spptr = (void *)lusol;
410: /************************************************************************/
411: /* Initialize parameters */
412: /************************************************************************/
414: for (i = 0; i < 30; i++)
415: {
416: lusol->luparm[i] = 0;
417: lusol->parmlu[i] = 0;
418: }
420: lusol->luparm[1] = -1;
421: lusol->luparm[2] = 5;
422: lusol->luparm[7] = 1;
424: lusol->parmlu[0] = 1 / Factorization_Tolerance;
425: lusol->parmlu[1] = 1 / Factorization_Tolerance;
426: lusol->parmlu[2] = Factorization_Small_Tolerance;
427: lusol->parmlu[3] = Factorization_Pivot_Tolerance;
428: lusol->parmlu[4] = Factorization_Pivot_Tolerance;
429: lusol->parmlu[5] = 3.0;
430: lusol->parmlu[6] = 0.3;
431: lusol->parmlu[7] = 0.6;
433: /************************************************************************/
434: /* Allocate the workspace needed by LUSOL. */
435: /************************************************************************/
437: lusol->elbowroom = 2.5; /* Assume at least some extra memory alloced */
438: if (info)
439: {
440: lusol->elbowroom = PetscMax(lusol->elbowroom, info->fill);
441: }
442: nnz = PetscMax((int)(lusol->elbowroom*nz), 5*n);
443:
444: lusol->n = n;
445: lusol->nz = nz;
446: lusol->nnz = nnz;
447: lusol->luroom = 1.75;
449: PetscMalloc(sizeof(int)*n,&lusol->ip);
450: PetscMalloc(sizeof(int)*n,&lusol->iq);
451: PetscMalloc(sizeof(int)*n,&lusol->lenc);
452: PetscMalloc(sizeof(int)*n,&lusol->lenr);
453: PetscMalloc(sizeof(int)*n,&lusol->locc);
454: PetscMalloc(sizeof(int)*n,&lusol->locr);
455: PetscMalloc(sizeof(int)*n,&lusol->iploc);
456: PetscMalloc(sizeof(int)*n,&lusol->iqloc);
457: PetscMalloc(sizeof(int)*n,&lusol->ipinv);
458: PetscMalloc(sizeof(int)*n,&lusol->iqinv);
459: PetscMalloc(sizeof(double)*n,&lusol->mnsw);
460: PetscMalloc(sizeof(double)*n,&lusol->mnsv);
462: ierr = PetscMalloc((sizeof(double)+2*sizeof(int))*nnz,&lusol->indc);
463: lusol->indr = lusol->indc + nnz;
464: lusol->data = (double *)(lusol->indr + nnz);
465: return(0);
466: }
467: EXTERN_C_END
469: int MatUseLUSOL_SeqAIJ(Mat A)
470: {
471: int ierr, m, n;
472: PetscTruth match;
473:
475: MatGetSize(A, &m, &n);
476: if (m != n) {
477: SETERRQ(PETSC_ERR_ARG_SIZ,"matrix must be square");
478: }
479:
480: PetscTypeCompare((PetscObject)A,MATSEQAIJ,&match);
481: if (!match) {
482: SETERRQ(PETSC_ERR_ARG_SIZ,"matrix must be Seq_AIJ");
483: }
484:
485: A->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqAIJ_LUSOL;
486: PetscLogInfo(0,"Using LUSOL for SeqAIJ LU factorization and solves.");
487: return(0);
488: }
490: #else
492: int MatUseLUSOL_SeqAIJ(Mat A)
493: {
495: return(0);
496: }
498: #endif