GCC Code Coverage Report

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