GCC Code Coverage Report

Directory: ./
File: src/eps/tests/test14f.F90
Date: 2025-10-04 04:19:13
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 8 program main
15 #include <slepc/finclude/slepceps.h>
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,value
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 .eq. 0) then
52 6 write(*,100) n
53 endif
54 100 format (/'Diagonal Eigenproblem, n =',I3,' (Fortran)')
55
56
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
57
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
58
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A,ierr))
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr))
60
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 126 do i=Istart,Iend-1
61 120 value = i+1
62
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 126 PetscCallA(MatSetValue(A,i,i,value,INSERT_VALUES,ierr))
63 enddo
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))
66
67 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
68 ! Create eigensolver and test interface functions
69 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
70
71
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr))
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr))
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetOperators(eps,B,PETSC_NULL_MAT,ierr))
74
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatView(B,PETSC_NULL_VIEWER,ierr))
75
76
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetType(eps,EPSKRYLOVSCHUR,ierr))
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetType(eps,tname,ierr))
78
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
79 6 write(*,110) tname
80 endif
81 110 format (' Type set to ',A)
82
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetProblemType(eps,ptype,ierr))
84
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
85 6 write(*,120) ptype
86 endif
87 120 format (' Problem type before changing = ',I2)
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetProblemType(eps,EPS_HEP,ierr))
89
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetProblemType(eps,ptype,ierr))
90
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
91 6 write(*,130) ptype
92 endif
93 130 format (' ... changed to ',I2)
94
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsGeneralized(eps,flg,ierr))
95
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 6 if (flg .and. rank .eq. 0) then
96 ✗ write(*,*) 'generalized'
97 endif
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsHermitian(eps,flg,ierr))
99
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 .eq. 0) then
100 6 write(*,*) 'hermitian'
101 endif
102
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSIsPositive(eps,flg,ierr))
103
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 6 if (flg .and. rank .eq. 0) then
104 ✗ write(*,*) 'positive'
105 endif
106
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetExtraction(eps,extr,ierr))
108
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
109 6 write(*,140) extr
110 endif
111 140 format (' Extraction before changing = ',I2)
112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetExtraction(eps,EPS_HARMONIC,ierr))
113
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetExtraction(eps,extr,ierr))
114
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
115 6 write(*,150) extr
116 endif
117 150 format (' ... changed to ',I2)
118
119 6 its = 8
120 6 cut = 2.0e-6
121 6 bal = EPS_BALANCE_ONESIDE
122
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetBalance(eps,bal,its,cut,ierr))
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetBalance(eps,bal,its,cut,ierr))
124
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
125 6 write(*,160) bal,its,cut
126 endif
127 160 format (' Balance: ',I2,', its=',I2,', cutoff=',F9.6)
128
129 6 tget = 4.8
130
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetTarget(eps,tget,ierr))
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetTarget(eps,tget,ierr))
132
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetWhichEigenpairs(eps,EPS_TARGET_MAGNITUDE,ierr))
133
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetWhichEigenpairs(eps,which,ierr))
134
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
135 6 write(*,170) which,PetscRealPart(tget)
136 endif
137 170 format (' Which = ',I2,', target = ',F4.1)
138
139 6 nev = 4
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetDimensions(eps,nev,PETSC_DETERMINE_INTEGER,PETSC_DETERMINE_INTEGER,ierr))
141
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetDimensions(eps,nev,ncv,mpd,ierr))
142
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
143 6 write(*,180) nev,ncv,mpd
144 endif
145 180 format (' Dimensions: nev=',I2,', ncv=',I2,', mpd=',I2)
146
147 6 tol = 2.2e-4
148 6 its = 200
149
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetTolerances(eps,tol,its,ierr))
150
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetTolerances(eps,tol,its,ierr))
151
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
152 6 write(*,190) tol,its
153 endif
154 190 format (' Tolerance =',F8.5,', max_its =',I4)
155
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetConvergenceTest(eps,EPS_CONV_ABS,ierr))
157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetConvergenceTest(eps,conv,ierr))
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetStoppingTest(eps,EPS_STOP_BASIC,ierr))
159
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetStoppingTest(eps,stp,ierr))
160
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
161 6 write(*,200) conv,stp
162 endif
163 200 format (' Convergence test =',I2,', stopping test =',I2)
164
165
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,vf,ierr))
166
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorSet(eps,EPSMONITORFIRST,vf,PetscViewerAndFormatDestroy,ierr))
167
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))
168
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorSet(eps,EPSMONITORCONVERGED,vf,EPSMonitorConvergedDestroy,ierr))
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSMonitorCancel(eps,ierr))
170
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetST(eps,st,ierr))
172
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STGetKSP(st,ksp,ierr))
173 6 tol = 1.e-8
174 6 tolabs = 1.e-35
175
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(KSPSetTolerances(ksp,tol,tolabs,PETSC_CURRENT_REAL,PETSC_CURRENT_INTEGER,ierr))
176
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(STView(st,PETSC_NULL_VIEWER,ierr))
177
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetDS(eps,ds,ierr))
178
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(DSView(ds,PETSC_NULL_VIEWER,ierr))
179
180
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSetFromOptions(eps,ierr))
181
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSSolve(eps,ierr))
182
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetConvergedReason(eps,reason,ierr))
183
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSGetIterationNumber(eps,its,ierr))
184
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank .eq. 0) then
185 6 write(*,210) reason,its
186 endif
187 210 format (' Finished - converged reason =',I2,', its=',I4)
188
189 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
190 ! Display solution and clean up
191 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
192
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
193
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(EPSDestroy(eps,ierr))
194
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A,ierr))
195
196
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
197 1 end
198
199 !/*TEST
200 !
201 ! test:
202 ! suffix: 1
203 ! args: -eps_ncv 14
204 ! filter: sed -e "s/00001/00000/" | sed -e "s/4.99999/5.00000/" | sed -e "s/5.99999/6.00000/"
205 !
206 !TEST*/
207