Actual source code: ex8f.F
1: !
2: ! "$Id: ex8f.F,v 1.2 2001/01/15 21:47:06 bsmith Exp $";
3: !
4: ! Tests MGSetResidual
5: !
6: ! -----------------------------------------------------------------------
8: program main
9: implicit none
11: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
12: ! Include files
13: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
14: !
15: !
16: #include include/finclude/petsc.h
17: #include include/finclude/petscvec.h
18: #include include/finclude/petscmat.h
19: #include include/finclude/petscpc.h
20: #include include/finclude/petscksp.h
21: #include include/finclude/petscmg.h
22: #include include/finclude/petscsles.h
23: #include include/finclude/petscsys.h
24: !
25: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
26: ! Variable declarations
27: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
28: !
29: ! Variables:
30: ! sles - linear solver context
31: ! x, b, u - approx solution, right-hand-side, exact solution vectors
32: ! A - matrix that defines linear system
33: ! its - iterations for convergence
34: ! norm - norm of error in solution
35: ! rctx - random number context
36: !
38: SLES sles
39: Mat A
40: Vec x,b,u
41: PC pc
42: integer n,dim,ierr,istart,iend,i,j,jj,ii
43: double precision v,h2
44: external MyResidual
46: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47: ! Beginning of program
48: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
50: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
51: n = 6
52: dim = n*n
54: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
55: ! Compute the matrix and right-hand-side vector that define
56: ! the linear system, Ax = b.
57: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
59: ! Create parallel matrix, specifying only its global dimensions.
60: ! When using MatCreate(), the matrix format can be specified at
61: ! runtime. Also, the parallel partitioning of the matrix is
62: ! determined by PETSc at runtime.
64: call MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,dim, &
65: & dim,A,ierr)
66: call MatSetFromOptions(A,ierr)
68: ! Currently, all PETSc parallel matrix formats are partitioned by
69: ! contiguous chunks of rows across the processors. Determine which
70: ! rows of the matrix are locally owned.
72: call MatGetOwnershipRange(A,Istart,Iend,ierr)
74: ! Set matrix elements in parallel.
75: ! - Each processor needs to insert only elements that it owns
76: ! locally (but any non-local elements will be sent to the
77: ! appropriate processor during matrix assembly).
78: ! - Always specify global rows and columns of matrix entries.
80: h2 = 1.0/((n+1)*(n+1))
82: do 10, II=Istart,Iend-1
83: v = -1.0
84: i = II/n
85: j = II - i*n
86: if (i.gt.0) then
87: JJ = II - n
88: call MatSetValues(A,1,II,1,JJ,v,ADD_VALUES,ierr)
89: endif
90: if (i.lt.n-1) then
91: JJ = II + n
92: call MatSetValues(A,1,II,1,JJ,v,ADD_VALUES,ierr)
93: endif
94: if (j.gt.0) then
95: JJ = II - 1
96: call MatSetValues(A,1,II,1,JJ,v,ADD_VALUES,ierr)
97: endif
98: if (j.lt.n-1) then
99: JJ = II + 1
100: call MatSetValues(A,1,II,1,JJ,v,ADD_VALUES,ierr)
101: endif
102: v = 4.0
103: call MatSetValues(A,1,II,1,II,v,ADD_VALUES,ierr)
104: 10 continue
106: ! Assemble matrix, using the 2-step process:
107: ! MatAssemblyBegin(), MatAssemblyEnd()
108: ! Computations can be done while messages are in transition
109: ! by placing code between these two statements.
111: call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
112: call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
114: ! Create parallel vectors.
115: ! - Here, the parallel partitioning of the vector is determined by
116: ! PETSc at runtime. We could also specify the local dimensions
117: ! if desired.
118: ! - Note: We form 1 vector from scratch and then duplicate as needed.
120: call VecCreate(PETSC_COMM_WORLD,u,ierr)
121: call VecSetSizes(u,PETSC_DECIDE,dim,ierr)
122: call VecSetFromOptions(u,ierr)
123: call VecDuplicate(u,b,ierr)
124: call VecDuplicate(b,x,ierr)
126: ! Set exact solution; then compute right-hand-side vector.
128: call VecSet(.5d0,u,ierr)
129: call MatMult(A,u,b,ierr)
131: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132: ! Create the linear solver and set various options
133: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
135: ! Create linear solver context
137: call SLESCreate(PETSC_COMM_WORLD,sles,ierr)
138: call SLESGetPC(sles,pc,ierr)
139: call PCSetType(pc,PCMG,ierr)
140: call MGSetLevels(pc,1,PETSC_NULL_OBJECT,ierr)
141: call MGSetResidual(pc,0,MGDefaultResidual,A,ierr)
143: call MGSetResidual(pc,0,MyResidual,A,ierr)
145: ! Set operators. Here the matrix that defines the linear system
146: ! also serves as the preconditioning matrix.
148: call SLESSetOperators(sles,A,A,DIFFERENT_NONZERO_PATTERN, &
149: & ierr)
152: call SLESDestroy(sles,ierr)
153: call VecDestroy(u,ierr)
154: call VecDestroy(x,ierr)
155: call VecDestroy(b,ierr)
156: call MatDestroy(A,ierr)
158: 200 continue
159: call PetscFinalize(ierr)
160: end
162: subroutine MyResidual(A,b,x,r,ierr)
163: Mat A
164: Vec b,x,r
165: integer ierr
166: return
167: end