GCC Code Coverage Report


Directory: ./
File: src/nep/tutorials/ex27f.F90
Date: 2026-02-22 03:58:10
Exec Total Coverage
Lines: 124 136 91.2%
Functions: 2 2 100.0%
Branches: 99 190 52.1%

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> ./ex27f [-help] [-n <n>] [all SLEPc options]
11 !
12 ! Description: Simple NLEIGS example. Fortran90 equivalent of ex27.c
13 !
14 ! The command line options are:
15 ! -n <n>, where <n> = matrix dimension
16 !
17 ! ----------------------------------------------------------------------
18 ! Solve T(lambda)x=0 using NLEIGS solver
19 ! with T(lambda) = -D+sqrt(lambda)*I
20 ! where D is the Laplacian operator in 1 dimension
21 ! and with the interpolation interval [.01,16]
22 ! ----------------------------------------------------------------------
23 !
24 #include <slepc/finclude/slepcnep.h>
25
26 module ex27fmodule
27 use slepcnep
28 implicit none
29
30 contains
31 ! --------------------------------------------------------------
32 ! FormFunction - Computes Function matrix T(lambda)
33 !
34 228 subroutine FormFunction(nep, lambda, fun, B, ctx, ierr)
35 use slepcnep
36 implicit none
37
38 NEP :: nep
39 PetscScalar :: lambda, val(0:2), t
40 Mat :: fun, B
41 PetscInt :: ctx, i, n, col(0:2), Istart, Iend, Istart0, Iend0
42 PetscBool :: FirstBlock = PETSC_FALSE, LastBlock = PETSC_FALSE
43 PetscErrorCode, intent(out) :: ierr
44
45 ! ** Compute Function entries and insert into matrix
46 142 t = sqrt(lambda)
47
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatGetSize(fun, n, PETSC_NULL_INTEGER, ierr))
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatGetOwnershipRange(fun, Istart, Iend, ierr))
49
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (Istart == 0) FirstBlock = PETSC_TRUE
50
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (Iend == n) LastBlock = PETSC_TRUE
51 142 val(0) = 1.0
52 142 val(1) = t - 2.0
53 142 val(2) = 1.0
54
55 142 Istart0 = Istart
56
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (FirstBlock) Istart0 = Istart + 1
57 142 Iend0 = Iend
58
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (LastBlock) Iend0 = Iend - 1
59
60
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
14058 do i = Istart0, Iend0 - 1
61 13916 col(0) = i - 1
62 13916 col(1) = i
63 13916 col(2) = i + 1
64
3/4
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✗ Branch 3 not taken.
27974 PetscCall(MatSetValues(fun, 1_PETSC_INT_KIND, [i], 3_PETSC_INT_KIND, col, val, INSERT_VALUES, ierr))
65 end do
66
67
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (LastBlock) then
68 142 i = n - 1
69 142 col(0) = n - 2
70 142 col(1) = n - 1
71 142 val(0) = 1.0
72 142 val(1) = t - 2.0
73
3/4
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
284 PetscCall(MatSetValues(fun, 1_PETSC_INT_KIND, [i], 2_PETSC_INT_KIND, col, val, INSERT_VALUES, ierr))
74 end if
75
76
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
142 if (FirstBlock) then
77 142 i = 0
78 142 col(0) = 0
79 142 col(1) = 1
80 142 val(0) = t - 2.0
81 142 val(1) = 1.0
82
3/4
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
284 PetscCall(MatSetValues(fun, 1_PETSC_INT_KIND, [i], 2_PETSC_INT_KIND, col, val, INSERT_VALUES, ierr))
83 end if
84
85 ! ** Assemble matrix
86
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
87
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatAssemblyBegin(fun, MAT_FINAL_ASSEMBLY, ierr))
89
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
142 PetscCall(MatAssemblyEnd(fun, MAT_FINAL_ASSEMBLY, ierr))
90
91 end subroutine FormFunction
92
93 ! --------------------------------------------------------------
94 ! FormJacobian - Computes Jacobian matrix T'(lambda)
95 !
96 subroutine FormJacobian(nep, lambda, jac, ctx, ierr)
97 use slepcnep
98 implicit none
99
100 NEP :: nep
101 PetscScalar :: lambda, t
102 Mat :: jac
103 PetscInt :: ctx
104 Vec :: d
105 PetscErrorCode, intent(out) :: ierr
106
107 PetscCall(MatCreateVecs(jac, d, PETSC_NULL_VEC, ierr))
108 t = 0.5/sqrt(lambda)
109 PetscCall(VecSet(d, t, ierr))
110 PetscCall(MatDiagonalSet(jac, d, INSERT_VALUES, ierr))
111 PetscCall(VecDestroy(d, ierr))
112
113 end subroutine FormJacobian
114
115 ! --------------------------------------------------------------
116 ! ComputeSingularities - This is a user-defined routine to compute maxnp
117 ! points (at most) in the complex plane where the function T(.) is not analytic.
118 !
119 ! In this case, we discretize the singularity region (-inf,0)~(-1e+6,-1e-5)
120 !
121 ! Input Parameters:
122 ! nep - nonlinear eigensolver context
123 ! maxnp - on input number of requested points in the discretization (can be set)
124 ! xi - computed values of the discretization
125 ! dummy - optional user-defined monitor context (unused here)
126 !
127 10 subroutine ComputeSingularities(nep, maxnp, xi, dummy, ierr)
128 use slepcnep
129 implicit none
130
131 NEP :: nep
132 PetscInt :: maxnp, dummy
133 PetscScalar :: xi(0:maxnp - 1)
134 PetscReal :: h
135 PetscInt :: i
136 PetscErrorCode, intent(out) :: ierr
137
138 10 h = 11.0/real(maxnp - 1, PETSC_REAL_KIND)
139 10 xi(0) = -1e-5
140 10 xi(maxnp - 1) = -1e+6
141
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
99990 do i = 1, maxnp - 2
142 99990 xi(i) = -10**(-5 + h*i)
143 end do
144 10 ierr = 0
145
146 10 end subroutine ComputeSingularities
147
148 end module ex27fmodule
149
150 10 program ex27f
151 10 use slepcnep
152 use ex27fmodule
153 implicit none
154
155 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
156 ! Declarations
157 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
158
159 NEP :: nep
160
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
30 Mat :: A(2), F, J
161 NEPType :: ntype
162 PetscInt :: n = 100, nev, Istart, Iend, i, col
163 PetscErrorCode :: ierr
164 PetscBool :: terse, flg, split = PETSC_TRUE
165 PetscReal :: ia, ib, ic, id
166 RG :: rg
167
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
30 FN :: fn(2)
168 PetscScalar :: coeffs, sigma
169 character(len=128) :: string
170 PetscScalar, parameter :: one = 1.0
171
172 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
173 ! Beginning of program
174 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
175
176
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
177
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, "-n", n, flg, ierr))
178
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(PetscOptionsGetBool(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, "-split", split, flg, ierr))
179
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
10 if (split) then
180 5 write (string, *) 'Square root eigenproblem, n=', n, ' (split-form)\n'
181 else
182 5 write (string, *) 'Square root eigenproblem, n=', n, '\n'
183 end if
184
2/4
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
10 PetscCallA(PetscPrintf(PETSC_COMM_WORLD, trim(string), ierr))
185
186 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
187 ! Create nonlinear eigensolver context and set options
188 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
189
190
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPCreate(PETSC_COMM_WORLD, nep, ierr))
191
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPSetType(nep, NEPNLEIGS, ierr))
192
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPNLEIGSSetSingularitiesFunction(nep, ComputeSingularities, 0, ierr))
193
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPGetRG(nep, rg, ierr))
194
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(RGSetType(rg, RGINTERVAL, ierr))
195 10 ia = 0.01
196 10 ib = 16.0
197 #if defined(PETSC_USE_COMPLEX)
198 6 ic = -0.001
199 6 id = 0.001
200 #else
201 4 ic = 0.0
202 4 id = 0.0
203 #endif
204
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(RGIntervalSetEndpoints(rg, ia, ib, ic, id, ierr))
205 10 sigma = 1.1
206
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPSetTarget(nep, sigma, ierr))
207
208 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
209 ! Define the nonlinear problem
210 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
211
212
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
10 if (split) then
213 ! ** Create matrices for the split form
214
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatCreate(PETSC_COMM_WORLD, A(1), ierr))
215
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetSizes(A(1), PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
216
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetFromOptions(A(1), ierr))
217
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatGetOwnershipRange(A(1), Istart, Iend, ierr))
218 5 coeffs = -2.0
219
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
505 do i = Istart, Iend - 1
220
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
500 if (i > 0) then
221 495 col = i - 1
222
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
495 PetscCallA(MatSetValue(A(1), i, col, one, INSERT_VALUES, ierr))
223 end if
224
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
500 if (i < n - 1) then
225 495 col = i + 1
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
495 PetscCallA(MatSetValue(A(1), i, col, one, INSERT_VALUES, ierr))
227 end if
228
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
505 PetscCallA(MatSetValue(A(1), i, i, coeffs, INSERT_VALUES, ierr))
229 end do
230
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatAssemblyBegin(A(1), MAT_FINAL_ASSEMBLY, ierr))
231
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatAssemblyEnd(A(1), MAT_FINAL_ASSEMBLY, ierr))
232
233
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatCreateConstantDiagonal(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, one, A(2), ierr))
234
235 ! ** Define functions for the split form
236
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNCreate(PETSC_COMM_WORLD, fn(1), ierr))
237
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNSetType(fn(1), FNRATIONAL, ierr))
238
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNRationalSetNumerator(fn(1), 1_PETSC_INT_KIND, [one], ierr))
239
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNCreate(PETSC_COMM_WORLD, fn(2), ierr))
240
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNSetType(fn(2), FNSQRT, ierr))
241
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(NEPSetSplitOperator(nep, 2_PETSC_INT_KIND, A, fn, SUBSET_NONZERO_PATTERN, ierr))
242 else
243 ! ** Callback form: create matrix and set Function evaluation routine
244
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatCreate(PETSC_COMM_WORLD, F, ierr))
245
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetSizes(F, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
246
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetFromOptions(F, ierr))
247
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSeqAIJSetPreallocation(F, 3_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, ierr))
248
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatMPIAIJSetPreallocation(F, 3_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, 1_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, ierr))
249
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(NEPSetFunction(nep, F, F, FormFunction, PETSC_NULL_INTEGER, ierr))
250
251
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatCreate(PETSC_COMM_WORLD, J, ierr))
252
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetSizes(J, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
253
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSetFromOptions(J, ierr))
254
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatSeqAIJSetPreallocation(J, 1_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, ierr))
255
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatMPIAIJSetPreallocation(J, 1_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, 1_PETSC_INT_KIND, PETSC_NULL_INTEGER_ARRAY, ierr))
256
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(NEPSetJacobian(nep, J, FormJacobian, PETSC_NULL_INTEGER, ierr))
257 end if
258
259
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPSetFromOptions(nep, ierr))
260
261 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
262 ! Solve the eigensystem
263 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
264
265
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPSolve(nep, ierr))
266
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPGetType(nep, ntype, ierr))
267 10 write (string, *) 'Solution method: ', ntype, '\n'
268
2/4
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
10 PetscCallA(PetscPrintf(PETSC_COMM_WORLD, trim(string), ierr))
269
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPGetDimensions(nep, nev, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
270 10 write (string, *) 'Number of requested eigenvalues:', nev, '\n'
271
2/4
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5 times.
10 PetscCallA(PetscPrintf(PETSC_COMM_WORLD, trim(string), ierr))
272
273 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
274 ! Display solution and clean up
275 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
276
277 ! ** show detailed info unless -terse option is given by user
278
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(PetscOptionsHasName(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-terse', terse, ierr))
279
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
10 if (terse) then
280
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPErrorView(nep, NEP_ERROR_BACKWARD, PETSC_NULL_VIEWER, ierr))
281 else
282 PetscCallA(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO_DETAIL, ierr))
283 PetscCallA(NEPConvergedReasonView(nep, PETSC_VIEWER_STDOUT_WORLD, ierr))
284 PetscCallA(NEPErrorView(nep, NEP_ERROR_BACKWARD, PETSC_VIEWER_STDOUT_WORLD, ierr))
285 PetscCallA(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD, ierr))
286 end if
287
288
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
10 if (split) then
289
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatDestroy(A(1), ierr))
290
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatDestroy(A(2), ierr))
291
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNDestroy(fn(1), ierr))
292
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(FNDestroy(fn(2), ierr))
293 else
294
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatDestroy(F, ierr))
295
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
5 PetscCallA(MatDestroy(J, ierr))
296 end if
297
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
10 PetscCallA(NEPDestroy(nep, ierr))
298
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
10 PetscCallA(SlepcFinalize(ierr))
299
300 end program ex27f
301
302 !/*TEST
303 !
304 ! test:
305 ! suffix: 1
306 ! args: -nep_nev 3 -nep_nleigs_interpolation_degree 90 -terse
307 ! requires: !single
308 ! filter: sed -e "s/[+-]0\.0*i//g"
309 !
310 ! test:
311 ! suffix: 2
312 ! args: -split 0 -nep_nev 3 -nep_nleigs_interpolation_degree 90 -terse
313 ! requires: !single
314 ! filter: sed -e "s/[+-]0\.0*i//g"
315 !
316 !TEST*/
317