Actual source code: fdmatrix.c

  1: #define PETSCMAT_DLL

  3: /*
  4:    This is where the abstract matrix operations are defined that are
  5:   used for finite difference computations of Jacobians using coloring.
  6: */

 8:  #include private/matimpl.h

 12: PetscErrorCode  MatFDColoringSetF(MatFDColoring fd,Vec F)
 13: {
 15:   fd->F = F;
 16:   return(0);
 17: }

 21: static PetscErrorCode MatFDColoringView_Draw_Zoom(PetscDraw draw,void *Aa)
 22: {
 23:   MatFDColoring  fd = (MatFDColoring)Aa;
 25:   PetscInt       i,j;
 26:   PetscReal      x,y;


 30:   /* loop over colors  */
 31:   for (i=0; i<fd->ncolors; i++) {
 32:     for (j=0; j<fd->nrows[i]; j++) {
 33:       y = fd->M - fd->rows[i][j] - fd->rstart;
 34:       x = fd->columnsforrow[i][j];
 35:       PetscDrawRectangle(draw,x,y,x+1,y+1,i+1,i+1,i+1,i+1);
 36:     }
 37:   }
 38:   return(0);
 39: }

 43: static PetscErrorCode MatFDColoringView_Draw(MatFDColoring fd,PetscViewer viewer)
 44: {
 46:   PetscTruth     isnull;
 47:   PetscDraw      draw;
 48:   PetscReal      xr,yr,xl,yl,h,w;

 51:   PetscViewerDrawGetDraw(viewer,0,&draw);
 52:   PetscDrawIsNull(draw,&isnull); if (isnull) return(0);

 54:   PetscObjectCompose((PetscObject)fd,"Zoomviewer",(PetscObject)viewer);

 56:   xr  = fd->N; yr = fd->M; h = yr/10.0; w = xr/10.0;
 57:   xr += w;     yr += h;    xl = -w;     yl = -h;
 58:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
 59:   PetscDrawZoom(draw,MatFDColoringView_Draw_Zoom,fd);
 60:   PetscObjectCompose((PetscObject)fd,"Zoomviewer",PETSC_NULL);
 61:   return(0);
 62: }

 66: /*@C
 67:    MatFDColoringView - Views a finite difference coloring context.

 69:    Collective on MatFDColoring

 71:    Input  Parameters:
 72: +  c - the coloring context
 73: -  viewer - visualization context

 75:    Level: intermediate

 77:    Notes:
 78:    The available visualization contexts include
 79: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
 80: .     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
 81:         output where only the first processor opens
 82:         the file.  All other processors send their 
 83:         data to the first processor to print. 
 84: -     PETSC_VIEWER_DRAW_WORLD - graphical display of nonzero structure

 86:    Notes:
 87:      Since PETSc uses only a small number of basic colors (currently 33), if the coloring
 88:    involves more than 33 then some seemingly identical colors are displayed making it look
 89:    like an illegal coloring. This is just a graphical artifact.

 91: .seealso: MatFDColoringCreate()

 93: .keywords: Mat, finite differences, coloring, view
 94: @*/
 95: PetscErrorCode  MatFDColoringView(MatFDColoring c,PetscViewer viewer)
 96: {
 97:   PetscErrorCode    ierr;
 98:   PetscInt          i,j;
 99:   PetscTruth        isdraw,iascii;
100:   PetscViewerFormat format;

104:   if (!viewer) {
105:     PetscViewerASCIIGetStdout(((PetscObject)c)->comm,&viewer);
106:   }

110:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
111:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
112:   if (isdraw) {
113:     MatFDColoringView_Draw(c,viewer);
114:   } else if (iascii) {
115:     PetscViewerASCIIPrintf(viewer,"MatFDColoring Object:\n");
116:     PetscViewerASCIIPrintf(viewer,"  Error tolerance=%G\n",c->error_rel);
117:     PetscViewerASCIIPrintf(viewer,"  Umin=%G\n",c->umin);
118:     PetscViewerASCIIPrintf(viewer,"  Number of colors=%D\n",c->ncolors);

120:     PetscViewerGetFormat(viewer,&format);
121:     if (format != PETSC_VIEWER_ASCII_INFO) {
122:       for (i=0; i<c->ncolors; i++) {
123:         PetscViewerASCIIPrintf(viewer,"  Information for color %D\n",i);
124:         PetscViewerASCIIPrintf(viewer,"    Number of columns %D\n",c->ncolumns[i]);
125:         for (j=0; j<c->ncolumns[i]; j++) {
126:           PetscViewerASCIIPrintf(viewer,"      %D\n",c->columns[i][j]);
127:         }
128:         PetscViewerASCIIPrintf(viewer,"    Number of rows %D\n",c->nrows[i]);
129:         for (j=0; j<c->nrows[i]; j++) {
130:           PetscViewerASCIIPrintf(viewer,"      %D %D \n",c->rows[i][j],c->columnsforrow[i][j]);
131:         }
132:       }
133:     }
134:     PetscViewerFlush(viewer);
135:   } else {
136:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for MatFDColoring",((PetscObject)viewer)->type_name);
137:   }
138:   return(0);
139: }

