Actual source code: matimpl.h


 5:  #include petscmat.h

  7: /*
  8:   This file defines the parts of the matrix data structure that are 
  9:   shared by all matrix types.
 10: */

 12: /*
 13:     If you add entries here also add them to the MATOP enum
 14:     in include/petscmat.h and include/finclude/petscmat.h
 15: */
 16: typedef struct _MatOps *MatOps;
 17: struct _MatOps {
 18:   /* 0*/
 19:   PetscErrorCode (*setvalues)(Mat,PetscInt,const PetscInt[],PetscInt,const PetscInt[],const MatScalar[],InsertMode);
 20:   PetscErrorCode (*getrow)(Mat,PetscInt,PetscInt *,PetscInt*[],PetscScalar*[]);
 21:   PetscErrorCode (*restorerow)(Mat,PetscInt,PetscInt *,PetscInt *[],PetscScalar *[]);
 22:   PetscErrorCode (*mult)(Mat,Vec,Vec);
 23:   PetscErrorCode (*multadd)(Mat,Vec,Vec,Vec);
 24:   /* 5*/
 25:   PetscErrorCode (*multtranspose)(Mat,Vec,Vec);
 26:   PetscErrorCode (*multtransposeadd)(Mat,Vec,Vec,Vec);
 27:   PetscErrorCode (*solve)(Mat,Vec,Vec);
 28:   PetscErrorCode (*solveadd)(Mat,Vec,Vec,Vec);
 29:   PetscErrorCode (*solvetranspose)(Mat,Vec,Vec);
 30:   /*10*/
 31:   PetscErrorCode (*solvetransposeadd)(Mat,Vec,Vec,Vec);
 32:   PetscErrorCode (*lufactor)(Mat,IS,IS,MatFactorInfo*);
 33:   PetscErrorCode (*choleskyfactor)(Mat,IS,MatFactorInfo*);
 34:   PetscErrorCode (*relax)(Mat,Vec,PetscReal,MatSORType,PetscReal,PetscInt,PetscInt,Vec);
 35:   PetscErrorCode (*transpose)(Mat,Mat *);
 36:   /*15*/
 37:   PetscErrorCode (*getinfo)(Mat,MatInfoType,MatInfo*);
 38:   PetscErrorCode (*equal)(Mat,Mat,PetscTruth *);
 39:   PetscErrorCode (*getdiagonal)(Mat,Vec);
 40:   PetscErrorCode (*diagonalscale)(Mat,Vec,Vec);
 41:   PetscErrorCode (*norm)(Mat,NormType,PetscReal*);
 42:   /*20*/
 43:   PetscErrorCode (*assemblybegin)(Mat,MatAssemblyType);
 44:   PetscErrorCode (*assemblyend)(Mat,MatAssemblyType);
 45:   PetscErrorCode (*compress)(Mat);
 46:   PetscErrorCode (*setoption)(Mat,MatOption);
 47:   PetscErrorCode (*zeroentries)(Mat);
 48:   /*25*/
 49:   PetscErrorCode (*zerorows)(Mat,PetscInt,const PetscInt[],PetscScalar);
 50:   PetscErrorCode (*lufactorsymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*);
 51:   PetscErrorCode (*lufactornumeric)(Mat,MatFactorInfo*,Mat*);
 52:   PetscErrorCode (*choleskyfactorsymbolic)(Mat,IS,MatFactorInfo*,Mat*);
 53:   PetscErrorCode (*choleskyfactornumeric)(Mat,MatFactorInfo*,Mat*);
 54:   /*30*/
 55:   PetscErrorCode (*setuppreallocation)(Mat);
 56:   PetscErrorCode (*ilufactorsymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*);
 57:   PetscErrorCode (*iccfactorsymbolic)(Mat,IS,MatFactorInfo*,Mat*);
 58:   PetscErrorCode (*getarray)(Mat,PetscScalar**);
 59:   PetscErrorCode (*restorearray)(Mat,PetscScalar**);
 60:   /*35*/
 61:   PetscErrorCode (*duplicate)(Mat,MatDuplicateOption,Mat*);
 62:   PetscErrorCode (*forwardsolve)(Mat,Vec,Vec);
 63:   PetscErrorCode (*backwardsolve)(Mat,Vec,Vec);
 64:   PetscErrorCode (*ilufactor)(Mat,IS,IS,MatFactorInfo*);
 65:   PetscErrorCode (*iccfactor)(Mat,IS,MatFactorInfo*);
 66:   /*40*/
 67:   PetscErrorCode (*axpy)(Mat,PetscScalar,Mat,MatStructure);
 68:   PetscErrorCode (*getsubmatrices)(Mat,PetscInt,const IS[],const IS[],MatReuse,Mat *[]);
 69:   PetscErrorCode (*increaseoverlap)(Mat,PetscInt,IS[],PetscInt);
 70:   PetscErrorCode (*getvalues)(Mat,PetscInt,const PetscInt[],PetscInt,const PetscInt[],PetscScalar []);
 71:   PetscErrorCode (*copy)(Mat,Mat,MatStructure);
 72:   /*45*/
 73:   PetscErrorCode (*printhelp)(Mat);
 74:   PetscErrorCode (*scale)(Mat,PetscScalar);
 75:   PetscErrorCode (*shift)(Mat,PetscScalar);
 76:   PetscErrorCode (*diagonalset)(Mat,Vec,InsertMode);
 77:   PetscErrorCode (*iludtfactor)(Mat,IS,IS,MatFactorInfo*,Mat *);
 78:   /*50*/
 79:   PetscErrorCode (*setblocksize)(Mat,PetscInt);
 80:   PetscErrorCode (*getrowij)(Mat,PetscInt,PetscTruth,PetscInt*,PetscInt *[],PetscInt *[],PetscTruth *);
 81:   PetscErrorCode (*restorerowij)(Mat,PetscInt,PetscTruth,PetscInt *,PetscInt *[],PetscInt *[],PetscTruth *);
 82:   PetscErrorCode (*getcolumnij)(Mat,PetscInt,PetscTruth,PetscInt*,PetscInt *[],PetscInt *[],PetscTruth *);
 83:   PetscErrorCode (*restorecolumnij)(Mat,PetscInt,PetscTruth,PetscInt*,PetscInt *[],PetscInt *[],PetscTruth *);
 84:   /*55*/
 85:   PetscErrorCode (*fdcoloringcreate)(Mat,ISColoring,MatFDColoring);
 86:   PetscErrorCode (*coloringpatch)(Mat,PetscInt,PetscInt,ISColoringValue[],ISColoring*);
 87:   PetscErrorCode (*setunfactored)(Mat);
 88:   PetscErrorCode (*permute)(Mat,IS,IS,Mat*);
 89:   PetscErrorCode (*setvaluesblocked)(Mat,PetscInt,const PetscInt[],PetscInt,const PetscInt[],const PetscScalar[],InsertMode);
 90:   /*60*/
 91:   PetscErrorCode (*getsubmatrix)(Mat,IS,IS,PetscInt,MatReuse,Mat*);
 92:   PetscErrorCode (*destroy)(Mat);
 93:   PetscErrorCode (*view)(Mat,PetscViewer);
 94:   PetscErrorCode (*dummy)();
 95:   PetscErrorCode (*usescaledform)(Mat,PetscTruth);
 96:   /*65*/
 97:   PetscErrorCode (*scalesystem)(Mat,Vec,Vec);
 98:   PetscErrorCode (*unscalesystem)(Mat,Vec,Vec);
 99:   PetscErrorCode (*setlocaltoglobalmapping)(Mat,ISLocalToGlobalMapping);
100:   PetscErrorCode (*setvalueslocal)(Mat,PetscInt,const PetscInt[],PetscInt,const PetscInt[],const PetscScalar[],InsertMode);
101:   PetscErrorCode (*zerorowslocal)(Mat,PetscInt,const PetscInt[],PetscScalar);
102:   /*70*/
103:   PetscErrorCode (*getrowmax)(Mat,Vec);
104:   PetscErrorCode (*convert)(Mat, MatType,MatReuse,Mat*);
105:   PetscErrorCode (*setcoloring)(Mat,ISColoring);
106:   PetscErrorCode (*setvaluesadic)(Mat,void*);
107:   PetscErrorCode (*setvaluesadifor)(Mat,PetscInt,void*);
108:   /*75*/
109:   PetscErrorCode (*fdcoloringapply)(Mat,MatFDColoring,Vec,MatStructure*,void*);
110:   PetscErrorCode (*setfromoptions)(Mat);
111:   PetscErrorCode (*multconstrained)(Mat,Vec,Vec);
112:   PetscErrorCode (*multtransposeconstrained)(Mat,Vec,Vec);
113:   PetscErrorCode (*ilufactorsymbolicconstrained)(Mat,IS,IS,double,PetscInt,PetscInt,Mat *);
114:   /*80*/
115:   PetscErrorCode (*permutesparsify)(Mat, PetscInt, double, double, IS, IS, Mat *);
116:   PetscErrorCode (*mults)(Mat, Vecs, Vecs);
117:   PetscErrorCode (*solves)(Mat, Vecs, Vecs);
118:   PetscErrorCode (*getinertia)(Mat,PetscInt*,PetscInt*,PetscInt*);
119:   PetscErrorCode (*load)(PetscViewer, MatType,Mat*);
120:   /*85*/
121:   PetscErrorCode (*issymmetric)(Mat,PetscReal,PetscTruth*);
122:   PetscErrorCode (*ishermitian)(Mat,PetscTruth*);
123:   PetscErrorCode (*isstructurallysymmetric)(Mat,PetscTruth*);
124:   PetscErrorCode (*pbrelax)(Mat,Vec,PetscReal,MatSORType,PetscReal,PetscInt,PetscInt,Vec);
125:   PetscErrorCode (*getvecs)(Mat,Vec*,Vec*);
126:   /*90*/
127:   PetscErrorCode (*matmult)(Mat,Mat,MatReuse,PetscReal,Mat*);
128:   PetscErrorCode (*matmultsymbolic)(Mat,Mat,PetscReal,Mat*);
129:   PetscErrorCode (*matmultnumeric)(Mat,Mat,Mat);
130:   PetscErrorCode (*ptap)(Mat,Mat,MatReuse,PetscReal,Mat*);
131:   PetscErrorCode (*ptapsymbolic)(Mat,Mat,PetscReal,Mat*); /* double dispatch wrapper routine */
132:   /*95*/
133:   PetscErrorCode (*ptapnumeric)(Mat,Mat,Mat);             /* double dispatch wrapper routine */
134:   PetscErrorCode (*matmulttranspose)(Mat,Mat,MatReuse,PetscReal,Mat*);
135:   PetscErrorCode (*matmulttransposesymbolic)(Mat,Mat,PetscReal,Mat*);
136:   PetscErrorCode (*matmulttransposenumeric)(Mat,Mat,Mat);
137:   PetscErrorCode (*ptapsymbolic_seqaij)(Mat,Mat,PetscReal,Mat*); /* actual implememtation, A=seqaij */
138:   /*100*/
139:   PetscErrorCode (*ptapnumeric_seqaij)(Mat,Mat,Mat);             /* actual implememtation, A=seqaij */
140:   PetscErrorCode (*ptapsymbolic_mpiaij)(Mat,Mat,PetscReal,Mat*); /* actual implememtation, A=mpiaij */
141:   PetscErrorCode (*ptapnumeric_mpiaij)(Mat,Mat,Mat);             /* actual implememtation, A=mpiaij */
142:   PetscErrorCode (*conjugate)(Mat);                              /* complex conjugate */
143:   PetscErrorCode (*setsizes)(Mat,PetscInt,PetscInt,PetscInt,PetscInt);
144:   /*105*/
145:   PetscErrorCode (*setvaluesrow)(Mat,PetscInt,const MatScalar[]);
146:   PetscErrorCode (*realpart)(Mat);
147:   PetscErrorCode (*imaginarypart)(Mat);
148:   PetscErrorCode (*getrowuppertriangular)(Mat);
149:   PetscErrorCode (*restorerowuppertriangular)(Mat);
150:   /*110*/
151:   PetscErrorCode (*matsolve)(Mat,Mat,Mat);
152: };
153: /*
154:     If you add MatOps entries above also add them to the MATOP enum
155:     in include/petscmat.h and include/finclude/petscmat.h
156: */

