GCC Code Coverage Report

Directory: ./
File: src/sys/classes/bv/tests/test1f.F90
Date: 2025-10-04 04:19:13
Exec Total Coverage
Lines: 80 82 97.6%
Functions: 2 2 100.0%
Branches: 68 116 58.6%
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 ! Program usage: mpiexec -n <np> ./test1f [-help]
11 !
12 ! Description: Simple example that tests BV interface functions.
13 !
14 ! ----------------------------------------------------------------------
15 !
16 96 program main
17 #include <slepc/finclude/slepcbv.h>
18 72 use slepcbv
19 implicit none
20
21 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
22 ! Declarations
23 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
24
25 #define KMAX 35
26
27 Vec t,v
28 Mat Q,M
29 BV X,Y
30 PetscMPIInt rank
31 PetscInt i,j,n,k,l,izero,ione
32 PetscScalar z(KMAX),val
33 60 PetscScalar, pointer :: qq(:,:)
34 PetscScalar one,mone,two,zero
35 PetscReal nrm
36 PetscBool flg
37 PetscErrorCode ierr
38
39 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
40 ! Beginning of program
41 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42
43 72 n = 10
44 72 k = 5
45 72 l = 3
46 72 one = 1.0
47 72 mone = -1.0
48 72 two = 2.0
49 72 zero = 0.0
50 72 izero = 0
51 72 ione = 1
52
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 if (ierr .ne. 0) then
54 ✗ print*,'SlepcInitialize failed'
55 ✗ stop
56 endif
57
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
58
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-k',k,flg,ierr))
60
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-l',l,flg,ierr))
61
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 if (k .gt. KMAX) then; SETERRA(PETSC_COMM_SELF,1,'Program currently limited to k=35'); endif
62
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 72 if (rank .eq. 0) then
63 48 write(*,110) k,n
64 endif
65 110 format (/'Test BV with',I3,' columns of length',I3,' (Fortran)')
66
67 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
68 ! Initialize data
69 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
70
71 ! ** Create template vector
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(VecCreate(PETSC_COMM_WORLD,t,ierr))
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(VecSetSizes(t,PETSC_DECIDE,n,ierr))
74
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(VecSetFromOptions(t,ierr))
75
76 ! ** Create BV object X
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVCreate(PETSC_COMM_WORLD,X,ierr))
78
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVSetSizesFromVec(X,t,k,ierr))
79
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVSetFromOptions(X,ierr))
80
81 ! ** Fill X entries
82
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 432 do j=0,k-1
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 360 PetscCallA(BVGetColumn(X,j,v,ierr))
84
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 360 PetscCallA(VecSet(v,zero,ierr))
85
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 1800 do i=0,3
86
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 1800 if (i+j<n) then
87 1440 val = 3*i+j-2
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 1440 PetscCallA(VecSetValue(v,i+j,val,INSERT_VALUES,ierr))
89 end if
90 end do
91
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 360 PetscCallA(VecAssemblyBegin(v,ierr))
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 360 PetscCallA(VecAssemblyEnd(v,ierr))
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 432 PetscCallA(BVRestoreColumn(X,j,v,ierr))
94 end do
95
96 ! ** Create BV object Y
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVCreate(PETSC_COMM_WORLD,Y,ierr))
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVSetSizesFromVec(Y,t,l,ierr))
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVSetFromOptions(Y,ierr))
100
101 ! ** Fill Y entries
102
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 288 do j=0,l-1
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 216 PetscCallA(BVGetColumn(Y,j,v,ierr))
104 216 val = real(j+1)/4.0
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 216 PetscCallA(VecSet(v,val,ierr))
106
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 288 PetscCallA(BVRestoreColumn(Y,j,v,ierr))
107 end do
108
109 ! ** Create Mat
110
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatCreateSeqDense(PETSC_COMM_SELF,k,l,PETSC_NULL_SCALAR_ARRAY,Q,ierr))
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatDenseGetArray(Q,qq,ierr))
112
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 432 do i=1,k
113
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 1512 do j=1,l
114
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 1440 if (i<j) then
115 216 qq(i,j) = 2.0
116 else
117 864 qq(i,j) = -0.5
118 end if
119 end do
120 end do
121
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatDenseRestoreArray(Q,qq,ierr))
122
123 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
124 ! Test several operations
125 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
126
127 ! ** Test BVMult
128
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVMult(Y,two,one,X,Q,ierr))
129
130 ! ** Test BVMultVec
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVGetColumn(Y,izero,v,ierr))
132 72 z(1) = 2.0
133
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 360 do i=2,k
134 360 z(i) = -0.5*z(i-1)
135 end do
136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVMultVec(X,mone,one,v,z,ierr))
137
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVRestoreColumn(Y,izero,v,ierr))
138
139 ! ** Test BVDot
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatCreateSeqDense(PETSC_COMM_SELF,l,k,PETSC_NULL_SCALAR_ARRAY,M,ierr))
141
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVDot(X,Y,M,ierr))
142
143 ! ** Test BVDotVec
144
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVGetColumn(Y,izero,v,ierr))
145
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVDotVec(X,v,z,ierr))
146
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVRestoreColumn(Y,izero,v,ierr))
147
148 ! ** Test BVMultInPlace and BVScale
149
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVMultInPlace(X,Q,ione,l,ierr))
150
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVScale(X,two,ierr))
151
152 ! ** Test BVNorm
153
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVNormColumn(X,izero,NORM_2,nrm,ierr))
154
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 72 if (rank .eq. 0) then
155 48 write(*,120) nrm
156 endif
157 120 format ('2-Norm of X[0] = ',f8.4)
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVNorm(X,NORM_FROBENIUS,nrm,ierr))
159
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 72 if (rank .eq. 0) then
160 48 write(*,130) nrm
161 endif
162 130 format ('Frobenius Norm of X = ',f8.4)
163
164 ! *** Clean up
165
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVDestroy(X,ierr))
166
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(BVDestroy(Y,ierr))
167
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(VecDestroy(t,ierr))
168
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatDestroy(Q,ierr))
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 72 PetscCallA(MatDestroy(M,ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 72 PetscCallA(SlepcFinalize(ierr))
171 72 end
172
173 !/*TEST
174 !
175 ! test:
176 ! suffix: 1
177 ! nsize: 1
178 ! args: -bv_type {{vecs contiguous svec mat}separate output}
179 ! output_file: output/test1f_1.out
180 !
181 ! test:
182 ! suffix: 2
183 ! nsize: 2
184 ! args: -bv_type {{vecs contiguous svec mat}separate output}
185 ! output_file: output/test1f_1.out
186 !
187 !TEST*/
188