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: */
 14: int MatFDColoringDegreeSequence_Minpack(int m,int *cja, int *cia, int *rja, int *ria, int **seq)
 15: {
 16:   int *work;

 20:   PetscMalloc(m*sizeof(int),&work);
 21:   PetscMalloc(m*sizeof(int),seq);

 23:   MINPACKdegr(&m,cja,cia,rja,ria,*seq,work);

 25:   PetscFree(work);
 26:   return(0);
 27: }

 29: /*
 30:     MatFDColoringMinimumNumberofColors_Private - For a given sparse 
 31:         matrix computes the minimum number of colors needed.

 33: */
 34: int MatFDColoringMinimumNumberofColors_Private(int m,int *ia,int *minc)
 35: {
 36:   int i,c = 0;

 39:   for (i=0; i<m; i++) {
 40:     c = PetscMax(c,ia[i+1]-ia[i]);
 41:   }
 42:   *minc = c;
 43:   return(0);
 44: }

 46: EXTERN_C_BEGIN
 47: /* ----------------------------------------------------------------------------*/
 48: /*
 49:     MatFDColoringSL_Minpack - Uses the smallest-last (SL) coloring of minpack
 50: */
 51: int MatFDColoringSL_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
 52: {
 53:   int        *list,*work,clique,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
 54:   int        ncolors,i;
 55:   PetscTruth done;

 58:   MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
 59:   MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
 60:   if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");

 62:   MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);

 64:   PetscMalloc(5*n*sizeof(int),&list);
 65:   work = list + n;

 67:   MINPACKslo(&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);

 69:   PetscMalloc(n*sizeof(int),&coloring);
 70:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

 72:   PetscFree(list);
 73:   PetscFree(seq);
 74:   MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
 75:   MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);

 77:   /* shift coloring numbers to start at zero */
 78:   for (i=0; i<n; i++) coloring[i]--;
 79:   MatColoringPatch(mat,n,ncolors,coloring,iscoloring);
 80:   return(0);
 81: }
 82: EXTERN_C_END

 84: EXTERN_C_BEGIN
 85: /* ----------------------------------------------------------------------------*/
 86: /*
 87:     MatFDColoringLF_Minpack - 
 88: */
 89: int MatFDColoringLF_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
 90: {
 91:   int        *list,*work,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
 92:   int        n1, none,ncolors,i;
 93:   PetscTruth done;

 96:   MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
 97:   MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
 98:   if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");

100:   MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);

102:   PetscMalloc(5*n*sizeof(int),&list);
103:   work = list + n;

105:   n1   = n - 1;
106:   none = -1;
107:   MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
108:   PetscMalloc(n*sizeof(int),&coloring);
109:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

111:   PetscFree(list);
112:   PetscFree(seq);

114:   MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
115:   MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);

117:   /* shift coloring numbers to start at zero */
118:   for (i=0; i<n; i++) coloring[i]--;
119:   MatColoringPatch(mat,n,ncolors,coloring,iscoloring);
120:   return(0);
121: }
122: EXTERN_C_END

124: EXTERN_C_BEGIN
125: /* ----------------------------------------------------------------------------*/
126: /*
127:     MatFDColoringID_Minpack - 
128: */
129: int MatFDColoringID_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
130: {
131:   int        *list,*work,clique,ierr,*ria,*rja,*cia,*cja,*seq,*coloring,n;
132:   int        ncolors,i;
133:   PetscTruth done;

136:   MatGetRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
137:   MatGetColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);
138:   if (!done) SETERRQ(PETSC_ERR_SUP,"Ordering requires IJ");

140:   MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);

142:   PetscMalloc(5*n*sizeof(int),&list);
143:   work = list + n;

145:   MINPACKido(&n,&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);

147:   PetscMalloc(n*sizeof(int),&coloring);
148:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

150:   PetscFree(list);
151:   PetscFree(seq);

153:   MatRestoreRowIJ(mat,1,PETSC_FALSE,&n,&ria,&rja,&done);
154:   MatRestoreColumnIJ(mat,1,PETSC_FALSE,&n,&cia,&cja,&done);

156:   /* shift coloring numbers to start at zero */
157:   for (i=0; i<n; i++) coloring[i]--;
158:   MatColoringPatch(mat,n,ncolors,coloring,iscoloring);
159:   return(0);
160: }
161: EXTERN_C_END