158: /*
159:    Utility private matrix routines
160: */
161: EXTERN PetscErrorCode MatConvert_Basic(Mat, MatType,MatReuse,Mat*);
162: EXTERN PetscErrorCode MatCopy_Basic(Mat,Mat,MatStructure);
163: EXTERN PetscErrorCode MatView_Private(Mat);

165: EXTERN PetscErrorCode MatHeaderCopy(Mat,Mat);
166: EXTERN PetscErrorCode MatHeaderReplace(Mat,Mat);
167: EXTERN PetscErrorCode MatAXPYGetxtoy_Private(PetscInt,PetscInt*,PetscInt*,PetscInt*, PetscInt*,PetscInt*,PetscInt*, PetscInt**);
168: EXTERN PetscErrorCode MatPtAP_Basic(Mat,Mat,MatReuse,PetscReal,Mat*);

170: /* 
171:   The stash is used to temporarily store inserted matrix values that 
172:   belong to another processor. During the assembly phase the stashed 
173:   values are moved to the correct processor and 
174: */
175:  #include src/mat/utils/matstashspace.h
176: typedef struct {
177:   PetscInt      nmax;                   /* maximum stash size */
178:   PetscInt      umax;                   /* user specified max-size */
179:   PetscInt      oldnmax;                /* the nmax value used previously */
180:   PetscInt      n;                      /* stash size */
181:   PetscInt      bs;                     /* block size of the stash */
182:   PetscInt      reallocs;               /* preserve the no of mallocs invoked */
183:   PetscMatStashSpace space_head,space;  /* linked list to hold stashed global row/column numbers and matrix values */
184:   /* The following variables are used for communication */
185:   MPI_Comm      comm;
186:   PetscMPIInt   size,rank;
187:   PetscMPIInt   tag1,tag2;
188:   MPI_Request   *send_waits;            /* array of send requests */
189:   MPI_Request   *recv_waits;            /* array of receive requests */
190:   MPI_Status    *send_status;           /* array of send status */
191:   PetscInt      nsends,nrecvs;          /* numbers of sends and receives */
192:   MatScalar     *svalues;               /* sending data */
193:   MatScalar     **rvalues;              /* receiving data (values) */
194:   PetscInt      **rindices;             /* receiving data (indices) */
195:   PetscMPIInt   *nprocs;                /* tmp data used both during scatterbegin and end */
196:   PetscInt      nprocessed;             /* number of messages already processed */
197: } MatStash;

