GCC Code Coverage Report

Directory: ./
File: src/nep/tests/test2f.F90
Date: 2025-10-03 04:28:47
Exec Total Coverage
Lines: 129 129 100.0%
Functions: 2 2 100.0%
Branches: 98 186 52.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 ! Description: Simple example to test the NEP Fortran interface.
11 !
12 ! ----------------------------------------------------------------------
13 !
14 6 program main
15 #include <slepc/finclude/slepcnep.h>
16 6 use slepcnep
17 implicit none
18
19 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
20 ! Declarations
21 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
22
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 24 Mat A(3),B
23
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 24 FN f(3),g
24 NEP nep
25 DS ds
26 RG rg
27 PetscReal tol
28 PetscScalar coeffs(2),tget,val
29 PetscInt n,i,its,Istart,Iend
30 PetscInt nev,ncv,mpd,nterm
31 PetscInt nc,np
32 NEPWhich which
33 NEPConvergedReason reason
34 NEPType tname
35 NEPRefine refine
36 NEPRefineScheme rscheme
37 NEPConv conv
38 NEPStop stp
39 NEPProblemType ptype
40 MatStructure mstr
41 PetscMPIInt rank
42 PetscErrorCode ierr
43 PetscViewerAndFormat vf
44
45 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
46 ! Beginning of program
47 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
48
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
50
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
51 6 n = 20
52
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
53 6 write(*,100) n
54 endif
55 100 format (/'Diagonal Nonlinear Eigenproblem, n =',I3,' (Fortran)')
56
57 ! Matrices
58
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD,A(1),ierr))
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A(1),PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
60
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A(1),ierr))
61
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A(1),Istart,Iend,ierr))
62
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 126 do i=Istart,Iend-1
63 120 val = i+1
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 126 PetscCallA(MatSetValue(A(1),i,i,val,INSERT_VALUES,ierr))
65 enddo
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A(1),MAT_FINAL_ASSEMBLY,ierr))
67
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A(1),MAT_FINAL_ASSEMBLY,ierr))
68
69
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD,A(2),ierr))
70
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A(2),PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
71
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A(2),ierr))
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A(2),Istart,Iend,ierr))
73
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 126 do i=Istart,Iend-1
74 120 val = 1
75
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 126 PetscCallA(MatSetValue(A(2),i,i,val,INSERT_VALUES,ierr))
76 enddo
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A(2),MAT_FINAL_ASSEMBLY,ierr))
78
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A(2),MAT_FINAL_ASSEMBLY,ierr))
79
80
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD,A(3),ierr))
81
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A(3),PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
82
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A(3),ierr))
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A(3),Istart,Iend,ierr))
84
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 126 do i=Istart,Iend-1
85 120 val = real(n)/real(i+1)
86
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 126 PetscCallA(MatSetValue(A(3),i,i,val,INSERT_VALUES,ierr))
87 enddo
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A(3),MAT_FINAL_ASSEMBLY,ierr))
89
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A(3),MAT_FINAL_ASSEMBLY,ierr))
90
91 ! Functions: f0=-lambda, f1=1.0, f2=sqrt(lambda)
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNCreate(PETSC_COMM_WORLD,f(1),ierr))
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetType(f(1),FNRATIONAL,ierr))
94 6 nc = 2
95 6 coeffs(1) = -1.0
96 6 coeffs(2) = 0.0
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNRationalSetNumerator(f(1),nc,coeffs,ierr))
98
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNCreate(PETSC_COMM_WORLD,f(2),ierr))
100
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetType(f(2),FNRATIONAL,ierr))
101 6 nc = 1
102 6 coeffs(1) = 1.0
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNRationalSetNumerator(f(2),nc,coeffs,ierr))
104
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNCreate(PETSC_COMM_WORLD,f(3),ierr))
106
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetType(f(3),FNSQRT,ierr))
107
108 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109 ! Create eigensolver and test interface functions
110 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
111
112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPCreate(PETSC_COMM_WORLD,nep,ierr))
113 6 nterm = 3
114 6 mstr = SAME_NONZERO_PATTERN
115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetSplitOperator(nep,nterm,A,f,mstr,ierr))
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetSplitOperatorInfo(nep,nterm,mstr,ierr))
117
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
118 6 write(*,110) nterm
119 endif
120 110 format (' Nonlinear function with ',I2,' terms')
121 6 i = 0
122
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetSplitOperatorTerm(nep,i,B,g,ierr))
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatView(B,PETSC_NULL_VIEWER,ierr))
124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNView(g,PETSC_NULL_VIEWER,ierr))
125
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetType(nep,NEPRII,ierr))
127
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetType(nep,tname,ierr))
128
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
129 6 write(*,120) tname
130 endif
131 120 format (' Type set to ',A)
132
133
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetProblemType(nep,ptype,ierr))
134
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
135 6 write(*,130) ptype
136 endif
137 130 format (' Problem type before changing = ',I2)
138
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetProblemType(nep,NEP_RATIONAL,ierr))
139
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetProblemType(nep,ptype,ierr))
140
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
141 6 write(*,140) ptype
142 endif
143 140 format (' ... changed to ',I2)
144
145 6 np = 1
146 6 tol = 1e-9
147 6 its = 2
148 6 refine = NEP_REFINE_SIMPLE
149 6 rscheme = NEP_REFINE_SCHEME_EXPLICIT
150
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetRefine(nep,refine,np,tol,its,rscheme,ierr))
151
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetRefine(nep,refine,np,tol,its,rscheme,ierr))
152
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
153 6 write(*,190) refine,tol,its,rscheme
154 endif
155 190 format (' Refinement: ',I2,', tol=',F12.9,', its=',I2,', scheme=',I2)
156
157 6 tget = 1.1
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetTarget(nep,tget,ierr))
159
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetTarget(nep,tget,ierr))
160
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetWhichEigenpairs(nep,NEP_TARGET_MAGNITUDE,ierr))
161
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetWhichEigenpairs(nep,which,ierr))
162
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
163 6 write(*,200) which,PetscRealPart(tget)
164 endif
165 200 format (' Which = ',I2,', target = ',F4.1)
166
167 6 nev = 1
168 6 ncv = 12
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetDimensions(nep,nev,ncv,PETSC_DETERMINE_INTEGER,ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetDimensions(nep,nev,ncv,mpd,ierr))
171
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
172 6 write(*,210) nev,ncv,mpd
173 endif
174 210 format (' Dimensions: nev=',I2,', ncv=',I2,', mpd=',I2)
175
176 6 tol = 1.0e-6
177 6 its = 200
178
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetTolerances(nep,tol,its,ierr))
179
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetTolerances(nep,tol,its,ierr))
180
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
181 6 write(*,220) tol,its
182 endif
183 220 format (' Tolerance =',F9.6,', max_its =',I4)
184
185
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetConvergenceTest(nep,NEP_CONV_ABS,ierr))
186
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetConvergenceTest(nep,conv,ierr))
187
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetStoppingTest(nep,NEP_STOP_BASIC,ierr))
188
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetStoppingTest(nep,stp,ierr))
189
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
190 6 write(*,230) conv,stp
191 endif
192 230 format (' Convergence test =',I2,', stopping test =',I2)
193
194
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,vf,ierr))
195
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPMonitorSet(nep,NEPMONITORFIRST,vf,PetscViewerAndFormatDestroy,ierr))
196
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPMonitorConvergedCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,PETSC_NULL_VEC,vf,ierr))
197
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPMonitorSet(nep,NEPMONITORCONVERGED,vf,NEPMonitorConvergedDestroy,ierr))
198
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPMonitorCancel(nep,ierr))
199
200
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetDS(nep,ds,ierr))
201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(DSView(ds,PETSC_NULL_VIEWER,ierr))
202
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSetFromOptions(nep,ierr))
203
204
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetRG(nep,rg,ierr))
205
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGView(rg,PETSC_NULL_VIEWER,ierr))
206
207
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPSolve(nep,ierr))
208
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPGetConvergedReason(nep,reason,ierr))
209
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
210 6 write(*,240) reason
211 endif
212 240 format (' Finished - converged reason =',I2)
213
214 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
215 ! Display solution and clean up
216 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
217
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPErrorView(nep,NEP_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
218
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(NEPDestroy(nep,ierr))
219
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(1),ierr))
220
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(2),ierr))
221
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(3),ierr))
222
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNDestroy(f(1),ierr))
223
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNDestroy(f(2),ierr))
224
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNDestroy(f(3),ierr))
225
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
227 1 end
228
229 !/*TEST
230 !
231 ! test:
232 ! suffix: 1
233 ! requires: !single
234 !
235 !TEST*/
236