Actual source code: fdmatrix.c

  1: /*$Id: fdmatrix.c,v 1.92 2001/08/21 21:03:06 bsmith Exp $*/

  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 src/mat/matimpl.h

 10: /* Logging support */
 11: int MAT_FDCOLORING_COOKIE;

 13: int MatFDColoringSetF(MatFDColoring fd,Vec F)
 14: {
 16:   fd->F = F;
 17:   return(0);
 18: }

 20: static int MatFDColoringView_Draw_Zoom(PetscDraw draw,void *Aa)
 21: {
 22:   MatFDColoring fd = (MatFDColoring)Aa;
 23:   int           ierr,i,j;
 24:   PetscReal     x,y;


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

 39: static int MatFDColoringView_Draw(MatFDColoring fd,PetscViewer viewer)
 40: {
 41:   int         ierr;
 42:   PetscTruth  isnull;
 43:   PetscDraw   draw;
 44:   PetscReal   xr,yr,xl,yl,h,w;

 47:   PetscViewerDrawGetDraw(viewer,0,&draw);
 48:   PetscDrawIsNull(draw,&isnull); if (isnull) return(0);

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

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

 60: /*@C
 61:    MatFDColoringView - Views a finite difference coloring context.

 63:    Collective on MatFDColoring

 65:    Input  Parameters:
 66: +  c - the coloring context
 67: -  viewer - visualization context

 69:    Level: intermediate

 71:    Notes:
 72:    The available visualization contexts include
 73: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
 74: .     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
 75:         output where only the first processor opens
 76:         the file.  All other processors send their 
 77:         data to the first processor to print. 
 78: -     PETSC_VIEWER_DRAW_WORLD - graphical display of nonzero structure

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

 85: .seealso: MatFDColoringCreate()

 87: .keywords: Mat, finite differences, coloring, view
 88: @*/
 89: int MatFDColoringView(MatFDColoring c,PetscViewer viewer)
 90: {
 91:   int               i,j,ierr;
 92:   PetscTruth        isdraw,isascii;
 93:   PetscViewerFormat format;

 97:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(c->comm);

101:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
102:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
103:   if (isdraw) {
104:     MatFDColoringView_Draw(c,viewer);
105:   } else if (isascii) {
106:     PetscViewerASCIIPrintf(viewer,"MatFDColoring Object:n");
107:     PetscViewerASCIIPrintf(viewer,"  Error tolerance=%gn",c->error_rel);
108:     PetscViewerASCIIPrintf(viewer,"  Umin=%gn",c->umin);
109:     PetscViewerASCIIPrintf(viewer,"  Number of colors=%dn",c->ncolors);

111:     PetscViewerGetFormat(viewer,&format);
112:     if (format != PETSC_VIEWER_ASCII_INFO) {
113:       for (i=0; i<c->ncolors; i++) {
114:         PetscViewerASCIIPrintf(viewer,"  Information for color %dn",i);
115:         PetscViewerASCIIPrintf(viewer,"    Number of columns %dn",c->ncolumns[i]);
116:         for (j=0; j<c->ncolumns[i]; j++) {
117:           PetscViewerASCIIPrintf(viewer,"      %dn",c->columns[i][j]);
118:         }
119:         PetscViewerASCIIPrintf(viewer,"    Number of rows %dn",c->nrows[i]);
120:         for (j=0; j<c->nrows[i]; j++) {
121:           PetscViewerASCIIPrintf(viewer,"      %d %d n",c->rows[i][j],c->columnsforrow[i][j]);
122:         }
123:       }
124:     }
125:     PetscViewerFlush(viewer);
126:   } else {
127:     SETERRQ1(1,"Viewer type %s not supported for MatFDColoring",((PetscObject)viewer)->type_name);
128:   }
129:   return(0);
130: }

132: /*@
133:    MatFDColoringSetParameters - Sets the parameters for the sparse approximation of
134:    a Jacobian matrix using finite differences.

136:    Collective on MatFDColoring

138:    The Jacobian is estimated with the differencing approximation
139: .vb
140:        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
141:        h = error_rel*u[i]                 if  abs(u[i]) > umin
142:          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
143:        dx_{i} = (0, ... 1, .... 0)
144: .ve

146:    Input Parameters:
147: +  coloring - the coloring context
148: .  error_rel - relative error
149: -  umin - minimum allowable u-value magnitude

151:    Level: advanced

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

155: .seealso: MatFDColoringCreate()
156: @*/
157: int MatFDColoringSetParameters(MatFDColoring matfd,PetscReal error,PetscReal umin)
158: {

162:   if (error != PETSC_DEFAULT) matfd->error_rel = error;
163:   if (umin != PETSC_DEFAULT)  matfd->umin      = umin;
164:   return(0);
165: }

167: /*@
168:    MatFDColoringSetFrequency - Sets the frequency for computing new Jacobian
169:    matrices. 

171:    Collective on MatFDColoring

173:    Input Parameters:
174: +  coloring - the coloring context
175: -  freq - frequency (default is 1)

177:    Options Database Keys:
178: .  -mat_fd_coloring_freq <freq>  - Sets coloring frequency

180:    Level: advanced

182:    Notes:
183:    Using a modified Newton strategy, where the Jacobian remains fixed for several
184:    iterations, can be cost effective in terms of overall nonlinear solution 
185:    efficiency.  This parameter indicates that a new Jacobian will be computed every
186:    <freq> nonlinear iterations.  

188: .keywords: Mat, finite differences, coloring, set, frequency

190: .seealso: MatFDColoringCreate(), MatFDColoringGetFrequency(), MatFDColoringSetRecompute()
191: @*/
192: int MatFDColoringSetFrequency(MatFDColoring matfd,int freq)
193: {

197:   matfd->freq = freq;
198:   return(0);
199: }

201: /*@
202:    MatFDColoringGetFrequency - Gets the frequency for computing new Jacobian
203:    matrices. 

205:    Not Collective

207:    Input Parameters:
208: .  coloring - the coloring context

210:    Output Parameters:
211: .  freq - frequency (default is 1)

213:    Options Database Keys:
214: .  -mat_fd_coloring_freq <freq> - Sets coloring frequency

216:    Level: advanced

218:    Notes:
219:    Using a modified Newton strategy, where the Jacobian remains fixed for several
220:    iterations, can be cost effective in terms of overall nonlinear solution 
221:    efficiency.  This parameter indicates that a new Jacobian will be computed every
222:    <freq> nonlinear iterations.  

224: .keywords: Mat, finite differences, coloring, get, frequency

226: .seealso: MatFDColoringSetFrequency()
227: @*/
228: int MatFDColoringGetFrequency(MatFDColoring matfd,int *freq)
229: {

233:   *freq = matfd->freq;
234:   return(0);
235: }

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

240:    Collective on MatFDColoring

242:    Input Parameters:
243: +  coloring - the coloring context
244: .  f - the function
245: -  fctx - the optional user-defined function context

247:    Level: intermediate

249:    Notes:
250:     In Fortran you must call MatFDColoringSetFunctionSNES() for a coloring object to 
251:   be used with the SNES solvers and MatFDColoringSetFunctionTS() if it is to be used
252:   with the TS solvers.

254: .keywords: Mat, Jacobian, finite differences, set, function
255: @*/
256: int MatFDColoringSetFunction(MatFDColoring matfd,int (*f)(void),void *fctx)
257: {

261:   matfd->f    = f;
262:   matfd->fctx = fctx;

264:   return(0);
265: }

267: /*@
268:    MatFDColoringSetFromOptions - Sets coloring finite difference parameters from 
269:    the options database.

271:    Collective on MatFDColoring

273:    The Jacobian, F'(u), is estimated with the differencing approximation
274: .vb
275:        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
276:        h = error_rel*u[i]                 if  abs(u[i]) > umin
277:          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
278:        dx_{i} = (0, ... 1, .... 0)
279: .ve

281:    Input Parameter:
282: .  coloring - the coloring context

284:    Options Database Keys:
285: +  -mat_fd_coloring_err <err> - Sets <err> (square root
286:            of relative error in the function)
287: .  -mat_fd_coloring_umin <umin> - Sets umin, the minimum allowable u-value magnitude
288: .  -mat_fd_coloring_freq <freq> - Sets frequency of computing a new Jacobian
289: .  -mat_fd_coloring_view - Activates basic viewing
290: .  -mat_fd_coloring_view_info - Activates viewing info
291: -  -mat_fd_coloring_view_draw - Activates drawing

293:     Level: intermediate

295: .keywords: Mat, finite differences, parameters

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

299: @*/
300: int MatFDColoringSetFromOptions(MatFDColoring matfd)
301: {
302:   int        ierr;


307:   PetscOptionsBegin(matfd->comm,matfd->prefix,"Jacobian computation via finite differences option","MatFD");
308:     PetscOptionsReal("-mat_fd_coloring_err","Square root of relative error in function","MatFDColoringSetParameters",matfd->error_rel,&matfd->error_rel,0);
309:     PetscOptionsReal("-mat_fd_coloring_umin","Minimum allowable u magnitude","MatFDColoringSetParameters",matfd->umin,&matfd->umin,0);
310:     PetscOptionsInt("-mat_fd_coloring_freq","How often Jacobian is recomputed","MatFDColoringSetFrequency",matfd->freq,&matfd->freq,0);
311:     /* not used here; but so they are presented in the GUI */
312:     PetscOptionsName("-mat_fd_coloring_view","Print entire datastructure used for Jacobian","None",0);
313:     PetscOptionsName("-mat_fd_coloring_view_info","Print number of colors etc for Jacobian","None",0);
314:     PetscOptionsName("-mat_fd_coloring_view_draw","Plot nonzero structure ofJacobian","None",0);
315:   PetscOptionsEnd();
316:   return(0);
317: }

319: int MatFDColoringView_Private(MatFDColoring fd)
320: {
321:   int        ierr;
322:   PetscTruth flg;

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

343: /*@C
344:    MatFDColoringCreate - Creates a matrix coloring context for finite difference 
345:    computation of Jacobians.

347:    Collective on Mat

349:    Input Parameters:
350: +  mat - the matrix containing the nonzero structure of the Jacobian
351: -  iscoloring - the coloring of the matrix

353:     Output Parameter:
354: .   color - the new coloring context
355:    
356:     Options Database Keys:
357: +    -mat_fd_coloring_view - Activates basic viewing or coloring
358: .    -mat_fd_coloring_view_draw - Activates drawing of coloring
359: -    -mat_fd_coloring_view_info - Activates viewing of coloring info

361:     Level: intermediate

363: .seealso: MatFDColoringDestroy(),SNESDefaultComputeJacobianColor(), ISColoringCreate(),
364:           MatFDColoringSetFunction(), MatFDColoringSetFromOptions(), MatFDColoringApply(),
365:           MatFDColoringSetFrequency(), MatFDColoringSetRecompute(), MatFDColoringView(),
366:           MatFDColoringSetParameters()
367: @*/
368: int MatFDColoringCreate(Mat mat,ISColoring iscoloring,MatFDColoring *color)
369: {
370:   MatFDColoring c;
371:   MPI_Comm      comm;
372:   int           ierr,M,N;

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

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

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

389:   c->error_rel         = PETSC_SQRT_MACHINE_EPSILON;
390:   c->umin              = 100.0*PETSC_SQRT_MACHINE_EPSILON;
391:   c->freq              = 1;
392:   c->usersetsrecompute = PETSC_FALSE;
393:   c->recompute         = PETSC_FALSE;

395:   MatFDColoringView_Private(c);

397:   *color = c;
398:   PetscLogEventEnd(MAT_FDColoringCreate,mat,0,0,0);
399:   return(0);
400: }

402: /*@C
403:     MatFDColoringDestroy - Destroys a matrix coloring context that was created
404:     via MatFDColoringCreate().

406:     Collective on MatFDColoring

408:     Input Parameter:
409: .   c - coloring context

411:     Level: intermediate

413: .seealso: MatFDColoringCreate()
414: @*/
415: int MatFDColoringDestroy(MatFDColoring c)
416: {
417:   int i,ierr;

420:   if (--c->refct > 0) return(0);

422:   for (i=0; i<c->ncolors; i++) {
423:     if (c->columns[i])         {PetscFree(c->columns[i]);}
424:     if (c->rows[i])            {PetscFree(c->rows[i]);}
425:     if (c->columnsforrow[i])   {PetscFree(c->columnsforrow[i]);}
426:     if (c->vscaleforrow && c->vscaleforrow[i]) {PetscFree(c->vscaleforrow[i]);}
427:   }
428:   PetscFree(c->ncolumns);
429:   PetscFree(c->columns);
430:   PetscFree(c->nrows);
431:   PetscFree(c->rows);
432:   PetscFree(c->columnsforrow);
433:   if (c->vscaleforrow) {PetscFree(c->vscaleforrow);}
434:   if (c->vscale)       {VecDestroy(c->vscale);}
435:   if (c->w1) {
436:     VecDestroy(c->w1);
437:     VecDestroy(c->w2);
438:     VecDestroy(c->w3);
439:   }
440:   PetscLogObjectDestroy(c);
441:   PetscHeaderDestroy(c);
442:   return(0);
443: }

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

449:     Collective on MatFDColoring

451:     Input Parameters:
452: +   mat - location to store Jacobian
453: .   coloring - coloring context created with MatFDColoringCreate()
454: .   x1 - location at which Jacobian is to be computed
455: -   sctx - optional context required by function (actually a SNES context)

457:    Options Database Keys:
458: .  -mat_fd_coloring_freq <freq> - Sets coloring frequency

460:    Level: intermediate

462: .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView()

464: .keywords: coloring, Jacobian, finite differences
465: @*/
466: int MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
467: {
468:   int           (*f)(void *,Vec,Vec,void*) = (int (*)(void *,Vec,Vec,void *))coloring->f;
469:   int           k,ierr,N,start,end,l,row,col,srow,**vscaleforrow,m1,m2;
470:   PetscScalar   dx,mone = -1.0,*y,*xx,*w3_array;
471:   PetscScalar   *vscale_array;
472:   PetscReal     epsilon = coloring->error_rel,umin = coloring->umin;
473:   Vec           w1,w2,w3;
474:   void          *fctx = coloring->fctx;
475:   PetscTruth    flg;



483:   if (coloring->usersetsrecompute) {
484:     if (!coloring->recompute) {
485:       *flag = SAME_PRECONDITIONER;
486:       PetscLogInfo(J,"MatFDColoringApply:Skipping Jacobian, since user called MatFDColorSetRecompute()n");
487:       return(0);
488:     } else {
489:       coloring->recompute = PETSC_FALSE;
490:     }
491:   }

493:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
494:   if (J->ops->fdcoloringapply) {
495:     (*J->ops->fdcoloringapply)(J,coloring,x1,flag,sctx);
496:   } else {

498:     if (!coloring->w1) {
499:       VecDuplicate(x1,&coloring->w1);
500:       PetscLogObjectParent(coloring,coloring->w1);
501:       VecDuplicate(x1,&coloring->w2);
502:       PetscLogObjectParent(coloring,coloring->w2);
503:       VecDuplicate(x1,&coloring->w3);
504:       PetscLogObjectParent(coloring,coloring->w3);
505:     }
506:     w1 = coloring->w1; w2 = coloring->w2; w3 = coloring->w3;

508:     MatSetUnfactored(J);
509:     PetscOptionsHasName(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg);
510:     if (flg) {
511:       PetscLogInfo(coloring,"MatFDColoringApply: Not calling MatZeroEntries()n");
512:     } else {
513:       MatZeroEntries(J);
514:     }

516:     VecGetOwnershipRange(x1,&start,&end);
517:     VecGetSize(x1,&N);
518: 
519:     /*
520:       This is a horrible, horrible, hack. See DMMGComputeJacobian_Multigrid() it inproperly sets
521:       coloring->F for the coarser grids from the finest
522:     */
523:     if (coloring->F) {
524:       VecGetLocalSize(coloring->F,&m1);
525:       VecGetLocalSize(w1,&m2);
526:       if (m1 != m2) {
527:         coloring->F = 0;
528:       }
529:     }

531:     if (coloring->F) {
532:       w1          = coloring->F; /* use already computed value of function */
533:       coloring->F = 0;
534:     } else {
535:       (*f)(sctx,x1,w1,fctx);
536:     }

538:     /* 
539:        Compute all the scale factors and share with other processors
540:     */
541:     VecGetArray(x1,&xx);xx = xx - start;
542:     VecGetArray(coloring->vscale,&vscale_array);vscale_array = vscale_array - start;
543:     for (k=0; k<coloring->ncolors; k++) {
544:       /*
545:         Loop over each column associated with color adding the 
546:         perturbation to the vector w3.
547:       */
548:       for (l=0; l<coloring->ncolumns[k]; l++) {
549:         col = coloring->columns[k][l];    /* column of the matrix we are probing for */
550:         dx  = xx[col];
551:         if (dx == 0.0) dx = 1.0;
552: #if !defined(PETSC_USE_COMPLEX)
553:         if (dx < umin && dx >= 0.0)      dx = umin;
554:         else if (dx < 0.0 && dx > -umin) dx = -umin;
555: #else
556:         if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
557:         else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
558: #endif
559:         dx                *= epsilon;
560:         vscale_array[col] = 1.0/dx;
561:       }
562:     }
563:     vscale_array = vscale_array + start;VecRestoreArray(coloring->vscale,&vscale_array);
564:     VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);
565:     VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);

567:     /*  VecView(coloring->vscale,PETSC_VIEWER_STDOUT_WORLD);
568:         VecView(x1,PETSC_VIEWER_STDOUT_WORLD);*/

570:     if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
571:     else                        vscaleforrow = coloring->columnsforrow;

573:     VecGetArray(coloring->vscale,&vscale_array);
574:     /*
575:       Loop over each color
576:     */
577:     for (k=0; k<coloring->ncolors; k++) {
578:       VecCopy(x1,w3);
579:       VecGetArray(w3,&w3_array);w3_array = w3_array - start;
580:       /*
581:         Loop over each column associated with color adding the 
582:         perturbation to the vector w3.
583:       */
584:       for (l=0; l<coloring->ncolumns[k]; l++) {
585:         col = coloring->columns[k][l];    /* column of the matrix we are probing for */
586:         dx  = xx[col];
587:         if (dx == 0.0) dx = 1.0;
588: #if !defined(PETSC_USE_COMPLEX)
589:         if (dx < umin && dx >= 0.0)      dx = umin;
590:         else if (dx < 0.0 && dx > -umin) dx = -umin;
591: #else
592:         if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
593:         else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
594: #endif
595:         dx            *= epsilon;
596:         if (!PetscAbsScalar(dx)) SETERRQ(1,"Computed 0 differencing parameter");
597:         w3_array[col] += dx;
598:       }
599:       w3_array = w3_array + start; VecRestoreArray(w3,&w3_array);

601:       /*
602:         Evaluate function at x1 + dx (here dx is a vector of perturbations)
603:       */

605:       (*f)(sctx,w3,w2,fctx);
606:       VecAXPY(&mone,w1,w2);

608:       /*
609:         Loop over rows of vector, putting results into Jacobian matrix
610:       */
611:       VecGetArray(w2,&y);
612:       for (l=0; l<coloring->nrows[k]; l++) {
613:         row    = coloring->rows[k][l];
614:         col    = coloring->columnsforrow[k][l];
615:         y[row] *= vscale_array[vscaleforrow[k][l]];
616:         srow   = row + start;
617:         ierr   = MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);
618:       }
619:       VecRestoreArray(w2,&y);
620:     }
621:     VecRestoreArray(coloring->vscale,&vscale_array);
622:     xx = xx + start; ierr  = VecRestoreArray(x1,&xx);
623:     ierr  = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
624:     ierr  = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
625:   }
626:   PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);