199: EXTERN PetscErrorCode MatStashCreate_Private(MPI_Comm,PetscInt,MatStash*);
200: EXTERN PetscErrorCode MatStashDestroy_Private(MatStash*);
201: EXTERN PetscErrorCode MatStashScatterEnd_Private(MatStash*);
202: EXTERN PetscErrorCode MatStashSetInitialSize_Private(MatStash*,PetscInt);
203: EXTERN PetscErrorCode MatStashGetInfo_Private(MatStash*,PetscInt*,PetscInt*);
204: EXTERN PetscErrorCode MatStashValuesRow_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const MatScalar[]);
205: EXTERN PetscErrorCode MatStashValuesCol_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const MatScalar[],PetscInt);
206: EXTERN PetscErrorCode MatStashValuesRowBlocked_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const MatScalar[],PetscInt,PetscInt,PetscInt);
207: EXTERN PetscErrorCode MatStashValuesColBlocked_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const MatScalar[],PetscInt,PetscInt,PetscInt);
208: EXTERN PetscErrorCode MatStashScatterBegin_Private(MatStash*,PetscInt*);
209: EXTERN PetscErrorCode MatStashScatterGetMesg_Private(MatStash*,PetscMPIInt*,PetscInt**,PetscInt**,MatScalar**,PetscInt*);

211: #define FACTOR_LU       1
212: #define FACTOR_CHOLESKY 2

214: typedef struct {
215:   PetscInt   dim;
216:   PetscInt   dims[4];
217:   PetscInt   starts[4];
218:   PetscTruth noc;        /* this is a single component problem, hence user will not set MatStencil.c */
219: } MatStencilInfo;

221: /* Info about using compressed row format */
222: typedef struct {
223:   PetscTruth use;
224:   PetscInt   nrows;                         /* number of non-zero rows */
225:   PetscInt   *i;                            /* compressed row pointer  */
226:   PetscInt   *rindex;                       /* compressed row index               */
227:   PetscTruth checked;                       /* if compressed row format have been checked for */
228: } Mat_CompressedRow;
229: EXTERN PetscErrorCode Mat_CheckCompressedRow(Mat,Mat_CompressedRow*,PetscInt*,PetscInt,PetscReal);

231: struct _p_Mat {
232:   PETSCHEADER(struct _MatOps);
233:   PetscMap               rmap,cmap;
234:   void                   *data;            /* implementation-specific data */
235:   PetscInt               factor;           /* 0, FACTOR_LU, or FACTOR_CHOLESKY */
236:   PetscTruth             assembled;        /* is the matrix assembled? */
237:   PetscTruth             was_assembled;    /* new values inserted into assembled mat */
238:   PetscInt               num_ass;          /* number of times matrix has been assembled */
239:   PetscTruth             same_nonzero;     /* matrix has same nonzero pattern as previous */
240:   MatInfo                info;             /* matrix information */
241:   ISLocalToGlobalMapping mapping;          /* mapping used in MatSetValuesLocal() */
242:   ISLocalToGlobalMapping bmapping;         /* mapping used in MatSetValuesBlockedLocal() */
243:   InsertMode             insertmode;       /* have values been inserted in matrix or added? */
244:   MatStash               stash,bstash;     /* used for assembling off-proc mat emements */
245:   MatNullSpace           nullsp;
246:   PetscTruth             preallocated;
247:   MatStencilInfo         stencil;          /* information for structured grid */
248:   PetscTruth             symmetric,hermitian,structurally_symmetric;
249:   PetscTruth             symmetric_set,hermitian_set,structurally_symmetric_set; /* if true, then corresponding flag is correct*/
250:   PetscTruth             symmetric_eternal;
251:   void                   *spptr;          /* pointer for special library like SuperLU */
252: };

