Actual source code: matimpl.h

  2: #ifndef __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 PetscScalar[],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,const MatFactorInfo*);
 33:   PetscErrorCode (*choleskyfactor)(Mat,IS,const MatFactorInfo*);
 34:   PetscErrorCode (*relax)(Mat,Vec,PetscReal,MatSORType,PetscReal,PetscInt,PetscInt,Vec);
 35:   PetscErrorCode (*transpose)(Mat,MatReuse,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,PetscTruth);
 47:   PetscErrorCode (*zeroentries)(Mat);
 48:   /*25*/
 49:   PetscErrorCode (*zerorows)(Mat,PetscInt,const PetscInt[],PetscScalar);
 50:   PetscErrorCode (*lufactorsymbolic)(Mat,Mat,IS,IS,const MatFactorInfo*);
 51:   PetscErrorCode (*lufactornumeric)(Mat,Mat,const MatFactorInfo*);
 52:   PetscErrorCode (*choleskyfactorsymbolic)(Mat,Mat,IS,const MatFactorInfo*);
 53:   PetscErrorCode (*choleskyfactornumeric)(Mat,Mat,const MatFactorInfo*);
 54:   /*30*/
 55:   PetscErrorCode (*setuppreallocation)(Mat);
 56:   PetscErrorCode (*ilufactorsymbolic)(Mat,Mat,IS,IS,const MatFactorInfo*);
 57:   PetscErrorCode (*iccfactorsymbolic)(Mat,Mat,IS,const MatFactorInfo*);
 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,const MatFactorInfo*);
 65:   PetscErrorCode (*iccfactor)(Mat,IS,const 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 (*getrowmax)(Mat,Vec,PetscInt[]);
 74:   PetscErrorCode (*scale)(Mat,PetscScalar);
 75:   PetscErrorCode (*shift)(Mat,PetscScalar);
 76:   PetscErrorCode (*diagonalset)(Mat,Vec,InsertMode);
 77:   PetscErrorCode (*iludtfactor)(Mat,IS,IS,const MatFactorInfo*,Mat *);
 78:   /*50*/
 79:   PetscErrorCode (*setblocksize)(Mat,PetscInt);
 80:   PetscErrorCode (*getrowij)(Mat,PetscInt,PetscTruth,PetscTruth,PetscInt*,PetscInt *[],PetscInt *[],PetscTruth *);
 81:   PetscErrorCode (*restorerowij)(Mat,PetscInt,PetscTruth,PetscTruth,PetscInt *,PetscInt *[],PetscInt *[],PetscTruth *);
 82:   PetscErrorCode (*getcolumnij)(Mat,PetscInt,PetscTruth,PetscTruth,PetscInt*,PetscInt *[],PetscInt *[],PetscTruth *);
 83:   PetscErrorCode (*restorecolumnij)(Mat,PetscInt,PetscTruth,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 (*convertfrom)(Mat, const MatType,MatReuse,Mat*);
 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 (*getrowmaxabs)(Mat,Vec,PetscInt[]);
104:   PetscErrorCode (*getrowminabs)(Mat,Vec,PetscInt[]);
105:   PetscErrorCode (*convert)(Mat, const MatType,MatReuse,Mat*);
106:   PetscErrorCode (*setcoloring)(Mat,ISColoring);
107:   PetscErrorCode (*setvaluesadic)(Mat,void*);
108:   /*75*/
109:   PetscErrorCode (*setvaluesadifor)(Mat,PetscInt,void*);
110:   PetscErrorCode (*fdcoloringapply)(Mat,MatFDColoring,Vec,MatStructure*,void*);
111:   PetscErrorCode (*setfromoptions)(Mat);
112:   PetscErrorCode (*multconstrained)(Mat,Vec,Vec);
113:   PetscErrorCode (*multtransposeconstrained)(Mat,Vec,Vec);
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, const MatType,Mat*);
120:   /*85*/
121:   PetscErrorCode (*issymmetric)(Mat,PetscReal,PetscTruth*);
122:   PetscErrorCode (*ishermitian)(Mat,PetscReal,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 PetscScalar[]);
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:   PetscErrorCode (*getredundantmatrix)(Mat,PetscInt,MPI_Comm,PetscInt,MatReuse,Mat*);
153:   PetscErrorCode (*getrowmin)(Mat,Vec,PetscInt[]);
154:   PetscErrorCode (*getcolumnvector)(Mat,Vec,PetscInt);
155:   PetscErrorCode (*missingdiagonal)(Mat,PetscTruth*,PetscInt*);
156:   /*115*/
157:   PetscErrorCode (*getseqnonzerostructure)(Mat,Mat *[]);
158:   PetscErrorCode (*create)(Mat);
159: };
160: /*
161:     If you add MatOps entries above also add them to the MATOP enum
162:     in include/petscmat.h and include/finclude/petscmat.h
163: */