163: EXTERN_C_BEGIN
164: /*
165:    Simplest coloring, each column of the matrix gets its own unique color.
166: */
167: int MatColoring_Natural(Mat mat,MatColoringType color, ISColoring *iscoloring)
168: {
169:   int      start,end,ierr,i,*colors;
170:   MPI_Comm comm;

173:   MatGetOwnershipRange(mat,&start,&end);
174:   PetscObjectGetComm((PetscObject)mat,&comm);
175:   PetscMalloc((end-start+1)*sizeof(int),&colors);
176:   for (i=start; i<end; i++) {
177:     colors[i-start] = i;
178:   }
179:   ISColoringCreate(comm,end-start,colors,iscoloring);

181:   return(0);
182: }
183: EXTERN_C_END
184: 
185: /* ===========================================================================================*/

187:  #include petscsys.h

189: PetscFList      MatColoringList = 0;
190: PetscTruth MatColoringRegisterAllCalled = PETSC_FALSE;

192: /*MC
193:    MatColoringRegisterDynamic - Adds a new sparse matrix coloring to the 
194:                                matrix package. 

196:    Synopsis:
197:    int MatColoringRegisterDynamic(char *name_coloring,char *path,char *name_create,int (*routine_create)(MatColoring))

199:    Not Collective

201:    Input Parameters:
202: +  sname - name of Coloring (for example MATCOLORING_SL)
203: .  path - location of library where creation routine is 
204: .  name - name of function that creates the Coloring type, a string
205: -  function - function pointer that creates the coloring

207:    Level: developer

209:    If dynamic libraries are used, then the fourth input argument (function)
210:    is ignored.

212:    Sample usage:
213: .vb
214:    MatColoringRegisterDynamic("my_color",/home/username/my_lib/lib/libO/solaris/mylib.a,
215:                "MyColor",MyColor);
216: .ve

218:    Then, your partitioner can be chosen with the procedural interface via
219: $     MatColoringSetType(part,"my_color")
220:    or at runtime via the option
221: $     -mat_coloring_type my_color

223:    $PETSC_ARCH and $BOPT occuring in pathname will be replaced with appropriate values.

225: .keywords: matrix, Coloring, register

227: .seealso: MatColoringRegisterDestroy(), MatColoringRegisterAll()
228: M*/

230: int MatColoringRegister(char *sname,char *path,char *name,int (*function)(Mat,MatColoringType,ISColoring*))
231: {
232:   int  ierr;
233:   char fullname[256];

236:   PetscFListConcat(path,name,fullname);
237:   PetscFListAdd(&MatColoringList,sname,fullname,(void (*)(void))function);
238:   return(0);
239: }

241: /*@C
242:    MatColoringRegisterDestroy - Frees the list of coloringing routines.

244:    Not Collective

246:    Level: developer

248: .keywords: matrix, register, destroy

250: .seealso: MatColoringRegisterDynamic(), MatColoringRegisterAll()
251: @*/
252: int MatColoringRegisterDestroy(void)
253: {

257:   if (MatColoringList) {
258:     PetscFListDestroy(&MatColoringList);
259:     MatColoringList = 0;
260:   }
261:   return(0);
262: }

264: EXTERN int MatAdjustForInodes(Mat,IS *,IS *);

266: /*@C
267:    MatGetColoring - Gets a coloring for a matrix to reduce the number of function evaluations
268:    needed to compute a sparse Jacobian via differencing.

270:    Collective on Mat

272:    Input Parameters:
273: .  mat - the matrix
274: .  type - type of coloring, one of the following:
275: $      MATCOLORING_NATURAL - natural (one color for each column, very slow)
276: $      MATCOLORING_SL - smallest-last
277: $      MATCOLORING_LF - largest-first
278: $      MATCOLORING_ID - incidence-degree

280:    Output Parameters:
281: .   iscoloring - the coloring

283:    Options Database Keys:
284:    To specify the coloring through the options database, use one of
285:    the following 
286: $    -mat_coloring_type natural, -mat_coloring_type sl, -mat_coloring_type lf,
287: $    -mat_coloring_type id
288:    To see the coloring use
289: $    -mat_coloring_view

291:    Level: intermediate

293:    Notes:
294:      These compute the graph coloring of the graph of A^{T}A. The coloring used 
295:    for efficient (parallel or thread based) triangular solves etc is NOT yet 
296:    available. 

298:    The user can define additional colorings; see MatColoringRegisterDynamic().

300:    The sequential colorings SL, LF, and ID are obtained via the Minpack software that was
301:    converted to C using f2c.

303: .keywords: matrix, get, coloring

305: .seealso:  MatGetColoringTypeFromOptions(), MatColoringRegisterDynamic(), MatFDColoringCreate(),
306:            SNESDefaultComputeJacobianColor()
307: @*/
308: int MatGetColoring(Mat mat,MatColoringType type,ISColoring *iscoloring)
309: {
310:   PetscTruth flag;
311:   int        ierr,(*r)(Mat,MatColoringType,ISColoring *);
312:   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 %dn",(*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: