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 LINLEN (MP, COOR, LINKP, KNUM, LNUM, KT, I3, J1, J2, & J3, DIST, ERR) C*********************************************************************** C SUBROUTINE LINLEN = CALCULATES THE LENGTH OF A GIVEN LINE C*********************************************************************** C VARIABLES USED: C NID = AN ARRAY OF UNIQUE NODE IDENTIFIERS. C REAL = .TRUE. FOR AN ACTUAL GENERATION C = .FALSE. FOR A TRIAL GENERATION C ERR = .TRUE. IF AN ERROR WAS ENCOUNTERED C J1 = POINTER FOR THE FIRST POINT C J2 = POINTER FOR THE SECOND POINT C J3 = POINTER FOR THE THIRD POINT C MAXNP = MAXIMUM NUMBER OF NODES ON THE PERIMETER C NOTE: MAXNP MUST BE ADJUSTED FOR THE CURRENT C LOCATION IN X, Y, & NID C KT = THE LINE TYPE: C = 1 FOR STRAIGHT LINES C = 2 FOR CORNER LINES C = 3 FOR ARC WITH CENTER GIVEN C = 4 FOR ARC WITH THIRD POINT ON THE ARC C = 5 FOR PARABOLA C = 6 FOR ARC WITH RADIUS GIVEN C*********************************************************************** DIMENSION COOR (2, MP), LINKP (2, MP) LOGICAL ERR PI = ATAN2(0.0, -1.0) DIST = 0. ERR = .TRUE. C STRAIGHT LINE GENERATION IF (KT.EQ.1) THEN YDIFF = COOR (2, J2) -COOR (2, J1) XDIFF = COOR (1, J2) -COOR (1, J1) DIST = SQRT (YDIFF ** 2 + XDIFF ** 2) IF (DIST.EQ.0.) THEN WRITE (*, 10000) KNUM RETURN ENDIF C CORNER GENERATION ELSEIF (KT.EQ.2) THEN XDA = COOR (1, J3) -COOR (1, J1) YDA = COOR (2, J3) -COOR (2, J1) XDB = COOR (1, J2) -COOR (1, J3) YDB = COOR (2, J2) -COOR (2, J3) DA = SQRT (XDA ** 2 + YDA ** 2) DB = SQRT (XDB ** 2 + YDB ** 2) IF ((DA.EQ.0.) .OR. (DB.EQ.0.) )THEN WRITE (*, 10000) KNUM RETURN ENDIF DIST = DA+DB C CIRCULAR ARC ELSEIF ((KT.EQ.3) .OR. (KT.EQ.4) .OR. (KT.EQ.6) )THEN XSTART = COOR (1, J1) YSTART = COOR (2, J1) CALL ARCPAR (MP, KT, KNUM, COOR, LINKP, J1, J2, J3, I3, & XCEN, YCEN, THETA1, THETA2, TANG, R1, R2, ERR, ICCW, ICW, & XK, XA) C GENERATE THE CIRCLE ANG = THETA1 DEL = TANG/30 DO 100 I = 2, 29 ANG = ANG+DEL RADIUS = XA * EXP (XK * ANG) XEND = XCEN+COS (ANG) * RADIUS YEND = YCEN+SIN (ANG) * RADIUS DIST = DIST+SQRT ((XEND-XSTART) ** 2 + (YEND-YSTART) ** 2) XSTART = XEND YSTART = YEND 100 CONTINUE XEND = COOR (1, J2) YEND = COOR (2, J2) DIST = DIST+SQRT ((XEND-XSTART) ** 2 + (YEND-YSTART) ** 2) C ELIPSE ELSEIF (KT .EQ. 7) THEN XSTART = COOR (1, J1) YSTART = COOR (2, J1) CALL ELPSPR (MP, KT, KNUM, COOR, LINKP, J1, J2, J3, & I3, XCEN, YCEN, THETA1, THETA2, TANG, IDUM1, IDUM2, & AVALUE, BVALUE, ERR) C GENERATE THE ELIPSE ANG = THETA1 DEL = TANG/30 DO 110 I = 2, 29 ANG = ANG+DEL RADIUS = SQRT ( (AVALUE **2 * BVALUE **2) / & ( (BVALUE **2 * COS (ANG) **2) + & (AVALUE **2 * SIN (ANG) **2) ) ) XEND = XCEN+COS (ANG) * RADIUS YEND = YCEN+SIN (ANG) * RADIUS DIST = DIST+SQRT ((XEND-XSTART) ** 2 + (YEND-YSTART) ** 2) XSTART = XEND YSTART = YEND 110 CONTINUE XEND = COOR (1, J2) YEND = COOR (2, J2) DIST = DIST+SQRT ((XEND-XSTART) ** 2 + (YEND-YSTART) ** 2) C PARABOLA ELSEIF (KT.EQ.5) THEN C CHECK LEGITIMACY OF DATA XMID = (COOR (1, J1) +COOR (1, J2) ) * 0.5 YMID = (COOR (2, J1) +COOR (2, J2) ) * 0.5 DOT = (COOR (1, J2) -COOR (1, J1) ) * (COOR (1, J3) -XMID) & + (COOR (2, J2) -COOR (2, J1) ) * (COOR (2, J3) -YMID) PERP = SQRT ((COOR (1, J2) -COOR (1, J1) ) ** 2 + & (COOR (2, J2) - COOR (2, J1) ) ** 2) * & SQRT ((COOR (1, J3) -XMID) ** 2 + (COOR (2, J3) & -YMID) ** 2) IF (DOT.GE.0.05 * PERP) THEN WRITE (*, 10030) KNUM RETURN ENDIF C GETARC LENGTH HALFW = SQRT ((COOR (1, J2) -COOR (1, J1) ) ** 2 + & (COOR (2, J2) - COOR (2, J1) ) ** 2 ) * 0.5 IF (HALFW.EQ.0.) THEN WRITE (*, 10000) KNUM RETURN ENDIF HEIGHT = SQRT ((XMID-COOR (1, J3) ) ** 2 & + (YMID-COOR (2, J3) ) ** 2) COEF = HEIGHT/HALFW ** 2 TCOEF = 2.0 * COEF C PARC IS A STATEMENT FUNCTION PLEFT = PARC (-TCOEF * HALFW, TCOEF) ARCTOT = 2.0 * PARC (TCOEF * HALFW, TCOEF) ARCDEL = ARCTOT/30 ARCNXT = ARCDEL ARCNOW = 0.0 THETA = ATAN2 (COOR (2, J2) -COOR (2, J1) , COOR (1, J2) & - COOR (1, J1) ) C CORRECT FOR ORIENTATION CROSS = (COOR (1, J3) -XMID) * (COOR (2, J2) -COOR (2, J1) )- & (COOR (2, J3) -YMID) * (COOR (1, J2) -COOR (1, J1) ) IF (CROSS.LT.0.0) THETA = THETA+PI SINT = SIN (THETA) COST = COS (THETA) C FIND POINTS APPROXIMATELY BY INTEGRATION XL = -HALFW FL = SQRT (1.0+ (TCOEF * XL) ** 2) KOUNT = 1 DELX = 2.0 * HALFW/200.0 XSTART = COOR (1, J1) YSTART = COOR (2, J1) DO 120 I = 1, 100 FM = SQRT (1.0+ (TCOEF * (XL+DELX) ) ** 2) XR = - HALFW + DBLE(I) * 2.0 * DELX FR = SQRT (1.0+ (TCOEF * XR) ** 2) ARCOLD = ARCNOW ARCNOW = ARCNOW+DELX * (FL+4.0 * FM+FR) / 3.0 IF (ARCNOW.GE.ARCNXT) THEN C COMPUTE POSITION IN LOCAL COORDINATE SYSTEM FRAC = (ARCNXT-ARCOLD) / (ARCNOW-ARCOLD) XK = XL+FRAC * 2.0 * DELX YK = COEF * XK ** 2 C CORRECT FOR ORIENTATION PROBLEM IF (CROSS.LT.0.0) XK = -XK C ROTATE IN LINE WITH GLOBAL COORDINATE SYSTEM ROTX = XK * COST - YK * SINT ROTY = YK * COST + XK * SINT C RESTORE XK IF (CROSS.LT.0.0) XK = -XK C TRANSLATE XEND = ROTX+COOR (1, J3) YEND = ROTY+COOR (2, J3) DIST = DIST+SQRT ((XEND-XSTART) ** 2 + (YEND-YSTART) **2) KOUNT = KOUNT+1 XSTART = XEND YSTART = YEND C PREPARE FOR NEXT POINT IF (KOUNT.GE.29) GOTO 130 ARCNXT = ARCNXT+ARCDEL C RESTART INTEGRATION XR = XK FR = SQRT (1.0+ (TCOEF * XR) ** 2) C CORRECT FOR INTEGRATION ERROR ARCNOW = PARC (TCOEF * XR, TCOEF) -PLEFT ENDIF XL = XR FL = FR 120 CONTINUE 130 CONTINUE XEND = COOR (1, J2) YEND = COOR (2, J2) DIST = DIST+SQRT ((XEND-XSTART) ** 2+ (YEND-YSTART) ** 2) ENDIF C NORMAL EXIT ERR = .FALSE. RETURN 10000 FORMAT (' ZERO LINE LENGTH ENCOUNTERED FOR LINE', I5) 10030 FORMAT (' POINTS GIVEN FOR LINE', I5, ' DO NOT DEFINE A PARABOLA') END