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 PERIML (NBNODE, MXND, NPER, ISTART, MLN, XN, YN, ZN, & LXK, KXL, NXL, LXN, ANGLE, BNSIZE, LNODES, LPERIM, LLL, LLLOLD, & XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG, ERR) C*********************************************************************** C SUBROUTINE PERIML = LINKS THE PERIMETER OF A REGION TOGETHER FOR C THE FILL ROUTINES C*********************************************************************** C VARIABLES USED: C NPER = NUMBER OF PERIMETER NODES C ERR = .TRUE. IF ERRORS WERE ENCOUNTERED C XN = GLOBAL X VALUES OF NODES C YN = GLOBAL Y VALUES OF NODES C ZN = GLOBAL Z VALUES OF NODES C LXK = LINES PER ELEMENT C KXL = ELEMENTS PER LINE C NXL = NODES PER LINE C LXN = LINES PER NODE C NOTE: C FOR *XN TABLES A NEGATIVE FLAG IN THE FOURTH COLUMN MEANS C GO TO THAT ROW FOR A CONTINUATION OF THE LIST. IN THAT ROW C THE FIRST ELEMENT WILL BE NEGATED TO INDICATE THAT THIS IS C A CONTINUATION ROW. C A NEGATIVE FLAG IN THE SECOND COLUMN OF THE LXN ARRAY MEANS C THAT THIS NODE IS AN EXTERIOR BOUNDARY NODE. C*********************************************************************** DIMENSION XN (MXND), YN (MXND), ZN (MXND) DIMENSION LPERIM (NBNODE) 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) CHARACTER*3 DEV1 LOGICAL ERR ERR = .FALSE. LLLOLD = LLL IEND = NPER + ISTART - 1 DO 100 I = ISTART, IEND NODE1 = LPERIM (I) IF (I .EQ. IEND) THEN NODE0 = LPERIM (I - 1) NODE2 = LPERIM (ISTART) ELSEIF (I .EQ. ISTART) THEN NODE0 = LPERIM (IEND) NODE2 = LPERIM (I + 1) ELSE NODE0 = LPERIM (I - 1) NODE2 = LPERIM (I + 1) ENDIF LLL = LLL+1 C FILL UP THE NODES PER LINE ARRAY NXL (1, LLL) = NODE1 NXL (2, LLL) = NODE2 C FILL UP THE LINES PER NODE ARRAY LXN (1, NODE1) = LLL IF (I .EQ. ISTART) THEN LXN (2, NODE1) = - (IEND - ISTART + 1 + LLLOLD) ELSE LXN (2, NODE1) = 1 - LLL ENDIF LXN (3, NODE1) = 0 LXN (4, NODE1) = 0 C THE LNODES ARRAY IS DOCUMENTED IN THE ADDROW ROUTINE LNODES (1, NODE1) = 0 LNODES (2, NODE1) = NODE0 LNODES (3, NODE1) = NODE2 LNODES (4, NODE1) = 1 LNODES (5, NODE1) = LLL LNODES (6, NODE1) = 0 LNODES (7, NODE1) = 0 LNODES (8, NODE1) = 0 100 CONTINUE C SET ALL THE INTERIOR ANGLES CALL LUPANG (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN, NPER, & ANGLE, LNODES, LPERIM(ISTART), LLL, XMIN, XMAX, YMIN, YMAX, & ZMIN, ZMAX, DEV1, KREG, ERR) IF (ERR) GOTO 120 C SET UP THE CORRECT SIZE ARRAY N1S = LPERIM(ISTART) KOUNT = 0 110 CONTINUE N0 = LNODES (2, N1S) N2 = LNODES (3, N1S) N1S = N2 IF (N1S .EQ. LPERIM(ISTART)) GOTO 120 KOUNT = KOUNT + 1 IF (KOUNT .GT. NPER) THEN CALL MESSAGE(' ** ERROR IN PERIML GETTING NODE SIZES ** ') ERR = .TRUE. GOTO 120 ENDIF BNSIZE (1, N1S) = & ( SQRT ( (XN (N1S) - XN (N0)) **2 + (YN (N1S) - YN (N0)) **2) + & SQRT ( (XN (N1S) - XN (N2)) **2 + (YN (N1S) - YN (N2)) **2) ) & * .5 BNSIZE (2, N1S) = 1. GOTO 110 120 CONTINUE RETURN END