Actual source code: tsfd.c

 2:  #include src/mat/matimpl.h
 3:  #include src/ts/tsimpl.h

  7: /*@C
  8:     TSDefaultComputeJacobianColor - Computes the Jacobian using
  9:     finite differences and coloring to exploit matrix sparsity.  
 10:   
 11:     Collective on TS, Vec and Mat

 13:     Input Parameters:
 14: +   ts - nonlinear solver object
 15: .   t - current time
 16: .   x1 - location at which to evaluate Jacobian
 17: -   ctx - coloring context, where ctx must have type MatFDColoring, 
 18:           as created via MatFDColoringCreate()

 20:     Output Parameters:
 21: +   J - Jacobian matrix (not altered in this routine)
 22: .   B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
 23: -   flag - flag indicating whether the matrix sparsity structure has changed

 25:    Options Database Keys:
 26: $  -mat_fd_coloring_freq <freq> 

 28:    Level: intermediate

 30: .keywords: TS, finite differences, Jacobian, coloring, sparse

 32: .seealso: TSSetJacobian(), MatFDColoringCreate(), MatFDColoringSetFunction()
 33: @*/
 34: PetscErrorCode TSDefaultComputeJacobianColor(TS ts,PetscReal t,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
 35: {
 36:   MatFDColoring  color = (MatFDColoring) ctx;
 37:   SNES           snes;
 39:   PetscInt       freq,it;

 42:   /*
 43:        If we are not using SNES we have no way to know the current iteration.
 44:   */
 45:   TSGetSNES(ts,&snes);
 46:   if (snes) {
 47:     MatFDColoringGetFrequency(color,&freq);
 48:     SNESGetIterationNumber(snes,&it);

 50:     if ((freq > 1) && ((it % freq) != 1)) {
 51:       PetscLogInfo(color,"TSDefaultComputeJacobianColor:Skipping Jacobian, it %D, freq %D\n",it,freq);
 52:       *flag = SAME_PRECONDITIONER;
 53:       goto end;
 54:     } else {
 55:       PetscLogInfo(color,"TSDefaultComputeJacobianColor:Computing Jacobian, it %D, freq %D\n",it,freq);
 56:       *flag = SAME_NONZERO_PATTERN;
 57:     }
 58:   }
 59:   MatFDColoringApplyTS(*B,color,t,x1,flag,ts);
 60:   end:
 61:   if (*J != *B) {
 62:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
 63:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
 64:   }
 65:   return(0);
 66: }

 70: /*
 71:    TSDefaultComputeJacobian - Computes the Jacobian using finite differences.

 73:    Input Parameters:
 74: +  ts - TS context
 75: .  xx1 - compute Jacobian at this point
 76: -  ctx - application's function context, as set with SNESSetFunction()

 78:    Output Parameters:
 79: +  J - Jacobian
 80: .  B - preconditioner, same as Jacobian
 81: -  flag - matrix flag

 83:    Notes:
 84:    This routine is slow and expensive, and is not optimized.

 86:    Sparse approximations using colorings are also available and
 87:    would be a much better alternative!

 89:    Level: intermediate

 91: .seealso: TSDefaultComputeJacobianColor()
 92: */
 93: PetscErrorCode TSDefaultComputeJacobian(TS ts,PetscReal t,Vec xx1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
 94: {
 95:   Vec            jj1,jj2,xx2;
 97:   PetscInt       i,N,start,end,j;
 98:   PetscScalar    dx,mone = -1.0,*y,scale,*xx,wscale;
 99:   PetscReal      amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
100:   PetscReal      dx_min = 1.e-16,dx_par = 1.e-1;
101:   MPI_Comm       comm;
102:   PetscTruth     assembled;

105:   VecDuplicate(xx1,&jj1);
106:   VecDuplicate(xx1,&jj2);
107:   VecDuplicate(xx1,&xx2);

109:   PetscObjectGetComm((PetscObject)xx1,&comm);
110:   MatAssembled(*J,&assembled);
111:   if (assembled) {
112:     MatZeroEntries(*J);
113:   }

115:   VecGetSize(xx1,&N);
116:   VecGetOwnershipRange(xx1,&start,&end);
117:   TSComputeRHSFunction(ts,ts->ptime,xx1,jj1);

119:   /* Compute Jacobian approximation, 1 column at a time.
120:       xx1 = current iterate, jj1 = F(xx1)
121:       xx2 = perturbed iterate, jj2 = F(xx2)
122:    */
123:   for (i=0; i<N; i++) {
124:     VecCopy(xx1,xx2);
125:     if (i>= start && i<end) {
126:        VecGetArray(xx1,&xx);
127:       dx   = xx[i-start];
128:        VecRestoreArray(xx1,&xx);
129: #if !defined(PETSC_USE_COMPLEX)
130:       if (dx < dx_min && dx >= 0.0) dx = dx_par;
131:       else if (dx < 0.0 && dx > -dx_min) dx = -dx_par;
132: #else
133:       if (PetscAbsScalar(dx) < dx_min && PetscRealPart(dx) >= 0.0) dx = dx_par;
134:       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < dx_min) dx = -dx_par;
135: #endif
136:       dx *= epsilon;
137:       wscale = 1.0/dx;
138:        VecSetValues(xx2,1,&i,&dx,ADD_VALUES);
139:     } else {
140:       wscale = 0.0;
141:     }
142:     TSComputeRHSFunction(ts,t,xx2,jj2);
143:     VecAXPY(&mone,jj1,jj2);
144:     /* Communicate scale to all processors */
145:     MPI_Allreduce(&wscale,&scale,1,MPIU_SCALAR,PetscSum_Op,comm);
146:     VecScale(&scale,jj2);
147:     VecNorm(jj2,NORM_INFINITY,&amax); amax *= 1.e-14;
148:     VecGetArray(jj2,&y);
149:     for (j=start; j<end; j++) {
150:       if (PetscAbsScalar(y[j-start]) > amax) {
151:         MatSetValues(*J,1,&j,1,&i,y+j-start,INSERT_VALUES);
152:       }
153:     }
154:     VecRestoreArray(jj2,&y);
155:   }
156:   MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
157:   MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
158:   *flag =  DIFFERENT_NONZERO_PATTERN;

160:   VecDestroy(jj1);
161:   VecDestroy(jj2);
162:   VecDestroy(xx2);

164:   return(0);
165: }