254: #define MatPreallocated(A)  ((!(A)->preallocated) ? MatSetUpPreallocation(A) : 0)
256: /*
257:     Frees the a, i, and j arrays from the XAIJ (AIJ, BAIJ, and SBAIJ) matrix types
258: */
261: PETSC_STATIC_INLINE PetscErrorCode MatSeqXAIJFreeAIJ(PetscTruth singlemalloc,PetscScalar **a,PetscInt **j,PetscInt **i) {
263:                                      if (singlemalloc) {
264:                                        PetscFree3(*a,*j,*i);
265:                                      } else {
266:                                        if (*a) {PetscFree(*a);}
267:                                        if (*j) {PetscFree(*j);}
268:                                        if (*i) {PetscFree(*i);}
269:                                      }
270:                                      *a = 0; *j = 0; *i = 0;
271:                                      return 0;
272:                                    }

274: /*
275:     Allocates larger a, i, and j arrays for the XAIJ (AIJ, BAIJ, and SBAIJ) matrix types
276: */
277: #define MatSeqXAIJReallocateAIJ(A,BS2,NROW,ROW,COL,RMAX,AA,AI,AJ,AM,RP,AP,AIMAX,NONEW) \
278:       if (NROW >= RMAX) { \
279:         /* there is no extra room in row, therefore enlarge */ \
280:         PetscInt    new_nz = AI[AM] + CHUNKSIZE,len,*new_i=0,*new_j=0; \
281:         PetscScalar *new_a; \
282:  \
283:         if (NONEW == -2) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"New nonzero at (%D,%D) caused a malloc",ROW,COL); \
284:         /* malloc new storage space */ \
285:         PetscMalloc3(BS2*new_nz,PetscScalar,&new_a,new_nz,PetscInt,&new_j,AM+1,PetscInt,&new_i);\
286:  \
287:         /* copy over old data into new slots */ \
288:         for (ii=0; ii<ROW+1; ii++) {new_i[ii] = AI[ii];} \
289:         for (ii=ROW+1; ii<AM+1; ii++) {new_i[ii] = AI[ii]+CHUNKSIZE;} \
290:         PetscMemcpy(new_j,AJ,(AI[ROW]+NROW)*sizeof(PetscInt)); \
291:         len = (new_nz - CHUNKSIZE - AI[ROW] - NROW); \
292:         PetscMemcpy(new_j+AI[ROW]+NROW+CHUNKSIZE,AJ+AI[ROW]+NROW,len*sizeof(PetscInt)); \
293:         PetscMemcpy(new_a,AA,BS2*(AI[ROW]+NROW)*sizeof(PetscScalar)); \
294:         PetscMemzero(new_a+BS2*(AI[ROW]+NROW),BS2*CHUNKSIZE*sizeof(MatScalar));\
295:         PetscMemcpy(new_a+BS2*(AI[ROW]+NROW+CHUNKSIZE),AA+BS2*(AI[ROW]+NROW),BS2*len*sizeof(PetscScalar));  \
296:         /* free up old matrix storage */ \
297:         MatSeqXAIJFreeAIJ(A->singlemalloc,&A->a,&A->j,&A->i);\
298:         AA = A->a = new_a; AI = A->i = new_i; AJ = A->j = new_j;  \
299:         A->singlemalloc = PETSC_TRUE; \
300:  \
301:         RP        = AJ + AI[ROW]; AP = AA + BS2*AI[ROW]; \
302:         RMAX      = AIMAX[ROW] = AIMAX[ROW] + CHUNKSIZE; \
303:         A->maxnz += CHUNKSIZE; \
304:         A->reallocs++; \
305:       } \

307: /*
308:     Object for partitioning graphs
309: */

311: typedef struct _MatPartitioningOps *MatPartitioningOps;
312: struct _MatPartitioningOps {
313:   PetscErrorCode (*apply)(MatPartitioning,IS*);
314:   PetscErrorCode (*setfromoptions)(MatPartitioning);
315:   PetscErrorCode (*destroy)(MatPartitioning);
316:   PetscErrorCode (*view)(MatPartitioning,PetscViewer);
317: };

319: struct _p_MatPartitioning {
320:   PETSCHEADER(struct _MatPartitioningOps);
321:   Mat         adj;
322:   PetscInt    *vertex_weights;
323:   PetscReal   *part_weights;
324:   PetscInt    n;                                 /* number of partitions */
325:   void        *data;
326:   PetscInt    setupcalled;
327: };

329: /*
330:     MatFDColoring is used to compute Jacobian matrices efficiently
331:   via coloring. The data structure is explained below in an example.

333:    Color =   0    1     0    2   |   2      3       0 
334:    ---------------------------------------------------
335:             00   01              |          05
336:             10   11              |   14     15               Processor  0
337:                        22    23  |          25
338:                        32    33  | 
339:    ===================================================
340:                                  |   44     45     46
341:             50                   |          55               Processor 1
342:                                  |   64            66
343:    ---------------------------------------------------

345:     ncolors = 4;

347:     ncolumns      = {2,1,1,0}
348:     columns       = {{0,2},{1},{3},{}}
349:     nrows         = {4,2,3,3}
350:     rows          = {{0,1,2,3},{0,1},{1,2,3},{0,1,2}}
351:     columnsforrow = {{0,0,2,2},{1,1},{4,3,3},{5,5,5}}
352:     vscaleforrow  = {{,,,},{,},{,,},{,,}}
353:     vwscale       = {dx(0),dx(1),dx(2),dx(3)}               MPI Vec
354:     vscale        = {dx(0),dx(1),dx(2),dx(3),dx(4),dx(5)}   Seq Vec

356:     ncolumns      = {1,0,1,1}
357:     columns       = {{6},{},{4},{5}}
358:     nrows         = {3,0,2,2}
359:     rows          = {{0,1,2},{},{1,2},{1,2}}
360:     columnsforrow = {{6,0,6},{},{4,4},{5,5}}
361:     vscaleforrow =  {{,,},{},{,},{,}}
362:     vwscale       = {dx(4),dx(5),dx(6)}              MPI Vec
363:     vscale        = {dx(0),dx(4),dx(5),dx(6)}        Seq Vec

365:     See the routine MatFDColoringApply() for how this data is used
366:     to compute the Jacobian.

368: */

