Actual source code: ex7f.F90
1: ! Block Jacobi preconditioner for solving a linear system in parallel with KSP
2: ! The code indicates the procedures for setting the particular block sizes and
3: ! for using different linear solvers on the individual blocks
5: ! This example focuses on ways to customize the block Jacobi preconditioner.
6: ! See ex1.c and ex2.c for more detailed comments on the basic usage of KSP
7: ! (including working with matrices and vectors)
9: ! Recall: The block Jacobi method is equivalent to the ASM preconditioner with zero overlap.
11: program main
12: #include <petsc/finclude/petscksp.h>
13: use petscksp
15: implicit none
16: Vec :: x, b, u ! approx solution, RHS, exact solution
17: Mat :: A ! linear system matrix
18: KSP :: ksp ! KSP context
19: PC :: myPc ! PC context
20: PC :: subpc ! PC context for subdomain
21: PetscReal :: norm ! norm of solution error
22: PetscReal, parameter :: tol = 1.e-6
23: PetscErrorCode :: ierr
24: PetscInt :: i, j, Ii, JJ, n
25: PetscInt :: m
26: PetscMPIInt :: rank, size
27: PetscInt :: its, nlocal, first, Istart, Iend
28: PetscScalar :: v
29: PetscScalar, parameter :: &
30: myNone = -1.0, &
31: sone = 1.0
32: PetscBool :: isbjacobi, flg
33: KSP, pointer :: subksp(:) => null()
34: PetscInt :: blks(4)
35: character(len=PETSC_MAX_PATH_LEN) :: outputString
36: PetscInt, parameter :: one = 1, five = 5
38: PetscCallA(PetscInitialize(ierr))
39: m = 4
40: PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-m', m, flg, ierr))
41: PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
42: PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))
43: n = m + 2
44: blks(1) = n
45: blks(2) = n
46: blks(3) = n
47: blks(4) = n
49: !-------------------------------------------------------------------
50: ! Compute the matrix and right-hand-side vector that define
51: ! the linear system, Ax = b.
52: !---------------------------------------------------------------
54: ! Create and assemble parallel matrix
56: PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
57: PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, m*n, m*n, ierr))
58: PetscCallA(MatSetFromOptions(A, ierr))
59: PetscCallA(MatMPIAIJSetPreallocation(A, five, PETSC_NULL_INTEGER_ARRAY, five, PETSC_NULL_INTEGER_ARRAY, ierr))
60: PetscCallA(MatSeqAIJSetPreallocation(A, five, PETSC_NULL_INTEGER_ARRAY, ierr))
61: PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
63: do Ii = Istart, Iend - 1
64: v = -1.0; i = Ii/n; j = Ii - i*n
65: if (i > 0) then
66: JJ = Ii - n
67: PetscCallA(MatSetValues(A, one, [Ii], one, [JJ], [v], ADD_VALUES, ierr))
68: end if
70: if (i < m - 1) then
71: JJ = Ii + n
72: PetscCallA(MatSetValues(A, one, [Ii], one, [JJ], [v], ADD_VALUES, ierr))
73: end if
75: if (j > 0) then
76: JJ = Ii - 1
77: PetscCallA(MatSetValues(A, one, [Ii], one, [JJ], [v], ADD_VALUES, ierr))
78: end if
80: if (j < n - 1) then
81: JJ = Ii + 1
82: PetscCallA(MatSetValues(A, one, [Ii], one, [JJ], [v], ADD_VALUES, ierr))
83: end if
85: v = 4.0
86: PetscCallA(MatSetValues(A, one, [Ii], one, [Ii], [v], ADD_VALUES, ierr))
88: end do
90: PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
91: PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
93: ! Create parallel vectors
95: PetscCallA(VecCreate(PETSC_COMM_WORLD, u, ierr))
96: PetscCallA(VecSetSizes(u, PETSC_DECIDE, m*n, ierr))
97: PetscCallA(VecSetFromOptions(u, ierr))
98: PetscCallA(VecDuplicate(u, b, ierr))
99: PetscCallA(VecDuplicate(b, x, ierr))
101: ! Set exact solution; then compute right-hand-side vector.
103: PetscCallA(Vecset(u, sone, ierr))
104: PetscCallA(MatMult(A, u, b, ierr))
106: ! Create linear solver context
108: PetscCallA(KSPCreate(PETSC_COMM_WORLD, ksp, ierr))
110: ! Set operators. Here the matrix that defines the linear system
111: ! also serves as the matrix used to construct the preconditioner.
113: PetscCallA(KSPSetOperators(ksp, A, A, ierr))
115: ! Set default preconditioner for this program to be block Jacobi.
116: ! This choice can be overridden at runtime with the option
117: ! -pc_type <type>
119: PetscCallA(KSPGetPC(ksp, myPc, ierr))
120: PetscCallA(PCSetType(myPc, PCBJACOBI, ierr))
122: ! -----------------------------------------------------------------
123: ! Define the problem decomposition
124: !-------------------------------------------------------------------
126: ! Call PCBJacobiSetTotalBlocks() to set individually the size of
127: ! each block in the preconditioner. This could also be done with
128: ! the runtime option -pc_bjacobi_blocks <blocks>
129: ! Also, see the command PCBJacobiSetLocalBlocks() to set the
130: ! local blocks.
132: ! Note: The default decomposition is 1 block per processor.
134: PetscCallA(PCBJacobiSetTotalBlocks(myPc, m, blks, ierr))
136: !-------------------------------------------------------------------
137: ! Set the linear solvers for the subblocks
138: !-------------------------------------------------------------------
140: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141: ! Basic method, should be sufficient for the needs of most users.
142: !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
143: ! By default, the block Jacobi method uses the same solver on each
144: ! block of the problem. To set the same solver options on all blocks,
145: ! use the prefix -sub before the usual PC and KSP options, e.g.,
146: ! -sub_pc_type <pc> -sub_ksp_type <ksp> -sub_ksp_rtol 1.e-4
148: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
149: ! Advanced method, setting different solvers for various blocks.
150: !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
152: ! Note that each block's KSP context is completely independent of
153: ! the others, and the full range of uniprocessor KSP options is
154: ! available for each block. The following section of code is intended
155: ! to be a simple illustration of setting different linear solvers for
156: ! the individual blocks. These choices are obviously not recommended
157: ! for solving this particular problem.
159: PetscCallA(PetscObjectTypeCompare(myPc, PCBJACOBI, isbjacobi, ierr))
161: if (isbjacobi) then
163: ! Call KSPSetUp() to set the block Jacobi data structures (including
164: ! creation of an internal KSP context for each block).
165: ! Note: KSPSetUp() MUST be called before PCBJacobiGetSubKSP()
167: PetscCallA(KSPSetUp(ksp, ierr))
169: ! Extract the array of KSP contexts for the local blocks
170: PetscCallA(PCBJacobiGetSubKSP(myPc, nlocal, first, PETSC_NULL_KSP_POINTER, ierr))
171: PetscCallA(PCBJacobiGetSubKSP(myPc, nlocal, first, subksp, ierr))
173: ! Loop over the local blocks, setting various KSP options for each block
175: do i = 0, nlocal - 1
177: PetscCallA(KSPGetPC(subksp(i + 1), subpc, ierr))
179: if (rank > 0) then
181: if (mod(i, 2) == 1) then
182: PetscCallA(PCSetType(subpc, PCILU, ierr))
184: else
185: PetscCallA(PCSetType(subpc, PCNONE, ierr))
186: PetscCallA(KSPSetType(subksp(i + 1), KSPBCGS, ierr))
187: PetscCallA(KSPSetTolerances(subksp(i + 1), tol, PETSC_CURRENT_REAL, PETSC_CURRENT_REAL, PETSC_CURRENT_INTEGER, ierr))
188: end if
190: else
191: PetscCallA(PCSetType(subpc, PCJACOBI, ierr))
192: PetscCallA(KSPSetType(subksp(i + 1), KSPGMRES, ierr))
193: PetscCallA(KSPSetTolerances(subksp(i + 1), tol, PETSC_CURRENT_REAL, PETSC_CURRENT_REAL, PETSC_CURRENT_INTEGER, ierr))
194: end if
196: end do
198: end if
200: !----------------------------------------------------------------
201: ! Solve the linear system
202: !-----------------------------------------------------------------
204: ! Set runtime options
206: PetscCallA(KSPSetFromOptions(ksp, ierr))
208: ! Solve the linear system
210: PetscCallA(KSPSolve(ksp, b, x, ierr))
212: ! -----------------------------------------------------------------
213: ! Check solution and clean up
214: !-------------------------------------------------------------------
216: ! -----------------------------------------------------------------
217: ! Check the error
218: ! -----------------------------------------------------------------
220: !PetscCallA(VecView(x,PETSC_VIEWER_STDOUT_WORLD,ierr))
222: PetscCallA(VecAXPY(x, myNone, u, ierr))
224: !PetscCallA(VecView(x,PETSC_VIEWER_STDOUT_WORLD,ierr))
226: PetscCallA(VecNorm(x, NORM_2, norm, ierr))
227: PetscCallA(KSPGetIterationNumber(ksp, its, ierr))
228: write (outputString, *) 'Norm of error', real(norm), 'Iterations', its, '\n' ! PETScScalar might be of complex type
229: PetscCallA(PetscPrintf(PETSC_COMM_WORLD, outputString, ierr))
231: ! Free work space. All PETSc objects should be destroyed when they
232: ! are no longer needed.
233: PetscCallA(KSPDestroy(ksp, ierr))
234: PetscCallA(VecDestroy(u, ierr))
235: PetscCallA(VecDestroy(b, ierr))
236: PetscCallA(MatDestroy(A, ierr))
237: PetscCallA(VecDestroy(x, ierr))
238: PetscCallA(PetscFinalize(ierr))
240: end program main
242: !/*TEST
243: !
244: ! test:
245: ! nsize: 2
246: ! args: -ksp_monitor_short -ksp_gmres_cgs_refinement_type refine_always
247: !
248: ! test:
249: ! suffix: 2
250: ! nsize: 2
251: ! args: -ksp_view ::ascii_info_detail
252: !
253: !TEST*/