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: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9: #define LU1FAC lu1fac_
10: #define LU6SOL lu6sol_
11: #define M1PAGE m1page_
12: #define M5SETX m5setx_
13: #define M6RDEL m6rdel_
14: #elif !defined(PETSC_HAVE_FORTRAN_CAPS)
15: #define LU1FAC lu1fac
16: #define LU6SOL lu6sol
17: #define M1PAGE m1page
18: #define M5SETX m5setx
19: #define M6RDEL m6rdel
20: #endif
22: EXTERN_C_BEGIN
23: /*
24: Dummy symbols that the MINOS files mi25bfac.f and mi15blas.f may require
25: */
26: void PETSC_STDCALL M1PAGE() {
27: ;
28: }
29: void PETSC_STDCALL M5SETX() {
30: ;
31: }
33: void PETSC_STDCALL M6RDEL() {
34: ;
35: }
37: extern void PETSC_STDCALL LU1FAC (int *m, int *n, int *nnz, int *size, int *luparm,
38: double *parmlu, double *data, int *indc, int *indr,
39: int *rowperm, int *colperm, int *collen, int *rowlen,
40: int *colstart, int *rowstart, int *rploc, int *cploc,
41: int *rpinv, int *cpinv, double *w, int *inform);
43: extern void PETSC_STDCALL LU6SOL (int *mode, int *m, int *n, double *rhs, double *x,
44: int *size, int *luparm, double *parmlu, double *data,
45: int *indc, int *indr, int *rowperm, int *colperm,
46: int *collen, int *rowlen, int *colstart, int *rowstart,
47: int *inform);
48: EXTERN_C_END
50: EXTERN int MatDuplicate_LUSOL(Mat,MatDuplicateOption,Mat*);
52: typedef struct {
53: double *data;
54: int *indc;
55: int *indr;
57: int *ip;
58: int *iq;
59: int *lenc;
60: int *lenr;
61: int *locc;
62: int *locr;
63: int *iploc;
64: int *iqloc;
65: int *ipinv;
66: int *iqinv;
67: double *mnsw;
68: double *mnsv;
70: double elbowroom;
71: double luroom; /* Extra space allocated when factor fails */
72: double parmlu[30]; /* Input/output to LUSOL */
74: int n; /* Number of rows/columns in matrix */
75: int nz; /* Number of nonzeros */
76: int nnz; /* Number of nonzeros allocated for factors */
77: int luparm[30]; /* Input/output to LUSOL */
79: int (*MatDuplicate)(Mat,MatDuplicateOption,Mat*);
80: int (*MatLUFactorSymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*);
81: int (*MatDestroy)(Mat);
82: PetscTruth CleanUpLUSOL;
84: } Mat_LUSOL;
86: /* LUSOL input/Output Parameters (Description uses C-style indexes
87: *
88: * Input parameters Typical value
89: *
90: * luparm(0) = nout File number for printed messages. 6
91: * luparm(1) = lprint Print level. 0
92: * < 0 suppresses output.
93: * = 0 gives error messages.
94: * = 1 gives debug output from some of the
95: * other routines in LUSOL.
96: * >= 2 gives the pivot row and column and the
97: * no. of rows and columns involved at
98: * each elimination step in lu1fac.
99: * luparm(2) = maxcol lu1fac: maximum number of columns 5
100: * searched allowed in a Markowitz-type
101: * search for the next pivot element.
102: * For some of the factorization, the
103: * number of rows searched is
104: * maxrow = maxcol - 1.
105: *
106: *
107: * Output parameters
108: *
109: * luparm(9) = inform Return code from last call to any LU routine.
110: * luparm(10) = nsing No. of singularities marked in the
111: * output array w(*).
112: * luparm(11) = jsing Column index of last singularity.
113: * luparm(12) = minlen Minimum recommended value for lena.
114: * luparm(13) = maxlen ?
115: * luparm(14) = nupdat No. of updates performed by the lu8 routines.
116: * luparm(15) = nrank No. of nonempty rows of U.
117: * luparm(16) = ndens1 No. of columns remaining when the density of
118: * the matrix being factorized reached dens1.
119: * luparm(17) = ndens2 No. of columns remaining when the density of
120: * the matrix being factorized reached dens2.
121: * luparm(18) = jumin The column index associated with dumin.
122: * luparm(19) = numl0 No. of columns in initial L.
123: * luparm(20) = lenl0 Size of initial L (no. of nonzeros).
124: * luparm(21) = lenu0 Size of initial U.
125: * luparm(22) = lenl Size of current L.
126: * luparm(23) = lenu Size of current U.
127: * luparm(24) = lrow Length of row file.
128: * luparm(25) = ncp No. of compressions of LU data structures.
129: * luparm(26) = mersum lu1fac: sum of Markowitz merit counts.
130: * luparm(27) = nutri lu1fac: triangular rows in U.
131: * luparm(28) = nltri lu1fac: triangular rows in L.
132: * luparm(29) =
133: *
134: *
135: * Input parameters Typical value
136: *
137: * parmlu(0) = elmax1 Max multiplier allowed in L 10.0
138: * during factor.
139: * parmlu(1) = elmax2 Max multiplier allowed in L 10.0
140: * during updates.
141: * parmlu(2) = small Absolute tolerance for eps**0.8
142: * treating reals as zero. IBM double: 3.0d-13
143: * parmlu(3) = utol1 Absolute tol for flagging eps**0.66667
144: * small diagonals of U. IBM double: 3.7d-11
145: * parmlu(4) = utol2 Relative tol for flagging eps**0.66667
146: * small diagonals of U. IBM double: 3.7d-11
147: * parmlu(5) = uspace Factor limiting waste space in U. 3.0
148: * In lu1fac, the row or column lists
149: * are compressed if their length
150: * exceeds uspace times the length of
151: * either file after the last compression.
152: * parmlu(6) = dens1 The density at which the Markowitz 0.3
153: * strategy should search maxcol columns
154: * and no rows.
155: * parmlu(7) = dens2 the density at which the Markowitz 0.6
156: * strategy should search only 1 column
157: * or (preferably) use a dense LU for
158: * all the remaining rows and columns.
159: *
160: *
161: * Output parameters
162: *
163: * parmlu(9) = amax Maximum element in A.
164: * parmlu(10) = elmax Maximum multiplier in current L.
165: * parmlu(11) = umax Maximum element in current U.
166: * parmlu(12) = dumax Maximum diagonal in U.
167: * parmlu(13) = dumin Minimum diagonal in U.
168: * parmlu(14) =
169: * parmlu(15) =
170: * parmlu(16) =
171: * parmlu(17) =
172: * parmlu(18) =
173: * parmlu(19) = resid lu6sol: residual after solve with U or U'.
174: * ...
175: * parmlu(29) =
176: */
178: #define Factorization_Tolerance 1e-1
179: #define Factorization_Pivot_Tolerance pow(2.2204460492503131E-16, 2.0 / 3.0)
180: #define Factorization_Small_Tolerance 1e-15 /* pow(DBL_EPSILON, 0.8) */
182: EXTERN_C_BEGIN
185: int MatConvert_LUSOL_SeqAIJ(Mat A,const MatType type,Mat *newmat) {
186: /* This routine is only called to convert an unfactored PETSc-LUSOL matrix */
187: /* to its base PETSc type, so we will ignore 'MatType type'. */
188: int ierr;
189: Mat B=*newmat;
190: Mat_LUSOL *lusol=(Mat_LUSOL *)A->spptr;
193: if (B != A) {
194: MatDuplicate(A,MAT_COPY_VALUES,&B);
195: }
196: B->ops->duplicate = lusol->MatDuplicate;
197: B->ops->lufactorsymbolic = lusol->MatLUFactorSymbolic;
198: B->ops->destroy = lusol->MatDestroy;
199:
200: PetscFree(lusol);
201: PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);
202: *newmat = B;
203: return(0);
204: }
205: EXTERN_C_END
209: int MatDestroy_LUSOL(Mat A) {
210: int ierr;
211: Mat_LUSOL *lusol=(Mat_LUSOL *)A->spptr;
214: if (lusol->CleanUpLUSOL) {
215: PetscFree(lusol->ip);
216: PetscFree(lusol->iq);
217: PetscFree(lusol->lenc);
218: PetscFree(lusol->lenr);
219: PetscFree(lusol->locc);
220: PetscFree(lusol->locr);
221: PetscFree(lusol->iploc);
222: PetscFree(lusol->iqloc);
223: PetscFree(lusol->ipinv);
224: PetscFree(lusol->iqinv);
225: PetscFree(lusol->mnsw);
226: PetscFree(lusol->mnsv);
227:
228: PetscFree(lusol->indc);
229: }
231: MatConvert_LUSOL_SeqAIJ(A,MATSEQAIJ,&A);
232: (*A->ops->destroy)(A);
233: return(0);
234: }
238: int MatSolve_LUSOL(Mat A,Vec b,Vec x) {
239: Mat_LUSOL *lusol=(Mat_LUSOL*)A->spptr;
240: double *bb,*xx;
241: int mode=5;
242: int i,m,n,nnz,status,ierr;
245: VecGetArray(x, &xx);
246: VecGetArray(b, &bb);
248: m = n = lusol->n;
249: nnz = lusol->nnz;
251: for (i = 0; i < m; i++)
252: {
253: lusol->mnsv[i] = bb[i];
254: }
256: LU6SOL(&mode, &m, &n, lusol->mnsv, xx, &nnz,
257: lusol->luparm, lusol->parmlu, lusol->data,
258: lusol->indc, lusol->indr, lusol->ip, lusol->iq,
259: lusol->lenc, lusol->lenr, lusol->locc, lusol->locr, &status);
261: if (status != 0)
262: {
263: SETERRQ(PETSC_ERR_ARG_SIZ,"solve failed");
264: }
266: VecRestoreArray(x, &xx);
267: VecRestoreArray(b, &bb);
268: return(0);
269: }
273: int MatLUFactorNumeric_LUSOL(Mat A, Mat *F) {
274: Mat_SeqAIJ *a;
275: Mat_LUSOL *lusol = (Mat_LUSOL*)(*F)->spptr;
276: int m, n, nz, nnz, status;
277: int i, rs, re,ierr;
278: int factorizations;
281: MatGetSize(A,&m,&n);
282: a = (Mat_SeqAIJ *)A->data;
284: if (m != lusol->n) {
285: SETERRQ(PETSC_ERR_ARG_SIZ,"factorization struct inconsistent");
286: }
288: factorizations = 0;
289: do
290: {
291: /*******************************************************************/
292: /* Check the workspace allocation. */
293: /*******************************************************************/
295: nz = a->nz;
296: nnz = PetscMax(lusol->nnz, (int)(lusol->elbowroom*nz));
297: nnz = PetscMax(nnz, 5*n);
299: if (nnz < lusol->luparm[12]){
300: nnz = (int)(lusol->luroom * lusol->luparm[12]);
301: } else if ((factorizations > 0) && (lusol->luroom < 6)){
302: lusol->luroom += 0.1;
303: }
305: nnz = PetscMax(nnz, (int)(lusol->luroom*(lusol->luparm[22] + lusol->luparm[23])));
307: if (nnz > lusol->nnz){
308: PetscFree(lusol->indc);
309: PetscMalloc((sizeof(double)+2*sizeof(int))*nnz,&lusol->indc);
310: lusol->indr = lusol->indc + nnz;
311: lusol->data = (double *)(lusol->indr + nnz);
312: lusol->nnz = nnz;
313: }
315: /*******************************************************************/
316: /* Fill in the data for the problem. (1-based Fortran style) */
317: /*******************************************************************/
319: nz = 0;
320: for (i = 0; i < n; i++)
321: {
322: rs = a->i[i];
323: re = a->i[i+1];
325: while (rs < re)
326: {
327: if (a->a[rs] != 0.0)
328: {
329: lusol->indc[nz] = i + 1;
330: lusol->indr[nz] = a->j[rs] + 1;
331: lusol->data[nz] = a->a[rs];
332: nz++;
333: }
334: rs++;
335: }
336: }
338: /*******************************************************************/
339: /* Do the factorization. */
340: /*******************************************************************/
342: LU1FAC(&m, &n, &nz, &nnz,
343: lusol->luparm, lusol->parmlu, lusol->data,
344: lusol->indc, lusol->indr, lusol->ip, lusol->iq,
345: lusol->lenc, lusol->lenr, lusol->locc, lusol->locr,
346: lusol->iploc, lusol->iqloc, lusol->ipinv,
347: lusol->iqinv, lusol->mnsw, &status);
348:
349: switch(status)
350: {
351: case 0: /* factored */
352: break;
354: case 7: /* insufficient memory */
355: break;
357: case 1:
358: case -1: /* singular */
359: SETERRQ(1,"Singular matrix");
361: case 3:
362: case 4: /* error conditions */
363: SETERRQ(1,"matrix error");
365: default: /* unknown condition */
366: SETERRQ(1,"matrix unknown return code");
367: }
369: factorizations++;
370: } while (status == 7);
371: (*F)->assembled = PETSC_TRUE;
372: return(0);
373: }
377: int MatLUFactorSymbolic_LUSOL(Mat A, IS r, IS c,MatFactorInfo *info, Mat *F) {
378: /************************************************************************/
379: /* Input */
380: /* A - matrix to factor */
381: /* r - row permutation (ignored) */
382: /* c - column permutation (ignored) */
383: /* */
384: /* Output */
385: /* F - matrix storing the factorization; */
386: /************************************************************************/
387: Mat B;
388: Mat_LUSOL *lusol;
389: int ierr,i, m, n, nz, nnz;
392:
393: /************************************************************************/
394: /* Check the arguments. */
395: /************************************************************************/
397: MatGetSize(A, &m, &n);
398: nz = ((Mat_SeqAIJ *)A->data)->nz;
400: /************************************************************************/
401: /* Create the factorization. */
402: /************************************************************************/
404: MatCreate(A->comm,PETSC_DECIDE,PETSC_DECIDE,m,n,&B);
405: MatSetType(B,A->type_name);
406: MatSeqAIJSetPreallocation(B,0,PETSC_NULL);
408: B->ops->lufactornumeric = MatLUFactorNumeric_LUSOL;
409: B->ops->solve = MatSolve_LUSOL;
410: B->factor = FACTOR_LU;
411: lusol = (Mat_LUSOL*)(B->spptr);
413: /************************************************************************/
414: /* Initialize parameters */
415: /************************************************************************/
417: for (i = 0; i < 30; i++)
418: {
419: lusol->luparm[i] = 0;
420: lusol->parmlu[i] = 0;
421: }
423: lusol->luparm[1] = -1;
424: lusol->luparm[2] = 5;
425: lusol->luparm[7] = 1;
427: lusol->parmlu[0] = 1 / Factorization_Tolerance;
428: lusol->parmlu[1] = 1 / Factorization_Tolerance;
429: lusol->parmlu[2] = Factorization_Small_Tolerance;
430: lusol->parmlu[3] = Factorization_Pivot_Tolerance;
431: lusol->parmlu[4] = Factorization_Pivot_Tolerance;
432: lusol->parmlu[5] = 3.0;
433: lusol->parmlu[6] = 0.3;
434: lusol->parmlu[7] = 0.6;
436: /************************************************************************/
437: /* Allocate the workspace needed by LUSOL. */
438: /************************************************************************/
440: lusol->elbowroom = PetscMax(lusol->elbowroom, info->fill);
441: nnz = PetscMax((int)(lusol->elbowroom*nz), 5*n);
442:
443: lusol->n = n;
444: lusol->nz = nz;
445: lusol->nnz = nnz;
446: lusol->luroom = 1.75;
448: PetscMalloc(sizeof(int)*n,&lusol->ip);
449: PetscMalloc(sizeof(int)*n,&lusol->iq);
450: PetscMalloc(sizeof(int)*n,&lusol->lenc);
451: PetscMalloc(sizeof(int)*n,&lusol->lenr);
452: PetscMalloc(sizeof(int)*n,&lusol->locc);
453: PetscMalloc(sizeof(int)*n,&lusol->locr);
454: PetscMalloc(sizeof(int)*n,&lusol->iploc);
455: PetscMalloc(sizeof(int)*n,&lusol->iqloc);
456: PetscMalloc(sizeof(int)*n,&lusol->ipinv);
457: PetscMalloc(sizeof(int)*n,&lusol->iqinv);
458: PetscMalloc(sizeof(double)*n,&lusol->mnsw);
459: PetscMalloc(sizeof(double)*n,&lusol->mnsv);
461: PetscMalloc((sizeof(double)+2*sizeof(int))*nnz,&lusol->indc);
462: lusol->indr = lusol->indc + nnz;
463: lusol->data = (double *)(lusol->indr + nnz);
464: lusol->CleanUpLUSOL = PETSC_TRUE;
465: *F = B;
466: return(0);
467: }
469: EXTERN_C_BEGIN
472: int MatConvert_SeqAIJ_LUSOL(Mat A,const MatType type,Mat *newmat) {
473: int ierr, m, n;
474: Mat_LUSOL *lusol;
475: Mat B=*newmat;
478: MatGetSize(A, &m, &n);
479: if (m != n) {
480: SETERRQ(PETSC_ERR_ARG_SIZ,"matrix must be square");
481: }
482: if (B != A) {
483: MatDuplicate(A,MAT_COPY_VALUES,&B);
484: }
485:
486: PetscNew(Mat_LUSOL,&lusol);
487: lusol->MatDuplicate = A->ops->duplicate;
488: lusol->MatLUFactorSymbolic = A->ops->lufactorsymbolic;
489: lusol->MatDestroy = A->ops->destroy;
490: lusol->CleanUpLUSOL = PETSC_FALSE;
492: B->spptr = (void *)lusol;
493: B->ops->duplicate = MatDuplicate_LUSOL;
494: B->ops->lufactorsymbolic = MatLUFactorSymbolic_LUSOL;
495: B->ops->destroy = MatDestroy_LUSOL;
497: PetscLogInfo(0,"Using LUSOL for LU factorization and solves.");
498: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqaij_lusol_C",
499: "MatConvert_SeqAIJ_LUSOL",MatConvert_SeqAIJ_LUSOL);
500: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_lusol_seqaij_C",
501: "MatConvert_LUSOL_SeqAIJ",MatConvert_LUSOL_SeqAIJ);
502: PetscObjectChangeTypeName((PetscObject)B,type);
503: *newmat = B;
504: return(0);
505: }
506: EXTERN_C_END
510: int MatDuplicate_LUSOL(Mat A, MatDuplicateOption op, Mat *M) {
511: int ierr;
512: Mat_LUSOL *lu=(Mat_LUSOL *)A->spptr;
514: (*lu->MatDuplicate)(A,op,M);
515: PetscMemcpy((*M)->spptr,lu,sizeof(Mat_LUSOL));
516: return(0);
517: }
519: /*MC
520: MATLUSOL - MATLUSOL = "lusol" - A matrix type providing direct solvers (LU) for sequential matrices
521: via the external package LUSOL.
523: If LUSOL is installed (see the manual for
524: instructions on how to declare the existence of external packages),
525: a matrix type can be constructed which invokes LUSOL solvers.
526: After calling MatCreate(...,A), simply call MatSetType(A,MATLUSOL).
527: This matrix type is only supported for double precision real.
529: This matrix inherits from MATSEQAIJ. As a result, MatSeqAIJSetPreallocation is
530: supported for this matrix type. MatConvert can be called for a fast inplace conversion
531: to and from the MATSEQAIJ matrix type.
533: Options Database Keys:
534: . -mat_type lusol - sets the matrix type to "lusol" during a call to MatSetFromOptions()
536: Level: beginner
538: .seealso: PCLU
539: M*/
541: EXTERN_C_BEGIN
544: int MatCreate_LUSOL(Mat A) {
548: /* Change type name before calling MatSetType to force proper construction of SeqAIJ and LUSOL types */
549: PetscObjectChangeTypeName((PetscObject)A,MATLUSOL);
550: MatSetType(A,MATSEQAIJ);
551: MatConvert_SeqAIJ_LUSOL(A,MATLUSOL,&A);
552: return(0);
553: }
554: EXTERN_C_END