628:   PetscOptionsHasName(PETSC_NULL,"-mat_null_space_test",&flg);
629:   if (flg) {
630:     MatNullSpaceTest(J->nullsp,J);
631:   }
632:   return(0);
633: }

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

639:    Collective on Mat, MatFDColoring, and Vec

641:     Input Parameters:
642: +   mat - location to store Jacobian
643: .   coloring - coloring context created with MatFDColoringCreate()
644: .   x1 - location at which Jacobian is to be computed
645: -   sctx - optional context required by function (actually a SNES context)

647:    Options Database Keys:
648: .  -mat_fd_coloring_freq <freq> - Sets coloring frequency

650:    Level: intermediate

652: .seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView()

654: .keywords: coloring, Jacobian, finite differences
655: @*/
656: int MatFDColoringApplyTS(Mat J,MatFDColoring coloring,PetscReal t,Vec x1,MatStructure *flag,void *sctx)
657: {
658:   int           (*f)(void *,PetscReal,Vec,Vec,void*)=(int (*)(void *,PetscReal,Vec,Vec,void *))coloring->f;
659:   int           k,ierr,N,start,end,l,row,col,srow,**vscaleforrow;
660:   PetscScalar   dx,mone = -1.0,*y,*xx,*w3_array;
661:   PetscScalar   *vscale_array;
662:   PetscReal     epsilon = coloring->error_rel,umin = coloring->umin;
663:   Vec           w1,w2,w3;
664:   void          *fctx = coloring->fctx;
665:   PetscTruth    flg;


672:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
673:   if (!coloring->w1) {
674:     VecDuplicate(x1,&coloring->w1);
675:     PetscLogObjectParent(coloring,coloring->w1);
676:     VecDuplicate(x1,&coloring->w2);
677:     PetscLogObjectParent(coloring,coloring->w2);
678:     VecDuplicate(x1,&coloring->w3);
679:     PetscLogObjectParent(coloring,coloring->w3);
680:   }
681:   w1 = coloring->w1; w2 = coloring->w2; w3 = coloring->w3;

683:   MatSetUnfactored(J);
684:   PetscOptionsHasName(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg);
685:   if (flg) {
686:     PetscLogInfo(coloring,"MatFDColoringApply: Not calling MatZeroEntries()n");
687:   } else {
688:     MatZeroEntries(J);
689:   }

691:   VecGetOwnershipRange(x1,&start,&end);
692:   VecGetSize(x1,&N);
693:   (*f)(sctx,t,x1,w1,fctx);

695:   /* 
696:       Compute all the scale factors and share with other processors
697:   */
698:   VecGetArray(x1,&xx);xx = xx - start;
699:   VecGetArray(coloring->vscale,&vscale_array);vscale_array = vscale_array - start;
700:   for (k=0; k<coloring->ncolors; k++) {
701:     /*
702:        Loop over each column associated with color adding the 
703:        perturbation to the vector w3.
704:     */
705:     for (l=0; l<coloring->ncolumns[k]; l++) {
706:       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
707:       dx  = xx[col];
708:       if (dx == 0.0) dx = 1.0;
709: #if !defined(PETSC_USE_COMPLEX)
710:       if (dx < umin && dx >= 0.0)      dx = umin;
711:       else if (dx < 0.0 && dx > -umin) dx = -umin;
712: #else
713:       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
714:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
715: #endif
716:       dx                *= epsilon;
717:       vscale_array[col] = 1.0/dx;
718:     }
719:   }
720:   vscale_array = vscale_array - start;VecRestoreArray(coloring->vscale,&vscale_array);
721:   VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);
722:   VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);