143: /*@
144:    MatFDColoringSetParameters - Sets the parameters for the sparse approximation of
145:    a Jacobian matrix using finite differences.

147:    Collective on MatFDColoring

149:    The Jacobian is estimated with the differencing approximation
150: .vb
151:        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
152:        h = error_rel*u[i]                 if  abs(u[i]) > umin
153:          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
154:        dx_{i} = (0, ... 1, .... 0)
155: .ve

157:    Input Parameters:
158: +  coloring - the coloring context
159: .  error_rel - relative error
160: -  umin - minimum allowable u-value magnitude

162:    Level: advanced

164: .keywords: Mat, finite differences, coloring, set, parameters

166: .seealso: MatFDColoringCreate(), MatFDColoringSetFromOptions()

168: @*/
169: PetscErrorCode  MatFDColoringSetParameters(MatFDColoring matfd,PetscReal error,PetscReal umin)
170: {

174:   if (error != PETSC_DEFAULT) matfd->error_rel = error;
175:   if (umin != PETSC_DEFAULT)  matfd->umin      = umin;
176:   return(0);
177: }



183: /*@C
184:    MatFDColoringGetFunction - Gets the function to use for computing the Jacobian.

186:    Collective on MatFDColoring

188:    Input Parameters:
189: .  coloring - the coloring context

191:    Output Parameters:
192: +  f - the function
193: -  fctx - the optional user-defined function context

195:    Level: intermediate

197: .keywords: Mat, Jacobian, finite differences, set, function

199: .seealso: MatFDColoringCreate(), MatFDColoringSetFunction(), MatFDColoringSetFromOptions()

201: @*/
202: PetscErrorCode  MatFDColoringGetFunction(MatFDColoring matfd,PetscErrorCode (**f)(void),void **fctx)
203: {
206:   if (f) *f = matfd->f;
207:   if (fctx) *fctx = matfd->fctx;
208:   return(0);
209: }

213: /*@C
214:    MatFDColoringSetFunction - Sets the function to use for computing the Jacobian.

216:    Collective on MatFDColoring

218:    Input Parameters:
219: +  coloring - the coloring context
220: .  f - the function
221: -  fctx - the optional user-defined function context

223:    Calling sequence of (*f) function:
224:     For SNES:    PetscErrorCode (*f)(SNES,Vec,Vec,void*)
225:     For TS:      PetscErrorCode (*f)(TS,PetscReal,Vec,Vec,void*)
226:     If not using SNES or TS: PetscErrorCode (*f)(void *dummy,Vec,Vec,void*) and dummy is ignored

228:    Level: advanced

230:    Notes: This function is usually used automatically by SNES or TS (when one uses SNESSetJacobian() with the argument 
231:      SNESDefaultComputeJacobianColor() or TSSetRHSJacobian() with the argument TSDefaultComputeJacobianColor()) and only needs to be used
232:      by someone computing a matrix via coloring directly by calling MatFDColoringApply()

234:    Fortran Notes:
235:     In Fortran you must call MatFDColoringSetFunction() for a coloring object to 
236:   be used without SNES or TS or within the SNES solvers and MatFDColoringSetFunctionTS() if it is to be used
237:   within the TS solvers.

239: .keywords: Mat, Jacobian, finite differences, set, function

241: .seealso: MatFDColoringCreate(), MatFDColoringGetFunction(), MatFDColoringSetFromOptions()

243: @*/
244: PetscErrorCode  MatFDColoringSetFunction(MatFDColoring matfd,PetscErrorCode (*f)(void),void *fctx)
245: {
248:   matfd->f    = f;
249:   matfd->fctx = fctx;
250:   return(0);
251: }

