lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
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.
6 Commits
1 Branch
0 Tags
19 MiB
Tag: Branch: Tree: 6ce61ef92b
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '6ce61ef92b'
${ noResults }
EXODUS/packages/seacas/applications/fastq/addrow.f

687 lines
26 KiB
Raw Normal View History Unescape

Initial commit
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 ADDROW (MXND, MXCORN, MXLOOP, MLN, MAXPRM, NUID, XN,
& YN, ZN, LXK, KXL, NXL, LXN, ANGLE, BNSIZE, LNODES, NBEGIN,
& NEND, NLOOP, NEXTN1, LINKPR, KPERIM, KKKOLD, LLLOLD, NNNOLD,
& IAVAIL, NAVAIL, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL,
& KKK, NNN, NNN2, NADJ1, NADJ2, LCORN, KLOOP, GRAPH, VIDEO, KREG,
& DONE, SIZEIT, NOROOM, ERR, XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH, REXMIN,
& REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
C***********************************************************************
C SUBROUTINE ADDROW = ADDS 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)
DIMENSION LCORN (MXCORN)
DIMENSION NLOOP (MXLOOP), NEXTN1 (MXLOOP)
DIMENSION LINKPR (3, MAXPRM)
DIMENSION X(5), Y(5)
DIMENSION XNOLD(NPNOLD), YNOLD(NPNOLD)
DIMENSION NXKOLD(NNXK, NPEOLD)
DIMENSION LINKEG(2, MLINK), LISTEG(4 * NPEOLD), BMESUR(NPNOLD)
LOGICAL ERR, GRAPH, AMBIG, DONE, VIDEO, SIZEIT, NOROOM
CHARACTER*3 DEV1
nlold = 0
idum1 = 0
idum2 = 0
CALL GETIME (TIME1)
ERR = .FALSE.
AMBIG = .FALSE.
NNNOLD = MIN (NNN, NNNOLD)
NNN2 = NNNOLD
C IN THE LNODES ARRAY,
C THE CORNER STATUS IS STORED IN LNODES (1, N1):
C 0 = NOT DECIDED
C 1 = ROW END
C 3 = ROW SIDE
C 5 = ROW CORNER
C 7 = ROW REVERSAL
C THE PRECEDING NODE IN LNODES (2, N1),
C THE NEXT NODE IN LNODES (3, N1),
C THE INTERIOR/EXTERIOR STATUS OF NODE IS IN LNODES (4, N1).
C 1 = EXTERIOR OR ON THE BOUNDARY OF THE MESH
C (NEGATED FOR SMOOTHING)
C 2 = INTERIOR TO THE MESH (NEGATED FOR SMOOTHING)
C THE NEXT COUNTERCLOCKWISE LINE IS STORED IN LNODES (5, N1).
C THE ANGLE STATUS OF LNODES IS STORED IN (6, N1),
C 1 = ROW END ONLY
C 2 = ROW END OR SIDE
C 3 = ROW SIDE ONLY
C 4 = ROW SIDE OR ROW CORNER
C 5 = ROW CORNER ONLY
C 6 = ROW CORNER OR REVERSAL
C 7 = ROW REVERSAL ONLY
C THE NUMBER OF NODES TO THE NEXT CORNER IS STORED IN (7, N1).
C THE DEPTH OF THE ROW OF THIS NODE IS STORED IN (8, N1)
C START AT THE FIRST BEGINNING (CORNER) NODE
C AND GO TO THE END (CORNER) NODE
N1 = NBEGIN
N0 = LNODES (2, N1)
NADJ1 = N0
N2 = LNODES (3, N1)
N3 = LNODES (3, N2)
C SET UP FOR SMOOTHING AROUND THE BEGINNING AND ENDING OF THE ROW
LNODES (4, NBEGIN) = - IABS (LNODES (4, NBEGIN))
LNODES (4, NEND) = - IABS (LNODES (4, NEND))
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES, NBEGIN, ERR)
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES, NEND, ERR)
C FIRST CHECK TO SEE IF THE ROW IS CIRCULAR - BEGINS AND ENDS AT N1
IF (NEND .EQ. NBEGIN) THEN
C A CIRCLUAR ROW THAT ENDS AT A ROW END (TEAR DROP SHAPE) NEEDS STARTED
IF (LNODES (1, N1) .EQ. 1) THEN
NEND = N0
NADJ1 = NNN + 1
C A CIRCLUAR ROW THAT HAS NO END, CORNER, OR REVERSAL (CIRCLE SHAPE)
C NEEDS STARTED
ELSEIF (LNODES (1, N1) .EQ. 3) THEN
CALL EXTND1 (MXND, XN, YN, ANGLE, N0, N1, N2, X(1), Y(1),
& DIST1)
CALL EXTND1 (MXND, XN, YN, ANGLE, N1, N2, N3, X(2), Y(2),
& DIST2)
CALL ADD2ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X(1), Y(1), X(2), Y(2), DIST1, DIST2,
& NNN, LLL, KKK, N1, N2, NLOOP (1), SIZEIT, ERR, NOROOM,
& XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR, MLINK,
& NPNOLD, NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN,
& REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
N0 = NNN
NADJ1 = NNN - 1
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N1, NNN-1)
CALL D2NODE (MXND, XN, YN, NNN-1, NNN)
CALL D2NODE (MXND, XN, YN, NNN, N2)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
N1 = N2
C A CIRCLUAR ROW THAT ENDS AT A ROW CORNER NEEDS STARTED
ELSEIF (LNODES (1, N1) .EQ. 5) THEN
AMBIG = .TRUE.
LAMBIG = LNODES (5, N1)
CALL EXTND3 (MXND, XN, YN, ANGLE (N1), N0, N1, N2, X, Y,
& DIST)
CALL ADD3ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X, Y, DIST, NNN, LLL, KKK, N1, NLOOP (1),
& SIZEIT, ERR, NOROOM, XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX,
& EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
NADJ1 = NNN - 2
LNODES (1, N1) = 1
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N1, NNN-2)
CALL D2NODE (MXND, XN, YN, NNN-2, NNN-1)
CALL D2NODE (MXND, XN, YN, NNN-1, NNN)
CALL D2NODE (MXND, XN, YN, NNN, N1)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
N0 = NNN
N3 = LNODES (2, N2)
GOTO 110
C A CIRCLUAR ROW THAT ENDS AT A ROW REVERSAL NEEDS STARTED
ELSEIF (LNODES (1, N1) .EQ. 7) THEN
CALL EXTND5 (MXND, XN, YN, ANGLE (N2), N1, N2, N3, X, Y,
& DIST)
CALL ADD3ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X, Y, DIST, NNN, LLL, KKK, N1, NLOOP (1),
& SIZEIT, ERR, NOROOM, XNOLD, YNOLD, NXKOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX,
& EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N1, NNN-2)
CALL D2NODE (MXND, XN, YN, NNN-2, NNN-1)
CALL D2NODE (MXND, XN, YN, NNN-1, NNN)
CALL D2NODE (MXND, XN, YN, NNN, N1)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
N0 = NNN
CALL ADD2ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X(4), Y(4), X(5), Y(5), DIST, DIST, NNN,
& LLL, KKK, NNN, N1, NLOOP (1), SIZEIT, ERR, NOROOM, XNOLD,
& YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR, MLINK, NPNOLD,
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
LNODES (1, N1) = 1
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N0, NNN-1)
CALL D2NODE (MXND, XN, YN, NNN-1, NNN)
CALL D2NODE (MXND, XN, YN, NNN, N1)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
ELSE
CALL MESSAGE('PROBLEMS IN ADDROW - THE CIRCLUAR ROW')
CALL MESSAGE('HAS NO END POINT CLASSIFICATION')
ERR = .TRUE.
GOTO 120
ENDIF
ENDIF
KOUNT = 0
100 CONTINUE
KOUNT = KOUNT + 1
N0 = LNODES (2, N1)
N2 = LNODES (3, N1)
N3 = LNODES (3, N2)
110 CONTINUE
C NOW ADD THE NEXT ELEMENT(S) TO THE ROW
IF (N2 .NE. NEND) THEN
C IF N2 IS A ROW SIDE NODE, THEN PROJECT AT THE MIDLINE ANGLE
IF (LNODES (1, N2) .EQ. 3) THEN
CALL EXTND1 (MXND, XN, YN, ANGLE, N1, N2, N3, X, Y, DIST)
CALL ADDNOD (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN, ANGLE,
& BNSIZE, LNODES, X(1), Y(1), DIST, NNN, KKK, LLL,
& N0, N1, N2, AMBIG, LAMBIG, SIZEIT, ERR, NOROOM, XNOLD,
& YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR, MLINK, NPNOLD,
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
AMBIG = .FALSE.
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N0, NNN)
CALL D2NODE (MXND, XN, YN, N2, NNN)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
N1 = N2
GOTO 100
C IF N2 IS A ROW CORNER NODE,
C THEN PROJECT TWO NODES (1 & 3) AT AVERAGE ANGLES AND ANOTHER (2)
C AS AN ISOPARAMETRIC TYPE
ELSEIF (LNODES (1, N2) .EQ. 5) THEN
AHOLD = ANGLE (N2)
IF (NADJ1 .EQ. N1) NADJ1 = N0
CALL EXTND3 (MXND, XN, YN, AHOLD, N1, N2, N3, X, Y, DIST)
CALL ADDNOD (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN, ANGLE,
& BNSIZE, LNODES, X(1), Y(1), DIST, NNN, KKK, LLL,
& N0, N1, N2, AMBIG, LAMBIG, SIZEIT, ERR, NOROOM, XNOLD,
& YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR, MLINK, NPNOLD,
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
AMBIG = .FALSE.
NEW1 = NNN
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N0, NEW1)
CALL D2NODE (MXND, XN, YN, N2, NEW1)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
C TRY A PINCH TO MAKE SURE THAT CONTINUING DOES NOT OVERLAY
C AN ALREADY GOOD CLOSURE
CALL FIXLXN (MXND, LXN, NXL, NUID, NAVAIL, IAVAIL, NNN, LLL,
& NNNOLD, LLLOLD, ERR, NOROOM)
IF ((ERR) .OR. (NOROOM)) GOTO 120
LLLOLD = LLL
NNNOLD = NNN
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& LLL, NNN, NNN2, LNODES, BNSIZE, NLOOP (1), XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
CALL GETIME (TIME1)
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 (2)
ENDIF
CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& NLOOP (1), ANGLE, LNODES, NADJ1, LLL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, DEV1, KREG, ERR)
IF (ERR) GOTO 120
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL PINCH (MXND, MXCORN, MLN, NUID, XN, YN, ZN, LXK, KXL,
& NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1, NLOOP (1),
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, IDUM1, IDUM2, GRAPH, VIDEO, KREG, NOROOM,
& ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
C TRY A COLAPS TO MAKE SURE THAT CONTINUING DOES NOT COMPLICATE
C AN ALREADY OVERLAPPED SIDE
IF (NLOOP (1) .GT. 6) THEN
NLOLD = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL COLAPS (MXND, MXCORN, MLN, MXLOOP, NUID, XN, YN,
& ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1,
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO,
& KREG, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
ENDIF
C CHECK TO SEE IF ANY OF THE CONCURRENT PERIMETERS OVERLAP
IF (LINKPR (2, KPERIM) .NE. 0) THEN
LINKPR (3, KPERIM) = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
IDUM = NADJ1
CALL PCROSS (MXND, MXCORN, MLN, MXLOOP, MAXPRM,
& NUID, XN, YN, ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES,
& BNSIZE, LINKPR, KPERIM, IDUM, NADJ1, NEW1, KKKOLD,
& LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN, LCORN,
& NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO, KREG,
& NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
CALL GETIME (TIME1)
ENDIF
C THE ROW CAN BE CONTINUED IF THE NEW NODE AND THE ENDING NODE
C IS STILL ON THE BOUNDARY AFTER THE PINCH, COLAPS AND PCROSS
IF ( (NLOLD .EQ. NLOOP(1)) .AND.
& (IABS (LNODES (4, NEW1)) .EQ. 1) .AND.
& (IABS (LNODES (4, NEND)) .EQ. 1) .AND.
& (LNODES (2, N2) .EQ. NEW1) .AND.
& (LXN (1, NEW1) .GT. 0) .AND.
& (ANGLE (N2) .GT. 2.3561945) ) THEN
CALL EXTND3 (MXND, XN, YN, AHOLD, N1, N2, N3, X, Y, DIST)
CALL ADD2ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X(2), Y(2), X(3), Y(3), DIST, DIST,
& NNN, LLL, KKK, NEW1, N2, NLOOP (1), SIZEIT, ERR,
& NOROOM, XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR,
& MLINK, NPNOLD, NPEOLD, NNXK, REMESH, REXMIN, REXMAX,
& REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
NEW2 = NNN - 1
NEW3 = NNN
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, NEW1, NEW2)
CALL D2NODE (MXND, XN, YN, NEW2, NEW3)
CALL D2NODE (MXND, XN, YN, N2, NEW3)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
N1 = N2
GOTO 100
ELSE
NBEGIN = NADJ1
NADJ1 = 0
NADJ2 = 0
GOTO 120
ENDIF
C IF N2 IS A ROW REVERSAL NODE,
C THEN PROJECT THREE NODES (1, 3, & 5) AT AVERAGE ANGLES AND
C TWO OTHERS (2 & 4) AS AN ISOPARAMETRIC TYPE
ELSEIF (LNODES (1, N2) .EQ. 7) THEN
AHOLD = ANGLE (N2)
CALL EXTND5 (MXND, XN, YN, AHOLD, N1, N2, N3, X, Y, DIST)
CALL ADDNOD (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN, ANGLE,
& BNSIZE, LNODES, X(1), Y(1), DIST, NNN, KKK, LLL,
& N0, N1, N2, AMBIG, LAMBIG, SIZEIT, ERR, NOROOM, XNOLD,
& YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR, MLINK, NPNOLD,
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
AMBIG = .FALSE.
NEW1 = NNN
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, N0, NEW1)
CALL D2NODE (MXND, XN, YN, N2, NEW1)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
C TRY A PINCH TO MAKE SURE THAT CONTINUING DOES NOT OVERLAY
C AN ALREADY GOOD CLOSURE
CALL FIXLXN (MXND, LXN, NXL, NUID, NAVAIL, IAVAIL, NNN, LLL,
& NNNOLD, LLLOLD, ERR, NOROOM)
IF ((NOROOM) .OR. (ERR)) GOTO 120
LLLOLD = LLL
NNNOLD = NNN
CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& NLOOP (1), ANGLE, LNODES, NADJ1, LLL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, DEV1, KREG, ERR)
IF (ERR) GOTO 120
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& LLL, NNN, NNN2, LNODES, BNSIZE, NLOOP (1), XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
CALL GETIME (TIME1)
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 (2)
ENDIF
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL PINCH (MXND, MXCORN, MLN, NUID, XN, YN, ZN, LXK, KXL,
& NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1, NLOOP (1),
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, IDUM1, IDUM2, GRAPH, VIDEO, KREG, NOROOM,
& ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
C TRY A COLAPS TO MAKE SURE THAT CONTINUING DOES NOT COMPLICATE
C AN ALREADY OVERLAPPED SIDE
IF (NLOOP (1) .GT. 6) THEN
NLOLD = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL COLAPS (MXND, MXCORN, MLN, MXLOOP, NUID, XN, YN,
& ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1,
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO,
& KREG, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
ENDIF
C CHECK TO SEE IF ANY OF THE CONCURRENT PERIMETERS OVERLAP
IF (LINKPR (2, KPERIM) .NE. 0) THEN
LINKPR (3, KPERIM) = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
IDUM = NADJ1
CALL PCROSS (MXND, MXCORN, MLN, MXLOOP, MAXPRM,
& NUID, XN, YN, ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES,
& BNSIZE, LINKPR, KPERIM, IDUM, NADJ1, NEW1, KKKOLD,
& LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN, LCORN,
& NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO, KREG,
& NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
CALL GETIME (TIME1)
ENDIF
C THE ROW CAN BE CONTINUED IF THE NEW NODE AND THE ENDING NODE
C IS STILL ON THE BOUNDARY AFTER THE PINCH, COLAPS AND PCROSS
C AND IF THE ANGLE AT THE NODE IS SOMEWHAT AS IT SHOULD BE
IF ( (NLOLD .EQ. NLOOP(1)) .AND.
& (IABS (LNODES (4, NEW1)) .EQ. 1) .AND.
& (LNODES (2, N2) .EQ. NEW1) .AND.
& (IABS (LNODES (4, NEND)) .EQ. 1) .AND.
& (LXN (1, NEW1) .GT. 0) .AND.
& (ANGLE (N2) .GT. 3.9269908 ) ) THEN
CALL EXTND5 (MXND, XN, YN, AHOLD, N1, N2, N3, X, Y, DIST)
CALL ADD2ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X(2), Y(2), X(3), Y(3), DIST, DIST,
& NNN, LLL, KKK, NEW1, N2, NLOOP (1), SIZEIT, ERR,
& NOROOM, XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR,
& MLINK, NPNOLD, NPEOLD, NNXK, REMESH, REXMIN, REXMAX,
& REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
NEW2 = NNN - 1
NEW3 = NNN
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, NEW1, NEW2)
CALL D2NODE (MXND, XN, YN, NEW2, NEW3)
CALL D2NODE (MXND, XN, YN, N2, NEW3)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
ELSE
NBEGIN = NADJ1
NADJ1 = 0
NADJ2 = 0
GOTO 120
ENDIF
C TRY A PINCH TO MAKE SURE THAT CONTINUING DOES NOT OVERLAY
C AN ALREADY GOOD CLOSURE
CALL FIXLXN (MXND, LXN, NXL, NUID, NAVAIL, IAVAIL, NNN, LLL,
& NNNOLD, LLLOLD, ERR, NOROOM)
IF ((NOROOM) .OR. (ERR)) GOTO 120
LLLOLD = LLL
NNNOLD = NNN
CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& NLOOP (1), ANGLE, LNODES, NADJ1, LLL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, DEV1, KREG, ERR)
IF (ERR) GOTO 120
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& LLL, NNN, NNN2, LNODES, BNSIZE, NLOOP (1), XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
CALL GETIME (TIME1)
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 (2)
ENDIF
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL PINCH (MXND, MXCORN, MLN, NUID, XN, YN, ZN, LXK, KXL,
& NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1, NLOOP (1),
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, IDUM1, IDUM2, GRAPH, VIDEO, KREG, NOROOM,
& ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
C TRY A COLAPS TO MAKE SURE THAT CONTINUING DOES NOT COMPLICATE
C AN ALREADY OVERLAPPED SIDE
IF (NLOOP (1) .GT. 6) THEN
NLOLD = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL COLAPS (MXND, MXCORN, MLN, MXLOOP, NUID, XN, YN,
& ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES, BNSIZE, NADJ1,
& KKKOLD, LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN,
& XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN,
& LCORN, NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO,
& KREG, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
IF (DONE) GOTO 120
CALL GETIME (TIME1)
ENDIF
C CHECK TO SEE IF ANY OF THE CONCURRENT PERIMETERS OVERLAP
IF (LINKPR (2, KPERIM) .NE. 0) THEN
LINKPR (3, KPERIM) = NLOOP (1)
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
IDUM = NADJ1
CALL PCROSS (MXND, MXCORN, MLN, MXLOOP, MAXPRM,
& NUID, XN, YN, ZN, LXK, KXL, NXL, LXN, ANGLE, LNODES,
& BNSIZE, LINKPR, KPERIM, IDUM, NADJ1, NEW3, KKKOLD,
& LLLOLD, NNNOLD, IAVAIL, NAVAIL, DONE, XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, LLL, KKK, NNN, LCORN,
& NCORN, NLOOP, NEXTN1, KLOOP, GRAPH, VIDEO, KREG,
& NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
CALL GETIME (TIME1)
ENDIF
C THE ROW CAN BE CONTINUED IF THE NEW NODE AND THE ENDING NODE
C IS STILL ON THE BOUNDARY AFTER THE PINCH, COLAPS AND PCROSS
IF ( (NLOLD .EQ. NLOOP(1)) .AND.
& (IABS (LNODES (4, NEW3)) .EQ. 1) .AND.
& (LNODES (2, N2) .EQ. NEW3) .AND.
& (IABS (LNODES (4, NEND)) .EQ. 1) .AND.
& (LXN (1, NEW3) .GT. 0) .AND.
& (ANGLE (N2) .GT. 2.3561945) ) THEN
CALL EXTND5 (MXND, XN, YN, AHOLD, N1, N2, N3, X, Y, DIST)
CALL ADD2ND (MXND, MLN, XN, YN, LXK, KXL, NXL, LXN,
& BNSIZE, LNODES, X(4), Y(4), X(5), Y(5), DIST, DIST,
& NNN, LLL, KKK, NEW3, N2, NLOOP (1), SIZEIT, ERR,
& NOROOM, XNOLD, YNOLD, NXKOLD, LINKEG, LISTEG, BMESUR,
& MLINK, NPNOLD, NPEOLD, NNXK, REMESH, REXMIN, REXMAX,
& REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
IF ((ERR) .OR. (NOROOM)) GOTO 120
NEW4 = NNN - 1
IF ((GRAPH) .OR. (VIDEO)) THEN
CALL D2NODE (MXND, XN, YN, NEW3, NEW4)
CALL D2NODE (MXND, XN, YN, NEW4, NNN)
CALL D2NODE (MXND, XN, YN, N2, NNN)
CALL SFLUSH
IF (VIDEO) THEN
CALL SNAPIT (1)
ENDIF
ENDIF
ELSE
NBEGIN = NADJ1
NADJ1 = 0
NADJ2 = 0
GOTO 120
ENDIF
N1 = N2
GOTO 100
ELSE
CALL MESSAGE('PROBLEMS IN ADDROW - THE NEXT NODE IN THE')
CALL MESSAGE('ROW DOES NOT HAVE THE RIGHT CLASSIFICATION')
ERR = .TRUE.
GOTO 120
ENDIF
IF (KOUNT .GT. NLOOP (1)) THEN
CALL MESSAGE('PROBLEMS IN ADDROW - THE ROW DOESN''T STOP')
ERR = .TRUE.
GOTO 120
ENDIF
C CLOSE OFF THE END OF THE ROW - THE END NODE IS THE CONNECTION
ELSE
NADJ2 = LNODES (3, N2)
CALL CONNOD (MXND, MLN, XN, YN, NUID, LXK, KXL, NXL, LXN,
& ANGLE, LNODES, NNN, KKK, LLL, NNNOLD, LLLOLD, N0, N1, N2,
& LNODES (3, N2), N1, NLOOP (1), IAVAIL, NAVAIL, GRAPH,
& VIDEO, NOROOM, ERR)
IF ((NOROOM) .OR. (ERR)) GOTO 120
C NOW SMOOTH THE CURRENT ROW INTO THE MESH
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
CALL FILSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& LLL, NNN, NNN2, LNODES, BNSIZE, NLOOP (1), XMIN, XMAX,
& YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
CALL GETIME (TIME1)
C CALCULATE NEW ANGLES
CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN,
& NLOOP (1), ANGLE, LNODES, N3, LLL, XMIN, XMAX, YMIN, YMAX,
& ZMIN, ZMAX, DEV1, KREG, ERR)
IF (ERR) GOTO 120
C PLOT THE NEW MESH
IF (VIDEO) THEN
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
CALL SNAPIT (2)
ENDIF
ENDIF
NBEGIN = N3
120 CONTINUE
CALL GETIME (TIME2)
TIMEA = TIMEA + TIME2 - TIME1
RETURN
END