370: struct  _p_MatFDColoring{
371:   PETSCHEADER(int);
372:   PetscInt       M,N,m;            /* total rows, columns; local rows */
373:   PetscInt       rstart;           /* first row owned by local processor */
374:   PetscInt       ncolors;          /* number of colors */
375:   PetscInt       *ncolumns;        /* number of local columns for a color */
376:   PetscInt       **columns;        /* lists the local columns of each color (using global column numbering) */
377:   PetscInt       *nrows;           /* number of local rows for each color */
378:   PetscInt       **rows;           /* lists the local rows for each color (using the local row numbering) */
379:   PetscInt       **columnsforrow;  /* lists the corresponding columns for those rows (using the global column) */
380:   PetscReal      error_rel;        /* square root of relative error in computing function */
381:   PetscReal      umin;             /* minimum allowable u'dx value */
382:   PetscInt       freq;             /* frequency at which new Jacobian is computed */
383:   Vec            w1,w2,w3;         /* work vectors used in computing Jacobian */
384:   PetscErrorCode (*f)(void);       /* function that defines Jacobian */
385:   void           *fctx;            /* optional user-defined context for use by the function f */
386:   PetscInt       **vscaleforrow;   /* location in vscale for each columnsforrow[] entry */
387:   Vec            vscale;           /* holds FD scaling, i.e. 1/dx for each perturbed column */
388:   PetscTruth     usersetsrecompute;/* user determines when Jacobian is recomputed, via MatFDColoringSetRecompute() */
389:   PetscTruth     recompute;        /* used with usersetrecompute to determine if Jacobian should be recomputed */
390:   Vec            F;                /* current value of user provided function; can set with MatFDColoringSetF() */
391:   PetscInt       currentcolor;     /* color for which function evaluation is being done now */
392:   const char     *htype;            /* "wp" or "ds" */
393: };

395: /*
396:    Null space context for preconditioner/operators
397: */
398: struct _p_MatNullSpace {
399:   PETSCHEADER(int);
400:   PetscTruth     has_cnst;
401:   PetscInt       n;
402:   Vec*           vecs;
403:   Vec            vec;                   /* for out of place removals */
404:   PetscErrorCode (*remove)(Vec,void*);  /* for user provided removal function */
405:   void*          rmctx;                 /* context for remove() function */
406: };

408: /* 
409:    Checking zero pivot for LU, ILU preconditioners.
410: */
411: typedef struct {
412:   PetscInt       nshift,nshift_max;
413:   PetscReal      shift_amount,shift_lo,shift_hi,shift_top;
414:   PetscTruth     lushift;
415:   PetscReal      rs;  /* active row sum of abs(offdiagonals) */
416:   PetscScalar    pv;  /* pivot of the active row */
417: } LUShift_Ctx;

421: /*@C
422:    MatLUCheckShift_inline - shift the diagonals when zero pivot is detected on LU factor

424:    Collective on Mat

426:    Input Parameters:
427: +  info - information about the matrix factorization 
428: .  sctx - pointer to the struct LUShift_Ctx
429: -  newshift - 0: shift is unchanged; 1: shft is updated; -1: zeropivot  

431:    Level: developer
432: @*/
433: #define MatLUCheckShift_inline(info,sctx,newshift) 0;\
434: {\
435:   PetscInt _newshift;\
436:   PetscReal _zero = info->zeropivot*rs;\
437:   if (info->shiftnz && PetscAbsScalar(sctx.pv) <= _zero){\
438:     /* force |diag| > zeropivot*rs */\
439:     if (!sctx.nshift){\
440:       sctx.shift_amount = info->shiftnz;\
441:     } else {\
442:       sctx.shift_amount *= 2.0;\
443:     }\
444:     sctx.lushift = PETSC_TRUE;\
445:     (sctx.nshift)++;\
446:     _newshift = 1;\
447:   } else if (info->shiftpd && PetscRealPart(sctx.pv) <= _zero){\
448:     /* force matfactor to be diagonally dominant */\
449:     if (sctx.nshift > sctx.nshift_max) {\
450:       SETERRQ(PETSC_ERR_CONV_FAILED,"Unable to determine shift to enforce positive definite preconditioner");\
451:     } else if (sctx.nshift == sctx.nshift_max) {\
452:       info->shift_fraction = sctx.shift_hi;\
453:       sctx.lushift        = PETSC_TRUE;\
454:     } else {\
455:       sctx.shift_lo = info->shift_fraction;\
456:       info->shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;\
457:       sctx.lushift  = PETSC_TRUE;\
458:     }\
459:     sctx.shift_amount = info->shift_fraction * sctx.shift_top;\
460:     sctx.nshift++;\
461:     _newshift = 1;\
462:   } else if (PetscAbsScalar(sctx.pv) <= _zero){\
463:     _newshift = -1;\
464:   } else {\
465:     _newshift = 0;\
466:   }\
467:   newshift = _newshift;\
468: }

470: /* 
471:    Checking zero pivot for Cholesky, ICC preconditioners.
472: */
473: typedef struct {
474:   PetscInt       nshift;
475:   PetscReal      shift_amount;
476:   PetscTruth     chshift;
477:   PetscReal      rs;  /* active row sum of abs(offdiagonals) */
478:   PetscScalar    pv;  /* pivot of the active row */
479: } ChShift_Ctx;

483: /*@C
484:    MatCholeskyCheckShift_inline -  shift the diagonals when zero pivot is detected on Cholesky factor

486:    Collective on Mat

488:    Input Parameters:
489: +  info - information about the matrix factorization 
490: .  sctx - pointer to the struct CholeskyShift_Ctx
491: -  newshift - 0: shift is unchanged; 1: shft is updated; -1: zeropivot  

493:    Level: developer
494:    Note: Unlike in the ILU case there is no exit condition on nshift:
495:        we increase the shift until it converges. There is no guarantee that
496:        this algorithm converges faster or slower, or is better or worse
497:        than the ILU algorithm. 
498: @*/
499: #define MatCholeskyCheckShift_inline(info,sctx,newshift) 0;\
500: {\
501:   PetscInt _newshift;\
502:   PetscReal _zero = info->zeropivot*rs;\
503:   if (info->shiftnz && PetscAbsScalar(sctx.pv) <= _zero){\
504:     /* force |diag| > zeropivot*sctx.rs */\
505:     if (!sctx.nshift){\
506:       sctx.shift_amount = info->shiftnz;\
507:     } else {\
508:       sctx.shift_amount *= 2.0;\
509:     }\
510:     sctx.chshift = PETSC_TRUE;\
511:     sctx.nshift++;\
512:     _newshift = 1;\
513:   } else if (info->shiftpd && PetscRealPart(sctx.pv) <= _zero){\
514:     /* calculate a shift that would make this row diagonally dominant */\
515:     sctx.shift_amount = PetscMax(sctx.rs+PetscAbs(PetscRealPart(sctx.pv)),1.1*sctx.shift_amount);\
516:     sctx.chshift      = PETSC_TRUE;\
517:     sctx.nshift++;\
518:     _newshift = 1;\
519:   } else if (PetscAbsScalar(sctx.pv) <= _zero){\
520:     _newshift = -1;\
521:   } else {\
522:     _newshift = 0; \
523:   }\
524:   newshift = _newshift;\
525: }