255: /*@
256:    MatFDColoringSetFromOptions - Sets coloring finite difference parameters from 
257:    the options database.

259:    Collective on MatFDColoring

261:    The Jacobian, F'(u), is estimated with the differencing approximation
262: .vb
263:        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
264:        h = error_rel*u[i]                 if  abs(u[i]) > umin
265:          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
266:        dx_{i} = (0, ... 1, .... 0)
267: .ve

269:    Input Parameter:
270: .  coloring - the coloring context

272:    Options Database Keys:
273: +  -mat_fd_coloring_err <err> - Sets <err> (square root
274:            of relative error in the function)
275: .  -mat_fd_coloring_umin <umin> - Sets umin, the minimum allowable u-value magnitude
276: .  -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS)
277: .  -mat_fd_coloring_view - Activates basic viewing
278: .  -mat_fd_coloring_view_info - Activates viewing info
279: -  -mat_fd_coloring_view_draw - Activates drawing

281:     Level: intermediate

283: .keywords: Mat, finite differences, parameters

285: .seealso: MatFDColoringCreate(), MatFDColoringView(), MatFDColoringSetParameters()

287: @*/
288: PetscErrorCode  MatFDColoringSetFromOptions(MatFDColoring matfd)
289: {
291:   PetscTruth     flg;
292:   char           value[3];


297:   PetscOptionsBegin(((PetscObject)matfd)->comm,((PetscObject)matfd)->prefix,"Jacobian computation via finite differences option","MatFD");
298:     PetscOptionsReal("-mat_fd_coloring_err","Square root of relative error in function","MatFDColoringSetParameters",matfd->error_rel,&matfd->error_rel,0);
299:     PetscOptionsReal("-mat_fd_coloring_umin","Minimum allowable u magnitude","MatFDColoringSetParameters",matfd->umin,&matfd->umin,0);
300:     PetscOptionsString("-mat_fd_type","Algorithm to compute h, wp or ds","MatFDColoringCreate",matfd->htype,value,2,&flg);
301:     if (flg) {
302:       if (value[0] == 'w' && value[1] == 'p') matfd->htype = "wp";
303:       else if (value[0] == 'd' && value[1] == 's') matfd->htype = "ds";
304:       else SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Unknown finite differencing type %s",value);
305:     }
306:     /* not used here; but so they are presented in the GUI */
307:     PetscOptionsName("-mat_fd_coloring_view","Print entire datastructure used for Jacobian","None",0);
308:     PetscOptionsName("-mat_fd_coloring_view_info","Print number of colors etc for Jacobian","None",0);
309:     PetscOptionsName("-mat_fd_coloring_view_draw","Plot nonzero structure ofJacobian","None",0);
310:   PetscOptionsEnd();
311:   return(0);
312: }

