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.
132 lines
3.7 KiB
132 lines
3.7 KiB
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 SNAPPT (MSNAP, SNAPDX, NSNAP, X, Y)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE SNAPPT = GETS THE X, Y TO THE CLOSEST GRID POINT
|
|
|
|
C***********************************************************************
|
|
|
|
C VARIABLES USED:
|
|
C SNAPDX = SNAP GRID LINE ARRAY
|
|
C NSNAP = ARRAY OF GRID LINE COUNTERS
|
|
C MSNAP = THE DIMENSION OF THE GRID LINE ARRAY
|
|
C XMID = .TRUE. IF THE X VALUE FALLS BETWEEN TWO X GRID LINES
|
|
C YMID = .TRUE. IF THE Y VALUE FALLS BETWEEN TWO Y GRID LINES
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION SNAPDX (2, MSNAP), NSNAP (2)
|
|
|
|
LOGICAL XMID, YMID
|
|
|
|
XMID = .FALSE.
|
|
YMID = .FALSE.
|
|
|
|
C GET THE BOUNDING X SNAP LINES
|
|
|
|
IF (X .LE. SNAPDX (1, 1)) THEN
|
|
XP = SNAPDX (1, 1)
|
|
ELSEIF (X .GE. SNAPDX (1, NSNAP (1))) THEN
|
|
XP = SNAPDX (1, NSNAP (1))
|
|
ELSE
|
|
XMID = .TRUE.
|
|
DO 100 I = 2, NSNAP (1)
|
|
IF (X .LE. SNAPDX (1, I)) THEN
|
|
XP1 = SNAPDX (1, I - 1)
|
|
XP2 = SNAPDX (1, I)
|
|
GOTO 110
|
|
ENDIF
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
ENDIF
|
|
|
|
C GET THE BOUNDING Y SNAP LINES
|
|
|
|
IF (Y .LE. SNAPDX (2, 1)) THEN
|
|
YP = SNAPDX (2, 1)
|
|
ELSEIF (Y .GE. SNAPDX (2, NSNAP (2))) THEN
|
|
YP = SNAPDX (2, NSNAP (2))
|
|
ELSE
|
|
YMID = .TRUE.
|
|
DO 120 I = 2, NSNAP (2)
|
|
IF (Y .LE. SNAPDX (2, I)) THEN
|
|
YP1 = SNAPDX (2, I - 1)
|
|
YP2 = SNAPDX (2, I)
|
|
GOTO 130
|
|
ENDIF
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
ENDIF
|
|
|
|
C NOW GET THE APPROPRIATE COMBINATION OF XLOW, XHIGH, XMID, YLOW, ETC.
|
|
|
|
C FIRST THE MOST COMMON CASE OF FITTING BETWEEN X AND Y GRIDS
|
|
|
|
IF ( (YMID) .AND. (XMID)) THEN
|
|
|
|
C GET THE SHORTEST DISTANCE TO THIS COMBINATION
|
|
|
|
DIST1 = SQRT ( ( (XP1 - X) ** 2) + ( (YP1 - Y) ** 2))
|
|
DIST2 = SQRT ( ( (XP1 - X) ** 2) + ( (YP2 - Y) ** 2))
|
|
DIST3 = SQRT ( ( (XP2 - X) ** 2) + ( (YP1 - Y) ** 2))
|
|
DIST4 = SQRT ( ( (XP2 - X) ** 2) + ( (YP2 - Y) ** 2))
|
|
|
|
IF (DIST1 .LE. AMIN1 (DIST2, DIST3, DIST4)) THEN
|
|
X = XP1
|
|
Y = YP1
|
|
ELSEIF (DIST2 .LE. AMIN1 (DIST1, DIST3, DIST4)) THEN
|
|
X = XP1
|
|
Y = YP2
|
|
ELSEIF (DIST3 .LE. AMIN1 (DIST1, DIST2, DIST4)) THEN
|
|
X = XP2
|
|
Y = YP1
|
|
ELSE
|
|
X = XP2
|
|
Y = YP2
|
|
ENDIF
|
|
|
|
C NOW THE CORNER CASES OF XLOW, XHIGH, YLOW, AND YHIGH COMBINATIONS
|
|
|
|
ELSEIF ( (.NOT.XMID) .AND. (.NOT.YMID)) THEN
|
|
X = XP
|
|
Y = YP
|
|
|
|
C NOW THE EDGE CASES OF XLOW OR XHIGH AND YMID
|
|
|
|
ELSEIF (.NOT.XMID) THEN
|
|
X = XP
|
|
DIST1 = SQRT ( ( (XP - X) ** 2) + ( (YP1 - Y) ** 2))
|
|
DIST2 = SQRT ( ( (XP - X) ** 2) + ( (YP2 - Y) ** 2))
|
|
IF (DIST1 .LT. DIST2) THEN
|
|
Y = YP1
|
|
ELSE
|
|
Y = YP2
|
|
ENDIF
|
|
|
|
C NOW THE EDGE CASES OF XMID AND YHIGH OR YLOW
|
|
|
|
ELSEIF (.NOT.YMID) THEN
|
|
Y = YP
|
|
DIST1 = SQRT ( ( (XP1 - X) ** 2) + ( (YP - Y) ** 2))
|
|
DIST2 = SQRT ( ( (XP2 - X) ** 2) + ( (YP - Y) ** 2))
|
|
IF (DIST1 .LT. DIST2) THEN
|
|
X = XP1
|
|
ELSE
|
|
X = XP2
|
|
ENDIF
|
|
|
|
C NOW A CHECK TO MAKE SURE THAT SOMETHING DIDN'T FALL THROUGH
|
|
|
|
ELSE
|
|
CALL MESSAGE(' ** ERROR - IMPOSSIBLE CASE IN SNAPPT ** ')
|
|
CALL PLTBEL
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
END
|
|
|