Actual source code: color.c
1: /*$Id: color.c,v 1.60 2001/06/21 21:17:33 bsmith Exp $*/
2:
3: /*
4: Routines that call the kernel minpack coloring subroutines
5: */
7: #include src/mat/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: int MatFDColoringDegreeSequence_Minpack(int m,int *cja, int *cia, int *rja, int *ria, int **seq)
17: {
18: int *work;
22: PetscMalloc(m*sizeof(int),&work);
23: PetscMalloc(m*sizeof(int),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: int MatFDColoringMinimumNumberofColors_Private(int m,int *ia,int *minc)
39: {
40: int 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: }
50: EXTERN_C_BEGIN
51: /* ----------------------------------------------------------------------------*/
52: /*
53: MatFDColoringSL_Minpack - Uses the smallest-last (SL) coloring of minpack
54: */
57: int MatFDColoringSL_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
58: {
59: int *list,*work,clique,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
60: int ncolors,i;
61: PetscTruth done;
64: MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
65: MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
66: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
68: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
70: PetscMalloc(5*n*sizeof(int),&list);
71: work = list + n;
73: MINPACKslo(&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
75: PetscMalloc(n*sizeof(int),&coloring);
76: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
78: PetscFree(list);
79: PetscFree(seq);
80: MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
81: MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
83: /* shift coloring numbers to start at zero and shorten */
84: if (ncolors > IS_COLORING_MAX-1) SETERRQ(1,"Maximum color size exceeded");
85: {
86: ISColoringValue *s = (ISColoringValue*) coloring;
87: for (i=0; i<n; i++) {
88: s[i] = (ISColoringValue) (coloring[i]-1);
89: }
90: MatColoringPatch(mat,n,ncolors,s,iscoloring);
91: }
92: return(0);
93: }
94: EXTERN_C_END
96: EXTERN_C_BEGIN
97: /* ----------------------------------------------------------------------------*/
98: /*
99: MatFDColoringLF_Minpack -
100: */
103: int MatFDColoringLF_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
104: {
105: int *list,*work,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
106: int n1, none,ncolors,i;
107: PetscTruth done;
110: MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
111: MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
112: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
114: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
116: PetscMalloc(5*n*sizeof(int),&list);
117: work = list + n;
119: n1 = n - 1;
120: none = -1;
121: MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
122: PetscMalloc(n*sizeof(int),&coloring);
123: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
125: PetscFree(list);
126: PetscFree(seq);
128: MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
129: MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
131: /* shift coloring numbers to start at zero and shorten */
132: if (ncolors > IS_COLORING_MAX-1) SETERRQ(1,"Maximum color size exceeded");
133: {
134: ISColoringValue *s = (ISColoringValue*) coloring;
135: for (i=0; i<n; i++) {
136: s[i] = (ISColoringValue) (coloring[i]-1);
137: }
138: MatColoringPatch(mat,n,ncolors,s,iscoloring);
139: }
140: return(0);
141: }
142: EXTERN_C_END
144: EXTERN_C_BEGIN
145: /* ----------------------------------------------------------------------------*/
146: /*
147: MatFDColoringID_Minpack -
148: */
151: int MatFDColoringID_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
152: {
153: int *list,*work,clique,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
154: int ncolors,i;
155: PetscTruth done;
158: MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
159: MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
160: if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");
162: MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);
164: PetscMalloc(5*n*sizeof(int),&list);
165: work = list + n;
167: MINPACKido(&n,&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
169: PetscMalloc(n*sizeof(int),&coloring);
170: MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
172: PetscFree(list);
173: PetscFree(seq);
175: MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
176: MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
178: /* shift coloring numbers to start at zero and shorten */
179: if (ncolors > IS_COLORING_MAX-1) SETERRQ(1,"Maximum color size exceeded");
180: {
181: ISColoringValue *s = (ISColoringValue*) coloring;
182: for (i=0; i<n; i++) {
183: s[i] = (ISColoringValue) (coloring[i]-1);
184: }
185: MatColoringPatch(mat,n,ncolors,s,iscoloring);
186: }
187: return(0);
188: }
189: EXTERN_C_END
191: EXTERN_C_BEGIN
192: /*
193: Simplest coloring, each column of the matrix gets its own unique color.
194: */
197: int MatColoring_Natural(Mat mat,const MatColoringType color, ISColoring *iscoloring)
198: {
199: int start,end,ierr,i;
200: ISColoringValue *colors;
201: MPI_Comm comm;
204: MatGetOwnershipRange(mat,&start,&end);
205: PetscObjectGetComm((PetscObject)mat,&comm);
206: PetscMalloc((end-start+1)*sizeof(int),&colors);
207: for (i=start; i<end; i++) {
208: colors[i-start] = i;
209: }
210: ISColoringCreate(comm,end-start,colors,iscoloring);
212: return(0);
213: }
214: EXTERN_C_END
215:
216: /* ===========================================================================================*/
218: #include petscsys.h
220: PetscFList MatColoringList = 0;
221: PetscTruth MatColoringRegisterAllCalled = PETSC_FALSE;
225: int MatColoringRegister(const char sname[],const char path[],const char name[],int (*function)(Mat,const MatColoringType,ISColoring*))
226: {
227: int ierr;
228: char fullname[256];
231: PetscFListConcat(path,name,fullname);
232: PetscFListAdd(&MatColoringList,sname,fullname,(void (*)(void))function);
233: return(0);
234: }
238: /*@C
239: MatColoringRegisterDestroy - Frees the list of coloringing routines.
241: Not Collective
243: Level: developer
245: .keywords: matrix, register, destroy
247: .seealso: MatColoringRegisterDynamic(), MatColoringRegisterAll()
248: @*/
249: int MatColoringRegisterDestroy(void)
250: {
254: if (MatColoringList) {
255: PetscFListDestroy(&MatColoringList);
256: MatColoringList = 0;
257: }
258: return(0);
259: }
261: EXTERN int MatAdjustForInodes(Mat,IS *,IS *);
265: /*@C
266: MatGetColoring - Gets a coloring for a matrix to reduce the number of function evaluations
267: 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: The sequential colorings SL, LF, and ID are obtained via the Minpack software that was
300: converted to C using f2c.
302: .keywords: matrix, get, coloring
304: .seealso: MatGetColoringTypeFromOptions(), MatColoringRegisterDynamic(), MatFDColoringCreate(),
305: SNESDefaultComputeJacobianColor()
306: @*/
307: int MatGetColoring(Mat mat,const MatColoringType type,ISColoring *iscoloring)
308: {
309: PetscTruth flag;
310: int ierr,(*r)(Mat,const MatColoringType,ISColoring *);
311: char tname[256];
316: if (!mat->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
317: if (mat->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
318: if (!MatColoringRegisterAllCalled) {
319: MatColoringRegisterAll(PETSC_NULL);
320: }
321:
322: /* look for type on command line */
323: PetscOptionsGetString(mat->prefix,"-mat_coloring_type",tname,256,&flag);
324: if (flag) {
325: type = tname;
326: }
328: PetscLogEventBegin(MAT_GetColoring,mat,0,0,0);
329: PetscFListFind(mat->comm, MatColoringList, type,(void (**)(void)) &r);
330: if (!r) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Unknown or unregistered type: %s",type);}
331: (*r)(mat,type,iscoloring);
332: PetscLogEventEnd(MAT_GetColoring,mat,0,0,0);
334: PetscLogInfo((PetscObject)mat,"MatGetColoring:Number of colors %d\n",(*iscoloring)->n);
335: PetscOptionsHasName(PETSC_NULL,"-mat_coloring_view",&flag);
336: if (flag) {
337: ISColoringView(*iscoloring,PETSC_VIEWER_STDOUT_((*iscoloring)->comm));
338: }
339: return(0);
340: }
341: