You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
78 lines
2.2 KiB
78 lines
2.2 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
SUBROUTINE INTSCT (X1, Y1, X2, Y2, X3, Y3, X4, Y4, U, W, LCROSS)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE INTSCT = CHECKS TO SEE IF THE LINE FROM N1 TO N2
|
||
|
|
C INTERSECTS THE LINE FROM N3 TO N4
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C NOTE: THIS INTERSECTION ROUTINE IS BASED ON AN ALGORITHM GIVEN
|
||
|
|
C IN THE BOOK "GEOMETRIC MODELING" BY MICHAEL E. MORTENSON ON
|
||
|
|
C PAGES 319 - 320.
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
LOGICAL LCROSS
|
||
|
|
|
||
|
|
LCROSS = .FALSE.
|
||
|
|
|
||
|
|
if (max(x1, x2) .lt. min(x3, x4)) return
|
||
|
|
if (max(y1, y2) .lt. min(y3, y4)) return
|
||
|
|
if (max(x3, x4) .lt. min(x1, x2)) return
|
||
|
|
if (max(y3, y4) .lt. min(y1, y2)) return
|
||
|
|
|
||
|
|
C SET UP THE FIRST LINE'S VECTORS (A AND B)
|
||
|
|
|
||
|
|
XA = X1
|
||
|
|
YA = Y1
|
||
|
|
XB = X2 - X1
|
||
|
|
YB = Y2 - Y1
|
||
|
|
|
||
|
|
C SET UP THE SECOND LINE'S VECTORS (C AND D)
|
||
|
|
|
||
|
|
XC = X3
|
||
|
|
YC = Y3
|
||
|
|
XD = X4 - X3
|
||
|
|
YD = Y4 - Y3
|
||
|
|
|
||
|
|
C NOW USE THE VECTORS AND SOLVE FOR W.
|
||
|
|
C W IS THE PROPORTION OF THE DISTANCE ALONG THE VECTOR D
|
||
|
|
C WHERE THE INTERSECTION OCCURS. LIKEWISE U IS THE PROPORTIONAL
|
||
|
|
C DISTANCE ALONG THE VECTOR B FOR THE INTERSECTION. IF THERE IS
|
||
|
|
C AN INTERSECTION, BOTH U AND W MUST BE BETWEEN 0 AND 1.
|
||
|
|
|
||
|
|
DENOM = (YB * XD) - (XB * YD)
|
||
|
|
|
||
|
|
C CHECK FOR SPECIAL PARALLEL CASE - THE DENOMINATOR IS EQUAL TO ZERO.
|
||
|
|
|
||
|
|
IF (DENOM .NE. 0.) THEN
|
||
|
|
|
||
|
|
C CHECK FOR INTERSECTION
|
||
|
|
|
||
|
|
W = ( (YC * XB) - (XB * YA) - (XC * YB) + (YB * XA) ) / DENOM
|
||
|
|
IF ( (W .LT. 1.) .AND. (W .GT. 0.) ) THEN
|
||
|
|
|
||
|
|
C W INDICATES AN INTERSECTION HAS OCCURRED.
|
||
|
|
C GET THE U VALUE AND CONFIRM.
|
||
|
|
|
||
|
|
IF (XB .NE. 0.) THEN
|
||
|
|
U = ( XC + (W * XD) - XA ) / XB
|
||
|
|
ELSE
|
||
|
|
U = ( YC + (W * YD) - YA ) / YB
|
||
|
|
ENDIF
|
||
|
|
IF ( (U .LT. 1.) .AND. (U .GT. 0.) ) THEN
|
||
|
|
LCROSS = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|