165: /*
166:    Utility private matrix routines
167: */
168: EXTERN PetscErrorCode MatConvert_Basic(Mat, const MatType,MatReuse,Mat*);
169: EXTERN PetscErrorCode MatCopy_Basic(Mat,Mat,MatStructure);
170: EXTERN PetscErrorCode MatView_Private(Mat);

172: EXTERN PetscErrorCode MatHeaderCopy(Mat,Mat);
173: EXTERN PetscErrorCode MatHeaderReplace(Mat,Mat);
174: EXTERN PetscErrorCode MatAXPYGetxtoy_Private(PetscInt,PetscInt*,PetscInt*,PetscInt*, PetscInt*,PetscInt*,PetscInt*, PetscInt**);
175: EXTERN PetscErrorCode MatPtAP_Basic(Mat,Mat,MatReuse,PetscReal,Mat*);
176: EXTERN PetscErrorCode MatDiagonalSet_Default(Mat,Vec,InsertMode);

178: /* 
179:   The stash is used to temporarily store inserted matrix values that 
180:   belong to another processor. During the assembly phase the stashed 
181:   values are moved to the correct processor and 
182: */

184: typedef struct _MatStashSpace *PetscMatStashSpace;

186: struct _MatStashSpace {
187:   PetscMatStashSpace next;
188:   PetscScalar        *space_head,*val;
189:   PetscInt           *idx,*idy;
190:   PetscInt           total_space_size;
191:   PetscInt           local_used;
192:   PetscInt           local_remaining;
193: };

195: EXTERN PetscErrorCode PetscMatStashSpaceGet(PetscInt,PetscInt,PetscMatStashSpace *);
196: EXTERN PetscErrorCode PetscMatStashSpaceContiguous(PetscInt,PetscMatStashSpace *,PetscScalar *,PetscInt *,PetscInt *);
197: EXTERN PetscErrorCode PetscMatStashSpaceDestroy(PetscMatStashSpace);

199: typedef struct {
200:   PetscInt      nmax;                   /* maximum stash size */
201:   PetscInt      umax;                   /* user specified max-size */
202:   PetscInt      oldnmax;                /* the nmax value used previously */
203:   PetscInt      n;                      /* stash size */
204:   PetscInt      bs;                     /* block size of the stash */
205:   PetscInt      reallocs;               /* preserve the no of mallocs invoked */
206:   PetscMatStashSpace space_head,space;  /* linked list to hold stashed global row/column numbers and matrix values */
207:   /* The following variables are used for communication */
208:   MPI_Comm      comm;
209:   PetscMPIInt   size,rank;
210:   PetscMPIInt   tag1,tag2;
211:   MPI_Request   *send_waits;            /* array of send requests */
212:   MPI_Request   *recv_waits;            /* array of receive requests */
213:   MPI_Status    *send_status;           /* array of send status */
214:   PetscInt      nsends,nrecvs;          /* numbers of sends and receives */
215:   PetscScalar   *svalues;               /* sending data */
216:   PetscScalar   **rvalues;              /* receiving data (values) */
217:   PetscInt      **rindices;             /* receiving data (indices) */
218:   PetscMPIInt   *nprocs;                /* tmp data used both during scatterbegin and end */
219:   PetscInt      nprocessed;             /* number of messages already processed */
220: } MatStash;

222: EXTERN PetscErrorCode MatStashCreate_Private(MPI_Comm,PetscInt,MatStash*);
223: EXTERN PetscErrorCode MatStashDestroy_Private(MatStash*);
224: EXTERN PetscErrorCode MatStashScatterEnd_Private(MatStash*);
225: EXTERN PetscErrorCode MatStashSetInitialSize_Private(MatStash*,PetscInt);
226: EXTERN PetscErrorCode MatStashGetInfo_Private(MatStash*,PetscInt*,PetscInt*);
227: EXTERN PetscErrorCode MatStashValuesRow_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const PetscScalar[]);
228: EXTERN PetscErrorCode MatStashValuesCol_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const PetscScalar[],PetscInt);
229: EXTERN PetscErrorCode MatStashValuesRowBlocked_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const PetscScalar[],PetscInt,PetscInt,PetscInt);
230: EXTERN PetscErrorCode MatStashValuesColBlocked_Private(MatStash*,PetscInt,PetscInt,const PetscInt[],const PetscScalar[],PetscInt,PetscInt,PetscInt);
231: EXTERN PetscErrorCode MatStashScatterBegin_Private(Mat,MatStash*,PetscInt*);
232: EXTERN PetscErrorCode MatStashScatterGetMesg_Private(MatStash*,PetscMPIInt*,PetscInt**,PetscInt**,PetscScalar**,PetscInt*);

234: typedef struct {
235:   PetscInt   dim;
236:   PetscInt   dims[4];
237:   PetscInt   starts[4];
238:   PetscTruth noc;        /* this is a single component problem, hence user will not set MatStencil.c */
239: } MatStencilInfo;