724:   if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
725:   else                        vscaleforrow = coloring->columnsforrow;

727:   VecGetArray(coloring->vscale,&vscale_array);
728:   /*
729:       Loop over each color
730:   */
731:   for (k=0; k<coloring->ncolors; k++) {
732:     VecCopy(x1,w3);
733:     VecGetArray(w3,&w3_array);w3_array = w3_array - start;
734:     /*
735:        Loop over each column associated with color adding the 
736:        perturbation to the vector w3.
737:     */
738:     for (l=0; l<coloring->ncolumns[k]; l++) {
739:       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
740:       dx  = xx[col];
741:       if (dx == 0.0) dx = 1.0;
742: #if !defined(PETSC_USE_COMPLEX)
743:       if (dx < umin && dx >= 0.0)      dx = umin;
744:       else if (dx < 0.0 && dx > -umin) dx = -umin;
745: #else
746:       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
747:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
748: #endif
749:       dx            *= epsilon;
750:       w3_array[col] += dx;
751:     }
752:     w3_array = w3_array + start; VecRestoreArray(w3,&w3_array);

754:     /*
755:        Evaluate function at x1 + dx (here dx is a vector of perturbations)
756:     */
757:     (*f)(sctx,t,w3,w2,fctx);
758:     VecAXPY(&mone,w1,w2);

760:     /*
761:        Loop over rows of vector, putting results into Jacobian matrix
762:     */
763:     VecGetArray(w2,&y);
764:     for (l=0; l<coloring->nrows[k]; l++) {
765:       row    = coloring->rows[k][l];
766:       col    = coloring->columnsforrow[k][l];
767:       y[row] *= vscale_array[vscaleforrow[k][l]];
768:       srow   = row + start;
769:       ierr   = MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);
770:     }
771:     VecRestoreArray(w2,&y);
772:   }
773:   ierr  = VecRestoreArray(coloring->vscale,&vscale_array);
774:   xx    = xx + start; ierr  = VecRestoreArray(x1,&xx);
775:   ierr  = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
776:   ierr  = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
777:   ierr  = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);
778:   return(0);
779: }


782: /*@C
783:    MatFDColoringSetRecompute - Indicates that the next time a Jacobian preconditioner
784:      is needed it sholuld be recomputed. Once this is called and the new Jacobian is computed
785:      no additional Jacobian's will be computed (the same one will be used) until this is
786:      called again.

788:    Collective on MatFDColoring

790:    Input  Parameters:
791: .  c - the coloring context

793:    Level: intermediate

795:    Notes: The MatFDColoringSetFrequency() is ignored once this is called

797: .seealso: MatFDColoringCreate(), MatFDColoringSetFrequency()

799: .keywords: Mat, finite differences, coloring
800: @*/
801: int MatFDColoringSetRecompute(MatFDColoring c)
802: {
805:   c->usersetsrecompute = PETSC_TRUE;
806:   c->recompute         = PETSC_TRUE;
807:   return(0);
808: }