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.
155 lines
5.0 KiB
155 lines
5.0 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 ELPSPR (MP, KT, KNUM, COOR, LINKP, IPNTR1, IPNTR2,
|
|
& IPNTR3, IP3, XCEN, YCEN, THETA1, THETA2, TANG, ICCW, ICW,
|
|
& AVALUE, BVALUE, ERR)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE ELPSPR = THIS ROUTINE CALCULATES THE ELIPSE PARAMETERS
|
|
|
|
C***********************************************************************
|
|
|
|
C VARIABLES USED:
|
|
C TANG = TOTAL ANGLE SCRIBED BY THE ARC
|
|
C THETA1 = FIRST CCW ANGLE OF THE ARC
|
|
C THETA2 = SECOND CCW ANGLE OF THE ARC
|
|
C IPNTR1 = POINTER TO FIRST COORDINATE VALUE
|
|
C IPNTR2 = POINTER TO SECOND COORDINATE VALUE
|
|
C IPNTR3 = POINTER TO THIRD COORDINATE VALUE
|
|
C IP3 = THE THIRD POINT NUMBER (CAN BE NEGATED)
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION COOR (2, MP), LINKP (2, MP)
|
|
|
|
LOGICAL ERR
|
|
|
|
PI = ATAN2(0.0, -1.0)
|
|
|
|
TWOPI = PI + PI
|
|
ERR = .FALSE.
|
|
|
|
C ELIPSE GOES FROM 1ST POINT TO 2ND IN *COUNTER-CLOCKWISE* DIRECTION.
|
|
|
|
XCEN = COOR (1, IPNTR3)
|
|
YCEN = COOR (2, IPNTR3)
|
|
|
|
C CHECK TO MAKE SURE THAT THE BEGINNING AND ENDING RADIUS EXIST
|
|
|
|
IF (( (COOR (1, IPNTR1) .EQ. XCEN).AND.
|
|
& (COOR (2,IPNTR1) .EQ. YCEN)).OR.
|
|
& ((COOR (1, IPNTR2) .EQ. XCEN).AND.
|
|
& (COOR (2, IPNTR2) .EQ. YCEN)))THEN
|
|
CALL PLTFLU
|
|
WRITE (*, 10000)ABS (KNUM)
|
|
ERR = .TRUE.
|
|
GOTO 100
|
|
ENDIF
|
|
THETA1 = ATAN2 (COOR (2, IPNTR1) - YCEN, COOR (1, IPNTR1) - XCEN)
|
|
THETA2 = ATAN2 (COOR (2, IPNTR2) - YCEN, COOR (1, IPNTR2) - XCEN)
|
|
|
|
C NOW CALCULATE THE MAJOR AXIS (AVALUE) AND THE MINOR AXIS (BVALUE)
|
|
|
|
X1 = COOR (1, IPNTR1) - XCEN
|
|
Y1 = COOR (2, IPNTR1) - YCEN
|
|
X2 = COOR (1, IPNTR2) - XCEN
|
|
Y2 = COOR (2, IPNTR2) - YCEN
|
|
|
|
C CHOOSE THE APPROPRIATE ELIPSE DEFINITION
|
|
|
|
IF (Y1 * Y1 .EQ. Y2 * Y2) THEN
|
|
AVALUE = SQRT (X1 * X1 + Y1 * Y1)
|
|
BVALUE = AVALUE
|
|
ELSEIF ((Y1 .EQ. 0.) .AND. (X2 .EQ. 0.)) THEN
|
|
AVALUE = X1
|
|
BVALUE = Y2
|
|
ELSEIF ((Y2 .EQ. 0.) .AND. (X1 .EQ. 0.)) THEN
|
|
AVALUE = X2
|
|
BVALUE = Y1
|
|
ELSE
|
|
RATIO = SQRT (ABS ( (X1 * X1 - X2 * X2) /
|
|
& (Y1 * Y1 - Y2 * Y2) ))
|
|
IF (RATIO .EQ. 0.) THEN
|
|
AVALUE = SQRT (X1 * X1 + Y1 * Y1)
|
|
BVALUE = AVALUE
|
|
ELSEIF (RATIO .EQ. 1.0) THEN
|
|
AVALUE = SQRT (X1 * X1 + Y1 * Y1)
|
|
BVALUE = AVALUE
|
|
ELSE
|
|
IF ((Y2 .EQ. 0.) .OR. ((X2 .EQ. 0.) .AND. (Y1 .NE. 0.)) )
|
|
& THEN
|
|
IF (RATIO .GT. 1.) THEN
|
|
VX = 1.
|
|
VY = - (1./RATIO**2) * (X1 / Y1)
|
|
ELSE
|
|
VX = 1.
|
|
VY = - (RATIO**2) * (X1 / Y1)
|
|
ENDIF
|
|
D0 = SQRT (X1 * X1 + Y1 * Y1)
|
|
A8 = ACOS ( ((X1 * VX) + (Y1 * VY)) /
|
|
& (D0 * SQRT (VX * VX + VY * VY)) )
|
|
A7 = PI - A8
|
|
A2 = ABS (ATAN2 (Y1, X1))
|
|
THETA1 = ABS(ATAN2 (VY, 1.))
|
|
ELSE
|
|
IF (RATIO .GT. 1.) THEN
|
|
VX = 1.
|
|
VY = - (1./RATIO**2) * (X2 / Y2)
|
|
ELSE
|
|
VX = 1.
|
|
VY = - (RATIO**2) * (X2 / Y2)
|
|
ENDIF
|
|
D0 = SQRT (X2 * X2 + Y2 * Y2)
|
|
A8 = ACOS ( ((X2 * VX) + (Y2 * VY)) /
|
|
& (D0 * SQRT (VX * VX + VY * VY)) )
|
|
A7 = PI - A8
|
|
A2 = ABS (ATAN2 (Y2, X2))
|
|
THETA1 = ABS(ATAN2 (VY, 1.))
|
|
ENDIF
|
|
|
|
RADMAX = MAX(A7,A8)
|
|
CALL ETHETA (A7, A8, A2, THETA1, RADMAX, THETA, ERR)
|
|
IF (ERR) THEN
|
|
WRITE (*, 10010) ABS (KNUM)
|
|
GOTO 100
|
|
ENDIF
|
|
|
|
CVALUE = D0 * SIN (A8 - THETA) / SIN (A2 - A8 + THETA)
|
|
BVALUE = SQRT (ABS (CVALUE **2 / (RATIO **2 - 1)) )
|
|
AVALUE = BVALUE * RATIO
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C NOW GET THE ANGLES GOING THE RIGHT WAY
|
|
|
|
THETA1 = ATAN2 (COOR (2, IPNTR1) - YCEN, COOR (1, IPNTR1) - XCEN)
|
|
THETA2 = ATAN2 (COOR (2, IPNTR2) - YCEN, COOR (1, IPNTR2) - XCEN)
|
|
IF (IPNTR1 .EQ. IPNTR2) THEN
|
|
THETA2 = THETA1 + TWOPI
|
|
ELSEIF ( (IP3 .GE. 0) .AND. (THETA2 .LE. THETA1) ) THEN
|
|
THETA2 = THETA2+TWOPI
|
|
ELSEIF ( (IP3 .LT. 0) .AND. (THETA1 .LE. THETA2) ) THEN
|
|
THETA1 = THETA1+TWOPI
|
|
ENDIF
|
|
TANG = THETA2 - THETA1
|
|
IF (IP3 .LT. 0) THEN
|
|
ICCW = IPNTR2
|
|
ICW = IPNTR1
|
|
ELSE
|
|
ICCW = IPNTR1
|
|
ICW = IPNTR2
|
|
ENDIF
|
|
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (' CENTER POINT FOR LINE', I5, ' LIES ON ONE OF',
|
|
& ' THE ENDPOINTS')
|
|
10010 FORMAT (' POINTS GIVEN FOR LINE', I5, ' DO NOT DEFINE AN ELIPSE')
|
|
|
|
END
|
|
|