GCC Code Coverage Report

Directory: ./
File: src/mfn/tutorials/ex23f.F90
Date: 2025-12-10 04:20:18
Exec Total Coverage
Lines: 80 80 100.0%
Functions: 2 2 100.0%
Branches: 58 102 56.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 8 program ex23f
23 6 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
43 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
44 ! Beginning of program
45 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
46
47
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
49 6 m = 15
50
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-m', m, flg, ierr))
51 6 t = 2.0
52
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(PetscOptionsGetScalar(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-t', t, flg, ierr))
53 6 N = m*(m + 1)/2
54
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
55 6 write (*, '(/a,i6,a,i4,a)') 'Markov y=exp(t*A)*e_1, N=', N, ' (m=', m, ')'
56 end if
57
58 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
59 ! Compute the transition probability matrix, A
60 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
61
62
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreate(PETSC_COMM_WORLD, A, ierr))
63
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetSizes(A, PETSC_DECIDE, PETSC_DECIDE, N, N, ierr))
64
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatSetFromOptions(A, ierr))
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatGetOwnershipRange(A, Istart, Iend, ierr))
66 6 ix = 0
67 6 cst = 0.5/real(m - 1)
68
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 96 do i = 1, m
69 90 jmax = m - i + 1
70
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 816 do j = 1, jmax
71 720 ix = ix + 1
72 720 ii = ix - 1
73
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
 810 if (ix - 1 >= Istart .and. ix <= Iend) then
74
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 720 if (j /= jmax) then
75 630 pd = cst*(i + j - 1)
76 !** north
77
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 630 if (i == 1) then
78 84 z = 2.0*pd
79 else
80 546 z = pd
81 end if
82
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 630 PetscCallA(MatSetValue(A, ii, ix, z, INSERT_VALUES, ierr))
83 !** east
84
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 630 if (j == 1) then
85 84 z = 2.0*pd
86 else
87 546 z = pd
88 end if
89 630 jj = ix + jmax - 1
90
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 630 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
91 end if
92
93 !** south
94 720 pu = 0.5 - cst*(i + j - 3)
95 720 z = pu
96
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 720 if (j > 1) then
97 630 jj = ix - 2
98
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 630 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
99 end if
100 !** west
101
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 720 if (i > 1) then
102 630 jj = ix - jmax - 2
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 630 PetscCallA(MatSetValue(A, ii, jj, z, INSERT_VALUES, ierr))
104 end if
105 end if
106 end do
107 end do
108
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY, ierr))
109
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY, ierr))
110
111 ! ** Set v = e_1
112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatCreateVecs(A, y, v, ierr))
113 6 ii = 0
114 6 z = 1.0
115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecSetValue(v, ii, z, INSERT_VALUES, ierr))
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecAssemblyBegin(v, ierr))
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecAssemblyEnd(v, ierr))
118
119 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
120 ! Create the solver and set various options
121 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
122
123 ! ** Create matrix function solver context
124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNCreate(PETSC_COMM_WORLD, mfn, ierr))
125
126 ! ** Set operator matrix, the function to compute, and other options
127
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNSetOperator(mfn, A, ierr))
128
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNGetFN(mfn, f, ierr))
129
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetType(f, FNEXP, ierr))
130 6 z = 1.0
131
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetScale(f, t, z, ierr))
132 6 tol = 0.0000001
133
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 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 6 times.
 6 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 6 times.
 6 PetscCallA(MFNSolve(mfn, v, y, ierr))
143
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNGetConvergedReason(mfn, reason, ierr))
144
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 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 6 times.
 6 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 6 times.
 6 PetscCallA(MFNGetIterationNumber(mfn, its, ierr))
149
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
150 6 write (*, '(a,i4)') ' Number of iterations of the method: ', its
151 end if
152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNGetDimensions(mfn, ncv, ierr))
153
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
154 6 write (*, '(a,i4)') ' Subspace dimension:', ncv
155 end if
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MFNGetTolerances(mfn, tol, maxit, ierr))
157
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
158 6 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 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
166 6 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 6 times.
 6 PetscCallA(MFNDestroy(mfn, ierr))
170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(MatDestroy(A, ierr))
171
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecDestroy(v, ierr))
172
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(VecDestroy(y, ierr))
173
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
174 1 end program ex23f
175
176 !/*TEST
177 !
178 ! test:
179 ! suffix: 1
180 ! args: -mfn_ncv 6
181 !
182 !TEST*/
183