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.
243 lines
8.1 KiB
243 lines
8.1 KiB
2 years ago
|
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 ADJROW (MXND, MLN, NUID, XN, YN, ZN, LXK, KXL, NXL,
|
||
|
|
& LXN, ANGLE, BNSIZE, LNODES, NLOOP, IAVAIL, NAVAIL, XMIN, XMAX,
|
||
|
|
& YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN, LLLOLD, NNNOLD,
|
||
|
|
& NODE, NADJ1, NADJ2, NNN2, GRAPH, VIDEO, KREG, DEFSIZ, ADJTED,
|
||
|
|
& NOROOM, ERR)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE ADJROW = ADJUSTS A ROW OF ELEMENTS BETWEEN TWO CORNERS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
COMMON /TIMING/ TIMEA, TIMEP, TIMEC, TIMEPC, TIMEAJ, TIMES
|
||
|
|
|
||
|
|
DIMENSION XN (MXND), YN (MXND), ZN (MXND), NUID (MXND)
|
||
|
|
DIMENSION LXK (4, MXND), KXL (2, 3*MXND)
|
||
|
|
DIMENSION NXL (2, 3*MXND), LXN (4, MXND)
|
||
|
|
DIMENSION ANGLE (MXND), BNSIZE (2, MXND), LNODES (MLN, MXND)
|
||
|
|
|
||
|
|
LOGICAL ERR, GRAPH, ADJTED, VIDEO, NOROOM
|
||
|
|
|
||
|
|
CHARACTER*3 DEV1
|
||
|
|
|
||
|
|
DATA TMIN1 /.80/, TMIN2 /.3/, WMIN1 /1.25/, WMIN2 /1.35/
|
||
|
|
|
||
|
|
PI = ATAN2(0.0, -1.0)
|
||
|
|
CALL GETIME (TIME1)
|
||
|
|
ERR = .FALSE.
|
||
|
|
EPS = .0523599
|
||
|
|
|
||
|
|
C START BY SETTING UP THE LIMITS OF THE SEARCH
|
||
|
|
|
||
|
|
IF (NADJ1 .EQ. NADJ2) THEN
|
||
|
|
N2 = LNODES (3, NADJ1)
|
||
|
|
KOUNT = 0
|
||
|
|
100 CONTINUE
|
||
|
|
KOUNT = KOUNT + 1
|
||
|
|
IF ((ANGLE (N2) .GE. PI - EPS) .AND.
|
||
|
|
& (ANGLE (N2) .LE. PI + EPS)) THEN
|
||
|
|
NADJ1 = N2
|
||
|
|
NADJ2 = N2
|
||
|
|
TEPS = .95 * (PI -
|
||
|
|
& ( (DBLE(NLOOP - 2) * PI) / DBLE(NLOOP)))
|
||
|
|
IF (TEPS .LE. EPS) EPS = TEPS
|
||
|
|
GOTO 110
|
||
|
|
ELSEIF (N2 .EQ. NADJ2) THEN
|
||
|
|
TEPS = .95 * (PI -
|
||
|
|
& ( (DBLE(NLOOP - 2) * PI) / DBLE(NLOOP)))
|
||
|
|
IF (TEPS .LE. EPS) EPS = TEPS
|
||
|
|
GOTO 110
|
||
|
|
ELSEIF (KOUNT .GT. NLOOP) THEN
|
||
|
|
CALL MESSAGE('** PROBLEMS IN ADJROW WITH LOOP NOT '//
|
||
|
|
& 'CLOSING **')
|
||
|
|
ERR = .TRUE.
|
||
|
|
GOTO 160
|
||
|
|
ELSE
|
||
|
|
N2 = LNODES (3, N2)
|
||
|
|
GOTO 100
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
110 CONTINUE
|
||
|
|
N1 = LNODES (3, NADJ1)
|
||
|
|
ADJTED = .FALSE.
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
IF (N1 .EQ. NADJ2) GOTO 150
|
||
|
|
|
||
|
|
C CHECK A STRING OF CONCAVE (< PI) INTERIOR ANGLES FOR NEEDING A
|
||
|
|
C TUCK INSERTED SOMEWHERE
|
||
|
|
|
||
|
|
IF ((ANGLE (N1) .LT. PI - EPS) .AND. (LNODES (8, N1) .GT. 1) .AND.
|
||
|
|
& (LXN (4, N1) .EQ. 0) .AND. (LXN (3, N1) .GT. 0)) THEN
|
||
|
|
|
||
|
|
C ADDED UP THE TURNING ANGLE AND THE AVERAGE SIZE REDUCTION
|
||
|
|
|
||
|
|
TANG = 0.
|
||
|
|
KANG = 0
|
||
|
|
RATIO = 0.
|
||
|
|
N11 = N1
|
||
|
|
130 CONTINUE
|
||
|
|
TANG = TANG + (PI - ANGLE (N11) )
|
||
|
|
KANG = KANG + 1
|
||
|
|
N0 = LNODES (2, N11)
|
||
|
|
N2 = LNODES (3, N11)
|
||
|
|
DIST = .5 * (SQRT ( ((XN (N0) - XN (N11)) ** 2) +
|
||
|
|
& ((YN (N0) - YN (N11)) ** 2) ) +
|
||
|
|
& SQRT ( ((XN (N2) - XN (N11)) ** 2) +
|
||
|
|
& ((YN (N2) - YN (N11)) ** 2) ) )
|
||
|
|
IF (DEFSIZ .GT. 0.) THEN
|
||
|
|
IF (DIST .LT. DEFSIZ) THEN
|
||
|
|
RATIO = RATIO + ( DIST / BNSIZE (1, N11) )
|
||
|
|
ELSE
|
||
|
|
RATIO = RATIO + ( DIST / DEFSIZ)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
RATIO = RATIO + ( DIST / BNSIZE (1, N11) )
|
||
|
|
ENDIF
|
||
|
|
N11 = LNODES (3, N11)
|
||
|
|
IF ((N11 .NE. NADJ2) .AND. (ANGLE (N11) .LT. PI - EPS) .AND.
|
||
|
|
& (LXN (4, N11) .EQ. 0) .AND. (LXN (3, N11) .GT. 0) .AND.
|
||
|
|
& (LNODES (8, N11) .GT. 1)) GOTO 130
|
||
|
|
KANG = KANG
|
||
|
|
|
||
|
|
C NOW SEE IF THIS PORTION OF THE ROW NEEDS ADJUSTED WITH A TUCK(S)
|
||
|
|
|
||
|
|
IF (KANG .GE. 1) THEN
|
||
|
|
RATIO = RATIO / DBLE(KANG)
|
||
|
|
|
||
|
|
C** THIS CRITERIA SHOULD HELP ALLEVIATE THE LONG SKINNY
|
||
|
|
C** ELEMENT FORMATIONS WHEN TRANSITIONING.
|
||
|
|
|
||
|
|
IF ( ((RATIO .LT. TMIN1) .AND. (TANG .GT. 1.2217)) .OR.
|
||
|
|
& ((RATIO .LT. TMIN2) .AND. (TANG .GT. .9)) ) THEN
|
||
|
|
IF ((GRAPH) .OR. (VIDEO)) THEN
|
||
|
|
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
|
||
|
|
IF (VIDEO) CALL SNAPIT (1)
|
||
|
|
ENDIF
|
||
|
|
N11OLD = N11
|
||
|
|
CALL ADDTUK (MXND, MLN, NUID, XN, YN, ZN, LXK, KXL, NXL,
|
||
|
|
& LXN, LNODES, ANGLE, NLOOP, IAVAIL, NAVAIL, LLL, KKK,
|
||
|
|
& NNN, TANG, KANG, N1, N11, NODE, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, GRAPH, VIDEO, DEV1, NOROOM, ERR)
|
||
|
|
IF ((NOROOM) .OR. (ERR)) GOTO 160
|
||
|
|
|
||
|
|
C MAKE SURE THAT THE TUCK DOES NOT ELIMINATE THE END NODES FOR THE LOOP
|
||
|
|
|
||
|
|
IF (N11 .NE. N11OLD) THEN
|
||
|
|
IF (NADJ2 .EQ. N11OLD) NADJ2 = N11
|
||
|
|
IF (NODE .EQ. N11OLD) NODE = N11
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
NNNOLD = NNN
|
||
|
|
LLLOLD = LLL
|
||
|
|
ADJTED = .TRUE.
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
N1 = N11
|
||
|
|
GOTO 120
|
||
|
|
|
||
|
|
C CHECK A STRING OF CONVEX (> PI) INTERIOR ANGLES FOR NEEDING A
|
||
|
|
C WEDGE INSERTED SOMEWHERE
|
||
|
|
|
||
|
|
ELSEIF ((ANGLE (N1) .GE. PI + EPS) .AND. (LXN (3, N1) .GT. 0)
|
||
|
|
& .AND. (LXN (4, N1) .EQ. 0)) THEN
|
||
|
|
|
||
|
|
C ADD UP THE TURNING ANGLE AND THE AVERAGE SIZE REDUCTION
|
||
|
|
|
||
|
|
TANG = 0.
|
||
|
|
KANG = 0
|
||
|
|
RATIO = 0.
|
||
|
|
IDEPTH = 0
|
||
|
|
N11 = N1
|
||
|
|
140 CONTINUE
|
||
|
|
TANG = TANG + (ANGLE (N11) - PI)
|
||
|
|
KANG = KANG + 1
|
||
|
|
N0 = LNODES (2, N11)
|
||
|
|
N2 = LNODES (3, N11)
|
||
|
|
DIST = .5 * (SQRT ( ((XN (N0) - XN (N11)) ** 2) +
|
||
|
|
& ((YN (N0) - YN (N11)) ** 2) ) +
|
||
|
|
& SQRT ( ((XN (N2) - XN (N11)) ** 2) +
|
||
|
|
& ((YN (N2) - YN (N11)) ** 2) ) )
|
||
|
|
IF (DEFSIZ .GT. 0.) THEN
|
||
|
|
IF (DIST .GT. DEFSIZ) THEN
|
||
|
|
RATIO = RATIO + ( DIST / BNSIZE (1, N11) )
|
||
|
|
ELSE
|
||
|
|
RATIO = RATIO + ( DIST / DEFSIZ)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
RATIO = RATIO + ( DIST / BNSIZE (1, N11) )
|
||
|
|
ENDIF
|
||
|
|
N11 = LNODES (3, N11)
|
||
|
|
IDEPTH = MAX (IDEPTH, LNODES (8, N11))
|
||
|
|
IF ((N11 .NE. NADJ2) .AND. (ANGLE (N11) .GE. PI + EPS) .AND.
|
||
|
|
& (LXN (4, N11) .EQ. 0) .AND. (LXN (3, N11) .GT. 0)) GOTO 140
|
||
|
|
|
||
|
|
C NOW SEE IF THIS PORTION OF THE ROW NEEDS ADJUSTED WITH A WEDGE(S)
|
||
|
|
|
||
|
|
IF (KANG .GE. 1) THEN
|
||
|
|
RATIO = RATIO / DBLE(KANG)
|
||
|
|
IF ( ( ((RATIO .GT. WMIN1) .AND. (IDEPTH .GT. 1)) .OR.
|
||
|
|
& ((RATIO .GT. WMIN2) .AND. (IDEPTH .EQ. 1)) )
|
||
|
|
& .AND. (TANG .GT. 1.2217)) THEN
|
||
|
|
IF ((GRAPH) .OR. (VIDEO)) THEN
|
||
|
|
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
|
||
|
|
IF (VIDEO) CALL SNAPIT (1)
|
||
|
|
ENDIF
|
||
|
|
CALL ADDWDG (MXND, MLN, NUID, XN, YN, ZN, LXK, KXL, NXL,
|
||
|
|
& LXN, LNODES, ANGLE, BNSIZE, NLOOP, IAVAIL, NAVAIL,
|
||
|
|
& LLL, KKK, NNN, LLLOLD, NNNOLD, TANG, KANG, N1, N11,
|
||
|
|
& XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, GRAPH, VIDEO,
|
||
|
|
& DEV1, KREG, NOROOM, ERR)
|
||
|
|
IF ((NOROOM) .OR. (ERR)) GOTO 160
|
||
|
|
NNNOLD = NNN
|
||
|
|
LLLOLD = LLL
|
||
|
|
ADJTED = .TRUE.
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
N1 = N11
|
||
|
|
GOTO 120
|
||
|
|
ELSE
|
||
|
|
N1 = LNODES (3, N1)
|
||
|
|
GOTO 120
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C NOW SMOOTH, CALCULATE THE NEW ANGLES, AND PLOT IF NEEDED
|
||
|
|
|
||
|
|
150 CONTINUE
|
||
|
|
IF (ADJTED) THEN
|
||
|
|
CALL GETIME (TIME2)
|
||
|
|
TIMEAJ = TIMEAJ + TIME2 - TIME1
|
||
|
|
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
|
||
|
|
& LLL, NNN, NNN2, LNODES, BNSIZE, NLOOP, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, DEV1, KREG)
|
||
|
|
CALL GETIME (TIME1)
|
||
|
|
CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN, NLOOP,
|
||
|
|
& ANGLE, LNODES, N1, LLL, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX,
|
||
|
|
& DEV1, KREG, ERR)
|
||
|
|
IF (ERR) GOTO 160
|
||
|
|
IF ((GRAPH) .OR. (VIDEO)) THEN
|
||
|
|
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
|
||
|
|
IF (VIDEO) CALL SNAPIT (1)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
160 CONTINUE
|
||
|
|
|
||
|
|
CALL GETIME (TIME2)
|
||
|
|
TIMEAJ = TIMEAJ + TIME2 - TIME1
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|