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