GCC Code Coverage Report

Directory: ./
File: src/svd/tutorials/ex15f.F90
Date: 2025-12-10 04:20:18
Exec Total Coverage
Lines: 59 59 100.0%
Functions: 2 2 100.0%
Branches: 46 84 54.8%
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> ./ex15f [-help] [-n <n>] [-mu <mu>] [all SLEPc options]
11 !
12 ! Description: Singular value decomposition of the Lauchli matrix.
13 !
14 ! The command line options are:
15 ! -n <n>, where <n> = matrix dimension.
16 ! -mu <mu>, where <mu> = subdiagonal value.
17 !
18 ! ----------------------------------------------------------------------
19 !
20 #include <slepc/finclude/slepcsvd.h>
21 8 program ex15f
22 6 use slepcsvd
23 implicit none
24
25 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
26 ! Declarations
27 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
28
29 Mat :: A ! operator matrix
30 SVD :: svd ! singular value solver context
31 SVDType :: tname
32 PetscReal :: tol, error, sigma, mu
33 PetscInt :: n, i, j, Istart, Iend
34 PetscInt :: nsv, maxit, its, nconv
35 PetscMPIInt :: rank
36 PetscErrorCode :: ierr
37 PetscBool :: flg
38 PetscScalar :: one, alpha
39
40 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
41 ! Beginning of program
42 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
43
44
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
45
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
46 6 n = 100
47
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
48 6 mu = PETSC_SQRT_MACHINE_EPSILON
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscOptionsGetReal(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-mu', mu, flg, ierr))
50
51
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
52 6 write (*, '(/a,i3,a,e12.4,a)') 'Lauchli SVD, n =', n, ', mu=', mu, ' (Fortran)'
53 end if
54
55 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
56 ! Build the Lauchli matrix
57 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
58
59
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
60
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, n + 1, n, ierr))
61
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A, ierr))
62
63
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
64 6 one = 1.0
65
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 612 do i = Istart, Iend - 1
66
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 612 if (i == 0) then
67
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 606 do j = 0, n - 1
68
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 606 PetscCallA(MatSetValue(A, i, j, one, INSERT_VALUES, ierr))
69 end do
70 else
71 600 alpha = mu
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 600 PetscCallA(MatSetValue(A, i, i - 1, alpha, INSERT_VALUES, ierr))
73 end if
74 end do
75
76
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
78
79 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
80 ! Create the singular value solver and display info
81 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
82
83 ! ** Create singular value solver context
84
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDCreate(PETSC_COMM_WORLD, svd, ierr))
85
86 ! ** Set operators and problem type
87
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDSetOperators(svd, A, PETSC_NULL_MAT, ierr))
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDSetProblemType(svd, SVD_STANDARD, ierr))
89
90 ! ** Use thick-restart Lanczos as default solver
91
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDSetType(svd, SVDTRLANCZOS, ierr))
92
93 ! ** Set solver parameters at runtime
94
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDSetFromOptions(svd, ierr))
95
96 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
97 ! Solve the singular value system
98 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99
100
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDSolve(svd, ierr))
101
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDGetIterationNumber(svd, its, ierr))
102
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
103 6 write (*, '(/a,i4)') ' Number of iterations of the method:', its
104 end if
105
106 ! ** Optional: Get some information from the solver and display it
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDGetType(svd, tname, ierr))
108
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
109 6 write (*, '(a,a)') ' Solution method: ', tname
110 end if
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDGetDimensions(svd, nsv, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, ierr))
112
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
113 6 write (*, '(a,i2)') ' Number of requested singular values:', nsv
114 end if
115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDGetTolerances(svd, tol, maxit, ierr))
116
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
117 6 write (*, '(a,1pe11.4,a,i4)') ' Stopping condition: tol=', tol, ', maxit=', maxit
118 end if
119
120 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
121 ! Display solution and clean up
122 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123
124 ! ** Get number of converged singular triplets
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDGetConverged(svd, nconv, ierr))
126
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
127 6 write (*, '(a,i2/)') ' Number of converged approximate singular triplets:', nconv
128 end if
129
130 ! ** Display singular values and relative errors
131
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (nconv > 0) then
132
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
133 6 write (*, *) ' sigma relative error'
134 6 write (*, *) ' ----------------- ------------------'
135 end if
136
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 66 do i = 0, nconv - 1
137 ! ** Get i-th singular value
138
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 60 PetscCallA(SVDGetSingularTriplet(svd, i, sigma, PETSC_NULL_VEC, PETSC_NULL_VEC, ierr))
139
140 ! ** Compute the relative error for each singular triplet
141
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 60 PetscCallA(SVDComputeError(svd, i, SVD_ERROR_RELATIVE, error, ierr))
142
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 66 if (rank == 0) then
143 60 write (*, '(1p,a,e12.4,a,e12.4)') ' ', sigma, ' ', error
144 end if
145
146 end do
147
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
148 6 write (*, *)
149 end if
150 end if
151
152 ! ** Free work space
153
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SVDDestroy(svd, ierr))
154
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A, ierr))
155
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
157 1 end program ex15f
158
159 !/*TEST
160 !
161 ! test:
162 ! suffix: 1
163 ! filter: sed -e "s/[0-9]\.[0-9]*E[+-]\([0-9]*\)/removed/g"
164 !
165 !TEST*/
166