GCC Code Coverage Report

Directory: ./
File: src/nep/tutorials/ex20f.F90
Date: 2025-12-10 04:20:18
Exec Total Coverage
Lines: 140 141 99.3%
Functions: 2 2 100.0%
Branches: 85 150 56.7%
Line Branch Exec Source
1 !
2 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3 ! SLEPc - Scalable Library for Eigenvalue Problem Computations
4 ! Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
5 !
6 ! This file is part of SLEPc.
7 ! SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9 !
10 ! Program usage: mpiexec -n <np> ./ex20f [-n <n>] [SLEPc opts]
11 !
12 ! Description: Simple 1-D nonlinear eigenproblem. Fortran90 equivalent of ex20.c
13 !
14 ! The command line options are:
15 ! -n <n>, where <n> = number of grid subdivisions
16 !
17 ! ----------------------------------------------------------------------
18 ! Solve 1-D PDE
19 ! -u'' = lambda*u
20 ! on [0,1] subject to
21 ! u(0)=0, u'(1)=u(1)*lambda*kappa/(kappa-lambda)
22 ! ----------------------------------------------------------------------
23 !
24
25 #include <slepc/finclude/slepcnep.h>
26 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
27 ! User-defined module with application context and callback functions
28 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
29 module ex20fmodule
30 use slepcnep
31 type User
32 PetscScalar :: kappa
33 PetscReal :: h
34 end type User
35
36 contains
37 ! --------------- Evaluate Function matrix T(lambda) ----------------
38
39 84 subroutine FormFunction(nep, lambda, fun, B, ctx, ierr)
40 implicit none
41 NEP :: nep
42 PetscScalar :: lambda, A(3), c, d
43 Mat :: fun, B
44 type(User) :: ctx
45 PetscReal :: h
46 PetscInt :: i, n, j(3), Istart, Iend, one, two, three
47 PetscErrorCode :: ierr
48
49 ! ** Compute Function entries and insert into matrix
50
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 84 PetscCall(MatGetSize(fun, n, PETSC_NULL_INTEGER, ierr))
51
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 84 PetscCall(MatGetOwnershipRange(fun, Istart, Iend, ierr))
52 84 h = ctx%h
53 84 c = ctx%kappa/(lambda - ctx%kappa)
54 84 d = n
55 84 one = 1
56 84 two = 2
57 84 three = 3
58
59 ! ** Boundary points
60
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 84 if (Istart == 0) then
61 84 i = 0
62 84 j(1) = 0
63 84 j(2) = 1
64 84 A(1) = 2.0*(d - lambda*h/3.0)
65 84 A(2) = -d - lambda*h/6.0
66
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
 168 PetscCall(MatSetValues(fun, one, [i], two, j, A, INSERT_VALUES, ierr))
67 84 Istart = Istart + 1
68 end if
69
70
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 84 if (Iend == n) then
71 84 i = n - 1
72 84 j(1) = n - 2
73 84 j(2) = n - 1
74 84 A(1) = -d - lambda*h/6.0
75 84 A(2) = d - lambda*h/3.0 + lambda*c
76
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
 168 PetscCall(MatSetValues(fun, one, [i], two, j, A, INSERT_VALUES, ierr))
77 84 Iend = Iend - 1
78 end if
79
80 ! ** Interior grid points
81
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 10668 do i = Istart, Iend - 1
82 10584 j(1) = i - 1
83 10584 j(2) = i
84 10584 j(3) = i + 1
85 10584 A(1) = -d - lambda*h/6.0
86 10584 A(2) = 2.0*(d - lambda*h/3.0)
87 10584 A(3) = -d - lambda*h/6.0
88
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
 21252 PetscCall(MatSetValues(fun, one, [i], three, j, A, INSERT_VALUES, ierr))