316: PetscErrorCode MatFDColoringView_Private(MatFDColoring fd)
317: {
319:   PetscTruth     flg = PETSC_FALSE;
320:   PetscViewer    viewer;

323:   PetscViewerASCIIGetStdout(((PetscObject)fd)->comm,&viewer);
324:   PetscOptionsGetTruth(PETSC_NULL,"-mat_fd_coloring_view",&flg,PETSC_NULL);
325:   if (flg) {
326:     MatFDColoringView(fd,viewer);
327:   }
328:   flg  = PETSC_FALSE;
329:   PetscOptionsGetTruth(PETSC_NULL,"-mat_fd_coloring_view_info",&flg,PETSC_NULL);
330:   if (flg) {
331:     PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO);
332:     MatFDColoringView(fd,viewer);
333:     PetscViewerPopFormat(viewer);
334:   }
335:   flg  = PETSC_FALSE;
336:   PetscOptionsGetTruth(PETSC_NULL,"-mat_fd_coloring_view_draw",&flg,PETSC_NULL);
337:   if (flg) {
338:     MatFDColoringView(fd,PETSC_VIEWER_DRAW_(((PetscObject)fd)->comm));
339:     PetscViewerFlush(PETSC_VIEWER_DRAW_(((PetscObject)fd)->comm));
340:   }
341:   return(0);
342: }

346: /*@
347:    MatFDColoringCreate - Creates a matrix coloring context for finite difference 
348:    computation of Jacobians.

350:    Collective on Mat

352:    Input Parameters:
353: +  mat - the matrix containing the nonzero structure of the Jacobian
354: -  iscoloring - the coloring of the matrix

356:     Output Parameter:
357: .   color - the new coloring context
358:    
359:     Level: intermediate

361: .seealso: MatFDColoringDestroy(),SNESDefaultComputeJacobianColor(), ISColoringCreate(),
362:           MatFDColoringSetFunction(), MatFDColoringSetFromOptions(), MatFDColoringApply(),
363:           MatFDColoringView(), MatFDColoringSetParameters()
364: @*/
365: PetscErrorCode  MatFDColoringCreate(Mat mat,ISColoring iscoloring,MatFDColoring *color)
366: {
367:   MatFDColoring  c;
368:   MPI_Comm       comm;
370:   PetscInt       M,N;
371:   PetscMPIInt    size;

374:   PetscLogEventBegin(MAT_FDColoringCreate,mat,0,0,0);
375:   MatGetSize(mat,&M,&N);
376:   if (M != N) SETERRQ(PETSC_ERR_SUP,"Only for square matrices");

378:   PetscObjectGetComm((PetscObject)mat,&comm);
379:   PetscHeaderCreate(c,_p_MatFDColoring,int,MAT_FDCOLORING_COOKIE,0,"MatFDColoring",comm,MatFDColoringDestroy,MatFDColoringView);

381:   MPI_Comm_size(comm,&size);
382:   c->ctype = iscoloring->ctype;

384:   if (mat->ops->fdcoloringcreate) {
385:     (*mat->ops->fdcoloringcreate)(mat,iscoloring,c);
386:   } else {
387:     SETERRQ(PETSC_ERR_SUP,"Code not yet written for this matrix type");
388:   }

390:   MatGetVecs(mat,PETSC_NULL,&c->w1);
391:   PetscLogObjectParent(c,c->w1);
392:   VecDuplicate(c->w1,&c->w2);
393:   PetscLogObjectParent(c,c->w2);

395:   c->error_rel         = PETSC_SQRT_MACHINE_EPSILON;
396:   c->umin              = 100.0*PETSC_SQRT_MACHINE_EPSILON;
397:   c->currentcolor      = -1;
398:   c->htype             = "wp";

400:   *color = c;
401:   PetscLogEventEnd(MAT_FDColoringCreate,mat,0,0,0);
402:   return(0);
403: }

