GCC Code Coverage Report

Directory: ./
File: src/sys/classes/rg/tests/test1f.F90
Date: 2026-03-16 03:58:17
Exec Total Coverage
Lines: 93 96 96.9%
Functions: 2 2 100.0%
Branches: 45 76 59.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: Simple example that tests RG interface functions.
13 !
14 ! ----------------------------------------------------------------------
15 !
16 #include <slepc/finclude/slepcrg.h>
17 92 program test1f
18 6 use slepcrg
19 implicit none
20
21 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
22 ! Declarations
23 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
24
25 RG :: rg
26 PetscInt :: i, n
27 PetscInt :: inside(1)
28 PetscMPIInt :: rank
29 PetscErrorCode :: ierr
30 PetscReal :: re, im
31 PetscScalar :: ar, ai, cr(10), ci(10)
32 PetscScalar :: vr(7), vi(7)
33 PetscScalar :: center
34 PetscReal :: radius, vscale, a, b, c, d
35
36 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
37 ! Beginning of program
38 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39
40
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
41
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
42
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGCreate(PETSC_COMM_WORLD, rg, ierr))
43
44 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 ! Ellipse
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetType(rg, RGELLIPSE, ierr))
49 6 center = 1.1
50 6 radius = 2
51 6 vscale = 0.1
52
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGEllipseSetParameters(rg, center, radius, vscale, ierr))
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetFromOptions(rg, ierr))
54
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
55 6 re = 0.1
56 6 im = 0.3
57 #if defined(PETSC_USE_COMPLEX)
58 4 ar = re + im*PETSC_i
59 4 ai = 0.0
60 #else
61 2 ar = re
62 2 ai = im
63 #endif
64
5/6
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
 18 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
65
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 if (inside(1) >= 0) then
67 ✗ write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is inside the region'
68 else
69 6 write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is outside the region'
70 end if
71 end if
72
73
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGComputeBoundingBox(rg, a, b, c, d, ierr))
74
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
75 6 write (*, '(a,f4.1,a,f4.1,a,f4.1,a,f4.1,a)') 'Bounding box: [', a, ',', b, ']x[', c, ',', d, ']'
76 end if
77
78
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
79 6 write (*, *) 'Contour points:'
80 end if
81 6 n = 10
82
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGComputeContour(rg, n, cr, ci, ierr))
83
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
 66 do i = 1, n
84 #if defined(PETSC_USE_COMPLEX)
85 40 re = PetscRealPart(cr(i))
86 40 im = PetscImaginaryPart(cr(i))
87 #else
88 20 re = cr(i)
89 20 im = ci(i)
90 #endif
91
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 66 if (rank == 0) then
92 60 write (*, '(a,f7.4,a,f7.4,a)') '(', re, ',', im, ')'
93 end if
94 end do
95
96 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
97 ! Interval
98 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99
100
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetType(rg, RGINTERVAL, ierr))
101 6 a = -1
102 6 b = 1
103 6 c = -0.1
104 6 d = 0.1
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGIntervalSetEndpoints(rg, a, b, c, d, ierr))
106
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetFromOptions(rg, ierr))
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
108 6 re = 0.2
109 6 im = 0
110 #if defined(PETSC_USE_COMPLEX)
111 4 ar = re + im*PETSC_i
112 4 ai = 0.0
113 #else
114 2 ar = re
115 2 ai = im
116 #endif
117
5/6
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
 18 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
118
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
119
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (inside(1) >= 0) then
120 6 write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is inside the region'
121 else
122 ✗ write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is outside the region'
123 end if
124 end if
125
126 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
127 ! Polygon
128 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
129
130 #if defined(PETSC_USE_COMPLEX)
131 4 vr(1) = (0.0, 2.0)
132 4 vr(2) = (1.0, 4.0)
133 4 vr(3) = (2.0, 5.0)
134 4 vr(4) = (4.0, 3.0)
135 4 vr(5) = (5.0, 4.0)
136 4 vr(6) = (6.0, 1.0)
137 4 vr(7) = (2.0, 0.0)
138 #else
139 2 vr(1) = 0.0
140 2 vi(1) = 1.0
141 2 vr(2) = 0.0
142 2 vi(2) = -1.0
143 2 vr(3) = 0.6
144 2 vi(3) = -0.8
145 2 vr(4) = 1.0
146 2 vi(4) = -1.0
147 2 vr(5) = 2.0
148 2 vi(5) = 0.0
149 2 vr(6) = 1.0
150 2 vi(6) = 1.0
151 2 vr(7) = 0.6
152 2 vi(7) = 0.8
153 #endif
154
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetType(rg, RGPOLYGON, ierr))
155 6 n = 7
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGPolygonSetVertices(rg, n, vr, vi, ierr))
157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGSetFromOptions(rg, ierr))
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
159 6 re = 5
160 6 im = 0.9
161 #if defined(PETSC_USE_COMPLEX)
162 4 ar = re + im*PETSC_i
163 4 ai = 0.0
164 #else
165 2 ar = re
166 2 ai = im
167 #endif
168
5/6
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6 times.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
 18 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
169
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
 6 if (rank == 0) then
170
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 2 times.
 6 if (inside(1) >= 0) then
171 4 write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is inside the region'
172 else
173 2 write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is outside the region'
174 end if
175 end if
176
177 ! *** Clean up
178
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
 6 PetscCallA(RGDestroy(rg, ierr))
179
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
 6 PetscCallA(SlepcFinalize(ierr))
180 ✗ end program test1f
181
182 !/*TEST
183 !
184 ! test:
185 ! suffix: 1
186 ! requires: !complex
187 !
188 ! test:
189 ! suffix: 1_complex
190 ! requires: complex
191 !
192 !TEST*/
193