Actual source code: lusol.c

  1: /*$Id: lusol.c,v 1.10 2001/04/09 15:38:01 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)

 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