Actual source code: fdmatrix.c

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

  7: #include <private/matimpl.h>        /*I "petscmat.h" I*/

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

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


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

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

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

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

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

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

 68:    Collective on MatFDColoring

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

 74:    Level: intermediate

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

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

 90: .seealso: MatFDColoringCreate()

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

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

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

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

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

146:    Logically Collective on MatFDColoring

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

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

161:    Level: advanced

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

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

167: @*/
168: PetscErrorCode  MatFDColoringSetParameters(MatFDColoring matfd,PetscReal error,PetscReal umin)
169: {
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:    Not Collective

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:    Logically 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:   PetscBool      flg;
292:   char           value[3];


297:   PetscObjectOptionsBegin((PetscObject)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,3,&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_COMM_SELF,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);

311:     /* process any options handlers added with PetscObjectAddOptionsHandler() */
312:     PetscObjectProcessOptionsHandlers((PetscObject)matfd);
313:   PetscOptionsEnd();
314:   return(0);
315: }

319: PetscErrorCode MatFDColoringView_Private(MatFDColoring fd)
320: {
322:   PetscBool      flg = PETSC_FALSE;
323:   PetscViewer    viewer;

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

349: /*@
350:    MatFDColoringCreate - Creates a matrix coloring context for finite difference 
351:    computation of Jacobians.

353:    Collective on Mat

355:    Input Parameters:
356: +  mat - the matrix containing the nonzero structure of the Jacobian
357: -  iscoloring - the coloring of the matrix; usually obtained with MatGetColoring() or DMGetColoring()

359:     Output Parameter:
360: .   color - the new coloring context
361:    
362:     Level: intermediate

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

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

380:   PetscObjectGetComm((PetscObject)mat,&comm);
381:   PetscHeaderCreate(c,_p_MatFDColoring,int,MAT_FDCOLORING_CLASSID,0,"MatFDColoring","Jacobian computation via finite differences with coloring","Mat",comm,MatFDColoringDestroy,MatFDColoringView);

383:   c->ctype = iscoloring->ctype;

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

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

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

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

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

410:     Collective on MatFDColoring

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

415:     Level: intermediate

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

425:   if (!*c) return(0);
426:   if (--((PetscObject)(*c))->refct > 0) {*c = 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:   VecDestroy(&(*c)->vscale);
441:   VecDestroy(&(*c)->w1);
442:   VecDestroy(&(*c)->w2);
443:   VecDestroy(&(*c)->w3);
444:   PetscHeaderDestroy(c);
445:   return(0);
446: }

450: /*@C
451:     MatFDColoringGetPerturbedColumns - Returns the indices of the columns that
452:       that are currently being perturbed.

454:     Not Collective

456:     Input Parameters:
457: .   coloring - coloring context created with MatFDColoringCreate()

459:     Output Parameters:
460: +   n - the number of local columns being perturbed
461: -   cols - the column indices, in global numbering

463:    Level: intermediate

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

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

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

487:     Collective on MatFDColoring

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

495:     Options Database Keys:
496: +    -mat_fd_type - "wp" or "ds"  (see MATMFFD_WP or MATMFFD_DS)
497: .    -mat_fd_coloring_view - Activates basic viewing or coloring
498: .    -mat_fd_coloring_view_draw - Activates drawing of coloring
499: -    -mat_fd_coloring_view_info - Activates viewing of coloring info

501:     Level: intermediate

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

505: .keywords: coloring, Jacobian, finite differences
506: @*/
507: PetscErrorCode  MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
508: {

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

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

541:   if (!f) SETERRQ(((PetscObject)J)->comm,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");

543:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
544:   MatSetUnfactored(J);
545:   PetscOptionsGetBool(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);
546:   if (flg) {
547:     PetscInfo(coloring,"Not calling MatZeroEntries()\n");
548:   } else {
549:     PetscBool  assembled;
550:     MatAssembled(J,&assembled);
551:     if (assembled) {
552:       MatZeroEntries(J);
553:     }
554:   }

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

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

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

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

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

700:   flg  = PETSC_FALSE;
701:   PetscOptionsGetBool(PETSC_NULL,"-mat_null_space_test",&flg,PETSC_NULL);
702:   if (flg) {
703:     MatNullSpaceTest(J->nullsp,J,PETSC_NULL);
704:   }
705:   MatFDColoringView_Private(coloring);
706:   return(0);
707: }

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

715:    Collective on Mat, MatFDColoring, and Vec

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

723:    Level: intermediate

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

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


746:   PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);
747:   if (!coloring->w3) {
748:     VecDuplicate(x1,&coloring->w3);
749:     PetscLogObjectParent(coloring,coloring->w3);
750:   }
751:   w3 = coloring->w3;

753:   MatSetUnfactored(J);
754:   flg  = PETSC_FALSE;
755:   PetscOptionsGetBool(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);
756:   if (flg) {
757:     PetscInfo(coloring,"Not calling MatZeroEntries()\n");
758:   } else {
759:     PetscBool  assembled;
760:     MatAssembled(J,&assembled);
761:     if (assembled) {
762:       MatZeroEntries(J);
763:     }
764:   }

766:   VecGetOwnershipRange(x1,&start,&end);
767:   VecGetSize(x1,&N);
768:   PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
769:   (*f)(sctx,t,x1,w1,fctx);
770:   PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);

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

801:   if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
802:   else                        vscaleforrow = coloring->columnsforrow;

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

831:     /*
832:        Evaluate function at x1 + dx (here dx is a vector of perturbations)
833:     */
834:     PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);
835:     (*f)(sctx,t,w3,w2,fctx);
836:     PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);
837:     VecAXPY(w2,-1.0,w1);

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