241: /* Info about using compressed row format */
242: typedef struct {
243:   PetscTruth use;
244:   PetscInt   nrows;                         /* number of non-zero rows */
245:   PetscInt   *i;                            /* compressed row pointer  */
246:   PetscInt   *rindex;                       /* compressed row index               */
247:   PetscTruth checked;                       /* if compressed row format have been checked for */
248: } Mat_CompressedRow;
249: EXTERN PetscErrorCode Mat_CheckCompressedRow(Mat,Mat_CompressedRow*,PetscInt*,PetscInt,PetscReal);

251: struct _p_Mat {
252:   PETSCHEADER(struct _MatOps);
253:   PetscMap               *rmap,*cmap;
254:   void                   *data;            /* implementation-specific data */
255:   MatFactorType          factor;           /* MAT_FACTOR_LU, or MAT_FACTOR_CHOLESKY */
256:   PetscTruth             assembled;        /* is the matrix assembled? */
257:   PetscTruth             was_assembled;    /* new values inserted into assembled mat */
258:   PetscInt               num_ass;          /* number of times matrix has been assembled */
259:   PetscTruth             same_nonzero;     /* matrix has same nonzero pattern as previous */
260:   MatInfo                info;             /* matrix information */
261:   ISLocalToGlobalMapping mapping;          /* mapping used in MatSetValuesLocal() */
262:   ISLocalToGlobalMapping bmapping;         /* mapping used in MatSetValuesBlockedLocal() */
263:   InsertMode             insertmode;       /* have values been inserted in matrix or added? */
264:   MatStash               stash,bstash;     /* used for assembling off-proc mat emements */
265:   MatNullSpace           nullsp;
266:   PetscTruth             preallocated;
267:   MatStencilInfo         stencil;          /* information for structured grid */
268:   PetscTruth             symmetric,hermitian,structurally_symmetric;
269:   PetscTruth             symmetric_set,hermitian_set,structurally_symmetric_set; /* if true, then corresponding flag is correct*/
270:   PetscTruth             symmetric_eternal;
271:   void                   *spptr;          /* pointer for special library like SuperLU */
272:   MatSolverPackage       solvertype;
273: };

275: #define MatPreallocated(A)  ((!(A)->preallocated) ? MatSetUpPreallocation(A) : 0)

278: /*
279:     Object for partitioning graphs
280: */

282: typedef struct _MatPartitioningOps *MatPartitioningOps;
283: struct _MatPartitioningOps {
284:   PetscErrorCode (*apply)(MatPartitioning,IS*);
285:   PetscErrorCode (*setfromoptions)(MatPartitioning);
286:   PetscErrorCode (*destroy)(MatPartitioning);
287:   PetscErrorCode (*view)(MatPartitioning,PetscViewer);
288: };

290: struct _p_MatPartitioning {
291:   PETSCHEADER(struct _MatPartitioningOps);
292:   Mat         adj;
293:   PetscInt    *vertex_weights;
294:   PetscReal   *part_weights;
295:   PetscInt    n;                                 /* number of partitions */
296:   void        *data;
297:   PetscInt    setupcalled;
298: };

300: /*
301:     MatFDColoring is used to compute Jacobian matrices efficiently
302:   via coloring. The data structure is explained below in an example.

304:    Color =   0    1     0    2   |   2      3       0 
305:    ---------------------------------------------------
306:             00   01              |          05
307:             10   11              |   14     15               Processor  0
308:                        22    23  |          25
309:                        32    33  | 
310:    ===================================================
311:                                  |   44     45     46
312:             50                   |          55               Processor 1
313:                                  |   64            66
314:    ---------------------------------------------------

316:     ncolors = 4;

318:     ncolumns      = {2,1,1,0}
319:     columns       = {{0,2},{1},{3},{}}
320:     nrows         = {4,2,3,3}
321:     rows          = {{0,1,2,3},{0,1},{1,2,3},{0,1,2}}
322:     columnsforrow = {{0,0,2,2},{1,1},{4,3,3},{5,5,5}}
323:     vscaleforrow  = {{,,,},{,},{,,},{,,}}
324:     vwscale       = {dx(0),dx(1),dx(2),dx(3)}               MPI Vec
325:     vscale        = {dx(0),dx(1),dx(2),dx(3),dx(4),dx(5)}   Seq Vec

327:     ncolumns      = {1,0,1,1}
328:     columns       = {{6},{},{4},{5}}
329:     nrows         = {3,0,2,2}
330:     rows          = {{0,1,2},{},{1,2},{1,2}}
331:     columnsforrow = {{6,0,6},{},{4,4},{5,5}}
332:     vscaleforrow =  {{,,},{},{,},{,}}
333:     vwscale       = {dx(4),dx(5),dx(6)}              MPI Vec
334:     vscale        = {dx(0),dx(4),dx(5),dx(6)}        Seq Vec

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

339: */