527: /* 
528:   Create and initialize a linked list 
529:   Input Parameters:
530:     idx_start - starting index of the list
531:     lnk_max   - max value of lnk indicating the end of the list
532:     nlnk      - max length of the list
533:   Output Parameters:
534:     lnk       - list initialized
535:     bt        - PetscBT (bitarray) with all bits set to false
536: */
537: #define PetscLLCreate(idx_start,lnk_max,nlnk,lnk,bt) \
538:   (PetscMalloc(nlnk*sizeof(PetscInt),&lnk) || PetscBTCreate(nlnk,bt) || PetscBTMemzero(nlnk,bt) || (lnk[idx_start] = lnk_max,0))

540: /*
541:   Add an index set into a sorted linked list
542:   Input Parameters:
543:     nidx      - number of input indices
544:     indices   - interger array
545:     idx_start - starting index of the list
546:     lnk       - linked list(an integer array) that is created
547:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
548:   output Parameters:
549:     nlnk      - number of newly added indices
550:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
551:     bt        - updated PetscBT (bitarray) 
552: */
553: #define PetscLLAdd(nidx,indices,idx_start,nlnk,lnk,bt) 0;\
554: {\
555:   PetscInt _k,_entry,_location,_lnkdata;\
556:   nlnk     = 0;\
557:   _lnkdata = idx_start;\
558:   for (_k=0; _k<nidx; _k++){\
559:     _entry = indices[_k];\
560:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
561:       /* search for insertion location */\
562:       /* start from the beginning if _entry < previous _entry */\
563:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
564:       do {\
565:         _location = _lnkdata;\
566:         _lnkdata  = lnk[_location];\
567:       } while (_entry > _lnkdata);\
568:       /* insertion location is found, add entry into lnk */\
569:       lnk[_location] = _entry;\
570:       lnk[_entry]    = _lnkdata;\
571:       nlnk++;\
572:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
573:     }\
574:   }\
575: }

577: /*
578:   Add a permuted index set into a sorted linked list
579:   Input Parameters:
580:     nidx      - number of input indices
581:     indices   - interger array
582:     perm      - permutation of indices
583:     idx_start - starting index of the list
584:     lnk       - linked list(an integer array) that is created
585:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
586:   output Parameters:
587:     nlnk      - number of newly added indices
588:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
589:     bt        - updated PetscBT (bitarray) 
590: */
591: #define PetscLLAddPerm(nidx,indices,perm,idx_start,nlnk,lnk,bt) 0;\
592: {\
593:   PetscInt _k,_entry,_location,_lnkdata;\
594:   nlnk     = 0;\
595:   _lnkdata = idx_start;\
596:   for (_k=0; _k<nidx; _k++){\
597:     _entry = perm[indices[_k]];\
598:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
599:       /* search for insertion location */\
600:       /* start from the beginning if _entry < previous _entry */\
601:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
602:       do {\
603:         _location = _lnkdata;\
604:         _lnkdata  = lnk[_location];\
605:       } while (_entry > _lnkdata);\
606:       /* insertion location is found, add entry into lnk */\
607:       lnk[_location] = _entry;\
608:       lnk[_entry]    = _lnkdata;\
609:       nlnk++;\
610:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
611:     }\
612:   }\
613: }

615: /*
616:   Add a SORTED index set into a sorted linked list
617:   Input Parameters:
618:     nidx      - number of input indices
619:     indices   - sorted interger array 
620:     idx_start - starting index of the list
621:     lnk       - linked list(an integer array) that is created
622:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
623:   output Parameters:
624:     nlnk      - number of newly added indices
625:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
626:     bt        - updated PetscBT (bitarray) 
627: */
628: #define PetscLLAddSorted(nidx,indices,idx_start,nlnk,lnk,bt) 0;\
629: {\
630:   PetscInt _k,_entry,_location,_lnkdata;\
631:   nlnk      = 0;\
632:   _lnkdata  = idx_start;\
633:   for (_k=0; _k<nidx; _k++){\
634:     _entry = indices[_k];\
635:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
636:       /* search for insertion location */\
637:       do {\
638:         _location = _lnkdata;\
639:         _lnkdata  = lnk[_location];\
640:       } while (_entry > _lnkdata);\
641:       /* insertion location is found, add entry into lnk */\
642:       lnk[_location] = _entry;\
643:       lnk[_entry]    = _lnkdata;\
644:       nlnk++;\
645:       _lnkdata = _entry; /* next search starts from here */\
646:     }\
647:   }\
648: }

650: /*
651:   Add a SORTED index set into a sorted linked list used for LUFactorSymbolic()
652:   Same as PetscLLAddSorted() with an additional operation:
653:        count the number of input indices that are no larger than 'diag'
654:   Input Parameters:
655:     indices   - sorted interger array 
656:     idx_start - starting index of the list
657:     lnk       - linked list(an integer array) that is created
658:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
659:     diag      - index of the active row in LUFactorSymbolic
660:     nzbd      - number of input indices with indices <= idx_start
661:   output Parameters:
662:     nlnk      - number of newly added indices
663:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
664:     bt        - updated PetscBT (bitarray) 
665:     im        - im[idx_start] =  num of entries with indices <= diag
666: */
667: #define PetscLLAddSortedLU(indices,idx_start,nlnk,lnk,bt,diag,nzbd,im) 0;\
668: {\
669:   PetscInt _k,_entry,_location,_lnkdata,_nidx;\
670:   nlnk     = 0;\
671:   _lnkdata = idx_start;\
672:   _nidx = im[idx_start] - nzbd; /* num of entries with idx_start < index <= diag */\
673:   for (_k=0; _k<_nidx; _k++){\
674:     _entry = indices[_k];\
675:     nzbd++;\
676:     if ( _entry== diag) im[idx_start] = nzbd;\
677:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
678:       /* search for insertion location */\
679:       do {\
680:         _location = _lnkdata;\
681:         _lnkdata  = lnk[_location];\
682:       } while (_entry > _lnkdata);\
683:       /* insertion location is found, add entry into lnk */\
684:       lnk[_location] = _entry;\
685:       lnk[_entry]    = _lnkdata;\
686:       nlnk++;\
687:       _lnkdata = _entry; /* next search starts from here */\
688:     }\
689:   }\
690: }