407: /*@
408:     MatFDColoringDestroy - Destroys a matrix coloring context that was created
409:     via MatFDColoringCreate().

411:     Collective on MatFDColoring

413:     Input Parameter:
414: .   c - coloring context

416:     Level: intermediate

418: .seealso: MatFDColoringCreate()
419: @*/
420: PetscErrorCode  MatFDColoringDestroy(MatFDColoring c)
421: {
423:   PetscInt       i;

426:   if (--((PetscObject)c)->refct > 0) return(0);

428:   for (i=0; i<c->ncolors; i++) {
429:     PetscFree(c->columns[i]);
430:     PetscFree(c->rows[i]);
431:     PetscFree(c->columnsforrow[i]);
432:     if (c->vscaleforrow) {PetscFree(c->vscaleforrow[i]);}
433:   }
434:   PetscFree(c->ncolumns);
435:   PetscFree(c->columns);
436:   PetscFree(c->nrows);
437:   PetscFree(c->rows);
438:   PetscFree(c->columnsforrow);
439:   PetscFree(c->vscaleforrow);
440:   if (c->vscale)       {VecDestroy(c->vscale);}
441:   if (c->w1) {
442:     VecDestroy(c->w1);
443:     VecDestroy(c->w2);
444:   }
445:   if (c->w3){
446:     VecDestroy(c->w3);
447:   }
448:   PetscHeaderDestroy(c);
449:   return(0);
450: }

454: /*@C
455:     MatFDColoringGetPerturbedColumns - Returns the indices of the columns that
456:       that are currently being perturbed.

458:     Not Collective

460:     Input Parameters:
461: .   coloring - coloring context created with MatFDColoringCreate()

463:     Output Parameters:
464: +   n - the number of local columns being perturbed
465: -   cols - the column indices, in global numbering

467:    Level: intermediate

469: .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringApply()

471: .keywords: coloring, Jacobian, finite differences
472: @*/
473: PetscErrorCode  MatFDColoringGetPerturbedColumns(MatFDColoring coloring,PetscInt *n,PetscInt *cols[])
474: {
476:   if (coloring->currentcolor >= 0) {
477:     *n    = coloring->ncolumns[coloring->currentcolor];
478:     *cols = coloring->columns[coloring->currentcolor];
479:   } else {
480:     *n = 0;
481:   }
482:   return(0);
483: }

487: /*@
488:     MatFDColoringApply - Given a matrix for which a MatFDColoring context 
489:     has been created, computes the Jacobian for a function via finite differences.

491:     Collective on MatFDColoring

493:     Input Parameters:
494: +   mat - location to store Jacobian
495: .   coloring - coloring context created with MatFDColoringCreate()
496: .   x1 - location at which Jacobian is to be computed
497: -   sctx - context required by function, if this is being used with the SNES solver then it is SNES object, otherwise it is null

499:     Options Database Keys:
500: +    -mat_fd_type - "wp" or "ds"  (see MATMFFD_WP or MATMFFD_DS)
501: .    -mat_fd_coloring_view - Activates basic viewing or coloring
502: .    -mat_fd_coloring_view_draw - Activates drawing of coloring
503: -    -mat_fd_coloring_view_info - Activates viewing of coloring info

505:     Level: intermediate

507: .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringSetFunction()

509: .keywords: coloring, Jacobian, finite differences
510: @*/
511: PetscErrorCode  MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
512: {

519:   if (!coloring->f) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");
520:   if (!J->ops->fdcoloringapply) SETERRQ1(PETSC_ERR_SUP,"Not supported for this matrix type %s",((PetscObject)J)->type_name);
521:   (*J->ops->fdcoloringapply)(J,coloring,x1,flag,sctx);
522:   return(0);
523: }

527: PetscErrorCode  MatFDColoringApply_AIJ(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
528: {
529:   PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void *))coloring->f;
531:   PetscInt       k,start,end,l,row,col,srow,**vscaleforrow,m1,m2;
532:   PetscScalar    dx,*y,*xx,*w3_array;
533:   PetscScalar    *vscale_array;
534:   PetscReal      epsilon = coloring->error_rel,umin = coloring->umin,unorm;
535:   Vec            w1=coloring->w1,w2=coloring->w2,w3;
536:   void           *fctx = coloring->fctx;
537:   PetscTruth     flg = PETSC_FALSE;
538:   PetscInt       ctype=coloring->ctype,N,col_start=0,col_end=0;
539:   Vec            x1_tmp;

545:   if (!f) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");

547:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
548:   MatSetUnfactored(J);
549:   PetscOptionsGetTruth(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);
550:   if (flg) {
551:     PetscInfo(coloring,"Not calling MatZeroEntries()\n");
552:   } else {
553:     PetscTruth assembled;
554:     MatAssembled(J,&assembled);
555:     if (assembled) {
556:       MatZeroEntries(J);
557:     }
558:   }

560:   x1_tmp = x1;
561:   if (!coloring->vscale){
562:     VecDuplicate(x1_tmp,&coloring->vscale);
563:   }
564: 
565:   /*
566:     This is a horrible, horrible, hack. See DMMGComputeJacobian_Multigrid() it inproperly sets
567:     coloring->F for the coarser grids from the finest
568:   */
569:   if (coloring->F) {
570:     VecGetLocalSize(coloring->F,&m1);
571:     VecGetLocalSize(w1,&m2);
572:     if (m1 != m2) {
573:       coloring->F = 0;
574:       }
575:     }

577:   if (coloring->htype[0] == 'w') { /* tacky test; need to make systematic if we add other approaches to computing h*/
578:     VecNorm(x1_tmp,NORM_2,&unorm);
579:   }
580:   VecGetOwnershipRange(w1,&start,&end); /* OwnershipRange is used by ghosted x! */
581: 
582:   /* Set w1 = F(x1) */
583:   if (coloring->F) {
584:     w1          = coloring->F; /* use already computed value of function */
585:     coloring->F = 0;
586:   } else {
587:     PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
588:     (*f)(sctx,x1_tmp,w1,fctx);
589:     PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);
590:   }
591: 
592:   if (!coloring->w3) {
593:     VecDuplicate(x1_tmp,&coloring->w3);
594:     PetscLogObjectParent(coloring,coloring->w3);
595:   }
596:   w3 = coloring->w3;

598:     /* Compute all the local scale factors, including ghost points */
599:   VecGetLocalSize(x1_tmp,&N);
600:   VecGetArray(x1_tmp,&xx);
601:   VecGetArray(coloring->vscale,&vscale_array);
602:   if (ctype == IS_COLORING_GHOSTED){
603:     col_start = 0; col_end = N;
604:   } else if (ctype == IS_COLORING_GLOBAL){
605:     xx = xx - start;
606:     vscale_array = vscale_array - start;
607:     col_start = start; col_end = N + start;
608:   }
609:   for (col=col_start; col<col_end; col++){
610:     /* Loop over each local column, vscale[col] = 1./(epsilon*dx[col]) */
611:     if (coloring->htype[0] == 'w') {
612:       dx = 1.0 + unorm;
613:     } else {
614:       dx  = xx[col];
615:     }
616:     if (dx == 0.0) dx = 1.0;
617: #if !defined(PETSC_USE_COMPLEX)
618:     if (dx < umin && dx >= 0.0)      dx = umin;
619:     else if (dx < 0.0 && dx > -umin) dx = -umin;
620: #else
621:     if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
622:     else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
623: #endif
624:     dx               *= epsilon;
625:     vscale_array[col] = 1.0/dx;
626:   }
627:   if (ctype == IS_COLORING_GLOBAL)  vscale_array = vscale_array + start;
628:   VecRestoreArray(coloring->vscale,&vscale_array);
629:   if (ctype == IS_COLORING_GLOBAL){
630:     VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);
631:     VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);
632:   }
633: 
634:   if (coloring->vscaleforrow) {
635:     vscaleforrow = coloring->vscaleforrow;
636:   } else {
637:     SETERRQ(PETSC_ERR_ARG_NULL,"Null Object: coloring->vscaleforrow");
638:   }

