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.
215 lines
7.6 KiB
215 lines
7.6 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 LABOVE (MP,ML,N,IPOINT,COOR,ILINE,LTYPE,LCON,
|
||
|
|
+ LINKP,LINKL,X,Y,Y1,Y2,IFIND,INDEX,IFIRST,INEXT)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE LABOVE = GETS THE CLOSEST LINE ABOVE A GIVEN X,Y
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C VARIABLES USED:
|
||
|
|
C IFIND = THE CLOSEST LINE FOUND ABOVE THE X,Y LOCATION
|
||
|
|
C IFIRST = THE CCW END OF THE LINE (LEFT END)
|
||
|
|
C INEXT = THE CW END OF THE LINE (RIGHT END)
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IPOINT(MP),COOR(2,MP),ILINE(ML),LTYPE(ML),LCON(3,ML)
|
||
|
|
DIMENSION LINKP(2,MP),LINKL(2,ML)
|
||
|
|
DIMENSION N(29)
|
||
|
|
|
||
|
|
LOGICAL BAD,ADDLNK,ERR,UP
|
||
|
|
|
||
|
|
PI = ATAN2(0.0, -1.0)
|
||
|
|
|
||
|
|
TWOPI=PI+PI
|
||
|
|
ADDLNK=.FALSE.
|
||
|
|
DIST=Y2-Y1
|
||
|
|
|
||
|
|
DO 100 I=1,N(19)
|
||
|
|
CALL LTSORT(ML,LINKL,I,II,ADDLNK)
|
||
|
|
IF(II.GT.0)THEN
|
||
|
|
I1=LCON(1,II)
|
||
|
|
I2=LCON(2,II)
|
||
|
|
I3=LCON(3,II)
|
||
|
|
CALL LTSORT(MP,LINKP,I1,J1,ADDLNK)
|
||
|
|
CALL LTSORT(MP,LINKP,I2,J2,ADDLNK)
|
||
|
|
IF(I3.NE.0)THEN
|
||
|
|
CALL LTSORT(MP,LINKP,IABS(I3),J3,ADDLNK)
|
||
|
|
ELSE
|
||
|
|
J3=0
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C SEE IF LINE EXISTS
|
||
|
|
|
||
|
|
IF((J1.GT.0).AND.(J2.GT.0))THEN
|
||
|
|
|
||
|
|
C CHECK A STRAIGHT LINE TO SEE IF IT SPANS THE POINT
|
||
|
|
|
||
|
|
IF((LTYPE(II).EQ.1).AND.
|
||
|
|
+ (((COOR(1,J1).LE.X).AND.(COOR(1,J2).GE.X)).OR.
|
||
|
|
+ ((COOR(1,J2).LE.X).AND.(COOR(1,J1).GE.X))))THEN
|
||
|
|
|
||
|
|
C SEE IF LINE IS ABOVE
|
||
|
|
|
||
|
|
CALL DLPARA(COOR(1,J1),COOR(2,J1),COOR(1,J2),
|
||
|
|
+ COOR(2,J2),XM1,B1,BAD)
|
||
|
|
IF(.NOT.BAD)THEN
|
||
|
|
YTRY=(XM1*X)+B1
|
||
|
|
IF(YTRY.GT.Y)THEN
|
||
|
|
|
||
|
|
C CHECK DISTANCE TO THE LINE - RECORD LINE NO. IF CLOSEST
|
||
|
|
|
||
|
|
DTRY=YTRY-Y
|
||
|
|
IF((DTRY.LE.DIST).OR.(ABS(DIST-DTRY).LT.
|
||
|
|
+ .001*DIST))THEN
|
||
|
|
DIST=DTRY
|
||
|
|
IFIND=I
|
||
|
|
INDEX=II
|
||
|
|
IF(COOR(1,J1).GT.X)THEN
|
||
|
|
IFIRST=I2
|
||
|
|
INEXT=I1
|
||
|
|
ELSE
|
||
|
|
IFIRST=I1
|
||
|
|
INEXT=I2
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C CHECK AN ARC LINE
|
||
|
|
|
||
|
|
ELSEIF(((LTYPE(II).EQ.3).OR.(LTYPE(II).EQ.4).OR.
|
||
|
|
+ (LTYPE(II).EQ.6)).AND.(J3.GT.0))THEN
|
||
|
|
CALL ARCPAR(MP,LTYPE(II),ILINE(II),COOR,LINKP,J1,J2,
|
||
|
|
+ J3,I3,XCEN,YCEN,THETA1,THETA2,TANG,R1,R2,ERR,
|
||
|
|
+ ICCW,ICW,XK,XA)
|
||
|
|
IF(.NOT.ERR)THEN
|
||
|
|
|
||
|
|
C SET THE ARC AS EITHER AN UPWARD ARCH OR DOWNWARD ARCH
|
||
|
|
C (A CLOSED CIRCLE IS ALWAYS AN UPWARD ARCH)
|
||
|
|
|
||
|
|
IF(J1.EQ.J2)THEN
|
||
|
|
UP=.TRUE.
|
||
|
|
ELSEIF(COOR(1,ICCW).GE.COOR(1,ICW))THEN
|
||
|
|
UP=.TRUE.
|
||
|
|
ELSE
|
||
|
|
UP=.FALSE.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C THE INPUT POINT IS RIGHT AT THE CENTER OF THE CIRCLE
|
||
|
|
|
||
|
|
IF((Y.EQ.YCEN).AND.(X.EQ.XCEN))THEN
|
||
|
|
RP=0.
|
||
|
|
THETAP=(THETA1+THETA2)*.5
|
||
|
|
ELSE
|
||
|
|
THETAP=ATAN2(Y-YCEN,X-XCEN)
|
||
|
|
RP=SQRT( ((X-XCEN)**2) + ((Y-YCEN)**2) )
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C SEE IF THE POINT ANGLE IS WITHIN THE BEGINNING AND ENDING ANGLES
|
||
|
|
|
||
|
|
IF( ( (THETAP.LE.THETA2) .AND. (THETAP.GE.THETA1) )
|
||
|
|
& .OR.
|
||
|
|
& ( (THETAP+TWOPI.LE.THETA2) .AND.
|
||
|
|
& (THETAP+TWOPI.GE.THETA1) )
|
||
|
|
& .OR.
|
||
|
|
& ( (THETAP.LE.THETA1) .AND. (THETAP.GE.THETA2) )
|
||
|
|
& .OR.
|
||
|
|
& ( (THETAP+TWOPI.LE.THETA1) .AND.
|
||
|
|
& (THETAP+TWOPI.GE.THETA2) ) ) THEN
|
||
|
|
|
||
|
|
C SEE IF THE POINT TO CENTER DISTANCE IS LESS THAN THE
|
||
|
|
C ARC RADIUS AT THAT ANGLE FOR AN UPWARD ARC OR GREATER FOR
|
||
|
|
C A DOWNWARD ARC (BELOW THE ARC)
|
||
|
|
|
||
|
|
RTEST = XA * EXP ( XK * THETAP )
|
||
|
|
IF( ( (UP) .AND. (RTEST.GE.RP) ) .OR.
|
||
|
|
+ ( (.NOT.UP) .AND. (RTEST.LE.RP) ) )THEN
|
||
|
|
|
||
|
|
C CHECK Y DISTANCE TO THE LINE - RECORD LINE NO. IF CLOSEST
|
||
|
|
|
||
|
|
CALL ARCY(XCEN,YCEN,THETA1,THETA2,XK,XA,
|
||
|
|
+ X,YTRY,ERR)
|
||
|
|
DTRY=YTRY-Y
|
||
|
|
IF( (.NOT.ERR) .AND.
|
||
|
|
+ (YTRY .GT. Y) .AND.
|
||
|
|
+ ( (DTRY.LE.DIST) .OR.
|
||
|
|
+ (ABS(DIST-DTRY).LT..001*DIST)))THEN
|
||
|
|
DIST=DTRY
|
||
|
|
IFIND=I
|
||
|
|
INDEX=II
|
||
|
|
IF(UP)THEN
|
||
|
|
IFIRST=IPOINT(ICW)
|
||
|
|
INEXT=IPOINT(ICCW)
|
||
|
|
ELSE
|
||
|
|
IFIRST=IPOINT(ICCW)
|
||
|
|
INEXT=IPOINT(ICW)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C THE ONLY OTHER ARC POSSIBILITY IS IF THE X FALLS IN THE SPAN
|
||
|
|
C BETWEEN THE TWO ENDPOINTS OR BETWEEN END POINTS AND CENTER POINT
|
||
|
|
|
||
|
|
ELSEIF ( ((X - COOR(1,J1) ) *
|
||
|
|
+ (X - COOR(1,J2) ) .LT.0)
|
||
|
|
+ .OR.
|
||
|
|
+ ((X - COOR(1,J1) ) *
|
||
|
|
+ (X - COOR(1,J3) ) .LT.0)
|
||
|
|
+ .OR.
|
||
|
|
+ ((X - COOR(1,J2) ) *
|
||
|
|
+ (X - COOR(1,J3) ) .LT.0) ) THEN
|
||
|
|
|
||
|
|
C CHECK Y DISTANCE TO THE LINE - RECORD LINE NO. IF CLOSEST
|
||
|
|
|
||
|
|
CALL ARCY(XCEN,YCEN,THETA1,THETA2,XK,XA,
|
||
|
|
+ X,YTRY,ERR)
|
||
|
|
DTRY=YTRY-Y
|
||
|
|
IF( (.NOT.ERR) .AND.
|
||
|
|
+ (YTRY .GT. Y) .AND.
|
||
|
|
+ ( (DTRY.LE.DIST) .OR.
|
||
|
|
+ (ABS(DIST-DTRY).LT..001*DIST)))THEN
|
||
|
|
DIST=DTRY
|
||
|
|
IFIND=I
|
||
|
|
INDEX=II
|
||
|
|
|
||
|
|
C TREAT THE BETWEEN END POINTS DIFFERENTLY THAN BETWEEN
|
||
|
|
C ENDPOINT AND CENTER POINT
|
||
|
|
|
||
|
|
IF( ((X - COOR(1,J1) ) *
|
||
|
|
+ (X - COOR(1,J2) )) .LT.0) THEN
|
||
|
|
IF(UP)THEN
|
||
|
|
IFIRST=IPOINT(ICW)
|
||
|
|
INEXT=IPOINT(ICCW)
|
||
|
|
ELSE
|
||
|
|
IFIRST=IPOINT(ICCW)
|
||
|
|
INEXT=IPOINT(ICW)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
IF( COOR(2,ICCW) .GT.
|
||
|
|
+ COOR(2,ICW) ) THEN
|
||
|
|
IFIRST=IPOINT(ICCW)
|
||
|
|
INEXT=IPOINT(ICW)
|
||
|
|
ELSE
|
||
|
|
IFIRST=IPOINT(ICW)
|
||
|
|
INEXT=IPOINT(ICCW)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|