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.
 
 
 
 
 
 

69 lines
2.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 ARCY (XCEN, YCEN, THETA1, THETA2, XK, XA, X, YTRY, ERR)
C***********************************************************************
C SUBROUTINE ARCY = ITERATIVELY SOLVES THE LOGARITHMIC SPIRAL PROBLEM
C TO DETERMINE A Y VALUE GIVEN AN X THAT INTERSECTS
C THE ARC
C***********************************************************************
LOGICAL ERR
C START WITH 10 INCREMENTS, EACH PASS INCREMENTS DECREASE TEN FOLD
ANGINC = (THETA2 - THETA1) * .05
ANG = THETA1
F1 = SPIRAL (XA, XK, X, XCEN, YCEN, ANG)
IF (F1 .EQ. 0.0) THEN
THETA = ANG
GO TO 110
END IF
ANG2 = ANG + ANGINC
100 CONTINUE
F2 = SPIRAL (XA, XK, X, XCEN, YCEN, ANG2)
IF (F2 .EQ. 0.0) THEN
THETA = ANG2
ELSE IF (F1*F2 .LT. 0.0) THEN
THETA = SOLVE(XA, XK, X, XCEN, YCEN, ANG, ANG2)
ELSE
ANG = ANG2
ANG2 = ANG2 + ANGINC
IF (ANG2 .LE. THETA2) GO TO 100
ERR = .TRUE.
GO TO 120
END IF
110 CONTINUE
YTRY = (XA * EXP(XK * THETA)) * SIN(THETA) + YCEN
120 CONTINUE
C FIND THE SECOND ROOT IF THE FIRST ONE HAS BEEN LOCATED
IF(.NOT.ERR)THEN
ANG=THETA+ANGINC
F1 = SPIRAL (XA, XK, X, XCEN, YCEN, ANG)
F2 = SPIRAL (XA, XK, X, XCEN, YCEN, THETA2)
IF (F1 .EQ. 0.0) THEN
THETA = ANG
ELSEIF (F2 .EQ. 0.0) THEN
THETA = THETA2
ELSE IF (F1*F2 .LT. 0.0) THEN
THETA = SOLVE(XA, XK, X, XCEN, YCEN, ANG, THETA2)
ELSE
GO TO 130
END IF
END IF
YTRY2 = (XA * EXP(XK * THETA)) * SIN(THETA) + YCEN
YTRY = MAX(YTRY,YTRY2)
130 CONTINUE
RETURN
END