GCC Code Coverage Report

Directory: ./
File: src/sys/classes/rg/tests/test1f.F90
Date: 2026-02-22 03:58:10
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 77 program test1f
18 5 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 5 times.
 5 PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER, ierr))
41
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
42
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGCreate(PETSC_COMM_WORLD, rg, ierr))
43
44 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 ! Ellipse
46 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
47
48
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGSetType(rg, RGELLIPSE, ierr))
49 5 center = 1.1
50 5 radius = 2
51 5 vscale = 0.1
52
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGEllipseSetParameters(rg, center, radius, vscale, ierr))
53
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGSetFromOptions(rg, ierr))
54
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
55 5 re = 0.1
56 5 im = 0.3
57 #if defined(PETSC_USE_COMPLEX)
58 3 ar = re + im*PETSC_i
59 3 ai = 0.0
60 #else
61 2 ar = re
62 2 ai = im
63 #endif
64
5/6
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 5 times.
 15 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
65
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
66
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 if (inside(1) >= 0) then
67 ✗ write (*, '(a,f4.1,a,f4.1,a)') 'Point (', re, ',', im, ') is inside the region'
68 else
69 5 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 5 times.
 5 PetscCallA(RGComputeBoundingBox(rg, a, b, c, d, ierr))
74
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
75 5 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 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
79 5 write (*, *) 'Contour points:'
80 end if
81 5 n = 10
82
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGComputeContour(rg, n, cr, ci, ierr))
83
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
 55 do i = 1, n
84 #if defined(PETSC_USE_COMPLEX)
85 30 re = PetscRealPart(cr(i))
86 30 im = PetscImaginaryPart(cr(i))
87 #else
88 20 re = cr(i)
89 20 im = ci(i)
90 #endif
91
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 55 if (rank == 0) then
92 50 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 5 times.
 5 PetscCallA(RGSetType(rg, RGINTERVAL, ierr))
101 5 a = -1
102 5 b = 1
103 5 c = -0.1
104 5 d = 0.1
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGIntervalSetEndpoints(rg, a, b, c, d, ierr))
106
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGSetFromOptions(rg, ierr))
107
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
108 5 re = 0.2
109 5 im = 0
110 #if defined(PETSC_USE_COMPLEX)
111 3 ar = re + im*PETSC_i
112 3 ai = 0.0
113 #else
114 2 ar = re
115 2 ai = im
116 #endif
117
5/6
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 5 times.
 15 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
118
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
119
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (inside(1) >= 0) then
120 5 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 3 vr(1) = (0.0, 2.0)
132 3 vr(2) = (1.0, 4.0)
133 3 vr(3) = (2.0, 5.0)
134 3 vr(4) = (4.0, 3.0)
135 3 vr(5) = (5.0, 4.0)
136 3 vr(6) = (6.0, 1.0)
137 3 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 5 times.
 5 PetscCallA(RGSetType(rg, RGPOLYGON, ierr))
155 5 n = 7
156
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGPolygonSetVertices(rg, n, vr, vi, ierr))
157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGSetFromOptions(rg, ierr))
158
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
 5 PetscCallA(RGView(rg, PETSC_NULL_VIEWER, ierr))
159 5 re = 5
160 5 im = 0.9
161 #if defined(PETSC_USE_COMPLEX)
162 3 ar = re + im*PETSC_i
163 3 ai = 0.0
164 #else
165 2 ar = re
166 2 ai = im
167 #endif
168
5/6
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 5 times.
 15 PetscCallA(RGCheckInside(rg, 1_PETSC_INT_KIND, [ar], [ai], inside, ierr))
169
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
 5 if (rank == 0) then
170
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 2 times.
 5 if (inside(1) >= 0) then
171 3 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 5 times.
 5 PetscCallA(RGDestroy(rg, ierr))
179
0/2
✗ Branch 0 not taken.
✗ Branch 1 not taken.
 5 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