GCC Code Coverage Report

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