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