Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

75 lines
2.1 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 VINTER (MXND, XN, YN, N1, N2, N3, XOLD, YOLD,
& XNEW, YNEW, VCROSS)
C***********************************************************************
C SUBROUTINE VINTER = FINDS WHERE A VECTOR FROM N1 TO N2
C INTERSECTS THE VECTOR FROM N3 TO (XOLD, YOLD)
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***********************************************************************
DIMENSION XN (MXND), YN (MXND)
LOGICAL VCROSS
VCROSS = .FALSE.
C SET UP THE FIRST LINE'S VECTORS (A AND B)
XA = XN (N1)
YA = YN (N1)
XB = XN (N2) - XN (N1)
YB = YN (N2) - YN (N1)
C SET UP THE SECOND LINE'S VECTORS (C AND D)
XC = XN (N3)
YC = YN (N3)
XD = XOLD - XN (N3)
YD = YOLD - YN (N3)
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.
DENOM = (YB * XD) - (XB * YD)
C CHECK FOR SPECIAL PARALLEL CASE - THE DENOMINATOR IS EQUAL TO ZERO.
IF (DENOM .NE. 0.) THEN
C GET INTERSECTION LOCATION
W = ( (YC * XB) - (XB * YA) - (XC * YB) + (YB * XA) ) / DENOM
C GET THE U VALUE TO CONFIRM.
IF (XB .NE. 0.) THEN
U = ( XC + (W * XD) - XA ) / XB
ELSE
U = ( YC + (W * YD) - YA ) / YB
ENDIF
C CALCULATE THE INTERSECTION POINT BASED ON SIMILAR TRIANGLES
XNEW = ( (XA + (XB * U)) + (XC + (XD * W)) ) * .5
YNEW = ( (YA + (YB * U)) + (YC + (YD * W)) ) * .5
VCROSS = .TRUE.
ENDIF
RETURN
END