89 end do
90
91 ! ** Assemble matrix
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 84 PetscCall(MatAssemblyBegin(fun, MAT_FINAL_ASSEMBLY, ierr))
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 84 PetscCall(MatAssemblyEnd(fun, MAT_FINAL_ASSEMBLY, ierr))
94
95 end subroutine
96
97 ! --------------- Evaluate Jacobian matrix T'(lambda) ---------------
98
99 66 subroutine FormJacobian(nep, lambda, jac, ctx, ierr)
100 implicit none
101 NEP :: nep
102 PetscScalar :: lambda, A(3), c
103 Mat :: jac
104 type(User) :: ctx
105 PetscReal :: h
106 PetscInt :: i, n, j(3), Istart, Iend, one, two, three
107 PetscErrorCode :: ierr
108
109 ! ** Compute Jacobian entries and insert into matrix
110
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 66 PetscCall(MatGetSize(jac, n, PETSC_NULL_INTEGER, ierr))
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 66 PetscCall(MatGetOwnershipRange(jac, Istart, Iend, ierr))
112 66 h = ctx%h
113 66 c = ctx%kappa/(lambda - ctx%kappa)
114 66 one = 1
115 66 two = 2
116 66 three = 3
117
118 ! ** Boundary points
119
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 66 if (Istart == 0) then
120 66 i = 0
121 66 j(1) = 0
122 66 j(2) = 1
123 66 A(1) = -2.0*h/3.0
124 66 A(2) = -h/6.0
125
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
 132 PetscCall(MatSetValues(jac, one, [i], two, j, A, INSERT_VALUES, ierr))
126 66 Istart = Istart + 1
127 end if
128
129
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 66 if (Iend == n) then
130 66 i = n - 1
131 66 j(1) = n - 2
132 66 j(2) = n - 1
133 66 A(1) = -h/6.0
134 66 A(2) = -h/3.0 - c*c
135
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
 132 PetscCall(MatSetValues(jac, one, [i], two, j, A, INSERT_VALUES, ierr))
136 66 Iend = Iend - 1
137 end if
138
139 ! ** Interior grid points
140
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 8382 do i = Istart, Iend - 1
141 8316 j(1) = i - 1
142 8316 j(2) = i
143 8316 j(3) = i + 1
144 8316 A(1) = -h/6.0
145 8316 A(2) = -2.0*h/3.0
146 8316 A(3) = -h/6.0
147
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
 16698 PetscCall(MatSetValues(jac, one, [i], three, j, A, INSERT_VALUES, ierr))
