Actual source code: color.c

petsc-3.7.3 2016-07-24
Report Typos and Errors
  2: /*
  3:      Routines that call the kernel minpack coloring subroutines
  4: */

  6: #include <petsc/private/matimpl.h>
  7: #include <petsc/private/isimpl.h>
  8: #include <../src/mat/color/impls/minpack/color.h>

 10: /*
 11:     MatFDColoringDegreeSequence_Minpack - Calls the MINPACK routine seqr() that
 12:       computes the degree sequence required by MINPACK coloring routines.
 13: */
 16: PETSC_INTERN PetscErrorCode MatFDColoringDegreeSequence_Minpack(PetscInt m,const PetscInt *cja,const PetscInt *cia,const PetscInt *rja,const PetscInt *ria,PetscInt **seq)
 17: {
 18:   PetscInt       *work;

 22:   PetscMalloc1(m,&work);
 23:   PetscMalloc1(m,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++) c = PetscMax(c,ia[i+1]-ia[i]);
 44:   *minc = c;
 45:   return(0);
 46: }

 50: static PetscErrorCode MatColoringApply_SL(MatColoring mc,ISColoring *iscoloring)
 51: {
 52:   PetscErrorCode  ierr;
 53:   PetscInt        *list,*work,clique,*seq,*coloring,n;
 54:   const PetscInt  *ria,*rja,*cia,*cja;
 55:   PetscInt        ncolors,i;
 56:   PetscBool       done;
 57:   Mat             mat = mc->mat;
 58:   Mat             mat_seq = mat;
 59:   PetscMPIInt     size;
 60:   MPI_Comm        comm;
 61:   ISColoring      iscoloring_seq;
 62:   PetscInt        bs = 1,rstart,rend,N_loc,nc;
 63:   ISColoringValue *colors_loc;
 64:   PetscBool       flg1,flg2;

 67:   if (mc->dist != 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"SL may only do distance 2 coloring");
 68:   /* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
 69:   PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);
 70:   PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);
 71:   if (flg1 || flg2) {
 72:     MatGetBlockSize(mat,&bs);
 73:   }

 75:   PetscObjectGetComm((PetscObject)mat,&comm);
 76:   MPI_Comm_size(comm,&size);
 77:   if (size > 1) {
 78:     /* create a sequential iscoloring on all processors */
 79:     MatGetSeqNonzeroStructure(mat,&mat_seq);
 80:   }

 82:   MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
 83:   MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
 84:   if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");

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

 88:   PetscMalloc2(n,&list,4*n,&work);

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

 92:   PetscMalloc1(n,&coloring);
 93:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

 95:   PetscFree2(list,work);
 96:   PetscFree(seq);
 97:   MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&ria,&rja,&done);
 98:   MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&cia,&cja,&done);

100:   /* shift coloring numbers to start at zero and shorten */
101:   if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
102:   {
103:     ISColoringValue *s = (ISColoringValue*) coloring;
104:     for (i=0; i<n; i++) {
105:       s[i] = (ISColoringValue) (coloring[i]-1);
106:     }
107:     MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);
108:   }

110:   if (size > 1) {
111:     MatDestroySeqNonzeroStructure(&mat_seq);

113:     /* convert iscoloring_seq to a parallel iscoloring */
114:     iscoloring_seq = *iscoloring;
115:     rstart         = mat->rmap->rstart/bs;
116:     rend           = mat->rmap->rend/bs;
117:     N_loc          = rend - rstart; /* number of local nodes */

119:     /* get local colors for each local node */
120:     PetscMalloc1(N_loc+1,&colors_loc);
121:     for (i=rstart; i<rend; i++) {
122:       colors_loc[i-rstart] = iscoloring_seq->colors[i];
123:     }
124:     /* create a parallel iscoloring */
125:     nc   = iscoloring_seq->n;
126:     ISColoringCreate(comm,nc,N_loc,colors_loc,PETSC_OWN_POINTER,iscoloring);
127:     ISColoringDestroy(&iscoloring_seq);
128:   }
129:   return(0);
130: }

134: PETSC_EXTERN PetscErrorCode MatColoringCreate_SL(MatColoring mc)
135: {
137:     mc->dist                = 2;
138:     mc->data                = NULL;
139:     mc->ops->apply          = MatColoringApply_SL;
140:     mc->ops->view           = NULL;
141:     mc->ops->destroy        = NULL;
142:     mc->ops->setfromoptions = NULL;
143:     return(0);
144: }

148: static PetscErrorCode MatColoringApply_LF(MatColoring mc,ISColoring *iscoloring)
149: {
150:   PetscErrorCode  ierr;
151:   PetscInt        *list,*work,*seq,*coloring,n;
152:   const PetscInt  *ria,*rja,*cia,*cja;
153:   PetscInt        n1, none,ncolors,i;
154:   PetscBool       done;
155:   Mat             mat = mc->mat;
156:   Mat             mat_seq = mat;
157:   PetscMPIInt     size;
158:   MPI_Comm        comm;
159:   ISColoring      iscoloring_seq;
160:   PetscInt        bs = 1,rstart,rend,N_loc,nc;
161:   ISColoringValue *colors_loc;
162:   PetscBool       flg1,flg2;

165:   if (mc->dist != 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LF may only do distance 2 coloring");
166:   /* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
167:   PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);
168:   PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);
169:   if (flg1 || flg2) {
170:     MatGetBlockSize(mat,&bs);
171:   }

173:   PetscObjectGetComm((PetscObject)mat,&comm);
174:   MPI_Comm_size(comm,&size);
175:   if (size > 1) {
176:     /* create a sequential iscoloring on all processors */
177:     MatGetSeqNonzeroStructure(mat,&mat_seq);
178:   }

180:   MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
181:   MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
182:   if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");

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

186:   PetscMalloc2(n,&list,4*n,&work);

188:   n1   = n - 1;
189:   none = -1;
190:   MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
191:   PetscMalloc1(n,&coloring);
192:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

194:   PetscFree2(list,work);
195:   PetscFree(seq);

197:   MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&ria,&rja,&done);
198:   MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&cia,&cja,&done);

