GCC Code Coverage Report


Directory: ./
File: src/sys/classes/fn/tests/test1f.F90
Date: 2025-12-10 04:20:18
Exec Total Coverage
Lines: 79 81 97.5%
Functions: 3 3 100.0%
Branches: 45 84 53.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: Test rational function in Fortran.
13 !
14 ! ----------------------------------------------------------------------
15 !
16 #include <slepc/finclude/slepcfn.h>
17 8 program test1f
18 6 use slepcfn
19 implicit none
20
21 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
22 ! Declarations
23 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
24
25 FN :: fn
26 PetscInt :: i, n, na, nb
27 PetscMPIInt :: rank
28 PetscErrorCode :: ierr
29 PetscScalar :: x, y, yp, p(10), q(10), five
30 PetscScalar :: pp(10), qq(10), tau, eta
31
32 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33 ! Beginning of program
34 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
35
36
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
37
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
38
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNCreate(PETSC_COMM_WORLD, fn, ierr))
39
40 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
41 ! Polynomial p(x)
42 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
43 6 na = 5
44 6 p(1) = -3.1
45 6 p(2) = 1.1
46 6 p(3) = 1.0
47 6 p(4) = -2.0
48 6 p(5) = 3.5
49
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNSetType(fn, FNRATIONAL, ierr))
50
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetNumerator(fn, na, p, ierr))
51
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNView(fn, PETSC_NULL_VIEWER, ierr))
52 6 x = 2.2
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateFunction(fn, x, y, ierr))
54
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateDerivative(fn, x, yp, ierr))
55 6 call PrintInfo(x, y, yp)
56
57 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
58 ! Inverse of polynomial 1/q(x)
59 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60 6 na = 0
61 6 nb = 3
62 6 q(1) = -3.1
63 6 q(2) = 1.1
64 6 q(3) = 1.0
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNSetType(fn, FNRATIONAL, ierr))
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetNumerator(fn, na, PETSC_NULL_SCALAR_ARRAY, ierr))
67
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetDenominator(fn, nb, q, ierr))
68
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNView(fn, PETSC_NULL_VIEWER, ierr))
69 6 x = 2.2
70
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateFunction(fn, x, y, ierr))
71
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateDerivative(fn, x, yp, ierr))
72 6 call PrintInfo(x, y, yp)
73
74 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
75 ! Rational p(x)/q(x)
76 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
77 6 na = 2
78 6 nb = 3
79 6 p(1) = 1.1
80 6 p(2) = 1.1
81 6 q(1) = 1.0
82 6 q(2) = -2.0
83 6 q(3) = 3.5
84
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNSetType(fn, FNRATIONAL, ierr))
85
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetNumerator(fn, na, p, ierr))
86
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetDenominator(fn, nb, q, ierr))
87 6 tau = 1.2
88 6 eta = 0.5
89
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNSetScale(fn, tau, eta, ierr))
90
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNView(fn, PETSC_NULL_VIEWER, ierr))
91 6 x = 2.2
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateFunction(fn, x, y, ierr))
93
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateDerivative(fn, x, yp, ierr))
94 6 call PrintInfo(x, y, yp)
95
96
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalGetNumerator(fn, n, pp, ierr))
97
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (rank == 0) then
98
3/4
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4 times.
✓ Branch 3 taken 4 times.
14 write (*, '(a15,10f6.1)') 'Numerator', (PetscRealPart(pp(i)), i=1, n)
99 end if
100
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalGetDenominator(fn, n, qq, ierr))
101
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (rank == 0) then
102
3/4
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4 times.
✓ Branch 3 taken 4 times.
18 write (*, '(a15,10f6.1)') 'Denominator', (PetscRealPart(qq(i)), i=1, n)
103 end if
104
105 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
106 ! Constant
107 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
108 6 na = 1
109 6 nb = 0
110 6 five = 5.0
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNSetType(fn, FNRATIONAL, ierr))
112
3/4
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
12 PetscCallA(FNRationalSetNumerator(fn, na, [five], ierr))
113
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNRationalSetDenominator(fn, nb, PETSC_NULL_SCALAR_ARRAY, ierr))
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNView(fn, PETSC_NULL_VIEWER, ierr))
115 6 x = 2.2
116
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateFunction(fn, x, y, ierr))
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNEvaluateDerivative(fn, x, yp, ierr))
118 6 call PrintInfo(x, y, yp)
119
120 ! *** Clean up
121
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 PetscCallA(FNDestroy(fn, ierr))
122
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
6 PetscCallA(SlepcFinalize(ierr))
123
124 contains
125
126 24 subroutine PrintInfo(x, y, yp)
127 use slepcfn
128 implicit none
129 PetscScalar :: x, y, yp
130 PetscReal :: re, im
131 PetscMPIInt :: rank
132 PetscErrorCode :: ierr
133
134
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
24 PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
135
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
24 if (rank == 0) then
136 24 re = PetscRealPart(y)
137 16 im = PetscImaginaryPart(y)
138
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
16 if (abs(im) < 1.d-10) then
139 24 write (*, '(a3,f3.1,a,f10.5)') 'f(', PetscRealPart(x), ') = ', re
140 else
141 write (*, '(a3,f3.1,a,f10.5,sp,f9.5,a)') 'f(', PetscRealPart(x), ') = ', re, im, 'i'
142 end if
143 24 re = PetscRealPart(yp)
144 16 im = PetscImaginaryPart(yp)
145
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
16 if (abs(im) < 1.d-10) then
146 24 write (*, '(a3,f3.1,a,f10.5)') 'f''(', PetscRealPart(x), ') = ', re
147 else
148 write (*, '(a3,f3.1,a,f10.5,sp,f9.5,a)') 'f''(', PetscRealPart(x), ') = ', re, im, 'i'
149 end if
150 end if
151
152 end subroutine
153
154 end program test1f
155
156 !/*TEST
157 !
158 ! test:
159 ! suffix: 1
160 ! nsize: 1
161 ! requires: !single
162 !
163 !TEST*/
164