Actual source code: util2.c
1: /*$Id: util2.c,v 1.19 2001/08/07 21:31:30 bsmith Exp $*/
3: /*
4: This file contains utility routines for finite difference
5: approximation of Jacobian matrices. This functionality for
6: the TS component will eventually be incorporated as part of
7: the base PETSc libraries.
8: */
9: #include src/ts/tsimpl.h
10: #include src/snes/snesimpl.h
11: #include src/fortran/custom/zpetsc.h
13: int RHSFunction(TS,PetscReal,Vec,Vec,void*);
14: int RHSJacobianFD(TS,PetscReal,Vec,Mat*,Mat*,MatStructure *,void*);
16: /* -------------------------------------------------------------------*/
18: /* Temporary interface routine; this will be eliminated soon! */
19: #ifdef PETSC_HAVE_FORTRAN_CAPS
20: #define setcroutinefromfortran_ SETCROUTINEFROMFORTRAN
21: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
22: #define setcroutinefromfortran_ setcroutinefromfortran
23: #endif
25: EXTERN_C_BEGIN
27: void PETSC_STDCALL setcroutinefromfortran_(TS ts,Mat A,Mat B,int *__ierr)
28: {
29: *__TSSetRHSJacobian((TS)PetscToPointer(*(int*)(ts)),
30: (Mat)PetscToPointer(*(int*)(A)),
31: (Mat)PetscToPointer(*(int*)(B)),RHSJacobianFD,PETSC_NULL);
32: }
34: EXTERN_C_END
37: /* -------------------------------------------------------------------*/
38: /*
39: RHSJacobianFD - Computes the Jacobian using finite differences.
41: Input Parameters:
42: . ts - TS context
43: . xx1 - compute Jacobian at this point
44: . ctx - application's function context, as set with SNESSetFunction()
46: Output Parameters:
47: . J - Jacobian
48: . B - preconditioner, same as Jacobian
49: . flag - matrix flag
51: Notes:
52: This routine is slow and expensive, and is not currently optimized
53: to take advantage of sparsity in the problem.
55: Sparse approximations using colorings are also available and
56: would be a much better alternative!
57: */
58: int RHSJacobianFD(TS ts,PetscReal t,Vec xx1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
59: {
60: Vec jj1,jj2,xx2;
61: int i,ierr,N,start,end,j;
62: PetscScalar dx,mone = -1.0,*y,scale,*xx,wscale;
63: PetscReal amax,epsilon = 1.e-8; /* assumes PetscReal precision */
64: PetscReal dx_min = 1.e-16,dx_par = 1.e-1;
65: MPI_Comm comm;
67: VecDuplicate(xx1,&jj1);
68: VecDuplicate(xx1,&jj2);
69: VecDuplicate(xx1,&xx2);
71: PetscObjectGetComm((PetscObject)xx1,&comm);
72: MatZeroEntries(*J);
74: VecGetSize(xx1,&N);
75: VecGetOwnershipRange(xx1,&start,&end);
76: TSComputeRHSFunction(ts,ts->ptime,xx1,jj1);
78: /* Compute Jacobian approximation, 1 column at a time.
79: xx1 = current iterate, jj1 = F(xx1)
80: xx2 = perturbed iterate, jj2 = F(xx2)
81: */
82: VecGetArray(xx1,&xx);
83: for (i=0; i<N; i++) {
84: VecCopy(xx1,xx2);
85: if (i>= start && i<end) {
86: dx = xx[i-start];
87: #if !defined(PETSC_USE_COMPLEX)
88: if (dx < dx_min && dx >= 0.0) dx = dx_par;
89: else if (dx < 0.0 && dx > -dx_min) dx = -dx_par;
90: #else
91: if (PetscAbsScalar(dx) < dx_min && PetscRealPart(dx) >= 0.0) dx = dx_par;
92: else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < dx_min) dx = -dx_par;
93: #endif
94: dx *= epsilon;
95: wscale = 1.0/dx;
96: VecSetValues(xx2,1,&i,&dx,ADD_VALUES);
97: } else {
98: wscale = 0.0;
99: }
100: TSComputeRHSFunction(ts,t,xx2,jj2);
101: VecAXPY(&mone,jj1,jj2);
102: /* Communicate scale to all processors */
103: MPI_Allreduce(&wscale,&scale,1,MPIU_SCALAR,PetscSum_Op,comm);
104: VecScale(&scale,jj2);
105: VecGetArray(jj2,&y);
106: VecNorm(jj2,NORM_INFINITY,&amax);
107: amax *= 1.e-14;
108: for (j=start; j<end; j++) {
109: if (PetscAbsScalar(y[j-start]) > amax) {
110: MatSetValues(*J,1,&j,1,&i,y+j-start,INSERT_VALUES);
111: }
112: }
113: VecRestoreArray(jj2,&y);
114: }
116: VecRestoreArray(xx1,&xx);
117: MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
118: MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
119: *flag = DIFFERENT_NONZERO_PATTERN;
121: VecDestroy(jj1);
122: VecDestroy(jj2);
123: VecDestroy(xx2);
125: return 0;
126: }