341: struct  _p_MatFDColoring{
342:   PETSCHEADER(int);
343:   PetscInt       M,N,m;            /* total rows, columns; local rows */
344:   PetscInt       rstart;           /* first row owned by local processor */
345:   PetscInt       ncolors;          /* number of colors */
346:   PetscInt       *ncolumns;        /* number of local columns for a color */
347:   PetscInt       **columns;        /* lists the local columns of each color (using global column numbering) */
348:   PetscInt       *nrows;           /* number of local rows for each color */
349:   PetscInt       **rows;           /* lists the local rows for each color (using the local row numbering) */
350:   PetscInt       **columnsforrow;  /* lists the corresponding columns for those rows (using the global column) */
351:   PetscReal      error_rel;        /* square root of relative error in computing function */
352:   PetscReal      umin;             /* minimum allowable u'dx value */
353:   Vec            w1,w2,w3;         /* work vectors used in computing Jacobian */
354:   PetscErrorCode (*f)(void);       /* function that defines Jacobian */
355:   void           *fctx;            /* optional user-defined context for use by the function f */
356:   PetscInt       **vscaleforrow;   /* location in vscale for each columnsforrow[] entry */
357:   Vec            vscale;           /* holds FD scaling, i.e. 1/dx for each perturbed column */
358:   Vec            F;                /* current value of user provided function; can set with MatFDColoringSetF() */
359:   PetscInt       currentcolor;     /* color for which function evaluation is being done now */
360:   const char     *htype;            /* "wp" or "ds" */
361:   ISColoringType ctype;            /* IS_COLORING_GLOBAL or IS_COLORING_GHOSTED */

363:   void           *ftn_func_pointer,*ftn_func_cntx; /* serve the same purpose as *fortran_func_pointers in PETSc objects */
364: };

366: /*
367:    Null space context for preconditioner/operators
368: */
369: struct _p_MatNullSpace {
370:   PETSCHEADER(int);
371:   PetscTruth     has_cnst;
372:   PetscInt       n;
373:   Vec*           vecs;
374:   PetscScalar*   alpha;                 /* for projections */
375:   Vec            vec;                   /* for out of place removals */
376:   PetscErrorCode (*remove)(Vec,void*);  /* for user provided removal function */
377:   void*          rmctx;                 /* context for remove() function */
378: };

380: /* 
381:    Checking zero pivot for LU, ILU preconditioners.
382: */
383: typedef struct {
384:   PetscInt       nshift,nshift_max;
385:   PetscReal      shift_amount,shift_lo,shift_hi,shift_top,shift_fraction;
386:   PetscTruth     lushift;
387:   PetscReal      rs;  /* active row sum of abs(offdiagonals) */
388:   PetscScalar    pv;  /* pivot of the active row */
389: } LUShift_Ctx;

391: EXTERN PetscErrorCode MatFactorDumpMatrix(Mat);

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

398:    Collective on Mat

400:    Input Parameters:
401: +  info - information about the matrix factorization 
402: .  sctx - pointer to the struct LUShift_Ctx
403: -  row  - active row index

405:    Output  Parameter:
406: +  newshift - 0: shift is unchanged; 1: shft is updated; -1: zeropivot  

