Actual source code: color.c
1: #define PETSCMAT_DLL
3: /*
4: Routines that call the kernel minpack coloring subroutines
5: */
7: #include include/private/matimpl.h
8: #include src/mat/color/color.h
10: /*
11: MatFDColoringDegreeSequence_Minpack - Calls the MINPACK routine seqr() that
12: computes the degree sequence required by MINPACK coloring routines.
13: */
16: PetscErrorCode MatFDColoringDegreeSequence_Minpack(PetscInt m,PetscInt *cja, PetscInt *cia, PetscInt *rja, PetscInt *ria, PetscInt **seq)
17: {
18: PetscInt *work;
22: PetscMalloc(m*sizeof(PetscInt),&work);
23: PetscMalloc(m*sizeof(PetscInt),seq);
25: MINPACKdegr(&m,cja,cia,rja,ria,*seq,work);
27: PetscFree(work);
28: return(0);
29: }
31: /*
32: MatFDColoringMinimumNumberofColors_Private - For a given sparse
33: matrix computes the minimum number of colors needed.
35: */
38: PetscErrorCode MatFDColoringMinimumNumberofColors_Private(PetscInt m,PetscInt *ia,PetscInt *minc)
39: {
40: PetscInt i,c = 0;
43: for (i=0; i<m; i++) {
44: c = PetscMax(c,ia[i+1]-ia[i]);
45: }
46: *minc = c;
47: return(0);
48: }
51: /* ----------------------------------------------------------------------------*/
52: /*
53: MatFDColoringSL_Minpack - Uses the smallest-last (SL) coloring of minpack
54: */
57: PetscErrorCode MatFDColoringSL_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
58: {
60: PetscInt *list,*work,clique,*ria,*rja,*cia,*cja,*seq,*coloring,n;
61: PetscInt ncolors,i;
62: PetscTruth done;
65: MatGetRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
66: MatGetColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
67: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
69: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
71: PetscMalloc(5*n*sizeof(PetscInt),&list);
72: work = list + n;
74: MINPACKslo(&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
76: PetscMalloc(n*sizeof(PetscInt),&coloring);
77: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
79: PetscFree(list);
80: PetscFree(seq);
81: MatRestoreRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
82: MatRestoreColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
84: /* shift coloring numbers to start at zero and shorten */
85: if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_ERR_SUP,"Maximum color size exceeded");
86: {
87: ISColoringValue *s = (ISColoringValue*) coloring;
88: for (i=0; i<n; i++) {
89: s[i] = (ISColoringValue) (coloring[i]-1);
90: }
91: MatColoringPatch(mat,ncolors,n,s,iscoloring);
92: }
93: return(0);
94: }
98: /* ----------------------------------------------------------------------------*/
99: /*
100: MatFDColoringLF_Minpack -
101: */
104: PetscErrorCode MatFDColoringLF_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
105: {
107: PetscInt *list,*work,*ria,*rja,*cia,*cja,*seq,*coloring,n;
108: PetscInt n1, none,ncolors,i;
109: PetscTruth done;
112: MatGetRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
113: MatGetColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
114: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
116: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
118: PetscMalloc(5*n*sizeof(PetscInt),&list);
119: work = list + n;
121: n1 = n - 1;
122: none = -1;
123: MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
124: PetscMalloc(n*sizeof(PetscInt),&coloring);
125: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
127: PetscFree(list);
128: PetscFree(seq);
130: MatRestoreRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
131: MatRestoreColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
133: /* shift coloring numbers to start at zero and shorten */
134: if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_ERR_SUP,"Maximum color size exceeded");
135: {
136: ISColoringValue *s = (ISColoringValue*) coloring;
137: for (i=0; i<n; i++) {
138: s[i] = (ISColoringValue) (coloring[i]-1);
139: }
140: MatColoringPatch(mat,ncolors,n,s,iscoloring);
141: }
142: return(0);
143: }
147: /* ----------------------------------------------------------------------------*/
148: /*
149: MatFDColoringID_Minpack -
150: */
153: PetscErrorCode MatFDColoringID_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
154: {
156: PetscInt *list,*work,clique,*ria,*rja,*cia,*cja,*seq,*coloring,n;
157: PetscInt ncolors,i;
158: PetscTruth done;
161: MatGetRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
162: MatGetColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
163: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
165: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
167: PetscMalloc(5*n*sizeof(PetscInt),&list);
168: work = list + n;
170: MINPACKido(&n,&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
172: PetscMalloc(n*sizeof(PetscInt),&coloring);
173: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
175: PetscFree(list);
176: PetscFree(seq);
178: MatRestoreRowIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
179: MatRestoreColumnIJ(mat,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
181: /* shift coloring numbers to start at zero and shorten */
182: if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_ERR_SUP,"Maximum color size exceeded");
183: {
184: ISColoringValue *s = (ISColoringValue*) coloring;
185: for (i=0; i<n; i++) {
186: s[i] = (ISColoringValue) (coloring[i]-1);
187: }
188: MatColoringPatch(mat,ncolors,n,s,iscoloring);
189: }
190: return(0);
191: }
195: /*
196: Simplest coloring, each column of the matrix gets its own unique color.
197: */
200: PetscErrorCode MatColoring_Natural(Mat mat,MatColoringType color, ISColoring *iscoloring)
201: {
202: PetscErrorCode ierr;
203: PetscInt start,end,i;
204: ISColoringValue *colors;
205: MPI_Comm comm;
208: MatGetOwnershipRange(mat,&start,&end);
209: PetscObjectGetComm((PetscObject)mat,&comm);
210: PetscMalloc((end-start+1)*sizeof(PetscInt),&colors);
211: for (i=start; i<end; i++) {
212: colors[i-start] = i;
213: }
214: ISColoringCreate(comm,mat->cmap.N,end-start,colors,iscoloring);
216: return(0);
217: }
219:
220: /* ===========================================================================================*/
222: #include petscsys.h
224: PetscFList MatColoringList = 0;
225: PetscTruth MatColoringRegisterAllCalled = PETSC_FALSE;
229: PetscErrorCode MatColoringRegister(const char sname[],const char path[],const char name[],PetscErrorCode (*function)(Mat,MatColoringType,ISColoring*))
230: {
232: char fullname[PETSC_MAX_PATH_LEN];
235: PetscFListConcat(path,name,fullname);
236: PetscFListAdd(&MatColoringList,sname,fullname,(void (*)(void))function);
237: return(0);
238: }
242: /*@C
243: MatColoringRegisterDestroy - Frees the list of coloringing routines.
245: Not Collective
247: Level: developer
249: .keywords: matrix, register, destroy
251: .seealso: MatColoringRegisterDynamic(), MatColoringRegisterAll()
252: @*/
253: PetscErrorCode MatColoringRegisterDestroy(void)
254: {
258: PetscFListDestroy(&MatColoringList);
259: return(0);
260: }
264: /*@C
265: MatGetColoring - Gets a coloring for a matrix to reduce the number of function evaluations
266: needed to compute a sparse Jacobian via differencing.
268: Collective on Mat
270: Input Parameters:
271: . mat - the matrix
272: . type - type of coloring, one of the following:
273: $ MATCOLORING_NATURAL - natural (one color for each column, very slow)
274: $ MATCOLORING_SL - smallest-last
275: $ MATCOLORING_LF - largest-first
276: $ MATCOLORING_ID - incidence-degree
278: Output Parameters:
279: . iscoloring - the coloring
281: Options Database Keys:
282: To specify the coloring through the options database, use one of
283: the following
284: $ -mat_coloring_type natural, -mat_coloring_type sl, -mat_coloring_type lf,
285: $ -mat_coloring_type id
286: To see the coloring use
287: $ -mat_coloring_view
289: Level: intermediate
291: Notes:
292: These compute the graph coloring of the graph of A^{T}A. The coloring used
293: for efficient (parallel or thread based) triangular solves etc is NOT yet
294: available.
296: The user can define additional colorings; see MatColoringRegisterDynamic().
298: The sequential colorings SL, LF, and ID are obtained via the Minpack software that was
299: converted to C using f2c.
301: .keywords: matrix, get, coloring
303: .seealso: MatGetColoringTypeFromOptions(), MatColoringRegisterDynamic(), MatFDColoringCreate(),
304: SNESDefaultComputeJacobianColor()
305: @*/
306: PetscErrorCode MatGetColoring(Mat mat,MatColoringType type,ISColoring *iscoloring)
307: {
308: PetscTruth flag;
309: PetscErrorCode ierr,(*r)(Mat,MatColoringType,ISColoring *);
310: char tname[PETSC_MAX_PATH_LEN];
315: if (!mat->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
316: if (mat->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
317: if (!MatColoringRegisterAllCalled) {
318: MatColoringRegisterAll(PETSC_NULL);
319: }
320:
321: /* look for type on command line */
322: PetscOptionsGetString(mat->prefix,"-mat_coloring_type",tname,256,&flag);
323: if (flag) {
324: type = tname;
325: }
328: PetscFListFind(MatColoringList,mat->comm, type,(void (**)(void)) &r);
329: if (!r) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Unknown or unregistered type: %s",type);}
330: (*r)(mat,type,iscoloring);
333: PetscInfo1(mat,"Number of colors %d\n",(*iscoloring)->n);
334: PetscOptionsHasName(PETSC_NULL,"-mat_coloring_view",&flag);
335: if (flag) {
336: PetscViewer viewer;
337: PetscViewerASCIIGetStdout((*iscoloring)->comm,&viewer);
338: ISColoringView(*iscoloring,viewer);
339: }
340: return(0);
341: }
342: