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