Actual source code: color.c
1: #define PETSCMAT_DLL
3: /*
4: Routines that call the kernel minpack coloring subroutines
5: */
7: #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: MatColoringRegisterAllCalled = PETSC_FALSE;
260: return(0);
261: }
265: /*@C
266: MatGetColoring - Gets a coloring for a matrix, from its sparsity structure,
267: to reduce the number of function evaluations needed to compute a sparse Jacobian via differencing.
269: Collective on Mat
271: Input Parameters:
272: . mat - the matrix
273: . type - type of coloring, one of the following:
274: $ MATCOLORING_NATURAL - natural (one color for each column, very slow)
275: $ MATCOLORING_SL - smallest-last
276: $ MATCOLORING_LF - largest-first
277: $ MATCOLORING_ID - incidence-degree
279: Output Parameters:
280: . iscoloring - the coloring
282: Options Database Keys:
283: To specify the coloring through the options database, use one of
284: the following
285: $ -mat_coloring_type natural, -mat_coloring_type sl, -mat_coloring_type lf,
286: $ -mat_coloring_type id
287: To see the coloring use
288: $ -mat_coloring_view
290: Level: intermediate
292: Notes:
293: These compute the graph coloring of the graph of A^{T}A. The coloring used
294: for efficient (parallel or thread based) triangular solves etc is NOT yet
295: available.
297: The user can define additional colorings; see MatColoringRegisterDynamic().
299: For parallel matrices currently converts to sequential matrix and uses the sequential coloring
300: on that.
302: The sequential colorings SL, LF, and ID are obtained via the Minpack software that was
303: converted to C using f2c.
305: .keywords: matrix, get, coloring
307: .seealso: MatGetColoringTypeFromOptions(), MatColoringRegisterDynamic(), MatFDColoringCreate(),
308: SNESDefaultComputeJacobianColor()
309: @*/
310: PetscErrorCode MatGetColoring(Mat mat,const MatColoringType type,ISColoring *iscoloring)
311: {
312: PetscTruth flag;
313: PetscErrorCode ierr,(*r)(Mat,const MatColoringType,ISColoring *);
314: char tname[PETSC_MAX_PATH_LEN];
315: MPI_Comm comm;
316: PetscMPIInt size;
321: if (!mat->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
322: if (mat->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
324: /* look for type on command line */
325: if (!MatColoringRegisterAllCalled) {MatColoringRegisterAll(PETSC_NULL);}
326: PetscOptionsGetString(((PetscObject)mat)->prefix,"-mat_coloring_type",tname,256,&flag);
327: if (flag) { type = tname; }
329: PetscObjectGetComm((PetscObject)mat,&comm);
330: PetscFListFind(MatColoringList,comm, type,(void (**)(void)) &r);
331: if (!r) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Unknown or unregistered type: %s",type);}
333: PetscLogEventBegin(MAT_GetColoring,mat,0,0,0);
334: MPI_Comm_size(comm,&size);
335: if (size == 1){
336: (*r)(mat,type,iscoloring);
337: } else { /* for parallel matrix */
338: Mat *mat_seq;
339: ISColoring iscoloring_seq;
340: ISColoringValue *colors_loc;
341: PetscInt i,rstart,rend,N_loc,nc;
342:
343: /* create a sequential iscoloring on all processors */
344: MatGetSeqNonzeroStructure(mat,&mat_seq);
345: (*r)(*mat_seq,type,&iscoloring_seq);
346: MatDestroySeqNonzeroStructure(&mat_seq);
348: /* convert iscoloring_seq to a parallel iscoloring */
349: rstart = mat->rmap->rstart;
350: rend = mat->rmap->rend;
351: N_loc = rend - rstart; /* number of local nodes */
353: /* get local colors for each local node */
354: PetscMalloc((N_loc+1)*sizeof(ISColoringValue),&colors_loc);
355: for (i=rstart; i<rend; i++){
356: colors_loc[i-rstart] = iscoloring_seq->colors[i];
357: }
358: /* create a parallel iscoloring */
359: nc=iscoloring_seq->n;
360: ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);
361: ISColoringDestroy(iscoloring_seq);
362: /* ISColoringView(iscoloring_mpi,PETSC_VIEWER_STDOUT_WORLD); */
363: }
364: PetscLogEventEnd(MAT_GetColoring,mat,0,0,0);
366: PetscInfo1(mat,"Number of colors %d\n",(*iscoloring)->n);
367: PetscOptionsHasName(PETSC_NULL,"-mat_coloring_view",&flag);
368: if (flag) {
369: PetscViewer viewer;
370: PetscViewerASCIIGetStdout((*iscoloring)->comm,&viewer);
371: ISColoringView(*iscoloring,viewer);
372: }
373: return(0);
374: }
375: