GCC Code Coverage Report

Directory: ./
File: src/sys/classes/fn/tests/test1f.F90
Date: 2025-10-03 04:28:47
Exec Total Coverage
Lines: 80 82 97.6%
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 8 program main
17 #include <slepc/finclude/slepcfn.h>
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 .eq. 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(*,100) '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 .eq. 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(*,100) 'Denominator',(PetscRealPart(qq(i)),i=1,n)
103 end if
104 100 format (A15,10F6.1)
105
106 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
107 ! Constant
108 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109 6 na = 1
110 6 nb = 0
111 6 five = 5.0
112
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNSetType(fn,FNRATIONAL,ierr))
113
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))
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNRationalSetDenominator(fn,nb,PETSC_NULL_SCALAR_ARRAY,ierr))
115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNView(fn,PETSC_NULL_VIEWER,ierr))
116 6 x = 2.2
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNEvaluateFunction(fn,x,y,ierr))
118
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNEvaluateDerivative(fn,x,yp,ierr))
119 6 call PrintInfo(x,y,yp)
120
121 ! *** Clean up
122
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(FNDestroy(fn,ierr))
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 6 PetscCallA(SlepcFinalize(ierr))
124 1 end
125
126 ! -----------------------------------------------------------------
127
128 24 subroutine PrintInfo(x,y,yp)
129 #include <slepc/finclude/slepcfn.h>
130 use slepcfn
131 implicit none
132 PetscScalar x,y,yp
133 PetscReal re,im
134 PetscMPIInt rank
135 PetscErrorCode ierr
136
137
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 24 PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
138
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 24 if (rank .eq. 0) then
139 24 re = PetscRealPart(y)
140 16 im = PetscImaginaryPart(y)
141
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
 16 if (abs(im).lt.1.d-10) then
142 24 write(*,110) 'f', PetscRealPart(x), re
143 else
144 ✗ write(*,120) 'f', PetscRealPart(x), re, im
145 endif
146 24 re = PetscRealPart(yp)
147 16 im = PetscImaginaryPart(yp)
148
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
 16 if (abs(im).lt.1.d-10) then
149 24 write(*,110) 'f''', PetscRealPart(x), re
150 else
151 ✗ write(*,120) 'f''', PetscRealPart(x), re, im
152 endif
153 endif
154 110 format (A2,'(',F4.1,') = ',F10.5)
155 120 format (A2,'(',F4.1,') = ',F10.5,SP,F9.5,'i')
156
157 end
158
159 !/*TEST
160 !
161 ! test:
162 ! suffix: 1
163 ! nsize: 1
164 ! requires: !single
165 !
166 !TEST*/
167