GCC Code Coverage Report

Directory: ./
File: src/pep/tests/test3f.F90
Date: 2025-10-04 04:19:13
Exec Total Coverage
Lines: 133 133 100.0%
Functions: 2 2 100.0%
Branches: 97 186 52.2%
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 PEP Fortran interface.
11 !
12 ! ----------------------------------------------------------------------
13 !
14 6 program main
15 #include <slepc/finclude/slepcpep.h>
16 6 use slepcpep
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 PEP pep
24 ST st
25 KSP ksp
26 DS ds
27 PetscReal tol,tolabs,alpha,lambda
28 PetscScalar tget,val
29 PetscInt n,i,its,Istart,Iend
30 PetscInt nev,ncv,mpd,nmat,np
31 PEPWhich which
32 PEPConvergedReason reason
33 PEPType tname
34 PEPExtract extr
35 PEPBasis basis
36 PEPScale scal
37 PEPRefine refine
38 PEPRefineScheme rscheme
39 PEPConv conv
40 PEPStop stp
41 PEPProblemType ptype
42 PetscMPIInt rank
43 PetscErrorCode ierr
44 PetscViewerAndFormat vf
45
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47 ! Beginning of program
48 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
49
50
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
51
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
52 6 n = 20
53
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
54 6 write(*,100) n
55 endif
56 100 format (/'Diagonal Quadratic Eigenproblem, n =',I3,' (Fortran)')
57
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 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92 ! Create eigensolver and test interface functions
93 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
94
95
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPCreate(PETSC_COMM_WORLD,pep,ierr))
96 6 nmat = 3
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetOperators(pep,nmat,A,ierr))
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetNumMatrices(pep,nmat,ierr))
99
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
100 6 write(*,110) nmat-1
101 endif
102 110 format (' Polynomial of degree ',I2)
103 6 i = 0
104
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetOperators(pep,i,B,ierr))
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatView(B,PETSC_NULL_VIEWER,ierr))
106
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetType(pep,PEPTOAR,ierr))
108
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetType(pep,tname,ierr))
109
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
110 6 write(*,120) tname
111 endif
112 120 format (' Type set to ',A)
113
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetProblemType(pep,ptype,ierr))
115
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
116 6 write(*,130) ptype
117 endif
118 130 format (' Problem type before changing = ',I2)
119
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetProblemType(pep,PEP_HERMITIAN,ierr))
120
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetProblemType(pep,ptype,ierr))
121
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
122 6 write(*,140) ptype
123 endif
124 140 format (' ... changed to ',I2)
125
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetExtract(pep,extr,ierr))
127
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
128 6 write(*,150) extr
129 endif
130 150 format (' Extraction before changing = ',I2)
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetExtract(pep,PEP_EXTRACT_STRUCTURED,ierr))
132
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetExtract(pep,extr,ierr))
133
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
134 6 write(*,160) extr
135 endif
136 160 format (' ... changed to ',I2)
137
138 6 alpha = .1
139 6 its = 5
140 6 lambda = 1.
141 6 scal = PEP_SCALE_SCALAR
142
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetScale(pep,scal,alpha,PETSC_NULL_VEC,PETSC_NULL_VEC,its,lambda,ierr))
143
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetScale(pep,scal,alpha,PETSC_NULL_VEC,PETSC_NULL_VEC,its,lambda,ierr))
144
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
145 6 write(*,170) scal,alpha,its
146 endif
147 170 format (' Scaling: ',I2,', alpha=',F7.4,', its=',I2)
148
149 6 basis = PEP_BASIS_CHEBYSHEV1
150
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetBasis(pep,basis,ierr))
151
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetBasis(pep,basis,ierr))
152
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
153 6 write(*,180) basis
154 endif
155 180 format (' Polynomial basis: ',I2)
156
157 6 np = 1
158 6 tol = 1e-9
159 6 its = 2
160 6 refine = PEP_REFINE_SIMPLE
161 6 rscheme = PEP_REFINE_SCHEME_SCHUR
162
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetRefine(pep,refine,np,tol,its,rscheme,ierr))
163
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetRefine(pep,refine,np,tol,its,rscheme,ierr))
164
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
165 6 write(*,190) refine,tol,its,rscheme
166 endif
167 190 format (' Refinement: ',I2,', tol=',F7.4,', its=',I2,', schem=',I2)
168
169 6 tget = 4.8
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetTarget(pep,tget,ierr))
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetTarget(pep,tget,ierr))
172
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetWhichEigenpairs(pep,PEP_TARGET_MAGNITUDE,ierr))
173
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetWhichEigenpairs(pep,which,ierr))
174
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
175 6 write(*,200) which,PetscRealPart(tget)
176 endif
177 200 format (' Which = ',I2,', target = ',F4.1)
178
179 6 nev = 4
180
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetDimensions(pep,nev,PETSC_DETERMINE_INTEGER,PETSC_DETERMINE_INTEGER,ierr))
181
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetDimensions(pep,nev,ncv,mpd,ierr))
182
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
183 6 write(*,210) nev,ncv,mpd
184 endif
185 210 format (' Dimensions: nev=',I2,', ncv=',I2,', mpd=',I2)
186
187 6 tol = 2.2e-4
188 6 its = 200
189
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetTolerances(pep,tol,its,ierr))
190
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetTolerances(pep,tol,its,ierr))
191
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
192 6 write(*,220) tol,its
193 endif
194 220 format (' Tolerance =',F8.5,', max_its =',I4)
195
196
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetConvergenceTest(pep,PEP_CONV_ABS,ierr))
197
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetConvergenceTest(pep,conv,ierr))
198
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetStoppingTest(pep,PEP_STOP_BASIC,ierr))
199
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetStoppingTest(pep,stp,ierr))
200
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
201 6 write(*,230) conv,stp
202 endif
203 230 format (' Convergence test =',I2,', stopping test =',I2)
204
205
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,vf,ierr))
206
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPMonitorSet(pep,PEPMONITORFIRST,vf,PetscViewerAndFormatDestroy,ierr))
207
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPMonitorConvergedCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,PETSC_NULL_VEC,vf,ierr))
208
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPMonitorSet(pep,PEPMONITORCONVERGED,vf,PEPMonitorConvergedDestroy,ierr))
209
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPMonitorCancel(pep,ierr))
210
211
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetST(pep,st,ierr))
212
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STGetKSP(st,ksp,ierr))
213 6 tol = 1.e-8
214 6 tolabs = 1.e-35
215
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(KSPSetTolerances(ksp,tol,tolabs,PETSC_CURRENT_REAL,PETSC_CURRENT_INTEGER,ierr))
216
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STView(st,PETSC_NULL_VIEWER,ierr))
217
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetDS(pep,ds,ierr))
218
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(DSView(ds,PETSC_NULL_VIEWER,ierr))
219
220
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSetFromOptions(pep,ierr))
221
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPSolve(pep,ierr))
222
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPGetConvergedReason(pep,reason,ierr))
223
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
224 6 write(*,240) reason
225 endif
226 240 format (' Finished - converged reason =',I2)
227
228 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
229 ! Display solution and clean up
230 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
231
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPErrorView(pep,PEP_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
232
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PEPDestroy(pep,ierr))
233
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(1),ierr))
234
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(2),ierr))
235
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A(3),ierr))
236
237
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
238 1 end
239
240 !/*TEST
241 !
242 ! test:
243 ! suffix: 1
244 ! args: -pep_tol 1e-6 -pep_ncv 22
245 ! filter: sed -e "s/[+-]0\.0*i//g"
246 !
247 !TEST*/
248