GCC Code Coverage Report


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