GCC Code Coverage Report

Directory: ./
File: src/eps/tests/test17f.F90
Date: 2025-10-04 04:19:13
Exec Total Coverage
Lines: 165 167 98.8%
Functions: 2 2 100.0%
Branches: 131 214 61.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: Test Fortran interface of spectrum-slicing Krylov-Schur.
11 !
12 ! ----------------------------------------------------------------------
13 !
14 20 program main
15 #include <slepc/finclude/slepceps.h>
16 12 use slepceps
17 implicit none
18
19 #define MAXSUB 16
20 #define MAXSHI 16
21
22 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
23 ! Declarations
24 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
25 Mat A,B,As,Bs,Au
26 EPS eps
27 ST st
28 KSP ksp
29 PC pc
30 Vec v
31 PetscScalar value
32 PetscInt n,m,i,j,k,Istart,Iend
33 PetscInt nev,ncv,mpd,nval
34 PetscInt row,col,nloc,nlocs,mlocs
35 PetscInt II,npart,inertias(MAXSHI)
36 PetscBool flg,lock
37 PetscMPIInt nprc,rank
38 PetscReal int0,int1,keep,subint(MAXSUB)
39 PetscReal shifts(MAXSHI)
40 PetscScalar eval,one,mone,zero
41 PetscErrorCode ierr
42 MPI_Comm comm
43
44 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 ! Beginning of program
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 if (ierr .ne. 0) then
50 ✗ print*,'SlepcInitialize failed'
51 ✗ stop
52 endif
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD,nprc,ierr))
54
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
55 12 n = 35
56
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
57 12 m = n*n
58
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
59 6 write(*,100) n
60 endif
61 100 format (/'Spectrum-slicing test, n =',I3,' (Fortran)'/)
62
63
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m,m,ierr))
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetFromOptions(A,ierr))
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatCreate(PETSC_COMM_WORLD,B,ierr))
67
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,m,m,ierr))
68
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetFromOptions(B,ierr))
69
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr))
70
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 7362 do II=Istart,Iend-1
71 7350 i = II/n
72 7350 j = II-i*n
73 7350 value = -1.0
74 7350 row = II
75
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 7350 if (i>0) then
76 7140 col = II-n
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7140 PetscCallA(MatSetValue(A,row,col,value,INSERT_VALUES,ierr))
78 endif
79
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 7350 if (i<n-1) then
80 7140 col = II+n
81
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7140 PetscCallA(MatSetValue(A,row,col,value,INSERT_VALUES,ierr))
82 endif
83
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 7350 if (j>0) then
84 7140 col = II-1
85
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7140 PetscCallA(MatSetValue(A,row,col,value,INSERT_VALUES,ierr))
86 endif
87
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 7350 if (j<n-1) then
88 7140 col = II+1
89
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7140 PetscCallA(MatSetValue(A,row,col,value,INSERT_VALUES,ierr))
90 endif
91 7350 col = II
92 7350 value = 4.0
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7350 PetscCallA(MatSetValue(A,row,col,value,INSERT_VALUES,ierr))
94 7350 value = 2.0
95
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 7362 PetscCallA(MatSetValue(B,row,col,value,INSERT_VALUES,ierr))
96 enddo
97
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (Istart .eq. 0) then
98 6 row = 0
99 6 col = 0
100 6 value = 6.0
101
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetValue(B,row,col,value,INSERT_VALUES,ierr))
102 6 row = 0
103 6 col = 1
104 6 value = -1.0
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetValue(B,row,col,value,INSERT_VALUES,ierr))
106 6 row = 1
107 6 col = 0
108 6 value = -1.0
109
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetValue(B,row,col,value,INSERT_VALUES,ierr))
110 6 row = 1
111 6 col = 1
112 6 value = 1.0
113
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetValue(B,row,col,value,INSERT_VALUES,ierr))
114 endif
115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY,ierr))
118
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY,ierr))
119
120 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
121 ! Create eigensolver and set various options
122 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123
124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr))
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetOperators(eps,A,B,ierr))
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetProblemType(eps,EPS_GHEP,ierr))
127
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetType(eps,EPSKRYLOVSCHUR,ierr))
128
129 ! Set interval and other settings for spectrum slicing
130
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetWhichEigenpairs(eps,EPS_ALL,ierr))
132 12 int0 = 1.1
133 12 int1 = 1.3
134
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetInterval(eps,int0,int1,ierr))
135
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSGetST(eps,st,ierr))
136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(STSetType(st,STSINVERT,ierr))
137
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 12 if (nprc>0) then
138 12 npart = nprc
139
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurSetPartitions(eps,npart,ierr))
140 endif
141
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetKSP(eps,ksp,ierr))
142
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(KSPGetPC(ksp,pc,ierr))
143
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(KSPSetType(ksp,KSPPREONLY,ierr))
144
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(PCSetType(pc,PCCHOLESKY,ierr))
145
146 ! Test interface functions of Krylov-Schur solver
147
148
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetRestart(eps,keep,ierr))
149
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
150 6 write(*,110) keep
151 endif
152 110 format (' Restart parameter before changing = ',f7.4)
153 12 keep = 0.4
154
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurSetRestart(eps,keep,ierr))
155
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetRestart(eps,keep,ierr))
156
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
157 6 write(*,120) keep
158 endif
159 120 format (' ... changed to ',f7.4)
160
161
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetLocking(eps,lock,ierr))
162
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
163 6 write(*,130) lock
164 endif
165 130 format (' Locking flag before changing = ',L4)
166
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurSetLocking(eps,PETSC_FALSE,ierr))
167
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetLocking(eps,lock,ierr))
168
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
169 6 write(*,140) lock
170 endif
171 140 format (' ... changed to ',L4)
172
173
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetDimensions(eps,nev,ncv,mpd,ierr))
174
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
175 6 write(*,150) nev,ncv,mpd
176 endif
177 150 format (' Sub-solve dimensions before changing: nev=',I2,', ncv=',I2,', mpd=',I2)
178 12 nev = 30
179 12 ncv = 60
180 12 mpd = 60
181
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurSetDimensions(eps,nev,ncv,mpd,ierr))
182
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetDimensions(eps,nev,ncv,mpd,ierr))
183
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
184 6 write(*,160) nev,ncv,mpd
185 endif
186 160 format (' ... changed to: nev=',I2,', ncv=',I2,', mpd=',I2)
187
188
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 12 if (nprc>0) then
189
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetPartitions(eps,npart,ierr))
190
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
191 6 write(*,170) npart
192 endif
193 170 format (' Using ',I2,' partitions')
194
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 if (npart>MAXSUB) then; SETERRA(PETSC_COMM_SELF,1,'Too many subintervals'); endif
195
196 12 subint(1) = int0
197 12 subint(npart+1) = int1
198
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 24 do i=2,npart
199 24 subint(i) = int0+(i-1)*(int1-int0)/npart
200 enddo
201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurSetSubintervals(eps,subint,ierr))
202
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetSubintervals(eps,subint,ierr))
203
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
204 6 write(*,*) 'Using sub-interval separations ='
205
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 do i=2,npart
206 12 write(*,180) subint(i)
207 enddo
208 endif
209 180 format (f7.4)
210 endif
211
212
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetFromOptions(eps,ierr))
213
214 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
215 ! Compute all eigenvalues in interval and display info
216 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
217
218
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSetUp(eps,ierr))
219
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetInertias(eps,k,PETSC_NULL_REAL_ARRAY,PETSC_NULL_INTEGER_ARRAY,ierr))
220
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 if (k>MAXSHI) then; SETERRA(PETSC_COMM_SELF,1,'Too many shifts'); endif
221
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetInertias(eps,k,shifts,inertias,ierr))
222
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
223 6 write(*,*) 'Inertias after EPSSetUp:'
224
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 24 do i=1,k
225 24 write(*,185) shifts(i),inertias(i)
226 enddo
227 endif
228 185 format (' .. ',f4.1,' (',I3,')')
229
230
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSSolve(eps,ierr))
231
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSGetDimensions(eps,nev,ncv,mpd,ierr))
232
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSGetInterval(eps,int0,int1,ierr))
233
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
234 6 write(*,190) nev,int0,int1
235 endif
236 190 format (' Found ',I2,' eigenvalues in interval [',f7.4,',',f7.4,']')
237
238
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 12 if (nprc>0) then
239
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetSubcommInfo(eps,k,nval,v,ierr))
240
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
241 6 write(*,200) rank,k,nval
242
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 174 do i=0,nval-1
243
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 168 PetscCallA(EPSKrylovSchurGetSubcommPairs(eps,i,eval,v,ierr))
244 174 write(*,210) PetscRealPart(eval)
245 enddo
246 endif
247 200 format (' Process ',I2,' has worked in sub-interval ',I2,', containing ',I2,' eigenvalues')
248 210 format (f7.4)
249
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(VecDestroy(v,ierr))
250
251
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurGetSubcommMats(eps,As,Bs,ierr))
252
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatGetLocalSize(A,nloc,PETSC_NULL_INTEGER,ierr))
253
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatGetLocalSize(As,nlocs,mlocs,ierr))
254
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 12 if (rank .eq. 0) then
255 6 write(*,220) rank,nloc,nlocs
256 endif
257 220 format (' Process ',I2,' owns ',I5,', rows of the global',' matrices, and ',I5,' rows in the subcommunicator')
258
259 ! modify A on subcommunicators
260
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(PetscObjectGetComm(As,comm,ierr))
261
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatCreate(comm,Au,ierr))
262
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetSizes(Au,nlocs,mlocs,m,m,ierr))
263
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatSetFromOptions(Au,ierr))
264
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatGetOwnershipRange(Au,Istart,Iend,ierr))
265
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 14712 do II=Istart,Iend-1
266 14700 value = 0.5
267
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 14712 PetscCallA(MatSetValue(Au,II,II,value,INSERT_VALUES,ierr))
268 end do
269
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyBegin(Au,MAT_FINAL_ASSEMBLY,ierr))
270
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatAssemblyEnd(Au,MAT_FINAL_ASSEMBLY,ierr))
271 12 one = 1.0
272 12 mone = -1.0
273 12 zero = 0.0
274
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSKrylovSchurUpdateSubcommMats(eps,one,mone,Au,zero,zero,PETSC_NULL_MAT,DIFFERENT_NONZERO_PATTERN,PETSC_TRUE,ierr))
275
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatDestroy(Au,ierr))
276 endif
277
278
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(EPSDestroy(eps,ierr))
279
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatDestroy(A,ierr))
280
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 12 PetscCallA(MatDestroy(B,ierr))
281
282
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 12 PetscCallA(SlepcFinalize(ierr))
283 2 end
284
285 !/*TEST
286 !
287 ! test:
288 ! suffix: 1
289 ! nsize: 2
290 !
291 !TEST*/
292