Date: 2022-03-31T04:46:46+00:00

Actual source code: lusol.c

      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: /*
     23:     Dummy symbols that the MINOS files mi25bfac.f and mi15blas.f may require
     24: */
     25: PETSC_EXTERN void M1PAGE()
     26: {
     27:   ;
     28: }
     29: PETSC_EXTERN void M5SETX()
     30: {
     31:   ;
     32: }

     34: PETSC_EXTERN void M6RDEL()
     35: {
     36:   ;
     37: }

     39: PETSC_EXTERN void LU1FAC(int *m, int *n, int *nnz, int *size, int *luparm,
     40:                                  double *parmlu, double *data, int *indc, int *indr,
     41:                                  int *rowperm, int *colperm, int *collen, int *rowlen,
     42:                                  int *colstart, int *rowstart, int *rploc, int *cploc,
     43:                                  int *rpinv, int *cpinv, double *w, int *inform);

     45: PETSC_EXTERN void LU6SOL(int *mode, int *m, int *n, double *rhs, double *x,
     46:                                  int *size, int *luparm, double *parmlu, double *data,
     47:                                  int *indc, int *indr, int *rowperm, int *colperm,
     48:                                  int *collen, int *rowlen, int *colstart, int *rowstart,
     49:                                  int *inform);

     51: extern PetscErrorCode MatDuplicate_LUSOL(Mat,MatDuplicateOption,Mat*);

     53: typedef struct  {
     54:   double *data;
     55:   int    *indc;
     56:   int    *indr;

     58:   int    *ip;
     59:   int    *iq;
     60:   int    *lenc;
     61:   int    *lenr;
     62:   int    *locc;
     63:   int    *locr;
     64:   int    *iploc;
     65:   int    *iqloc;
     66:   int    *ipinv;
     67:   int    *iqinv;
     68:   double *mnsw;
     69:   double *mnsv;

     71:   double elbowroom;
     72:   double luroom;                /* Extra space allocated when factor fails   */
     73:   double parmlu[30];            /* Input/output to LUSOL                     */

     75:   int n;                        /* Number of rows/columns in matrix          */
     76:   int nz;                       /* Number of nonzeros                        */
     77:   int nnz;                      /* Number of nonzeros allocated for factors  */
     78:   int luparm[30];               /* Input/output to LUSOL                     */

     80:   PetscBool CleanUpLUSOL;

     82: } Mat_LUSOL;

     84: /*  LUSOL input/Output Parameters (Description uses C-style indexes
     85:  *
     86:  *  Input parameters                                        Typical value
     87:  *
     88:  *  luparm(0) = nout     File number for printed messages.         6
     89:  *  luparm(1) = lprint   Print level.                              0
     90:  *                    < 0 suppresses output.
     91:  *                    = 0 gives error messages.
     92:  *                    = 1 gives debug output from some of the
     93:  *                        other routines in LUSOL.
     94:  *                   >= 2 gives the pivot row and column and the
     95:  *                        no. of rows and columns involved at
     96:  *                        each elimination step in lu1fac.
     97:  *  luparm(2) = maxcol   lu1fac: maximum number of columns         5
     98:  *                        searched allowed in a Markowitz-type
     99:  *                        search for the next pivot element.
    100:  *                        For some of the factorization, the
    101:  *                        number of rows searched is
    102:  *                        maxrow = maxcol - 1.
    103:  *
    104:  *
    105:  *  Output parameters:
    106:  *
    107:  *  luparm(9) = inform   Return code from last call to any LU routine.
    108:  *  luparm(10) = nsing    No. of singularities marked in the
    109:  *                        output array w(*).
    110:  *  luparm(11) = jsing    Column index of last singularity.
    111:  *  luparm(12) = minlen   Minimum recommended value for  lena.
    112:  *  luparm(13) = maxlen   ?
    113:  *  luparm(14) = nupdat   No. of updates performed by the lu8 routines.
    114:  *  luparm(15) = nrank    No. of nonempty rows of U.
    115:  *  luparm(16) = ndens1   No. of columns remaining when the density of
    116:  *                        the matrix being factorized reached dens1.
    117:  *  luparm(17) = ndens2   No. of columns remaining when the density of
    118:  *                        the matrix being factorized reached dens2.
    119:  *  luparm(18) = jumin    The column index associated with dumin.
    120:  *  luparm(19) = numl0    No. of columns in initial  L.
    121:  *  luparm(20) = lenl0    Size of initial  L  (no. of nonzeros).
    122:  *  luparm(21) = lenu0    Size of initial  U.
    123:  *  luparm(22) = lenl     Size of current  L.
    124:  *  luparm(23) = lenu     Size of current  U.
    125:  *  luparm(24) = lrow     Length of row file.
    126:  *  luparm(25) = ncp      No. of compressions of LU data structures.
    127:  *  luparm(26) = mersum   lu1fac: sum of Markowitz merit counts.
    128:  *  luparm(27) = nutri    lu1fac: triangular rows in U.
    129:  *  luparm(28) = nltri    lu1fac: triangular rows in L.
    130:  *  luparm(29) =
    131:  *
    132:  *
    133:  *  Input parameters                                        Typical value
    134:  *
    135:  *  parmlu(0) = elmax1   Max multiplier allowed in  L           10.0
    136:  *                        during factor.
    137:  *  parmlu(1) = elmax2   Max multiplier allowed in  L           10.0
    138:  *                        during updates.
    139:  *  parmlu(2) = small    Absolute tolerance for             eps**0.8
    140:  *                        treating reals as zero.     IBM double: 3.0d-13
    141:  *  parmlu(3) = utol1    Absolute tol for flagging          eps**0.66667
    142:  *                        small diagonals of U.       IBM double: 3.7d-11
    143:  *  parmlu(4) = utol2    Relative tol for flagging          eps**0.66667
    144:  *                        small diagonals of U.       IBM double: 3.7d-11
    145:  *  parmlu(5) = uspace   Factor limiting waste space in  U.      3.0
    146:  *                        In lu1fac, the row or column lists
    147:  *                        are compressed if their length
    148:  *                        exceeds uspace times the length of
    149:  *                        either file after the last compression.
    150:  *  parmlu(6) = dens1    The density at which the Markowitz      0.3
    151:  *                        strategy should search maxcol columns
    152:  *                        and no rows.
    153:  *  parmlu(7) = dens2    the density at which the Markowitz      0.6
    154:  *                        strategy should search only 1 column
    155:  *                        or (preferably) use a dense LU for
    156:  *                        all the remaining rows and columns.
    157:  *
    158:  *
    159:  *  Output parameters:
    160:  *
    161:  *  parmlu(9) = amax     Maximum element in  A.
    162:  *  parmlu(10) = elmax    Maximum multiplier in current  L.
    163:  *  parmlu(11) = umax     Maximum element in current  U.
    164:  *  parmlu(12) = dumax    Maximum diagonal in  U.
    165:  *  parmlu(13) = dumin    Minimum diagonal in  U.
    166:  *  parmlu(14) =
    167:  *  parmlu(15) =
    168:  *  parmlu(16) =
    169:  *  parmlu(17) =
    170:  *  parmlu(18) =
    171:  *  parmlu(19) = resid    lu6sol: residual after solve with U or U'.
    172:  *  ...
    173:  *  parmlu(29) =
    174:  */

    176: #define Factorization_Tolerance       1e-1
    177: #define Factorization_Pivot_Tolerance pow(2.2204460492503131E-16, 2.0 / 3.0)
    178: #define Factorization_Small_Tolerance 1e-15 /* pow(DBL_EPSILON, 0.8) */

    180: PetscErrorCode MatDestroy_LUSOL(Mat A)
    181: {
    182:   Mat_LUSOL      *lusol=(Mat_LUSOL*)A->spptr;

    184:   if (lusol && lusol->CleanUpLUSOL) {
    185:     PetscFree(lusol->ip);
    186:     PetscFree(lusol->iq);
    187:     PetscFree(lusol->lenc);
    188:     PetscFree(lusol->lenr);
    189:     PetscFree(lusol->locc);
    190:     PetscFree(lusol->locr);
    191:     PetscFree(lusol->iploc);
    192:     PetscFree(lusol->iqloc);
    193:     PetscFree(lusol->ipinv);
    194:     PetscFree(lusol->iqinv);
    195:     PetscFree(lusol->mnsw);
    196:     PetscFree(lusol->mnsv);
    197:     PetscFree3(lusol->data,lusol->indc,lusol->indr);
    198:   }
    199:   PetscFree(A->spptr);
    200:   MatDestroy_SeqAIJ(A);
    201:   return 0;
    202: }

    204: PetscErrorCode MatSolve_LUSOL(Mat A,Vec b,Vec x)
    205: {
    206:   Mat_LUSOL      *lusol=(Mat_LUSOL*)A->spptr;
    207:   double         *xx;
    208:   const double   *bb;
    209:   int            mode=5;
    210:   int            i,m,n,nnz,status;

    212:   VecGetArray(x, &xx);
    213:   VecGetArrayRead(b, &bb);

    215:   m   = n = lusol->n;
    216:   nnz = lusol->nnz;

    218:   for (i = 0; i < m; i++) lusol->mnsv[i] = bb[i];

    220:   LU6SOL(&mode, &m, &n, lusol->mnsv, xx, &nnz,
    221:          lusol->luparm, lusol->parmlu, lusol->data,
    222:          lusol->indc, lusol->indr, lusol->ip, lusol->iq,
    223:          lusol->lenc, lusol->lenr, lusol->locc, lusol->locr, &status);

    227:   VecRestoreArray(x, &xx);
    228:   VecRestoreArrayRead(b, &bb);
    229:   return 0;
    230: }

    232: PetscErrorCode MatLUFactorNumeric_LUSOL(Mat F,Mat A,const MatFactorInfo *info)
    233: {
    234:   Mat_SeqAIJ     *a;
    235:   Mat_LUSOL      *lusol = (Mat_LUSOL*)F->spptr;
    236:   int            m, n, nz, nnz, status;
    237:   int            i, rs, re;
    238:   int            factorizations;

    240:   MatGetSize(A,&m,&n);
    241:   a    = (Mat_SeqAIJ*)A->data;

    245:   factorizations = 0;
    246:   do {
    247:     /*******************************************************************/
    248:     /* Check the workspace allocation.                                 */
    249:     /*******************************************************************/

    251:     nz  = a->nz;
    252:     nnz = PetscMax(lusol->nnz, (int)(lusol->elbowroom*nz));
    253:     nnz = PetscMax(nnz, 5*n);

    255:     if (nnz < lusol->luparm[12]) {
    256:       nnz = (int)(lusol->luroom * lusol->luparm[12]);
    257:     } else if ((factorizations > 0) && (lusol->luroom < 6)) {
    258:       lusol->luroom += 0.1;
    259:     }

    261:     nnz = PetscMax(nnz, (int)(lusol->luroom*(lusol->luparm[22] + lusol->luparm[23])));

    263:     if (nnz > lusol->nnz) {
    264:       PetscFree3(lusol->data,lusol->indc,lusol->indr);
    265:       PetscMalloc3(nnz,&lusol->data,nnz,&lusol->indc,nnz,&lusol->indr);
    266:       lusol->nnz = nnz;
    267:     }

    269:     /*******************************************************************/
    270:     /* Fill in the data for the problem.      (1-based Fortran style)  */
    271:     /*******************************************************************/

    273:     nz = 0;
    274:     for (i = 0; i < n; i++) {
    275:       rs = a->i[i];
    276:       re = a->i[i+1];

    278:       while (rs < re) {
    279:         if (a->a[rs] != 0.0) {
    280:           lusol->indc[nz] = i + 1;
    281:           lusol->indr[nz] = a->j[rs] + 1;
    282:           lusol->data[nz] = a->a[rs];
    283:           nz++;
    284:         }
    285:         rs++;
    286:       }
    287:     }

    289:     /*******************************************************************/
    290:     /* Do the factorization.                                           */
    291:     /*******************************************************************/

    293:     LU1FAC(&m, &n, &nz, &nnz,
    294:            lusol->luparm, lusol->parmlu, lusol->data,
    295:            lusol->indc, lusol->indr, lusol->ip, lusol->iq,
    296:            lusol->lenc, lusol->lenr, lusol->locc, lusol->locr,
    297:            lusol->iploc, lusol->iqloc, lusol->ipinv,
    298:            lusol->iqinv, lusol->mnsw, &status);

    300:     switch (status) {
    301:     case 0:         /* factored */
    302:       break;

    304:     case 7:         /* insufficient memory */
    305:       break;

    307:     case 1:
    308:     case -1:        /* singular */
    309:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Singular matrix");

    311:     case 3:
    312:     case 4:         /* error conditions */
    313:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"matrix error");

    315:     default:        /* unknown condition */
    316:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"matrix unknown return code");
    317:     }

    319:     factorizations++;
    320:   } while (status == 7);
    321:   F->ops->solve   = MatSolve_LUSOL;
    322:   F->assembled    = PETSC_TRUE;
    323:   F->preallocated = PETSC_TRUE;
    324:   return 0;
    325: }

    327: PetscErrorCode MatLUFactorSymbolic_LUSOL(Mat F,Mat A, IS r, IS c,const MatFactorInfo *info)
    328: {
    329:   /************************************************************************/
    330:   /* Input                                                                */
    331:   /*     A  - matrix to factor                                            */
    332:   /*     r  - row permutation (ignored)                                   */
    333:   /*     c  - column permutation (ignored)                                */
    334:   /*                                                                      */
    335:   /* Output                                                               */
    336:   /*     F  - matrix storing the factorization;                           */
    337:   /************************************************************************/
    338:   Mat_LUSOL      *lusol;
    340:   int            i, m, n, nz, nnz;

    342:   /************************************************************************/
    343:   /* Check the arguments.                                                 */
    344:   /************************************************************************/

    346:   MatGetSize(A, &m, &n);
    347:   nz   = ((Mat_SeqAIJ*)A->data)->nz;

    349:   /************************************************************************/
    350:   /* Create the factorization.                                            */
    351:   /************************************************************************/

    353:   F->ops->lufactornumeric = MatLUFactorNumeric_LUSOL;
    354:   lusol                   = (Mat_LUSOL*)(F->spptr);

    356:   /************************************************************************/
    357:   /* Initialize parameters                                                */
    358:   /************************************************************************/

    360:   for (i = 0; i < 30; i++) {
    361:     lusol->luparm[i] = 0;
    362:     lusol->parmlu[i] = 0;
    363:   }

    365:   lusol->luparm[1] = -1;
    366:   lusol->luparm[2] = 5;
    367:   lusol->luparm[7] = 1;

    369:   lusol->parmlu[0] = 1 / Factorization_Tolerance;
    370:   lusol->parmlu[1] = 1 / Factorization_Tolerance;
    371:   lusol->parmlu[2] = Factorization_Small_Tolerance;
    372:   lusol->parmlu[3] = Factorization_Pivot_Tolerance;
    373:   lusol->parmlu[4] = Factorization_Pivot_Tolerance;
    374:   lusol->parmlu[5] = 3.0;
    375:   lusol->parmlu[6] = 0.3;
    376:   lusol->parmlu[7] = 0.6;

    378:   /************************************************************************/
    379:   /* Allocate the workspace needed by LUSOL.                              */
    380:   /************************************************************************/

    382:   lusol->elbowroom = PetscMax(lusol->elbowroom, info->fill);
    383:   nnz              = PetscMax((int)(lusol->elbowroom*nz), 5*n);

    385:   lusol->n      = n;
    386:   lusol->nz     = nz;
    387:   lusol->nnz    = nnz;
    388:   lusol->luroom = 1.75;

    390:   PetscMalloc(sizeof(int)*n,&lusol->ip);
    391:   PetscMalloc(sizeof(int)*n,&lusol->iq);
    392:   PetscMalloc(sizeof(int)*n,&lusol->lenc);
    393:   PetscMalloc(sizeof(int)*n,&lusol->lenr);
    394:   PetscMalloc(sizeof(int)*n,&lusol->locc);
    395:   PetscMalloc(sizeof(int)*n,&lusol->locr);
    396:   PetscMalloc(sizeof(int)*n,&lusol->iploc);
    397:   PetscMalloc(sizeof(int)*n,&lusol->iqloc);
    398:   PetscMalloc(sizeof(int)*n,&lusol->ipinv);
    399:   PetscMalloc(sizeof(int)*n,&lusol->iqinv);
    400:   PetscMalloc(sizeof(double)*n,&lusol->mnsw);
    401:   PetscMalloc(sizeof(double)*n,&lusol->mnsv);

    403:   PetscMalloc3(nnz,&lusol->data,nnz,&lusol->indc,nnz,&lusol->indr);

    405:   lusol->CleanUpLUSOL     = PETSC_TRUE;
    406:   F->ops->lufactornumeric = MatLUFactorNumeric_LUSOL;
    407:   return 0;
    408: }

    410: PetscErrorCode MatFactorGetSolverType_seqaij_lusol(Mat A,MatSolverType *type)
    411: {
    412:   *type = MATSOLVERLUSOL;
    413:   return 0;
    414: }

    416: PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_lusol(Mat A,MatFactorType ftype,Mat *F)
    417: {
    418:   Mat            B;
    419:   Mat_LUSOL      *lusol;
    420:   int            m, n;

    422:   MatGetSize(A, &m, &n);
    423:   MatCreate(PetscObjectComm((PetscObject)A),&B);
    424:   MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,m,n);
    425:   MatSetType(B,((PetscObject)A)->type_name);
    426:   MatSeqAIJSetPreallocation(B,0,NULL);

    428:   PetscNewLog(B,&lusol);
    429:   B->spptr = lusol;

    431:   B->trivialsymbolic       = PETSC_TRUE;
    432:   B->ops->lufactorsymbolic = MatLUFactorSymbolic_LUSOL;
    433:   B->ops->destroy          = MatDestroy_LUSOL;

    435:   PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverType_C",MatFactorGetSolverType_seqaij_lusol);

    437:   B->factortype = MAT_FACTOR_LU;
    438:   PetscFree(B->solvertype);
    439:   PetscStrallocpy(MATSOLVERLUSOL,&B->solvertype);

    441:   return 0;
    442: }

    444: PETSC_EXTERN PetscErrorCode MatSolverTypeRegister_Lusol(void)
    445: {
    446:   MatSolverTypeRegister(MATSOLVERLUSOL,MATSEQAIJ,        MAT_FACTOR_LU,MatGetFactor_seqaij_lusol);
    447:   return 0;
    448: }

    450: /*MC
    451:   MATSOLVERLUSOL - "lusol" - Provides direct solvers (LU) for sequential matrices
    452:                          via the external package LUSOL.

    454:   If LUSOL is installed (see the manual for
    455:   instructions on how to declare the existence of external packages),

    457:   Works with MATSEQAIJ matrices

    459:    Level: beginner

    461: .seealso: PCLU, PCFactorSetMatSolverType(), MatSolverType

    463: M*/