408:    Level: developer
409: @*/
410: #define MatLUCheckShift_inline(info,sctx,row,newshift) 0;\
411: {\
412:   PetscInt  _newshift;\
413:   PetscReal _rs   = sctx.rs;\
414:   PetscReal _zero = info->zeropivot*_rs;\
415:   if (info->shiftnz && PetscAbsScalar(sctx.pv) <= _zero){\
416:     /* force |diag| > zeropivot*rs */\
417:     if (!sctx.nshift){\
418:       sctx.shift_amount = info->shiftnz;\
419:     } else {\
420:       sctx.shift_amount *= 2.0;\
421:     }\
422:     sctx.lushift = PETSC_TRUE;\
423:     (sctx.nshift)++;\
424:     _newshift = 1;\
425:   } else if (info->shiftpd && PetscRealPart(sctx.pv) <= _zero){\
426:     /* force matfactor to be diagonally dominant */\
427:     if (sctx.nshift > sctx.nshift_max) {\
428:       MatFactorDumpMatrix(A);\
429:       SETERRQ1(PETSC_ERR_CONV_FAILED,"Unable to determine shift to enforce positive definite preconditioner after %d tries",sctx.nshift);\
430:     } else if (sctx.nshift == sctx.nshift_max) {\
431:       sctx.shift_fraction = sctx.shift_hi;\
432:       sctx.lushift        = PETSC_TRUE;\
433:     } else {\
434:       sctx.shift_lo = sctx.shift_fraction;\
435:       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;\
436:       sctx.lushift  = PETSC_TRUE;\
437:     }\
438:     sctx.shift_amount = sctx.shift_fraction * sctx.shift_top;\
439:     sctx.nshift++;\
440:     _newshift = 1;\
441:   } else if (PetscAbsScalar(sctx.pv) <= _zero){\
442:     MatFactorDumpMatrix(A);\
443:     SETERRQ4(PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot row %D value %G tolerance %G * rowsum %G",row,PetscAbsScalar(sctx.pv),_zero,_rs); \
444:   } else {\
445:     _newshift = 0;\
446:   }\
447:   newshift = _newshift;\
448: }

450: /* 
451:    Checking zero pivot for Cholesky, ICC preconditioners.
452: */
453: typedef struct {
454:   PetscInt       nshift;
455:   PetscReal      shift_amount;
456:   PetscTruth     chshift;
457:   PetscReal      rs;  /* active row sum of abs(offdiagonals) */
458:   PetscScalar    pv;  /* pivot of the active row */
459: } ChShift_Ctx;

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

466:    Collective on Mat

468:    Input Parameters:
469: +  info - information about the matrix factorization 
470: .  sctx - pointer to the struct CholeskyShift_Ctx
471: .  row  - pivot row
472: -  newshift - 0: shift is unchanged; 1: shft is updated; -1: zeropivot  

474:    Level: developer
475:    Note: Unlike in the ILU case there is no exit condition on nshift:
476:        we increase the shift until it converges. There is no guarantee that
477:        this algorithm converges faster or slower, or is better or worse
478:        than the ILU algorithm. 
479: @*/
480: #define MatCholeskyCheckShift_inline(info,sctx,row,newshift) 0;        \
481: {\
482:   PetscInt  _newshift;\
483:   PetscReal _rs   = sctx.rs;\
484:   PetscReal _zero = info->zeropivot*_rs;\
485:   if (info->shiftnz && PetscAbsScalar(sctx.pv) <= _zero){\
486:     /* force |diag| > zeropivot*sctx.rs */\
487:     if (!sctx.nshift){\
488:       sctx.shift_amount = info->shiftnz;\
489:     } else {\
490:       sctx.shift_amount *= 2.0;\
491:     }\
492:     sctx.chshift = PETSC_TRUE;\
493:     sctx.nshift++;\
494:     _newshift = 1;\
495:   } else if (info->shiftpd && PetscRealPart(sctx.pv) <= _zero){\
496:     /* calculate a shift that would make this row diagonally dominant */\
497:     sctx.shift_amount = PetscMax(_rs+PetscAbs(PetscRealPart(sctx.pv)),1.1*sctx.shift_amount);\
498:     sctx.chshift      = PETSC_TRUE;\
499:     sctx.nshift++;\
500:     _newshift = 1;\
501:   } else if (PetscAbsScalar(sctx.pv) <= _zero){\
502:     SETERRQ4(PETSC_ERR_MAT_CH_ZRPVT,"Zero pivot row %D value %G tolerance %G * rowsum %G",row,PetscAbsScalar(sctx.pv),_zero,_rs); \
503:   } else {\
504:     _newshift = 0; \
505:   }\
506:   newshift = _newshift;\
507: }

509: /* 
510:   Create and initialize a linked list 
511:   Input Parameters:
512:     idx_start - starting index of the list
513:     lnk_max   - max value of lnk indicating the end of the list
514:     nlnk      - max length of the list
515:   Output Parameters:
516:     lnk       - list initialized
517:     bt        - PetscBT (bitarray) with all bits set to false
518: */
519: #define PetscLLCreate(idx_start,lnk_max,nlnk,lnk,bt) \
520:   (PetscMalloc(nlnk*sizeof(PetscInt),&lnk) || PetscBTCreate(nlnk,bt) || PetscBTMemzero(nlnk,bt) || (lnk[idx_start] = lnk_max,0))

522: /*
523:   Add an index set into a sorted linked list
524:   Input Parameters:
525:     nidx      - number of input indices
526:     indices   - interger array
527:     idx_start - starting index of the list
528:     lnk       - linked list(an integer array) that is created
529:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
530:   output Parameters:
531:     nlnk      - number of newly added indices
532:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
533:     bt        - updated PetscBT (bitarray) 
534: */
535: #define PetscLLAdd(nidx,indices,idx_start,nlnk,lnk,bt) 0;\
536: {\
537:   PetscInt _k,_entry,_location,_lnkdata;\
538:   nlnk     = 0;\
539:   _lnkdata = idx_start;\
540:   for (_k=0; _k<nidx; _k++){\
541:     _entry = indices[_k];\
542:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
543:       /* search for insertion location */\
544:       /* start from the beginning if _entry < previous _entry */\
545:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
546:       do {\
547:         _location = _lnkdata;\
548:         _lnkdata  = lnk[_location];\
549:       } while (_entry > _lnkdata);\
550:       /* insertion location is found, add entry into lnk */\
551:       lnk[_location] = _entry;\
552:       lnk[_entry]    = _lnkdata;\
553:       nlnk++;\
554:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
555:     }\
556:   }\
557: }

559: /*
560:   Add a permuted index set into a sorted linked list
561:   Input Parameters:
562:     nidx      - number of input indices
563:     indices   - interger array
564:     perm      - permutation of indices
565:     idx_start - starting index of the list
566:     lnk       - linked list(an integer array) that is created
567:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
568:   output Parameters:
569:     nlnk      - number of newly added indices
570:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
571:     bt        - updated PetscBT (bitarray) 
572: */
573: #define PetscLLAddPerm(nidx,indices,perm,idx_start,nlnk,lnk,bt) 0;\
574: {\
575:   PetscInt _k,_entry,_location,_lnkdata;\
576:   nlnk     = 0;\
577:   _lnkdata = idx_start;\
578:   for (_k=0; _k<nidx; _k++){\
579:     _entry = perm[indices[_k]];\
580:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
581:       /* search for insertion location */\
582:       /* start from the beginning if _entry < previous _entry */\
583:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
584:       do {\
585:         _location = _lnkdata;\
586:         _lnkdata  = lnk[_location];\
587:       } while (_entry > _lnkdata);\
588:       /* insertion location is found, add entry into lnk */\
589:       lnk[_location] = _entry;\
590:       lnk[_entry]    = _lnkdata;\
591:       nlnk++;\
592:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
593:     }\
594:   }\
595: }

597: /*
598:   Add a SORTED index set into a sorted linked list
599:   Input Parameters:
600:     nidx      - number of input indices
601:     indices   - sorted interger array 
602:     idx_start - starting index of the list
603:     lnk       - linked list(an integer array) that is created
604:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
605:   output Parameters:
606:     nlnk      - number of newly added indices
607:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
608:     bt        - updated PetscBT (bitarray) 
609: */
610: #define PetscLLAddSorted(nidx,indices,idx_start,nlnk,lnk,bt) 0;\
611: {\
612:   PetscInt _k,_entry,_location,_lnkdata;\
613:   nlnk      = 0;\
614:   _lnkdata  = idx_start;\
615:   for (_k=0; _k<nidx; _k++){\
616:     _entry = indices[_k];\
617:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
618:       /* search for insertion location */\
619:       do {\
620:         _location = _lnkdata;\
621:         _lnkdata  = lnk[_location];\
622:       } while (_entry > _lnkdata);\
623:       /* insertion location is found, add entry into lnk */\
624:       lnk[_location] = _entry;\
625:       lnk[_entry]    = _lnkdata;\
626:       nlnk++;\
627:       _lnkdata = _entry; /* next search starts from here */\
628:     }\
629:   }\
630: }

