GCC Code Coverage Report

Directory: ./
File: src/mfn/tutorials/ex23f.F90
Date: 2026-02-22 03:58:10
Exec Total Coverage
Lines: 78 79 98.7%
Functions: 2 2 100.0%
Branches: 57 102 55.9%
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> ./ex23f [-help] [-t <t>] [-m <m>] [SLEPc opts]
11 !
12 ! Description: Computes exp(t*A)*v for a matrix from a Markov model.
13 ! This is the Fortran90 equivalent to ex23.c
14 !
15 ! The command line options are:
16 ! -t <t>, where <t> = time parameter (multiplies the matrix)
17 ! -m <m>, where <m> = number of grid subdivisions in each dimension
18 !
19 ! ----------------------------------------------------------------------
20 !
21 #include <slepc/finclude/slepcmfn.h>
22 112 program ex23f
23 5 use slepcmfn
24 implicit none
25
26 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
27 ! Declarations
28 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
29
30 Mat :: A ! problem matrix
31 MFN :: mfn ! matrix function solver context
32 FN :: f
33 PetscReal :: tol, norm, cst, pd, pu
34 PetscScalar :: t, z
35 Vec :: v, y
36 PetscInt :: N, m, ncv, maxit, its, ii, jj
37 PetscInt :: i, j, jmax, ix, Istart, Iend
38 PetscMPIInt :: rank
39 PetscErrorCode :: ierr
40 PetscBool :: flg
41 MFNConvergedReason :: reason
42 PetscScalar, parameter :: one = 1.0
43
44 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 ! Beginning of program
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
50 5 m = 15
51
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-m', m, flg, ierr))
52 5 t = 2.0
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(PetscOptionsGetScalar(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-t', t, flg, ierr))
54 5 N = m*(m + 1)/2
55
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
56 5 write (*, '(/a,i6,a,i4,a)') 'Markov y=exp(t*A)*e_1, N=', N, ' (m=', m, ')'
57 end if
58
59 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60 ! Compute the transition probability matrix, A
61 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
62
63
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, N, N, ierr))
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatSetFromOptions(A, ierr))
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
67 5 ix = 0
68 5 cst = 0.5/real(m - 1, PETSC_REAL_KIND)
69
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 80 do i = 1, m
70 75 jmax = m - i + 1
71
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 680 do j = 1, jmax
72 600 ix = ix + 1
73 600 ii = ix - 1
74
2/4
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 5 times.
✗ Branch 3 not taken.
 675 if (ix - 1 >= Istart .and. ix <= Iend) then
75
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 600 if (j /= jmax) then
76 525 pd = cst*(i + j - 1)
77 !** north
78
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 525 if (i == 1) then
79 70 z = 2.0*pd
80 else
81 455 z = pd
82 end if
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 525 PetscCallA(MatSetValue(A, ii, ix, z, INSERT_VALUES, ierr))
84 !** east
85
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 525 if (j == 1) then
86 70 z = 2.0*pd
87 else
88 455 z = pd
89 end if
90 525 jj = ix + jmax - 1
91
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 525 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
92 end if
93
94 !** south
95 600 pu = 0.5 - cst*(i + j - 3)
96 600 z = pu
97
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 600 if (j > 1) then
98 525 jj = ix - 2
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 525 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
100 end if
101 !** west
102
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 600 if (i > 1) then
103 525 jj = ix - jmax - 2
104
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 525 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
105 end if
106 end if
107 end do
108 end do
109
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
110
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
111
112 ! ** Set v = e_1
113
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatCreateVecs(A, y, v, ierr))
114 5 ii = 0
115 5 z = 1.0
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecSetValue(v, ii, z, INSERT_VALUES, ierr))
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecAssemblyBegin(v, ierr))
118
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecAssemblyEnd(v, ierr))
119
120 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
121 ! Create the solver and set various options
122 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123
124 ! ** Create matrix function solver context
125
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNCreate(PETSC_COMM_WORLD, mfn, ierr))
126
127 ! ** Set operator matrix, the function to compute, and other options
128
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNSetOperator(mfn, A, ierr))
129
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNGetFN(mfn, f, ierr))
130
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(FNSetType(f, FNEXP, ierr))
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(FNSetScale(f, t, one, ierr))
132 5 tol = 0.0000001
133
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNSetTolerances(mfn, tol, PETSC_CURRENT_INTEGER, ierr))
134
135 ! ** Set solver parameters at runtime
136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNSetFromOptions(mfn, ierr))
137
138 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
139 ! Solve the problem, y=exp(t*A)*v
140 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141
142
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNSolve(mfn, v, y, ierr))
143
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNGetConvergedReason(mfn, reason, ierr))
144
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCheckA(reason%v >= 0, PETSC_COMM_WORLD, PETSC_ERR_NOT_CONVERGED, 'Solver did not converge')
145
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecNorm(y, NORM_2, norm, ierr))
146
147 ! ** Optional: Get some information from the solver and display it
148
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNGetIterationNumber(mfn, its, ierr))
149
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
150 5 write (*, '(a,i4)') ' Number of iterations of the method: ', its
151 end if
152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNGetDimensions(mfn, ncv, ierr))
153
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
154 5 write (*, '(a,i4)') ' Subspace dimension:', ncv
155 end if
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNGetTolerances(mfn, tol, maxit, ierr))
157
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
158 5 write (*, '(a,f10.7,a,i4)') ' Stopping condition: tol=', tol, ' maxit=', maxit
159 end if
160
161 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162 ! Display solution and clean up
163 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
164
165
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
166 5 write (*, '(a,f4.1,a,f8.5)') ' Computed vector at time t=', PetscRealPart(t), ' has norm ', norm
167 end if
168
169
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MFNDestroy(mfn, ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(MatDestroy(A, ierr))
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecDestroy(v, ierr))
172
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(VecDestroy(y, ierr))
173
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
 5 PetscCallA(SlepcFinalize(ierr))
174 ✗ end program ex23f
175
176 !/*TEST
177 !
178 ! test:
179 ! suffix: 1
180 ! args: -mfn_ncv 6
181 !
182 !TEST*/
183