200:   /* shift coloring numbers to start at zero and shorten */
201:   if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
202:   {
203:     ISColoringValue *s = (ISColoringValue*) coloring;
204:     for (i=0; i<n; i++) s[i] = (ISColoringValue) (coloring[i]-1);
205:     MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);
206:   }

208:   if (size > 1) {
209:     MatDestroySeqNonzeroStructure(&mat_seq);

211:     /* convert iscoloring_seq to a parallel iscoloring */
212:     iscoloring_seq = *iscoloring;
213:     rstart         = mat->rmap->rstart/bs;
214:     rend           = mat->rmap->rend/bs;
215:     N_loc          = rend - rstart; /* number of local nodes */

217:     /* get local colors for each local node */
218:     PetscMalloc1(N_loc+1,&colors_loc);
219:     for (i=rstart; i<rend; i++) colors_loc[i-rstart] = iscoloring_seq->colors[i];

221:     /* create a parallel iscoloring */
222:     nc   = iscoloring_seq->n;
223:     ISColoringCreate(comm,nc,N_loc,colors_loc,PETSC_OWN_POINTER,iscoloring);
224:     ISColoringDestroy(&iscoloring_seq);
225:   }
226:   return(0);
227: }

231: PETSC_EXTERN PetscErrorCode MatColoringCreate_LF(MatColoring mc)
232: {
234:     mc->dist                = 2;
235:     mc->data                = NULL;
236:     mc->ops->apply          = MatColoringApply_LF;
237:     mc->ops->view           = NULL;
238:     mc->ops->destroy        = NULL;
239:     mc->ops->setfromoptions = NULL;
240:     return(0);
241: }

245: static PetscErrorCode MatColoringApply_ID(MatColoring mc,ISColoring *iscoloring)
246: {
247:   PetscErrorCode  ierr;
248:   PetscInt        *list,*work,clique,*seq,*coloring,n;
249:   const PetscInt  *ria,*rja,*cia,*cja;
250:   PetscInt        ncolors,i;
251:   PetscBool       done;
252:   Mat             mat = mc->mat;
253:   Mat             mat_seq = mat;
254:   PetscMPIInt     size;
255:   MPI_Comm        comm;
256:   ISColoring      iscoloring_seq;
257:   PetscInt        bs = 1,rstart,rend,N_loc,nc;
258:   ISColoringValue *colors_loc;
259:   PetscBool       flg1,flg2;

262:   if (mc->dist != 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"IDO may only do distance 2 coloring");
263:   /* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
264:   PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);
265:   PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);
266:   if (flg1 || flg2) {
267:     MatGetBlockSize(mat,&bs);
268:   }

270:   PetscObjectGetComm((PetscObject)mat,&comm);
271:   MPI_Comm_size(comm,&size);
272:   if (size > 1) {
273:     /* create a sequential iscoloring on all processors */
274:     MatGetSeqNonzeroStructure(mat,&mat_seq);
275:   }

277:   MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);
278:   MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);
279:   if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");

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

283:   PetscMalloc2(n,&list,4*n,&work);

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

287:   PetscMalloc1(n,&coloring);
288:   MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);

290:   PetscFree2(list,work);
291:   PetscFree(seq);

293:   MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&ria,&rja,&done);
294:   MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&cia,&cja,&done);

296:   /* shift coloring numbers to start at zero and shorten */
297:   if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
298:   {
299:     ISColoringValue *s = (ISColoringValue*) coloring;
300:     for (i=0; i<n; i++) {
301:       s[i] = (ISColoringValue) (coloring[i]-1);
302:     }
303:     MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);
304:   }

306:   if (size > 1) {
307:     MatDestroySeqNonzeroStructure(&mat_seq);

309:     /* convert iscoloring_seq to a parallel iscoloring */
310:     iscoloring_seq = *iscoloring;
311:     rstart         = mat->rmap->rstart/bs;
312:     rend           = mat->rmap->rend/bs;
313:     N_loc          = rend - rstart; /* number of local nodes */

315:     /* get local colors for each local node */
316:     PetscMalloc1(N_loc+1,&colors_loc);
317:     for (i=rstart; i<rend; i++) {
318:       colors_loc[i-rstart] = iscoloring_seq->colors[i];
319:     }
320:     /* create a parallel iscoloring */
321:     nc   = iscoloring_seq->n;
322:     ISColoringCreate(comm,nc,N_loc,colors_loc,PETSC_OWN_POINTER,iscoloring);
323:     ISColoringDestroy(&iscoloring_seq);
324:   }
325:   return(0);
326: }


331: PETSC_EXTERN PetscErrorCode MatColoringCreate_ID(MatColoring mc)
332: {
334:     mc->dist                = 2;
335:     mc->data                = NULL;
336:     mc->ops->apply          = MatColoringApply_ID;
337:     mc->ops->view           = NULL;
338:     mc->ops->destroy        = NULL;
339:     mc->ops->setfromoptions = NULL;
340:     return(0);
341: }