640:   /*
641:     Loop over each color
642:   */
643:   VecGetArray(coloring->vscale,&vscale_array);
644:   for (k=0; k<coloring->ncolors; k++) {
645:     coloring->currentcolor = k;
646:     VecCopy(x1_tmp,w3);
647:     VecGetArray(w3,&w3_array);
648:     if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array - start;
649:     /*
650:       Loop over each column associated with color 
651:       adding the perturbation to the vector w3.
652:     */
653:     for (l=0; l<coloring->ncolumns[k]; l++) {
654:       col = coloring->columns[k][l];    /* local column of the matrix we are probing for */
655:       if (coloring->htype[0] == 'w') {
656:         dx = 1.0 + unorm;
657:       } else {
658:         dx  = xx[col];
659:       }
660:       if (dx == 0.0) dx = 1.0;
661: #if !defined(PETSC_USE_COMPLEX)
662:       if (dx < umin && dx >= 0.0)      dx = umin;
663:       else if (dx < 0.0 && dx > -umin) dx = -umin;
664: #else
665:       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
666:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
667: #endif
668:       dx            *= epsilon;
669:       if (!PetscAbsScalar(dx)) SETERRQ(PETSC_ERR_PLIB,"Computed 0 differencing parameter");
670:       w3_array[col] += dx;
671:     }
672:     if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array + start;
673:     VecRestoreArray(w3,&w3_array);

675:     /*
676:       Evaluate function at w3 = x1 + dx (here dx is a vector of perturbations)
677:                            w2 = F(x1 + dx) - F(x1)
678:     */
679:     PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
680:     (*f)(sctx,w3,w2,fctx);
681:     PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);
682:     VecAXPY(w2,-1.0,w1);
683: 
684:     /*
685:       Loop over rows of vector, putting results into Jacobian matrix
686:     */
687:     VecGetArray(w2,&y);
688:     for (l=0; l<coloring->nrows[k]; l++) {
689:       row    = coloring->rows[k][l];             /* local row index */
690:       col    = coloring->columnsforrow[k][l];    /* global column index */
691:       y[row] *= vscale_array[vscaleforrow[k][l]];
692:       srow   = row + start;
693:       MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);
694:     }
695:     VecRestoreArray(w2,&y);
696:   } /* endof for each color */
697:   if (ctype == IS_COLORING_GLOBAL) xx = xx + start;
698:   VecRestoreArray(coloring->vscale,&vscale_array);
699:   VecRestoreArray(x1_tmp,&xx);
700: 
701:   coloring->currentcolor = -1;
702:   MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
703:   MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
704:   PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);

706:   flg  = PETSC_FALSE;
707:   PetscOptionsGetTruth(PETSC_NULL,"-mat_null_space_test",&flg,PETSC_NULL);
708:   if (flg) {
709:     MatNullSpaceTest(J->nullsp,J,PETSC_NULL);
710:   }
711:   MatFDColoringView_Private(coloring);
712:   return(0);
713: }

717: /*@
718:     MatFDColoringApplyTS - Given a matrix for which a MatFDColoring context 
719:     has been created, computes the Jacobian for a function via finite differences.

721:    Collective on Mat, MatFDColoring, and Vec

723:     Input Parameters:
724: +   mat - location to store Jacobian
725: .   coloring - coloring context created with MatFDColoringCreate()
726: .   x1 - location at which Jacobian is to be computed
727: -   sctx - context required by function, if this is being used with the TS solver then it is TS object, otherwise it is null

729:    Level: intermediate

731: .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringSetFunction()

733: .keywords: coloring, Jacobian, finite differences
734: @*/
735: PetscErrorCode  MatFDColoringApplyTS(Mat J,MatFDColoring coloring,PetscReal t,Vec x1,MatStructure *flag,void *sctx)
736: {
737:   PetscErrorCode (*f)(void*,PetscReal,Vec,Vec,void*)=(PetscErrorCode (*)(void*,PetscReal,Vec,Vec,void *))coloring->f;
739:   PetscInt       k,N,start,end,l,row,col,srow,**vscaleforrow;
740:   PetscScalar    dx,*y,*xx,*w3_array;
741:   PetscScalar    *vscale_array;
742:   PetscReal      epsilon = coloring->error_rel,umin = coloring->umin;
743:   Vec            w1=coloring->w1,w2=coloring->w2,w3;
744:   void           *fctx = coloring->fctx;
745:   PetscTruth     flg;


752:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
753:   if (!coloring->w3) {
754:     VecDuplicate(x1,&coloring->w3);
755:     PetscLogObjectParent(coloring,coloring->w3);
756:   }
757:   w3 = coloring->w3;

759:   MatSetUnfactored(J);
760:   flg  = PETSC_FALSE;
761:   PetscOptionsGetTruth(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);
762:   if (flg) {
763:     PetscInfo(coloring,"Not calling MatZeroEntries()\n");
764:   } else {
765:     PetscTruth assembled;
766:     MatAssembled(J,&assembled);
767:     if (assembled) {
768:       MatZeroEntries(J);
769:     }
770:   }

772:   VecGetOwnershipRange(x1,&start,&end);
773:   VecGetSize(x1,&N);
774:   PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
775:   (*f)(sctx,t,x1,w1,fctx);
776:   PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);

