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 TRIDEL (MXND, MLN, XN, YN, ZN, NUID, LXK, KXL, NXL,
& LXN, NNN, LLL, KKK, NAVAIL, IAVAIL, ANGLE, LNODES, BNSIZE,
& NLOOP, DEV1, KREG, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, GRAPH,
& VIDEO, NOROOM, ERR)
C***********************************************************************
C SUBROUTINE TRIDEL = CHECKS FOR ANY TRIANGULAR SHAPED QUADS ATTACHED
C TO A THREE NODE ELEMENT AND DELETES THEM WHEN
C FOUND AND POSSIBLE
C***********************************************************************
DIMENSION ANGLE (MXND), BNSIZE (2, MXND), LNODES (MLN, MXND)
DIMENSION NODES(4), K(3)
DIMENSION LXK(4, MXND), NXL(2, 3*MXND), KXL(2, 3*MXND)
DIMENSION LXN(4, MXND), XN(MXND), YN(MXND), ZN(MXND), NUID(MXND)
CHARACTER*3 DEV1
LOGICAL ERR, DONE, GRAPH, CHECK, REDO, CCW, VIDEO, PASSED, NOROOM
PI = ATAN2(0.0, -1.0)
TWOPI = 2.0 * PI
ERR = .FALSE.
DONE = .FALSE.
CHECK = .TRUE.
CCW = .TRUE.
KMAX = 30
KOUNT = 0
KKKADD = 0
100 CONTINUE
KOUNT = KOUNT + 1
IF (KOUNT .GT. KMAX) GOTO 180
110 CONTINUE
REDO = .FALSE.
DO 120 I = 1, NNN
IF ((LXN (1, I) .GT. 0) .AND. (LXN (2, I) .GT. 0) .AND.
& (LXN (4, I) .EQ. 0)) THEN
C SEE IF A 2-LINE NODE NEEDS DELETED
IF (LXN (3, I) .LE. 0) THEN
NODE = I
KELEM = KXL (1, LXN (1, NODE))
CHECK = .FALSE.
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& NODE, ERR)
IF (ERR) GOTO 180
CALL DELEM (MXND, XN, YN, NUID, LXK, KXL, NXL, LXN,
& NNN, NAVAIL, IAVAIL, NODE, KELEM, NODE1, NODE3,
& DONE, CHECK, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 180
IF (DONE) THEN
IF (VIDEO) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
CALL SNAPIT (3)
ENDIF
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL,
& LXN, LLL, NNN, NNN, LNODES, BNSIZE, NLOOP, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
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 (3)
ENDIF
REDO = .TRUE.
ENDIF
ENDIF
ENDIF
120 CONTINUE
IF (REDO) GOTO 110
DO 170 I = 1, NNN
IF ((LXN (1, I) .GT. 0) .AND. (LXN (2, I) .GT. 0) .AND.
& (LXN (4, I) .EQ. 0)) THEN
C GET THE ATTACHED LINES AND ELEMENTS
C K(1) IS BETWEEN L1 & L2
C K(2) IS BETWEEN L2 & L3
C K(3) IS BETWEEN L3 & L1
L1 = LXN (1, I)
L2 = LXN (2, I)
L3 = LXN (3, I)
N1 = NXL (1, L1) + NXL (2, L1) - I
N2 = NXL (1, L2) + NXL (2, L2) - I
N3 = NXL (1, L3) + NXL (2, L3) - I
IF ( (KXL (1, L1) .EQ. KXL (1, L2)) .OR.
& (KXL (1, L1) .EQ. KXL (2, L2)) ) THEN
K(1) = KXL (1, L1)
ELSEIF ( (KXL (2, L1) .EQ. KXL (1, L2)) .OR.
& (KXL (2, L1) .EQ. KXL (2, L2)) ) THEN
K(1) = KXL (2, L1)
ELSE
ERR = .TRUE.
CALL MESSAGE('** PROBLEMS IN TRIDEL FINDING K(1) **')
GOTO 180
ENDIF
IF ( (KXL (1, L2) .EQ. KXL (1, L3)) .OR.
& (KXL (1, L2) .EQ. KXL (2, L3)) ) THEN
K(2) = KXL (1, L2)
ELSEIF ( (KXL (2, L2) .EQ. KXL (1, L3)) .OR.
& (KXL (2, L2) .EQ. KXL (2, L3)) ) THEN
K(2) = KXL (2, L2)
ELSE
ERR = .TRUE.
CALL MESSAGE('** PROBLEMS IN TRIDEL FINDING K(2) **')
GOTO 180
ENDIF
IF ( (KXL (1, L3) .EQ. KXL (1, L1)) .OR.
& (KXL (1, L3) .EQ. KXL (2, L1)) ) THEN
K(3) = KXL (1, L3)
ELSEIF ( (KXL (2, L3) .EQ. KXL (1, L1)) .OR.
& (KXL (2, L3) .EQ. KXL (2, L1)) ) THEN
K(3) = KXL (2, L3)
ELSE
ERR = .TRUE.
CALL MESSAGE('** PROBLEMS IN TRIDEL FINDING K(3) **')
GOTO 180
ENDIF
C NOW CHECK K(1)'S, K(2)'S, AND K(3)'S ANGLE AT THE LINE JOINT.
C THERE ARE THREE POSSIBILITIES FOR CHANGE:
C 1) ANYTHING OVER 175 DEGREES GETS THE CORRESPONDING ELEMENT
C DELETED
C 2) ANYTHING OVER 150 AND HOOKED TO ANOTHER 3-LINE NODE GETS
C THE CORRESPONDING ELEMENT DELETED
C 3) AN ELONGATED ELEMENT OVER 150 DEGREES GETS A 3 ELEMENT
C REPLACEMENT FOR THE TWO ELEMENTS THERE
TOLER1 = 2.9670597
TOLER2 = 2.6179939
IF ((GRAPH) .AND. (.NOT. VIDEO)) THEN
DIST = MAX (ABS(XN (N1) - XN (I)), ABS(XN (N2) - XN (I)),
& ABS(XN (N3) - XN (I)), ABS(YN (N1) - YN (I)),
& ABS(YN (N2) - YN (I)), ABS(YN (N3) - YN (I))) * 3.
XMIN = XN (I) - DIST
XMAX = XN (I) + DIST
YMIN = YN (I) - DIST
YMAX = YN (I) + DIST
ENDIF
ANG1 = ATAN2 (YN (N1) - YN (I), XN (N1) - XN (I))
IF (ANG1 .LT. 0.) ANG1 = ANG1 + TWOPI
ANG2 = ATAN2 (YN (N2) - YN (I), XN (N2) - XN (I))
IF (ANG2 .LT. 0.) ANG2 = ANG2 + TWOPI
ANG3 = ATAN2 (YN (N3) - YN (I), XN (N3) - XN (I))
IF (ANG3 .LT. 0.) ANG3 = ANG3 + TWOPI
C CHECK TO SEE IF THE NODES ARE CLOCKWISE OR COUNTERCLOCKWISE
C (POSITIVE AREA IS CCW)
AREA = ( (YN (N1) + YN (N3)) * .5 * (XN (N3) - XN (N1)) ) +
& ( (YN (N2) + YN (N1)) * .5 * (XN (N1) - XN (N2)) ) +
& ( (YN (N3) + YN (N2)) * .5 * (XN (N2) - XN (N3)) )
IF (AREA .GT. 0.) THEN
ANG12 = ANG2 - ANG1
ANG23 = ANG3 - ANG2
ANG31 = ANG1 - ANG3
ELSE
ANG12 = ANG1 - ANG2
ANG23 = ANG2 - ANG3
ANG31 = ANG3 - ANG1
ENDIF
IF (ANG12 .LT. 0.) ANG12 = ANG12 + TWOPI
IF (ANG23 .LT. 0.) ANG23 = ANG23 + TWOPI
IF (ANG31 .LT. 0.) ANG31 = ANG31 + TWOPI
IF (GRAPH) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
C 5 IS PINK; 4 IS BLUE; 3 IS YELLOW; 0 IS BLACK ; 7 IS WHITE; 1 IS RED
CALL LCOLOR ('YELOW')
CALL D2NODE (MXND, XN, YN, I, N1)
CALL D2NODE (MXND, XN, YN, I, N2)
CALL D2NODE (MXND, XN, YN, I, N3)
CALL LCOLOR ('WHITE')
CALL SFLUSH
ENDIF
C NOW DO THE CHECKS FOR CHANGING THE ELEMENT
IF (AREA .GT. 0) THEN
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(1), ANG12,
& TOLER1, TOLER2, N2, N1, N3, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ELSE
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(1), ANG12,
& TOLER1, TOLER2, N1, N2, N3, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ENDIF
IF ((NOROOM) .OR. (ERR)) GOTO 180
IF (DONE) GOTO 130
IF (AREA .GT. 0) THEN
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(2), ANG23,
& TOLER1, TOLER2, N3, N2, N1, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ELSE
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(2), ANG23,
& TOLER1, TOLER2, N2, N3, N1, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ENDIF
IF ((NOROOM) .OR. (ERR)) GOTO 180
IF (DONE) GOTO 130
IF (AREA .GT. 0) THEN
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(3), ANG31,
& TOLER1, TOLER2, N1, N3, N2, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ELSE
CALL ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK,
& KXL, NXL, LXN, NNN, NAVAIL, IAVAIL, I, K(3), ANG31,
& TOLER1, TOLER2, N3, N1, N2, KREG, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, KKK, LLL, DEV1, DONE, CHECK, GRAPH,
& VIDEO, NOROOM, ERR, KKKADD)
ENDIF
IF ((NOROOM) .OR. (ERR)) GOTO 180
130 CONTINUE
IF (DONE) THEN
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N1, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N2, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N3, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& I, ERR)
IF (ERR) GOTO 180
IF (VIDEO) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
CALL SNAPIT (3)
ENDIF
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& LLL, NNN, NNN, LNODES, BNSIZE, NLOOP, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
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 (3)
ENDIF
DONE = .FALSE.
REDO = .TRUE.
GOTO 160
ENDIF
C NOW CHECK THE THREE ELEMENTS TO SEE IF AN ELEMENT EXISTS WHICH:
C (1) CONTAINS ONLY 2 OPPOSING "LARGE ANGLE" THREE-LINE NODES
C AND AT LEAST 1 "SMALL ANGLE" FOUR- OR FIVE-LINE NODE
C (2) ONE THAT IS REALLY SQUASHED WITH AT LEAST ONE
C "SMALL ANGLE" FIVE-LINE NODE.
C (3) CONTAINS A "LARGE ANGLE" THREE-LINE NODE AND TWO
C RELATIVELY SMALL FIVE-LINE NODE AND A NORMAL FOUR
C LINE NODE
C (4) CONTAINS TWO "VERY SMALL" ANGLES AND TWO "VERY LARGE"
C ANGLES
C (5) CONTAINS TWO RELATIVELY SMALL ANGLES AND TWO RELATIVELY
C LARGE ANGLES AND IS CONSIDERABLY SMALLER THAN IS
C DICTATED BY THE DESIRED SIZE
C THIS ELEMENT SHOULD BE DELETED.
TOLER3 = 1.7453293
TOLER4 = 1.5707963
TOLER5 = 2.0943951
TOLER6 = 0.9599311
DO 150 J = 1, 3
CALL GNXKA (MXND, XN, YN, K(J), NODES, AREA, LXK, NXL,
& CCW)
IF ( (I .NE. NODES(1)) .AND. (I .NE. NODES(2)) .AND.
& (I .NE. NODES(3)) .AND. (I .NE. NODES(4)) ) THEN
CALL MESSAGE('** PROBLEMS IN TRIDEL - I IS NOT IN '//
& 'ELEMENT K **')
ERR = .TRUE.
GOTO 180
ENDIF
C ARRANGE NODES SO THE COLLAPSING DIAGONAL IS FROM 1ST TO 3RD NODES
C AND INSURE THAT THE NODE TO BE DELETED IS NOT A BOUNDARY NODE
CALL NXKORD (NODES, I)
N1 = NODES(1)
N2 = NODES(2)
N3 = NODES(3)
N4 = NODES(4)
X21 = XN (N2) - XN (N1)
X32 = XN (N3) - XN (N2)
X43 = XN (N4) - XN (N3)
X14 = XN (N1) - XN (N4)
Y21 = YN (N2) - YN (N1)
Y32 = YN (N3) - YN (N2)
Y43 = YN (N4) - YN (N3)
Y14 = YN (N1) - YN (N4)
D21 = SQRT (X21 **2 + Y21 **2)
D32 = SQRT (X32 **2 + Y32 **2)
D43 = SQRT (X43 **2 + Y43 **2)
D14 = SQRT (X14 **2 + Y14 **2)
DMAX = MAX (D21, D32, D43, D14) * 1.5
IF (LXN (3, N1) .EQ. 0) THEN
THETA1 = PI
ELSE
THETA1 = ACOS (- ( (X21 * X14) + (Y21 * Y14) ) /
& (D21 * D14))
ENDIF
IF (LXN (3, N2) .EQ. 0) THEN
THETA2 = PI
ELSE
THETA2 = ACOS (- ( (X32 * X21) + (Y32 * Y21) ) /
& (D32 * D21))
ENDIF
IF (LXN (3, N3) .EQ. 0) THEN
THETA3 = PI
ELSE
THETA3 = ACOS (- ( (X43 * X32) + (Y43 * Y32) ) /
& (D43 * D32))
ENDIF
IF (LXN (3, N3) .EQ. 0) THEN
THETA4 = PI
ELSE
THETA4 = ACOS (- ( (X14 * X43) + (Y14 * Y43) ) /
& (D14 * D43))
ENDIF
C TEST CASE ONE
IF ( (LXN(2, N1) .GT. 0) .AND.
& (LXN (2, N3) .GT. 0) .AND.
& (LXN (4, N3) .EQ. 0) .AND.
& (LXN (4, N2) .NE. 0) .AND.
& (LXN (4, N4) .NE. 0) .AND.
C & ( (LXN (4, N2) .LT. 0) .OR.
C & (LXN (4, N4) .LT. 0) ) .AND.
& ((THETA1 .GT. TOLER3) .OR. (THETA3 .GT. TOLER3)) .AND.
& ((THETA2 .LT. TOLER4) .OR. (THETA4 .LT. TOLER4)) .AND.
& (K (J) .NE. KKKADD))
& THEN
PASSED = .TRUE.
C TEST CASE 2
ELSEIF ( (LXN(2, N1) .GT. 0) .AND.
& (LXN (2, N3) .GT. 0) .AND.
& (LXN (4, N3) .GE. 0) .AND.
& (LXN (4, N2) .NE. 0) .AND.
& (LXN (4, N4) .NE. 0) .AND.
& ( (LXN (4, N2) .LT. 0) .OR.
& (LXN (4, N4) .LT. 0) ) .AND.
& ((THETA1 .GT. TOLER5) .OR. (THETA3 .GT. TOLER5)) .AND.
& ((THETA2 .LT. TOLER6) .OR. (THETA4 .LT. TOLER6)) .AND.
& (K (J) .NE. KKKADD) )
& THEN
PASSED = .TRUE.
C TEST CASE 3
ELSEIF ( (LXN(2, N1) .GT. 0) .AND.
& (LXN (2, N3) .GT. 0) .AND.
& (LXN (4, N3) .GE. 0) .AND.
& (LXN (4, N2) .LT. 0) .AND.
& (LXN (4, N4) .LT. 0) .AND.
& ((THETA1 .GT. TOLER3) .OR. (THETA3 .GT. TOLER3)) .AND.
& ((THETA2 .LT. TOLER4) .OR. (THETA4 .LT. TOLER4)) .AND.
& (K (J) .NE. KKKADD) )
& THEN
PASSED = .TRUE.
C TEST CASE 4
ELSEIF ( (LXN(2, N1) .GT. 0) .AND.
& (LXN (2, N3) .GT. 0) .AND.
& (THETA1 .GT. TOLER5) .AND.
& (THETA3 .GT. TOLER5) .AND.
& (THETA2 .LT. TOLER6) .AND.
& (THETA4 .LT. TOLER6) .AND.
& (K (J) .NE. KKKADD) )
& THEN
PASSED = .TRUE.
C TEST CASE 5
ELSEIF ( (LXN(2, N1) .GT. 0) .AND.
& (LXN (2, N3) .GT. 0) .AND.
& (THETA1 .GT. TOLER3) .AND.
& (THETA3 .GT. TOLER3) .AND.
& (THETA2 .LT. TOLER4) .AND.
& (THETA4 .LT. TOLER4) .AND.
& (DMAX .LT. BNSIZE (1, N1)) .AND.
& (K (J) .NE. KKKADD) )
& THEN
PASSED = .TRUE.
ELSE
PASSED = .FALSE.
ENDIF
IF (PASSED) THEN
IF (GRAPH) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
CALL LCOLOR ('PINK ')
CALL D2NODE (MXND, XN, YN, N1, N2)
CALL D2NODE (MXND, XN, YN, N2, N3)
CALL D2NODE (MXND, XN, YN, N3, N4)
CALL D2NODE (MXND, XN, YN, N4, N1)
CALL LCOLOR ('WHITE')
CALL SFLUSH
ENDIF
NODE = N1
KELEM = K(J)
140 CONTINUE
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N1, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N2, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N3, ERR)
IF (ERR) GOTO 180
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N4, ERR)
IF (ERR) GOTO 180
CALL DELEM (MXND, XN, YN, NUID, LXK, KXL, NXL, LXN,
& NNN, NAVAIL, IAVAIL, NODE, KELEM, NODE1, NODE3,
& DONE, CHECK, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 180
IF (DONE) THEN
IF (VIDEO) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
CALL SNAPIT (3)
ENDIF
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL,
& LXN, LLL, NNN, NNN, LNODES, BNSIZE, NLOOP, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
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 (3)
ENDIF
C CHECK TO SEE IF WE HAVE MADE A 2-LINE NODE
IF (LXN (3, NODE1) .LE. 0) THEN
NODE = NODE1
KELEM = KXL (1, LXN (1, NODE))
CHECK = .FALSE.
GOTO 140
ELSEIF (LXN (3, NODE3) .LE. 0) THEN
NODE = NODE3
KELEM = KXL (1, LXN (1, NODE))
CHECK = .FALSE.
GOTO 140
ENDIF
CHECK = .TRUE.
DONE = .FALSE.
REDO = .TRUE.
GOTO 160
ENDIF
ENDIF
150 CONTINUE
160 CONTINUE
ENDIF
170 CONTINUE
CALL TRIFIX (MXND, MLN, XN, YN, ZN, NUID, LXK, KXL, NXL, LXN,
& NNN, LLL, KKK, NAVAIL, IAVAIL, ANGLE, LNODES, BNSIZE,
& NLOOP, DEV1, KREG, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, GRAPH,
& VIDEO, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 180
IF (REDO) GOTO 100
180 CONTINUE
RETURN
END