632: /*
633:   Add a SORTED index set into a sorted linked list used for LUFactorSymbolic()
634:   Same as PetscLLAddSorted() with an additional operation:
635:        count the number of input indices that are no larger than 'diag'
636:   Input Parameters:
637:     indices   - sorted interger array 
638:     idx_start - starting index of the list
639:     lnk       - linked list(an integer array) that is created
640:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
641:     diag      - index of the active row in LUFactorSymbolic
642:     nzbd      - number of input indices with indices <= idx_start
643:   output Parameters:
644:     nlnk      - number of newly added indices
645:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from indices
646:     bt        - updated PetscBT (bitarray) 
647:     im        - im[idx_start] =  num of entries with indices <= diag
648: */
649: #define PetscLLAddSortedLU(indices,idx_start,nlnk,lnk,bt,diag,nzbd,im) 0;\
650: {\
651:   PetscInt _k,_entry,_location,_lnkdata,_nidx;\
652:   nlnk     = 0;\
653:   _lnkdata = idx_start;\
654:   _nidx = im[idx_start] - nzbd; /* num of entries with idx_start < index <= diag */\
655:   for (_k=0; _k<_nidx; _k++){\
656:     _entry = indices[_k];\
657:     nzbd++;\
658:     if ( _entry== diag) im[idx_start] = nzbd;\
659:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
660:       /* search for insertion location */\
661:       do {\
662:         _location = _lnkdata;\
663:         _lnkdata  = lnk[_location];\
664:       } while (_entry > _lnkdata);\
665:       /* insertion location is found, add entry into lnk */\
666:       lnk[_location] = _entry;\
667:       lnk[_entry]    = _lnkdata;\
668:       nlnk++;\
669:       _lnkdata = _entry; /* next search starts from here */\
670:     }\
671:   }\
672: }

674: /*
675:   Copy data on the list into an array, then initialize the list 
676:   Input Parameters:
677:     idx_start - starting index of the list 
678:     lnk_max   - max value of lnk indicating the end of the list 
679:     nlnk      - number of data on the list to be copied
680:     lnk       - linked list
681:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
682:   output Parameters:
683:     indices   - array that contains the copied data
684:     lnk       - linked list that is cleaned and initialize
685:     bt        - PetscBT (bitarray) with all bits set to false
686: */
687: #define PetscLLClean(idx_start,lnk_max,nlnk,lnk,indices,bt) 0;\
688: {\
689:   PetscInt _j,_idx=idx_start;\
690:   for (_j=0; _j<nlnk; _j++){\
691:     _idx = lnk[_idx];\
692:     *(indices+_j) = _idx;\
693:     PetscBTClear(bt,_idx);\
694:   }\
695:   lnk[idx_start] = lnk_max;\
696: }
697: /*
698:   Free memories used by the list
699: */
700: #define PetscLLDestroy(lnk,bt) (PetscFree(lnk) || PetscBTDestroy(bt))