692: /*
693:   Copy data on the list into an array, then initialize the list 
694:   Input Parameters:
695:     idx_start - starting index of the list 
696:     lnk_max   - max value of lnk indicating the end of the list 
697:     nlnk      - number of data on the list to be copied
698:     lnk       - linked list
699:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
700:   output Parameters:
701:     indices   - array that contains the copied data
702:     lnk       - linked list that is cleaned and initialize
703:     bt        - PetscBT (bitarray) with all bits set to false
704: */
705: #define PetscLLClean(idx_start,lnk_max,nlnk,lnk,indices,bt) 0;\
706: {\
707:   PetscInt _j,_idx=idx_start;\
708:   for (_j=0; _j<nlnk; _j++){\
709:     _idx = lnk[_idx];\
710:     *(indices+_j) = _idx;\
711:     PetscBTClear(bt,_idx);\
712:   }\
713:   lnk[idx_start] = lnk_max;\
714: }
715: /*
716:   Free memories used by the list
717: */
718: #define PetscLLDestroy(lnk,bt) (PetscFree(lnk) || PetscBTDestroy(bt))

720: /* Routines below are used for incomplete matrix factorization */
721: /* 
722:   Create and initialize a linked list and its levels
723:   Input Parameters:
724:     idx_start - starting index of the list
725:     lnk_max   - max value of lnk indicating the end of the list
726:     nlnk      - max length of the list
727:   Output Parameters:
728:     lnk       - list initialized
729:     lnk_lvl   - array of size nlnk for storing levels of lnk
730:     bt        - PetscBT (bitarray) with all bits set to false
731: */
732: #define PetscIncompleteLLCreate(idx_start,lnk_max,nlnk,lnk,lnk_lvl,bt)\
733:   (PetscMalloc(2*nlnk*sizeof(PetscInt),&lnk) || PetscBTCreate(nlnk,bt) || PetscBTMemzero(nlnk,bt) || (lnk[idx_start] = lnk_max,lnk_lvl = lnk + nlnk,0))

735: /*
736:   Initialize a sorted linked list used for ILU and ICC
737:   Input Parameters:
738:     nidx      - number of input idx
739:     idx       - interger array used for storing column indices
740:     idx_start - starting index of the list
741:     perm      - indices of an IS
742:     lnk       - linked list(an integer array) that is created
743:     lnklvl    - levels of lnk
744:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
745:   output Parameters:
746:     nlnk     - number of newly added idx
747:     lnk      - the sorted(increasing order) linked list containing new and non-redundate entries from idx
748:     lnklvl   - levels of lnk
749:     bt       - updated PetscBT (bitarray) 
750: */
751: #define PetscIncompleteLLInit(nidx,idx,idx_start,perm,nlnk,lnk,lnklvl,bt) 0;\
752: {\
753:   PetscInt _k,_entry,_location,_lnkdata;\
754:   nlnk     = 0;\
755:   _lnkdata = idx_start;\
756:   for (_k=0; _k<nidx; _k++){\
757:     _entry = perm[idx[_k]];\
758:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
759:       /* search for insertion location */\
760:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
761:       do {\
762:         _location = _lnkdata;\
763:         _lnkdata  = lnk[_location];\
764:       } while (_entry > _lnkdata);\
765:       /* insertion location is found, add entry into lnk */\
766:       lnk[_location]  = _entry;\
767:       lnk[_entry]     = _lnkdata;\
768:       lnklvl[_entry] = 0;\
769:       nlnk++;\
770:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
771:     }\
772:   }\
773: }

775: /*
776:   Add a SORTED index set into a sorted linked list for ILU
777:   Input Parameters:
778:     nidx      - number of input indices
779:     idx       - sorted interger array used for storing column indices
780:     level     - level of fill, e.g., ICC(level)
781:     idxlvl    - level of idx 
782:     idx_start - starting index of the list
783:     lnk       - linked list(an integer array) that is created
784:     lnklvl    - levels of lnk
785:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
786:     prow      - the row number of idx
787:   output Parameters:
788:     nlnk     - number of newly added idx
789:     lnk      - the sorted(increasing order) linked list containing new and non-redundate entries from idx
790:     lnklvl   - levels of lnk
791:     bt       - updated PetscBT (bitarray) 

793:   Note: the level of factor(i,j) is set as lvl(i,j) = min{ lvl(i,j), lvl(i,prow)+lvl(prow,j)+1)
794:         where idx = non-zero columns of U(prow,prow+1:n-1), prow<i
795: */
796: #define PetscILULLAddSorted(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt,lnklvl_prow) 0;\
797: {\
798:   PetscInt _k,_entry,_location,_lnkdata,_incrlev,_lnklvl_prow=lnklvl[prow];\
799:   nlnk     = 0;\
800:   _lnkdata = idx_start;\
801:   for (_k=0; _k<nidx; _k++){\
802:     _incrlev = idxlvl[_k] + _lnklvl_prow + 1;\
803:     if (_incrlev > level) continue;\
804:     _entry = idx[_k];\
805:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
806:       /* search for insertion location */\
807:       do {\
808:         _location = _lnkdata;\
809:         _lnkdata  = lnk[_location];\
810:       } while (_entry > _lnkdata);\
811:       /* insertion location is found, add entry into lnk */\
812:       lnk[_location]  = _entry;\
813:       lnk[_entry]     = _lnkdata;\
814:       lnklvl[_entry] = _incrlev;\
815:       nlnk++;\
816:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
817:     } else { /* existing entry: update lnklvl */\
818:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
819:     }\
820:   }\
821: }