148 end do
149
150 ! ** Assemble matrix
151
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 66 PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY, ierr))
152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 66 PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY, ierr))
153
154 end subroutine
155
156 ✗ end module ex20fmodule
157
158 6 program ex20f
159 6 use ex20fmodule
160 implicit none
161
162 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
163 ! Declarations
164 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
165
166 NEP :: nep ! nonlinear eigensolver
167
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 Vec :: x, v(1) ! eigenvector, auxiliary vector
168 PetscScalar :: lambda ! eigenvalue
169 Mat :: F, J ! Function and Jacobian matrices
170 type(User) :: ctx ! user-defined context
171 NEPType :: tname
172 PetscInt :: n, i, k, nev, its, maxit, nconv, three, one
173 PetscReal :: tol, norm
174 PetscScalar :: alpha
175 PetscMPIInt :: rank
176 PetscBool :: flg
177 PetscErrorCode :: ierr
178
179 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
180 ! Beginning of program
181 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
182
183
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
184
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
185 6 n = 128
186
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
187
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
188 6 write (*, '(/a,i4)') 'Nonlinear Eigenproblem, n =', n
189 end if
190
191 6 ctx%h = 1.0/real(n)
192 6 ctx%kappa = 1.0
193
194 6 three = 3
195 6 one = 1
196
197 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
198 ! Create matrix data structure to hold the Function and the Jacobian
199 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
200
201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD, F, ierr))
202
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(F, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
203
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(F, ierr))
204
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSeqAIJSetPreallocation(F, three, PETSC_NULL_INTEGER_ARRAY, ierr))
205
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatMPIAIJSetPreallocation(F, three, PETSC_NULL_INTEGER_ARRAY, one, PETSC_NULL_INTEGER_ARRAY, ierr))
206
207
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD, J, ierr))
208
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(J, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
209
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(J, ierr))
210
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSeqAIJSetPreallocation(J, three, PETSC_NULL_INTEGER_ARRAY, ierr))
211
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatMPIAIJSetPreallocation(J, three, PETSC_NULL_INTEGER_ARRAY, one, PETSC_NULL_INTEGER_ARRAY, ierr))
212
213 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
214 ! Create the eigensolver and set various options
215 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
216
217 ! ** Create eigensolver context
218
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPCreate(PETSC_COMM_WORLD, nep, ierr))
219
220 ! ** Set routines for evaluation of Function and Jacobian
221
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetFunction(nep, F, F, FormFunction, ctx, ierr))
222
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetJacobian(nep, J, FormJacobian, ctx, ierr))
223
224 ! ** Customize nonlinear solver
225 6 tol = 1e-9
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetTolerances(nep, tol, PETSC_CURRENT_INTEGER, ierr))
227 6 k = 1
228
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetDimensions(nep, k, PETSC_DETERMINE_INTEGER, PETSC_DETERMINE_INTEGER, ierr))
229
230 ! ** Set solver parameters at runtime
231
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetFromOptions(nep, ierr))
232
233 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
234 ! Solve the eigensystem
235 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
236
237 ! ** Evaluate initial guess
238
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreateVecs(F, x, PETSC_NULL_VEC, ierr))
239
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecDuplicate(x, v(1), ierr))
240 6 alpha = 1.0
241
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecSet(v(1), alpha, ierr))
242 6 k = 1
243
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetInitialSpace(nep, k, v, ierr))
244
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecDestroy(v(1), ierr))
245
246 ! ** Call the solver
247
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSolve(nep, ierr))
248
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetIterationNumber(nep, its, ierr))
249
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
250 6 write (*, '(a,i3)') ' Number of NEP iterations =', its
251 end if
252
253 ! ** Optional: Get some information from the solver and display it
254
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetType(nep, tname, ierr))
255
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
256 6 write (*, '(a,a10)') ' Solution method: ', tname
257 end if
258
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetDimensions(nep, nev, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
259
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
260 6 write (*, '(a,i4)') ' Number of requested eigenvalues:', nev
261 end if
262
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetTolerances(nep, tol, maxit, ierr))
263
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
264 6 write (*, '(a,f12.9,a,i5)') ' Stopping condition: tol=', tol, ', maxit=', maxit
265 end if
266
267 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
268 ! Display solution and clean up
269 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
270
271
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetConverged(nep, nconv, ierr))
272
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
273 6 write (*, '(a,i2/)') ' Number of converged approximate eigenpairs:', nconv
274 end if
275
276 ! ** Display eigenvalues and relative errors
277
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (nconv > 0) then
278
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
279 6 write (*, *) ' k ||T(k)x||'
280 6 write (*, *) '----------------- ------------------'
281 end if
282
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 do i = 0, nconv - 1
283 ! ** Get converged eigenpairs: (in this example they are always real)
284
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetEigenpair(nep, i, lambda, PETSC_NULL_SCALAR, x, PETSC_NULL_VEC, ierr))
285
286 ! ** Compute residual norm and error
287
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPComputeError(nep, i, NEP_ERROR_RELATIVE, norm, ierr))
288
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 12 if (rank == 0) then
289 6 write (*, '(1p,e15.4,e18.4)') PetscRealPart(lambda), norm
290 end if
291 end do
292
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
293 6 write (*, *)
294 end if
295 end if
296
297
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPDestroy(nep, ierr))
298
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(F, ierr))
299
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(J, ierr))
300
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecDestroy(x, ierr))
301
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
302 1 end program ex20f
303
304 !/*TEST
305 !
306 ! test:
307 ! suffix: 1
308 ! args: -nep_target 4
309 ! filter: sed -e "s/[0-9]\.[0-9]*E-[0-9]*/removed/g" -e "s/ Number of NEP iterations = [ 0-9]*/ Number of NEP iterations = /"
310 ! requires: !single
311 !
312 !TEST*/
313