GCC Code Coverage Report

Directory: ./
File: src/svd/tests/test4f.F90
Date: 2025-10-04 04:19:13
Exec Total Coverage
Lines: 66 69 95.7%
Functions: 2 2 100.0%
Branches: 52 104 50.0%
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> ./test4f [-help] [-n <n>] [-m <m>] [all SLEPc options]
11 !
12 ! Description: Singular value decomposition of a bidiagonal matrix.
13 !
14 ! | 1 2 |
15 ! | 1 2 |
16 ! | 1 2 |
17 ! A = | . . |
18 ! | . . |
19 ! | 1 2 |
20 ! | 1 2 |
21 !
22 ! The command line options are:
23 ! -m <m>, where <m> = matrix rows.
24 ! -n <n>, where <n> = matrix columns (defaults to m+2).
25 !
26 ! ----------------------------------------------------------------------
27 !
28 40 program main
29 #include <slepc/finclude/slepcsvd.h>
30 30 use slepcsvd
31 implicit none
32
33 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
34 ! Declarations
35 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
36 !
37 Mat A, B
38 SVD svd
39 SVDConv conv
40 SVDStop stp
41 SVDWhich which
42 SVDConvergedReason reason
43 PetscInt m, n, i, Istart
44 PetscInt col(2), its, Iend
45 PetscScalar val(2)
46 SVDProblemType ptype
47 PetscMPIInt rank
48 PetscErrorCode ierr
49 PetscBool flg, tmode
50 PetscViewerAndFormat vf
51
52 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
53 ! Beginning of program
54 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
55
56
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
57
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
58 30 m = 20
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-m',m,flg,ierr))
60
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
61
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (.not. flg) n = m+2
62
63
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
64 30 write(*,100) m, n
65 endif
66 100 format (/'Bidiagonal matrix, m =',I3,', n=',I3,' (Fortran)')
67
68 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
69 ! Build the Lauchli matrix
70 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
71
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m,n,ierr))
74
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatSetFromOptions(A,ierr))
75
76
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatGetOwnershipRange(A,Istart,Iend,ierr))
77 30 val(1) = 1.0
78 30 val(2) = 2.0
79
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 630 do i=Istart,Iend-1
80 600 col(1) = i
81 600 col(2) = i+1
82
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 600 if (i .le. n-1) then
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 600 PetscCallA(MatSetValue(A,i,col(1),val(1),INSERT_VALUES,ierr))
84 end if
85
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 630 if (i .lt. n-1) then
86
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 600 PetscCallA(MatSetValue(A,i,col(2),val(2),INSERT_VALUES,ierr))
87 end if
88 enddo
89
90
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
91
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))
92
93 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
94 ! Compute singular values
95 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
96
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDCreate(PETSC_COMM_WORLD,svd,ierr))
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDSetOperators(svd,A,PETSC_NULL_MAT,ierr))
99
100 ! ** test some interface functions
101
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetOperators(svd,B,PETSC_NULL_MAT,ierr))
102
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatView(B,PETSC_VIEWER_STDOUT_WORLD,ierr))
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDSetConvergenceTest(svd,SVD_CONV_ABS,ierr))
104
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDSetStoppingTest(svd,SVD_STOP_BASIC,ierr))
105
106 ! ** query properties and print them
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetProblemType(svd,ptype,ierr))
108
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
109 30 write(*,105) ptype
110 endif
111 105 format (/' Problem type = ',I2)
112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDIsGeneralized(svd,flg,ierr))
113
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 30 if (flg .and. rank .eq. 0) then
114 ✗ write(*,*) 'generalized'
115 endif
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetImplicitTranspose(svd,tmode,ierr))
117
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
118
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 if (tmode) then
119 ✗ write(*,110) 'implicit'
120 else
121 30 write(*,110) 'explicit'
122 endif
123 endif
124 110 format (' Transpose mode is',A9)
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetConvergenceTest(svd,conv,ierr))
126
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
127 30 write(*,120) conv
128 endif
129 120 format (' Convergence test is',I2)
130
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetStoppingTest(svd,stp,ierr))
131
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
132 30 write(*,130) stp
133 endif
134 130 format (' Stopping test is',I2)
135
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetWhichSingularTriplets(svd,which,ierr))
136
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
137
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (which .eq. SVD_LARGEST) then
138 30 write(*,140) 'largest'
139 else
140 ✗ write(*,140) 'smallest'
141 endif
142 endif
143 140 format (' Which =',A9)
144
145
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(PetscViewerAndFormatCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,vf,ierr))
146
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDMonitorSet(svd,SVDMONITORFIRST,vf,PetscViewerAndFormatDestroy,ierr))
147
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDMonitorConvergedCreate(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_DEFAULT,PETSC_NULL_VEC,vf,ierr))
148
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDMonitorSet(svd,SVDMONITORCONVERGED,vf,SVDMonitorConvergedDestroy,ierr))
149
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDMonitorCancel(svd,ierr))
150
151 ! ** call the solver
152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDSetFromOptions(svd,ierr))
153
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDSolve(svd,ierr))
154
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetConvergedReason(svd,reason,ierr))
155
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 30 if (rank .eq. 0) then
156 30 write(*,150) reason
157 endif
158 150 format (' Converged reason:',I2)
159
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDGetIterationNumber(svd,its,ierr))
160 ! if (rank .eq. 0) then
161 ! write(*,160) its
162 ! endif
163 !160 format (' Number of iterations of the method:',I4)
164
165 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
166 ! Display solution and clean up
167 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
168
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDErrorView(svd,SVD_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(SVDDestroy(svd,ierr))
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 30 PetscCallA(MatDestroy(A,ierr))
172
173
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 30 PetscCallA(SlepcFinalize(ierr))
174 5 end
175
176 !/*TEST
177 !
178 ! test:
179 ! suffix: 1
180 ! args: -svd_type {{lanczos trlanczos cross cyclic randomized}}
181 ! filter: sed -e 's/2.99255/2.99254/'
182 !
183 !TEST*/
184