823: /*
824:   Add a index set into a sorted linked list
825:   Input Parameters:
826:     nidx      - number of input idx
827:     idx   - interger array used for storing column indices
828:     level     - level of fill, e.g., ICC(level)
829:     idxlvl - level of idx 
830:     idx_start - starting index of the list
831:     lnk       - linked list(an integer array) that is created
832:     lnklvl   - levels of lnk
833:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
834:   output Parameters:
835:     nlnk      - number of newly added idx
836:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from idx
837:     lnklvl   - levels of lnk
838:     bt        - updated PetscBT (bitarray) 
839: */
840: #define PetscIncompleteLLAdd(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt) 0;\
841: {\
842:   PetscInt _k,_entry,_location,_lnkdata,_incrlev;\
843:   nlnk     = 0;\
844:   _lnkdata = idx_start;\
845:   for (_k=0; _k<nidx; _k++){\
846:     _incrlev = idxlvl[_k] + 1;\
847:     if (_incrlev > level) continue;\
848:     _entry = idx[_k];\
849:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
850:       /* search for insertion location */\
851:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
852:       do {\
853:         _location = _lnkdata;\
854:         _lnkdata  = lnk[_location];\
855:       } while (_entry > _lnkdata);\
856:       /* insertion location is found, add entry into lnk */\
857:       lnk[_location]  = _entry;\
858:       lnk[_entry]     = _lnkdata;\
859:       lnklvl[_entry] = _incrlev;\
860:       nlnk++;\
861:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
862:     } else { /* existing entry: update lnklvl */\
863:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
864:     }\
865:   }\
866: }

868: /*
869:   Add a SORTED index set into a sorted linked list
870:   Input Parameters:
871:     nidx      - number of input indices
872:     idx   - sorted interger array used for storing column indices
873:     level     - level of fill, e.g., ICC(level)
874:     idxlvl - level of idx 
875:     idx_start - starting index of the list
876:     lnk       - linked list(an integer array) that is created
877:     lnklvl    - levels of lnk
878:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
879:   output Parameters:
880:     nlnk      - number of newly added idx
881:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from idx
882:     lnklvl    - levels of lnk
883:     bt        - updated PetscBT (bitarray) 
884: */
885: #define PetscIncompleteLLAddSorted(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt) 0;\
886: {\
887:   PetscInt _k,_entry,_location,_lnkdata,_incrlev;\
888:   nlnk = 0;\
889:   _lnkdata = idx_start;\
890:   for (_k=0; _k<nidx; _k++){\
891:     _incrlev = idxlvl[_k] + 1;\
892:     if (_incrlev > level) continue;\
893:     _entry = idx[_k];\
894:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
895:       /* search for insertion location */\
896:       do {\
897:         _location = _lnkdata;\
898:         _lnkdata  = lnk[_location];\
899:       } while (_entry > _lnkdata);\
900:       /* insertion location is found, add entry into lnk */\
901:       lnk[_location] = _entry;\
902:       lnk[_entry]    = _lnkdata;\
903:       lnklvl[_entry] = _incrlev;\
904:       nlnk++;\
905:       _lnkdata = _entry; /* next search starts from here */\
906:     } else { /* existing entry: update lnklvl */\
907:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
908:     }\
909:   }\
910: }

912: /*
913:   Add a SORTED index set into a sorted linked list for ICC
914:   Input Parameters:
915:     nidx      - number of input indices
916:     idx       - sorted interger array used for storing column indices
917:     level     - level of fill, e.g., ICC(level)
918:     idxlvl    - level of idx 
919:     idx_start - starting index of the list
920:     lnk       - linked list(an integer array) that is created
921:     lnklvl    - levels of lnk
922:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
923:     idxlvl_prow - idxlvl[prow], where prow is the row number of the idx
924:   output Parameters:
925:     nlnk   - number of newly added indices
926:     lnk    - the sorted(increasing order) linked list containing new and non-redundate entries from idx
927:     lnklvl - levels of lnk
928:     bt     - updated PetscBT (bitarray) 
929:   Note: the level of U(i,j) is set as lvl(i,j) = min{ lvl(i,j), lvl(prow,i)+lvl(prow,j)+1)
930:         where idx = non-zero columns of U(prow,prow+1:n-1), prow<i
931: */
932: #define PetscICCLLAddSorted(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt,idxlvl_prow) 0;\
933: {\
934:   PetscInt _k,_entry,_location,_lnkdata,_incrlev;\
935:   nlnk = 0;\
936:   _lnkdata = idx_start;\
937:   for (_k=0; _k<nidx; _k++){\
938:     _incrlev = idxlvl[_k] + idxlvl_prow + 1;\
939:     if (_incrlev > level) continue;\
940:     _entry = idx[_k];\
941:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
942:       /* search for insertion location */\
943:       do {\
944:         _location = _lnkdata;\
945:         _lnkdata  = lnk[_location];\
946:       } while (_entry > _lnkdata);\
947:       /* insertion location is found, add entry into lnk */\
948:       lnk[_location] = _entry;\
949:       lnk[_entry]    = _lnkdata;\
950:       lnklvl[_entry] = _incrlev;\
951:       nlnk++;\
952:       _lnkdata = _entry; /* next search starts from here */\
953:     } else { /* existing entry: update lnklvl */\
954:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
955:     }\
956:   }\
957: }

959: /*
960:   Copy data on the list into an array, then initialize the list 
961:   Input Parameters:
962:     idx_start - starting index of the list 
963:     lnk_max   - max value of lnk indicating the end of the list 
964:     nlnk      - number of data on the list to be copied
965:     lnk       - linked list
966:     lnklvl    - level of lnk
967:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
968:   output Parameters:
969:     indices - array that contains the copied data
970:     lnk     - linked list that is cleaned and initialize
971:     lnklvl  - level of lnk that is reinitialized 
972:     bt      - PetscBT (bitarray) with all bits set to false
973: */
974: #define PetscIncompleteLLClean(idx_start,lnk_max,nlnk,lnk,lnklvl,indices,indiceslvl,bt) 0;\
975: {\
976:   PetscInt _j,_idx=idx_start;\
977:   for (_j=0; _j<nlnk; _j++){\
978:     _idx = lnk[_idx];\
979:     *(indices+_j) = _idx;\
980:     *(indiceslvl+_j) = lnklvl[_idx];\
981:     lnklvl[_idx] = -1;\
982:     PetscBTClear(bt,_idx);\
983:   }\
984:   lnk[idx_start] = lnk_max;\
985: }
986: /*
987:   Free memories used by the list
988: */
989: #define PetscIncompleteLLDestroy(lnk,bt) (PetscFree(lnk) || PetscBTDestroy(bt))


1003: #endif