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 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,PetscTruth);
 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 (*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,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, 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 (*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,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 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:   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: };
159: /*
160:     If you add MatOps entries above also add them to the MATOP enum
161:     in include/petscmat.h and include/finclude/petscmat.h
162: */

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

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

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

183: typedef struct _MatStashSpace *PetscMatStashSpace;

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

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

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

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

233: #define FACTOR_LU       1
234: #define FACTOR_CHOLESKY 2

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

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

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

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

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

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

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

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

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

317:     ncolors = 4;

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

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

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

340: */

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

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

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

393: EXTERN PetscErrorCode MatFactorDumpMatrix(Mat);

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

400:    Collective on Mat

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

407:    Output  Parameter:
408: +  newshift - 0: shift is unchanged; 1: shft is updated; -1: zeropivot  

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

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

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

468:    Collective on Mat

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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




992: #endif