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 CRCSIZ (MAXNP, X, Y, NINT, N, XEND, YEND, XCEN, YCEN,
& THETA1, THETA2, TANG, AA, BB, ERR, TEST, XNOLD, YNOLD, NXKOLD,
& LINKEG, LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN,
& GRAPH)
C***********************************************************************
C SUBROUTINE CRCSIZ = GETS INTERVALS ON AN ARC LINE BASED ON ERROR
C SIZE
C***********************************************************************
DIMENSION X (MAXNP), Y (MAXNP)
DIMENSION XNOLD(NPNOLD), YNOLD(NPNOLD), NXKOLD(NNXK, NPEOLD)
DIMENSION LINKEG(2, MLINK), LISTEG(4 * NPEOLD), BMESUR(NPNOLD)
LOGICAL GRAPH, REMESH, TEST, ERR, SGRAPH, MOVED
IF (GRAPH) THEN
SGRAPH = .TRUE.
ELSE
SGRAPH = .FALSE.
ENDIF
ITERAT = 100
EPS = .01
DELANG = 0.
ANGNOW = 0.
INTNOW = 0
IF (GRAPH) THEN
CALL SYMBOL (1, X(1), Y(1), 'DIAMND')
CALL PLTFLU
ENDIF
100 CONTINUE
INTNOW = INTNOW + 1
IF ( ((TANG .GT. 0.) .AND.
& (THETA1 + ANGNOW + (DELANG * 1.3) .GT. TANG))
& .OR. ((TANG .LT. 0.) .AND.
& (THETA1 + ANGNOW + (DELANG * 1.3) .LT. TANG))
& ) THEN
C THE END OF THE LINE (OR CLOSE ENOUGH) HAS BEEN REACHED
C IF WE ARE TESTING OR THE INTERVALS MATCH, THEN SIMPLY FINISH THE
C LINE.
IF ((TEST) .OR. (INTNOW .EQ. NINT)) THEN
NINT = INTNOW
N = NINT + 1
X(N) = XEND
Y(N) = YEND
IF (GRAPH) THEN
CALL SYMBOL (1, X(INTNOW), Y(INTNOW), 'DIAMND')
CALL MPD2VC (1, X(INTNOW), Y(INTNOW),
& X(N), Y(N))
CALL SYMBOL (1, X(N), Y(N), 'DIAMND')
CALL PLTFLU
ENDIF
ELSE
C OTHERWISE, MAKE SURE THE INTERVALS ARE ALRIGHT AND ADD THE EXTRA ONE
EPS = .001
IF (INTNOW + 1 .NE. NINT) THEN
CALL MESSAGE('** PROBLEMS WITH INTNOW '//
& 'IN PLINE **')
ERR = .TRUE.
GOTO 160
ENDIF
ANG = THETA1 + ANGNOW +
& ((TANG - (THETA1 + ANGNOW)) * .5)
RADIUS = BB * EXP (AA * ANG)
X (INTNOW + 1) = XCEN + COS (ANG) * RADIUS
Y (INTNOW + 1) = YCEN + SIN (ANG) * RADIUS
N = NINT + 1
X(N) = XEND
Y(N) = YEND
IF (GRAPH) THEN
CALL SYMBOL (1, X(INTNOW + 1), Y(INTNOW + 1),
& 'DIAMND')
CALL SYMBOL (1, X(N), Y(N),
& 'DIAMND')
CALL MPD2VC (1, X(INTNOW), Y(INTNOW),
& X(INTNOW+1), Y(INTNOW+1))
CALL MPD2VC (1, X(INTNOW+1), Y(INTNOW+1),
& X(N), Y(N))
CALL PLTFLU
ENDIF
ENDIF
ELSE
C NOT TO THE END YET
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG,
& BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX,
& EMIN, X(INTNOW), Y(INTNOW), S1)
DELANG = S1 / (BB * EXP (AA * (THETA1 + ANGNOW)))
IF (TANG .LT. 0.) DELANG = - DELANG
ANG1 = ANGNOW + DELANG
RAD1 = BB * EXP (AA * (THETA1 + ANG1))
XNEW1 = XCEN + COS (THETA1 + ANG1) * RAD1
YNEW1 = YCEN + SIN (THETA1 + ANG1) * RAD1
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG,
& BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX,
& EMIN, XNEW1, YNEW1, S2)
DELANG = ((S1 + S2) * .5) / (BB * EXP (AA * (THETA1 + ANGNOW)))
IF (TANG .LT. 0.) DELANG = - DELANG
ANG1 = ANGNOW + DELANG
RAD1 = BB * EXP (AA * (THETA1 + ANG1))
XNEW1 = XCEN + COS (THETA1 + ANG1) * RAD1
YNEW1 = YCEN + SIN (THETA1 + ANG1) * RAD1
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG,
& BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX,
& EMIN, XNEW1, YNEW1, S3)
SIZNOW = (((S1 + S2) * .5) + S3) * .5
DELANG = SIZNOW / (BB * EXP (AA * (THETA1 + ANGNOW)))
IF (TANG .LT. 0.) DELANG = - DELANG
ANGNOW = ANGNOW + DELANG
RADIUS = BB * EXP (AA * (THETA1 + ANGNOW))
X (INTNOW + 1) = XCEN + COS (THETA1 + ANGNOW) * RADIUS
Y (INTNOW + 1) = YCEN + SIN (THETA1 + ANGNOW) * RADIUS
IF (GRAPH) THEN
CALL SYMBOL (1, X(INTNOW + 1), Y(INTNOW + 1),
& 'DIAMND')
CALL MPD2VC (1, X(INTNOW), Y(INTNOW),
& X(INTNOW+1), Y(INTNOW+1))
CALL PLTFLU
ENDIF
GOTO 100
ENDIF
C ERASE THE LINES FOR SMOOTHING IF NEEDED
IF ((.NOT. SGRAPH) .AND. (GRAPH)) THEN
DO 110 J = 2, NINT
CALL LCOLOR ('BLACK')
CALL MPD2VC (1, X(J), Y(J), X(J+1), Y(J+1))
CALL MPD2VC (1, X(J), Y(J), X(J-1), Y(J-1))
CALL SYMBOL (1, X(J), Y(J), 'DIAMND')
CALL LCOLOR ('WHITE')
CALL PLTFLU
110 CONTINUE
ENDIF
C NOW SMOOTH THE NODES ALONG THE LINE
DO 130 I = 1, ITERAT
MOVED = .FALSE.
ANGNOW = 0.
DO 120 J = 2, NINT
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK,
& REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN, X(J-1), Y(J-1), SIZE1)
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK,
& REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN, X(J), Y(J), SIZE2)
CALL GETSIZ (XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK,
& REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN, X(J+1), Y(J+1), SIZE3)
DIST1 = SQRT ( ((X(J-1) - X(J)) **2) +
& ((Y(J-1) - Y(J)) **2) )
DIST2 = SQRT ( ((X(J) - X(J+1)) **2) +
& ((Y(J) - Y(J+1)) **2) )
DTOTAL = DIST1 + DIST2
RATIO = DIST1 / DTOTAL
DRATIO = ((SIZE1 + SIZE2) * .5) /
& ( ((SIZE1 + SIZE2) * .5) +
& ((SIZE2 + SIZE3) * .5) )
TRATIO = (RATIO + DRATIO) * .5
IF (SGRAPH) THEN
CALL LCOLOR ('BLACK')
CALL MPD2VC (1, X(J), Y(J), X(J+1), Y(J+1))
CALL MPD2VC (1, X(J), Y(J), X(J-1), Y(J-1))
CALL SYMBOL (1, X(J), Y(J), 'DIAMND')
CALL LCOLOR ('WHITE')
CALL PLTFLU
ENDIF
SIZNOW = DTOTAL * TRATIO
DELANG = SIZNOW / (BB * EXP (AA * (THETA1 + ANGNOW)))
IF (TANG .LT. 0.) DELANG = -DELANG
ANGNOW = ANGNOW + DELANG
ANG = THETA1 + ANGNOW
RADIUS = BB * EXP (AA * ANG)
X (J) = XCEN + COS (ANG) * RADIUS
Y (J) = YCEN + SIN (ANG) * RADIUS
IF (SGRAPH) THEN
CALL MPD2VC (1, X(J), Y(J), X(J+1), Y(J+1))
CALL MPD2VC (1, X(J), Y(J), X(J-1), Y(J-1))
CALL SYMBOL (1, X(J), Y(J), 'DIAMND')
CALL PLTFLU
ENDIF
DX1 = DIST1 / (.5 * (SIZE1 + SIZE2))
DX2 = DIST2 / (.5 * (SIZE2 + SIZE3))
IF (J .EQ. 2) THEN
DXMAX = AMAX1 (DX1, DX2)
ELSE
DXMAX = AMAX1 (DXMAX, DX1, DX2)
ENDIF
DT = ABS((TRATIO * DTOTAL) - DIST1)
IF (DT/DTOTAL .GT. EPS) MOVED = .TRUE.
120 CONTINUE
IF (.NOT. MOVED) GOTO 140
130 CONTINUE
140 CONTINUE
IF ((.NOT. SGRAPH) .AND. (GRAPH)) THEN
DO 150 J = 2, NINT
CALL MPD2VC (1, X(J), Y(J), X(J+1), Y(J+1))
CALL MPD2VC (1, X(J), Y(J), X(J-1), Y(J-1))
CALL SYMBOL (1, X(J), Y(J), 'DIAMND')
CALL PLTFLU
150 CONTINUE
ENDIF
160 CONTINUE
RETURN
END