GCC Code Coverage Report

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