778:   /* 
779:       Compute all the scale factors and share with other processors
780:   */
781:   VecGetArray(x1,&xx);xx = xx - start;
782:   VecGetArray(coloring->vscale,&vscale_array);vscale_array = vscale_array - start;
783:   for (k=0; k<coloring->ncolors; k++) {
784:     /*
785:        Loop over each column associated with color adding the 
786:        perturbation to the vector w3.
787:     */
788:     for (l=0; l<coloring->ncolumns[k]; l++) {
789:       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
790:       dx  = xx[col];
791:       if (dx == 0.0) dx = 1.0;
792: #if !defined(PETSC_USE_COMPLEX)
793:       if (dx < umin && dx >= 0.0)      dx = umin;
794:       else if (dx < 0.0 && dx > -umin) dx = -umin;
795: #else
796:       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
797:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
798: #endif
799:       dx                *= epsilon;
800:       vscale_array[col] = 1.0/dx;
801:     }
802:   }
803:   vscale_array = vscale_array - start;VecRestoreArray(coloring->vscale,&vscale_array);
804:   VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);
805:   VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);

807:   if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
808:   else                        vscaleforrow = coloring->columnsforrow;

810:   VecGetArray(coloring->vscale,&vscale_array);
811:   /*
812:       Loop over each color
813:   */
814:   for (k=0; k<coloring->ncolors; k++) {
815:     VecCopy(x1,w3);
816:     VecGetArray(w3,&w3_array);w3_array = w3_array - start;
817:     /*
818:        Loop over each column associated with color adding the 
819:        perturbation to the vector w3.
820:     */
821:     for (l=0; l<coloring->ncolumns[k]; l++) {
822:       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
823:       dx  = xx[col];
824:       if (dx == 0.0) dx = 1.0;
825: #if !defined(PETSC_USE_COMPLEX)
826:       if (dx < umin && dx >= 0.0)      dx = umin;
827:       else if (dx < 0.0 && dx > -umin) dx = -umin;
828: #else
829:       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
830:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
831: #endif
832:       dx            *= epsilon;
833:       w3_array[col] += dx;
834:     }
835:     w3_array = w3_array + start; VecRestoreArray(w3,&w3_array);

837:     /*
838:        Evaluate function at x1 + dx (here dx is a vector of perturbations)
839:     */
840:     PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
841:     (*f)(sctx,t,w3,w2,fctx);
842:     PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);
843:     VecAXPY(w2,-1.0,w1);

845:     /*
846:        Loop over rows of vector, putting results into Jacobian matrix
847:     */
848:     VecGetArray(w2,&y);
849:     for (l=0; l<coloring->nrows[k]; l++) {
850:       row    = coloring->rows[k][l];
851:       col    = coloring->columnsforrow[k][l];
852:       y[row] *= vscale_array[vscaleforrow[k][l]];
853:       srow   = row + start;
854:       MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);
855:     }
856:     VecRestoreArray(w2,&y);
857:   }
858:   VecRestoreArray(coloring->vscale,&vscale_array);
859:   xx    = xx + start; VecRestoreArray(x1,&xx);
860:   MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
861:   MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
862:   PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);
863:   return(0);
864: }