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: