OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22clip_tools.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

function crossprod2d (v1, v2)
subroutine polygonalclipping (basepolygon, clippolygon, resultpolygon)
subroutine clipedge (polyg, p1, p2, resultpolyg)
function intersectp (seg_p1, seg_p2, line_p1, line_p2, iflg)
logical function is_on_1st_half_plane (point, p1, p2)
subroutine setclockwisepolyg (polyg, area)
subroutine setcounterclockwisepolyg (polyg, area)

Function/Subroutine Documentation

◆ clipedge()

subroutine clipedge ( type(polygon) polyg,
dimension(2), intent(inout) p1,
dimension(2), intent(inout) p2,
type(polygon) resultpolyg )

Definition at line 106 of file i22clip_tools.F.

107C-----------------------------------------------
108C I m p l i c i t T y p e s
109C-----------------------------------------------
110#include "implicit_f.inc"
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 type polygon
115 my_real :: node(16,2)
116 integer :: NumNodes
117 end type polygon
118 type(polygon) :: polyg, resultPolyg
119 my_real , intent(inout) :: p1(2), p2(2)
120C-----------------------------------------------
121C L o c a l V a r i a b l e s
122C-----------------------------------------------
123 my_real :: x1(2), x2(2), intersecpoint(2)
124 integer :: i, k
125 INTERFACE
126 function intersectp(a,b,c,d,iflg)
127 my_real , intent(inout) :: a(2),b(2),c(2),d(2)
128 integer, intent(in) :: iflg
129 my_real intersectp(2)
130 end function
131 function is_on_1st_half_plane(a,b,c)
132 my_real , intent(inout) :: a(2),b(2),c(2)
133 logical :: IS_ON_1ST_HALF_PLANE
134 end function
135 END INTERFACE
136C-----------------------------------------------
137C S o u r c e L i n e s
138C-----------------------------------------------
139 k = 0
140 do i=1,polyg%NumNodes-1 ! for each edge i of poly
141 x1(:) = polyg%node(i,:) ! node 1 of edge i
142 x2(:) = polyg%node(i+1,:) ! node 2 of edge i
143
144 if ( is_on_1st_half_plane(x1, p1, p2) ) then
145 if ( is_on_1st_half_plane(x2, p1, p2) ) then
146 ! add the node 2 to the output polygon
147 k = k+1
148 resultpolyg%node(k,:) = x2(:)
149
150 else ! node i+1 is outside
151 intersecpoint = intersectp(x1, x2, p1,p2 ,1)
152 k = k+1
153 resultpolyg%node(k,:) = intersecpoint(:)
154 end if
155 else ! node i is outside
156 if ( is_on_1st_half_plane(x2, p1, p2) ) then
157 intersecpoint = intersectp(x1, x2, p1,p2 ,1)
158 k = k+1
159 resultpolyg%node(k,:) = intersecpoint(:)
160
161 k = k+1
162 resultpolyg%node(k,:) = x2(:)
163 end if
164 end if
165 end do
166 if (k > 0) then
167 ! if the last vertice is not equal to the first one
168 if ( (resultpolyg%node(1,1) /= resultpolyg%node(k,1)) .or. (resultpolyg%node(1,2) /= resultpolyg%node(k,2))) then
169 k=k+1
170 resultpolyg%node(k,:) = resultpolyg%node(1,:)
171 end if
172 end if
173 ! set the size of the resultPolyggon
174 resultpolyg%NumNodes = k
my_real
#define my_real
Definition cppsort.cpp:32
is_on_1st_half_plane
logical function is_on_1st_half_plane(point, p1, p2)
Definition i22clip_tools.F:255
intersectp
function intersectp(seg_p1, seg_p2, line_p1, line_p2, iflg)
Definition i22clip_tools.F:189

◆ crossprod2d()

function crossprod2d ( dimension(2), intent(inout) v1,
dimension(2), intent(inout) v2 )

Definition at line 29 of file i22clip_tools.F.

30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C D u m m y A r g u m e n t s
36C-----------------------------------------------
37 my_real , intent(inout) :: v1(2),v2(2)
38 my_real :: crossprod2d
39C-----------------------------------------------
40C L o c a l V a r i a b l e s
41C-----------------------------------------------
42C-----------------------------------------------
43C S o u r c e L i n e s
44C-----------------------------------------------
45 crossprod2d = v1(1)*v2(2) - v1(2)*v2(1)
46 return
crossprod2d
function crossprod2d(v1, v2)
Definition i22clip_tools.F:30

◆ intersectp()

function intersectp ( dimension(2), intent(inout) seg_p1,
dimension(2), intent(inout) seg_p2,
dimension(2), intent(inout) line_p1,
dimension(2), intent(inout) line_p2,
integer, intent(in) iflg )

Definition at line 188 of file i22clip_tools.F.

189C-----------------------------------------------
190C I m p l i c i t T y p e s
191C-----------------------------------------------
192#include "implicit_f.inc"
193C-----------------------------------------------
194C D u m m y A r g u m e n t s
195C-----------------------------------------------
196 my_real ,intent(inout) :: seg_p1(2), seg_p2(2)
197 my_real ,intent(inout) :: line_p1(2), line_p2(2)
198 INTEGER ,intent(in) :: IFLG
199C-----------------------------------------------
200C L o c a l V a r i a b l e s
201C-----------------------------------------------
202 my_real :: intersectp(2), v1(2), v2(2), seg_p1_line_p1(2)
203 my_real :: alpha, tmp,tmp2, l
204 my_real :: crossprod2d, tol
205 external CrossProd2D
206C-----------------------------------------------
207C S o u r c e L i n e s
208C-----------------------------------------------
209 tol = em06
210
211 intersectp(1:2) = ep30
212 v1(:) = seg_p2(:) - seg_p1(:)
213 v2(:) = line_p2(:) - line_p1(:)
214 l=max(sum(v1(:)*v1(:)),sum(v2(:)*v2(:)))
215 tmp = crossprod2d(v1,v2)
216 if (abs(tmp) <= tol*l) then
217! if (tmp == 0.0D00) then
218 !colinear vectors
219 seg_p1_line_p1(:) = line_p1(:) - seg_p1(:)
220 ! if the the segment [Seg_P1Seg_P2] is included in the line (Line_P1Line_P2)
221 tmp = crossprod2d(seg_p1_line_p1,v1)
222! if ( tmp == 0.0d00) then
223 if(abs(tmp) <= tol*l)then
224 ! the intersection is the last point of the segment
225 intersectp(:) = seg_p2(:)
226 end if
227 else
228 ! non colinear vectors
229 seg_p1_line_p1(:) = line_p1(:) - seg_p1(:)
230 ! parametric coordinates
231 tmp2 = crossprod2d(seg_p1_line_p1,v2)
232 alpha = tmp2
233 tmp2 = crossprod2d(v1,v2)
234 alpha = alpha/tmp2
235 ! if a is not in [0;1]
236 if ( (alpha >= -em03) .and. (alpha <= one+em03)) then
237 alpha=max(zero,min(alpha,one))
238 intersectp(:) = seg_p1(:) + alpha*v1(:)
239 end if
240 end if
241
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ is_on_1st_half_plane()

logical function is_on_1st_half_plane ( dimension(2), intent(inout) point,
dimension(2), intent(inout) p1,
dimension(2), intent(inout) p2 )

Definition at line 254 of file i22clip_tools.F.

255C-----------------------------------------------
256C I m p l i c i t T y p e s
257C-----------------------------------------------
258#include "implicit_f.inc"
259C-----------------------------------------------
260C D u m m y A r g u m e n t s
261C-----------------------------------------------
262 my_real , intent(inout) :: point(2), p1(2), p2(2)
263C-----------------------------------------------
264C L o c a l V a r i a b l e s
265C-----------------------------------------------
266 my_real :: v1(2), v2(2)
267 logical :: IS_ON_1ST_HALF_PLANE
268 my_real :: crossp, l
269 my_real :: crossprod2d
270 EXTERNAL :: crossprod2d
271C-----------------------------------------------
272C S o u r c e L i n e s
273C-----------------------------------------------
274 v1(:) = p2(:) - p1(:)
275 v2(:) = point(:) - p1(:)
276 l=max(sum(v1(:)*v1(:)),sum(v2(:)*v2(:)))
277 crossp = crossprod2d(v1,v2)
278 !DONT BE TOO MUCH TOLERANT OTHERWISE ALGO WILL ADD AN EMPTY INTERSECTION POINT WHICH WOULD RECQUIRE ADDITIONAL CODE TO BE SKIPPED.
279 !EM06 : issue
280 !EM10 : OK
281 if ( crossp >= -em10*l) then
282 is_on_1st_half_plane = .true.
283 else
284 is_on_1st_half_plane = .false.
285 end if

◆ polygonalclipping()

subroutine polygonalclipping ( type(polygon) basepolygon,
type(polygon) clippolygon,
type(polygon) resultpolygon )

Definition at line 59 of file i22clip_tools.F.

60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64 ! based on Sutherland Hodgman algorithm
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 type polygon
69 my_real :: node(16,2)
70 integer :: NumNodes
71 end type polygon
72 type(polygon) :: basePolygon, clipPolygon, resultPolygon
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 type(polygon) :: tmpPolygon
77 my_real :: edge_p1(2),edge_p2(2) ! vertices of edge to clipPolygon tmpPolygon
78 integer :: i
79 tmppolygon%NumNodes = clippolygon%NumNodes
80 IF(tmppolygon%NumNodes > 0)THEN
81 tmppolygon%node(1:tmppolygon%NumNodes,:) = clippolygon%node(1:tmppolygon%NumNodes,:)
82 END IF
83
84 do i=1,basepolygon%NumNodes-1 ! for each edge i of the polygon basePolygon
85 edge_p1(:) = basepolygon%node(i,:) ! node 1 of edge i
86 edge_p2(:) = basepolygon%node(i+1,:) ! node 2 of edge i
87 ! clipPolygon the work polygon by edge i
88 call clipedge( tmppolygon, edge_p1, edge_p2, resultpolygon)
89 ! tmpPolygon <= resultPolygon
90 tmppolygon%NumNodes = resultpolygon%NumNodes
91 tmppolygon%node(1:tmppolygon%NumNodes,:) = resultpolygon%node(1:tmppolygon%NumNodes,:)
92 end do
clipedge
subroutine clipedge(polyg, p1, p2, resultpolyg)
Definition i22clip_tools.F:107

◆ setclockwisepolyg()

subroutine setclockwisepolyg ( type(polygon), intent(inout) polyg,
intent(inout) area )

Definition at line 294 of file i22clip_tools.F.

295C-----------------------------------------------
296C I m p l i c i t T y p e s
297C-----------------------------------------------
298#include "implicit_f.inc"
299C-----------------------------------------------
300C D u m m y A r g u m e n t s
301C-----------------------------------------------
302 type polygon
303 my_real :: node(16,2)
304 integer :: NumNodes
305 end type polygon
306 type(polygon) ,intent(inout) :: Polyg
307 my_real , intent(inout) :: area
308C-----------------------------------------------
309C L o c a l V a r i a b l e s
310C-----------------------------------------------
311 my_real :: x(16),y(16),total
312 integer :: i,n
313C-----------------------------------------------
314C S o u r c e L i n e s
315C-----------------------------------------------
316
317 total = zero
318 n = polyg%NumNodes
319
320 DO i=1,n
321 x(i) = polyg%node(i,1)
322 y(i) = polyg%node(i,2)
323 ENDDO
324
325 DO i=1,n-1
326 total = total + (x(i+1)-x(i))*(y(i+1)+y(i))
327 ENDDO
328
329 area = half * abs(total)
330
331 !setclockwise
332 IF (total < zero) THEN
333 DO i=1,n
334 polyg%node(i,1) = x(n-i+1)
335 polyg%node(i,2) = y(n-i+1)
336 ENDDO
337 ENDIF
338
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567

◆ setcounterclockwisepolyg()

subroutine setcounterclockwisepolyg ( type(polygon), intent(inout) polyg,
intent(inout) area )

Definition at line 349 of file i22clip_tools.F.

350C-----------------------------------------------
351C I m p l i c i t T y p e s
352C-----------------------------------------------
353#include "implicit_f.inc"
354C-----------------------------------------------
355C D u m m y A r g u m e n t s
356C-----------------------------------------------
357 type polygon
358 my_real :: node(16,2)
359 integer :: NumNodes
360 end type polygon
361 type(polygon) ,intent(inout) :: Polyg
362 my_real , intent(inout) :: area
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366 my_real :: x(16),y(16),total
367 integer :: i,n
368C-----------------------------------------------
369C S o u r c e L i n e s
370C-----------------------------------------------
371
372 total = zero
373 n = polyg%NumNodes
374
375 DO i=1,n
376 x(i) = polyg%node(i,1)
377 y(i) = polyg%node(i,2)
378 ENDDO
379
380 DO i=1,n-1
381 total = total + (x(i+1)-x(i))*(y(i+1)+y(i))
382 ENDDO
383
384 area = half * abs(total)
385
386 !setclockwise
387 IF (total > zero) THEN
388 DO i=1,n
389 polyg%node(i,1) = x(n-i+1)
390 polyg%node(i,2) = y(n-i+1)
391 ENDDO
392 ENDIF
393