702: /* Routines below are used for incomplete matrix factorization */
703: /* 
704:   Create and initialize a linked list and its levels
705:   Input Parameters:
706:     idx_start - starting index of the list
707:     lnk_max   - max value of lnk indicating the end of the list
708:     nlnk      - max length of the list
709:   Output Parameters:
710:     lnk       - list initialized
711:     lnk_lvl   - array of size nlnk for storing levels of lnk
712:     bt        - PetscBT (bitarray) with all bits set to false
713: */
714: #define PetscIncompleteLLCreate(idx_start,lnk_max,nlnk,lnk,lnk_lvl,bt)\
715:   (PetscMalloc(2*nlnk*sizeof(PetscInt),&lnk) || PetscBTCreate(nlnk,bt) || PetscBTMemzero(nlnk,bt) || (lnk[idx_start] = lnk_max,lnk_lvl = lnk + nlnk,0))

717: /*
718:   Initialize a sorted linked list used for ILU and ICC
719:   Input Parameters:
720:     nidx      - number of input idx
721:     idx       - interger array used for storing column indices
722:     idx_start - starting index of the list
723:     perm      - indices of an IS
724:     lnk       - linked list(an integer array) that is created
725:     lnklvl    - levels of lnk
726:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
727:   output Parameters:
728:     nlnk     - number of newly added idx
729:     lnk      - the sorted(increasing order) linked list containing new and non-redundate entries from idx
730:     lnklvl   - levels of lnk
731:     bt       - updated PetscBT (bitarray) 
732: */
733: #define PetscIncompleteLLInit(nidx,idx,idx_start,perm,nlnk,lnk,lnklvl,bt) 0;\
734: {\
735:   PetscInt _k,_entry,_location,_lnkdata;\
736:   nlnk     = 0;\
737:   _lnkdata = idx_start;\
738:   for (_k=0; _k<nidx; _k++){\
739:     _entry = perm[idx[_k]];\
740:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
741:       /* search for insertion location */\
742:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
743:       do {\
744:         _location = _lnkdata;\
745:         _lnkdata  = lnk[_location];\
746:       } while (_entry > _lnkdata);\
747:       /* insertion location is found, add entry into lnk */\
748:       lnk[_location]  = _entry;\
749:       lnk[_entry]     = _lnkdata;\
750:       lnklvl[_entry] = 0;\
751:       nlnk++;\
752:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
753:     }\
754:   }\
755: }

757: /*
758:   Add a SORTED index set into a sorted linked list for ILU
759:   Input Parameters:
760:     nidx      - number of input indices
761:     idx       - sorted interger array used for storing column indices
762:     level     - level of fill, e.g., ICC(level)
763:     idxlvl    - level of idx 
764:     idx_start - starting index of the list
765:     lnk       - linked list(an integer array) that is created
766:     lnklvl    - levels of lnk
767:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
768:     prow      - the row number of idx
769:   output Parameters:
770:     nlnk     - number of newly added idx
771:     lnk      - the sorted(increasing order) linked list containing new and non-redundate entries from idx
772:     lnklvl   - levels of lnk
773:     bt       - updated PetscBT (bitarray) 

775:   Note: the level of factor(i,j) is set as lvl(i,j) = min{ lvl(i,j), lvl(i,prow)+lvl(prow,j)+1)
776:         where idx = non-zero columns of U(prow,prow+1:n-1), prow<i
777: */
778: #define PetscILULLAddSorted(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt,lnklvl_prow) 0;\
779: {\
780:   PetscInt _k,_entry,_location,_lnkdata,_incrlev,_lnklvl_prow=lnklvl[prow];\
781:   nlnk     = 0;\
782:   _lnkdata = idx_start;\
783:   for (_k=0; _k<nidx; _k++){\
784:     _incrlev = idxlvl[_k] + _lnklvl_prow + 1;\
785:     if (_incrlev > level) continue;\
786:     _entry = idx[_k];\
787:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
788:       /* search for insertion location */\
789:       do {\
790:         _location = _lnkdata;\
791:         _lnkdata  = lnk[_location];\
792:       } while (_entry > _lnkdata);\
793:       /* insertion location is found, add entry into lnk */\
794:       lnk[_location]  = _entry;\
795:       lnk[_entry]     = _lnkdata;\
796:       lnklvl[_entry] = _incrlev;\
797:       nlnk++;\
798:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
799:     } else { /* existing entry: update lnklvl */\
800:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
801:     }\
802:   }\
803: }

