GCC Code Coverage Report

Directory: ./
File: src/eps/tests/test14f.F90
Date: 2025-11-19 04:19:03
Exec Total Coverage
Lines: 100 102 98.0%
Functions: 2 2 100.0%
Branches: 75 152 49.3%
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 EPS Fortran interface.
11 !
12 ! ----------------------------------------------------------------------
13 !
14 #include <slepc/finclude/slepceps.h>
15 8 program test14f
16 6 use slepceps
17 implicit none
18
19 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
20 ! Declarations
21 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
22 Mat :: A, B
23 EPS :: eps
24 ST :: st
25 KSP :: ksp
26 DS :: ds
27 PetscReal :: cut, tol, tolabs
28 PetscScalar :: tget, val
29 PetscInt :: n, i, its, Istart, Iend
30 PetscInt :: nev, ncv, mpd
31 PetscBool :: flg
32 EPSConvergedReason :: reason
33 EPSType :: tname
34 EPSExtraction :: extr
35 EPSBalance :: bal
36 EPSWhich :: which
37 EPSConv :: conv
38 EPSStop :: stp
39 EPSProblemType :: ptype
40 PetscMPIInt :: rank
41 PetscErrorCode :: ierr
42 PetscViewerAndFormat :: vf
43
44 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 ! Beginning of program
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
50 6 n = 20
51
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
52 6 write (*, '(/a,i3,a)') 'Diagonal Eigenproblem, n =', n, ' (Fortran)'
53 end if
54
55
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
56
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, n, n, ierr))
57
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A, ierr))
58
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
59
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 126 do i = Istart, Iend - 1
60 120 val = i + 1
61
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 126 PetscCallA(MatSetValue(A, i, i, val, INSERT_VALUES, ierr))
62 end do
63
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
65
66 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
67 ! Create eigensolver and test interface functions
68 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
69
70
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSCreate(PETSC_COMM_WORLD, eps, ierr))
71
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetOperators(eps, A, PETSC_NULL_MAT, ierr))
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetOperators(eps, B, PETSC_NULL_MAT, ierr))
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatView(B, PETSC_NULL_VIEWER, ierr))
74
75
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetType(eps, EPSKRYLOVSCHUR, ierr))
76
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetType(eps, tname, ierr))
77
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
78 6 write (*, '(a,a)') ' Type set to ', tname
79 end if
80
81
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetProblemType(eps, ptype, ierr))
82
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
83 6 write (*, '(a,i2)') ' Problem type before changing = ', ptype
84 end if
85
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetProblemType(eps, EPS_HEP, ierr))
86
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetProblemType(eps, ptype, ierr))
87
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
88 6 write (*, '(a,i2)') ' ... changed to ', ptype
89 end if
90
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsGeneralized(eps, flg, ierr))
91
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 6 if (flg .and. rank == 0) then
92 ✗ write (*, *) 'generalized'
93 end if
94
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsHermitian(eps, flg, ierr))
95
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
 6 if (flg .and. rank == 0) then
96 6 write (*, *) 'hermitian'
97 end if
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsPositive(eps, flg, ierr))
99
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 6 if (flg .and. rank == 0) then
100 ✗ write (*, *) 'positive'
101 end if
102
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetExtraction(eps, extr, ierr))
104
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
105 6 write (*, '(a,i2)') ' Extraction before changing = ', extr
106 end if
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetExtraction(eps, EPS_HARMONIC, ierr))
108
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetExtraction(eps, extr, ierr))
109
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
110 6 write (*, '(a,i2)') ' ... changed to ', extr
111 end if
112
113 6 its = 8
114 6 cut = 2.0e-6
115 6 bal = EPS_BALANCE_ONESIDE
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetBalance(eps, bal, its, cut, ierr))
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetBalance(eps, bal, its, cut, ierr))
118
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
119 6 write (*, '(a,i2,a,i2,a,f9.6)') ' Balance: ', bal, ', its=', its, ', cutoff=', cut
120 end if
121
122 6 tget = 4.8
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetTarget(eps, tget, ierr))
124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetTarget(eps, tget, ierr))
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetWhichEigenpairs(eps, EPS_TARGET_MAGNITUDE, ierr))
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetWhichEigenpairs(eps, which, ierr))
127
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
128 6 write (*, '(a,i2,a,f4.1)') ' Which = ', which, ', target = ', PetscRealPart(tget)
129 end if
130
131 6 nev = 4
132
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetDimensions(eps, nev, PETSC_DETERMINE_INTEGER, PETSC_DETERMINE_INTEGER, ierr))
133
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetDimensions(eps, nev, ncv, mpd, ierr))
134
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
135 6 write (*, '(a,i2,a,i2,a,i2)') ' Dimensions: nev=', nev, ', ncv=', ncv, ', mpd=', mpd
136 end if
137
138 6 tol = 2.2e-4
139 6 its = 200
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetTolerances(eps, tol, its, ierr))
141
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetTolerances(eps, tol, its, ierr))
142
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
143 6 write (*, '(a,f8.5,a,i4)') ' Tolerance =', tol, ', max_its =', its
144 end if
145
146
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetConvergenceTest(eps, EPS_CONV_ABS, ierr))
147
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetConvergenceTest(eps, conv, ierr))
148
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetStoppingTest(eps, EPS_STOP_BASIC, ierr))
149
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetStoppingTest(eps, stp, ierr))
150
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
151 6 write (*, '(a,i2,a,i2)') ' Convergence test =', conv, ', stopping test =', stp
152 end if
153
154
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_DEFAULT, vf, ierr))
155
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorSet(eps, EPSMONITORFIRST, vf, PetscViewerAndFormatDestroy, ierr))
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorConvergedCreate(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_DEFAULT, PETSC_NULL_VEC, vf, ierr))
157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorSet(eps, EPSMONITORCONVERGED, vf, EPSMonitorConvergedDestroy, ierr))
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorCancel(eps, ierr))
159
160
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetST(eps, st, ierr))
161
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STGetKSP(st, ksp, ierr))
162 6 tol = 1.e-8
163 6 tolabs = 1.e-35
164
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(KSPSetTolerances(ksp, tol, tolabs, PETSC_CURRENT_REAL, PETSC_CURRENT_INTEGER, ierr))
165
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STView(st, PETSC_NULL_VIEWER, ierr))
166
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetDS(eps, ds, ierr))
167
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(DSView(ds, PETSC_NULL_VIEWER, ierr))
168
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetFromOptions(eps, ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSolve(eps, ierr))
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetConvergedReason(eps, reason, ierr))
172
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetIterationNumber(eps, its, ierr))
173
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
174 6 write (*, '(a,i2,a,i4)') ' Finished - converged reason =', reason, ', its = ', its
175 end if
176
177 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
178 ! Display solution and clean up
179 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
180
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSErrorView(eps, EPS_ERROR_RELATIVE, PETSC_NULL_VIEWER, ierr))
181
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSDestroy(eps, ierr))
182
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A, ierr))
183
184
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
185 1 end program test14f
186
187 !/*TEST
188 !
189 ! test:
190 ! suffix: 1
191 ! args: -eps_ncv 14
192 ! filter: sed -e "s/00001/00000/" | sed -e "s/4.99999/5.00000/" | sed -e "s/5.99999/6.00000/"
193 !
194 !TEST*/
195