805: /*
806:   Add a index set into a sorted linked list
807:   Input Parameters:
808:     nidx      - number of input idx
809:     idx   - interger array used for storing column indices
810:     level     - level of fill, e.g., ICC(level)
811:     idxlvl - level of idx 
812:     idx_start - starting index of the list
813:     lnk       - linked list(an integer array) that is created
814:     lnklvl   - levels of lnk
815:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
816:   output Parameters:
817:     nlnk      - number of newly added idx
818:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from idx
819:     lnklvl   - levels of lnk
820:     bt        - updated PetscBT (bitarray) 
821: */
822: #define PetscIncompleteLLAdd(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt) 0;\
823: {\
824:   PetscInt _k,_entry,_location,_lnkdata,_incrlev;\
825:   nlnk     = 0;\
826:   _lnkdata = idx_start;\
827:   for (_k=0; _k<nidx; _k++){\
828:     _incrlev = idxlvl[_k] + 1;\
829:     if (_incrlev > level) continue;\
830:     _entry = idx[_k];\
831:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
832:       /* search for insertion location */\
833:       if (_k && _entry < _lnkdata) _lnkdata  = idx_start;\
834:       do {\
835:         _location = _lnkdata;\
836:         _lnkdata  = lnk[_location];\
837:       } while (_entry > _lnkdata);\
838:       /* insertion location is found, add entry into lnk */\
839:       lnk[_location]  = _entry;\
840:       lnk[_entry]     = _lnkdata;\
841:       lnklvl[_entry] = _incrlev;\
842:       nlnk++;\
843:       _lnkdata = _entry; /* next search starts from here if next_entry > _entry */\
844:     } else { /* existing entry: update lnklvl */\
845:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
846:     }\
847:   }\
848: }

850: /*
851:   Add a SORTED index set into a sorted linked list
852:   Input Parameters:
853:     nidx      - number of input indices
854:     idx   - sorted interger array used for storing column indices
855:     level     - level of fill, e.g., ICC(level)
856:     idxlvl - level of idx 
857:     idx_start - starting index of the list
858:     lnk       - linked list(an integer array) that is created
859:     lnklvl    - levels of lnk
860:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
861:   output Parameters:
862:     nlnk      - number of newly added idx
863:     lnk       - the sorted(increasing order) linked list containing new and non-redundate entries from idx
864:     lnklvl    - levels of lnk
865:     bt        - updated PetscBT (bitarray) 
866: */
867: #define PetscIncompleteLLAddSorted(nidx,idx,level,idxlvl,idx_start,nlnk,lnk,lnklvl,bt) 0;\
868: {\
869:   PetscInt _k,_entry,_location,_lnkdata,_incrlev;\
870:   nlnk = 0;\
871:   _lnkdata = idx_start;\
872:   for (_k=0; _k<nidx; _k++){\
873:     _incrlev = idxlvl[_k] + 1;\
874:     if (_incrlev > level) continue;\
875:     _entry = idx[_k];\
876:     if (!PetscBTLookupSet(bt,_entry)){  /* new entry */\
877:       /* search for insertion location */\
878:       do {\
879:         _location = _lnkdata;\
880:         _lnkdata  = lnk[_location];\
881:       } while (_entry > _lnkdata);\
882:       /* insertion location is found, add entry into lnk */\
883:       lnk[_location] = _entry;\
884:       lnk[_entry]    = _lnkdata;\
885:       lnklvl[_entry] = _incrlev;\
886:       nlnk++;\
887:       _lnkdata = _entry; /* next search starts from here */\
888:     } else { /* existing entry: update lnklvl */\
889:       if (lnklvl[_entry] > _incrlev) lnklvl[_entry] = _incrlev;\
890:     }\
891:   }\
892: }

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

941: /*
942:   Copy data on the list into an array, then initialize the list 
943:   Input Parameters:
944:     idx_start - starting index of the list 
945:     lnk_max   - max value of lnk indicating the end of the list 
946:     nlnk      - number of data on the list to be copied
947:     lnk       - linked list
948:     lnklvl    - level of lnk
949:     bt        - PetscBT (bitarray), bt[idx]=true marks idx is in lnk
950:   output Parameters:
951:     indices - array that contains the copied data
952:     lnk     - linked list that is cleaned and initialize
953:     lnklvl  - level of lnk that is reinitialized 
954:     bt      - PetscBT (bitarray) with all bits set to false
955: */
956: #define PetscIncompleteLLClean(idx_start,lnk_max,nlnk,lnk,lnklvl,indices,indiceslvl,bt) 0;\
957: {\
958:   PetscInt _j,_idx=idx_start;\
959:   for (_j=0; _j<nlnk; _j++){\
960:     _idx = lnk[_idx];\
961:     *(indices+_j) = _idx;\
962:     *(indiceslvl+_j) = lnklvl[_idx];\
963:     lnklvl[_idx] = -1;\
964:     PetscBTClear(bt,_idx);\
965:   }\
966:   lnk[idx_start] = lnk_max;\
967: }
968: /*
969:   Free memories used by the list
970: */
971: #define PetscIncompleteLLDestroy(lnk,bt) (PetscFree(lnk) || PetscBTDestroy(bt))




990: #endif