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.
143 lines
4.7 KiB
143 lines
4.7 KiB
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 GNLIST (MXLIST, NNUID, MSC, NPNODE, NPELEM, MAXKXN,
|
|
& NNXK, KXN, NXK, NUID, XN, YN, LIST, NLIST, NUMBER, KCRD, NNN,
|
|
& ERR, NOROOM)
|
|
C***********************************************************************
|
|
|
|
C SUBRUOTINE GNLIST = GETS INITIAL NODE LIST TO BEGIN CUTHILL - MCKEE
|
|
C PROCESS
|
|
|
|
C***********************************************************************
|
|
|
|
C NOTE:
|
|
C AS MANY CARDS OF AS MANY TYPES AS DESIRED MAY BE USED IN
|
|
C ANY ORDER. IF A NODE IS REFERENCED MORE THAN ONCE A WARNING
|
|
C WILL BE PRINTED AND ONLY THE FIRST REFERENCE WILL BE USED.
|
|
C (IT MAY BE NECESSARY TO MULTIPLY REFERENCE A NODE IN THE
|
|
C CASE OF MORE THAN ONE P - L - P CARD.)
|
|
|
|
C***********************************************************************
|
|
|
|
C EXAMPLE INPUT CARDS
|
|
C COL.1 5 ETC.
|
|
C X-Y 3.5 4.0
|
|
C NODE 7
|
|
C NODE 7 100100002 100100003 100100004 8
|
|
C P-L-P 1 1 2
|
|
C P-L-P 1 77 3 66 5
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION LIST (MXLIST), XN (NPNODE), YN (NPNODE)
|
|
DIMENSION KXN (NNXK, MAXKXN), NXK (NNXK, NPELEM), NUID (NNUID)
|
|
|
|
CHARACTER*80 NUMBER (MSC)
|
|
|
|
LOGICAL ERR, NOROOM
|
|
|
|
C INITIALIZE
|
|
|
|
ERR=.FALSE.
|
|
NLIST=0
|
|
|
|
C NEXT DATA CARD
|
|
|
|
DO 150 K=1, KCRD
|
|
|
|
C X - Y
|
|
|
|
IF ( (NUMBER (K) (1:3) .EQ. 'X-Y') .OR.
|
|
& (NUMBER (K) (1:3) .EQ. 'x-y')) THEN
|
|
READ (NUMBER (K) (11:20), ' (E10.0)')XVAL
|
|
READ (NUMBER (K) (21:30), ' (E10.0)')YVAL
|
|
INEAR=1
|
|
DIST=SQRT ( (XN (1) - XVAL)**2 + (YN (1) - YVAL)**2)
|
|
DO 100 I=2, NNN
|
|
D=SQRT ( (XN (I) - XVAL)**2 + (YN (I) - YVAL)**2)
|
|
IF (D .LT. DIST) THEN
|
|
DIST=D
|
|
INEAR=I
|
|
ENDIF
|
|
100 CONTINUE
|
|
NNOW=MAX0 (NLIST, 1)
|
|
IF (IOCCUR (NNOW, LIST, INEAR) .EQ. 1) THEN
|
|
WRITE (*, 10000)NUID (INEAR)
|
|
ELSE
|
|
NLIST=NLIST + 1
|
|
LIST (NLIST)=INEAR
|
|
ENDIF
|
|
|
|
C NODE ID
|
|
|
|
ELSEIF ( (NUMBER (K) (1:3) .EQ. 'NOD') .OR.
|
|
& (NUMBER (K) (1:3) .EQ. 'nod')) THEN
|
|
DO 110 I=11, 71, 10
|
|
J=I + 9
|
|
READ (NUMBER (K) (I:J), ' (I10)')IVAL
|
|
IF (IVAL .GT. 0) THEN
|
|
NEW=INDX (NNN, NUID, IVAL)
|
|
IF (NEW .EQ. 0) THEN
|
|
WRITE (*, 10010)IVAL
|
|
CALL MESSAGE('THIS NODE WILL BE SKIPPED')
|
|
ELSEIF (IOCCUR (NLIST, LIST, NEW) .EQ. 0) THEN
|
|
NLIST=NLIST + 1
|
|
LIST (NLIST)=NEW
|
|
ELSE
|
|
WRITE (*, 10000)IVAL
|
|
ENDIF
|
|
ENDIF
|
|
110 CONTINUE
|
|
|
|
C P-L-P
|
|
|
|
ELSEIF ( (NUMBER (K) (1:3) .EQ. 'P-L') .OR.
|
|
& (NUMBER (K) (1:3) .EQ. 'p-l')) THEN
|
|
NUMNEW=0
|
|
DO 130 J=6, 66, 10
|
|
READ (NUMBER (K) (J:J + 4), ' (I5)')IP1
|
|
READ (NUMBER (K) (J + 5:J + 9), ' (I5)')LINE
|
|
READ (NUMBER (K) (J + 10:J + 14), ' (I5)')IP2
|
|
IF (IP1 .GT. 0) THEN
|
|
MXLST1=MXLIST - NLIST
|
|
CALL GETPLP (NPNODE, NPELEM, MAXKXN, NNXK, MXLST1,
|
|
& KXN, NXK, NUID, IP1, LINE, IP2, LIST (NLIST + 1),
|
|
& NUMNEW, NNN, LASTN, NOROOM, ERR)
|
|
IF (NOROOM) THEN
|
|
CALL MESSAGE('DIMENSIONS MUST BE INCREASED')
|
|
RETURN
|
|
ELSEIF (ERR) THEN
|
|
RETURN
|
|
ENDIF
|
|
NLIST1=NLIST + 1
|
|
NLISTN=NLIST + NUMNEW
|
|
IF (NUMNEW .GT. 0) THEN
|
|
DO 120 I=NLIST1, NLISTN
|
|
IF ( (NLIST .EQ. 0) .OR.
|
|
& (IOCCUR (NLIST, LIST, LIST (I)) .EQ. 0)) THEN
|
|
NLIST=NLIST + 1
|
|
LIST (NLIST)=LIST (I)
|
|
ELSE
|
|
WRITE (*, 10000)LIST (I)
|
|
ENDIF
|
|
120 CONTINUE
|
|
ENDIF
|
|
ELSE
|
|
GOTO 140
|
|
ENDIF
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
ENDIF
|
|
150 CONTINUE
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (' NODE', I10, ' IS ALREADY IN THE LIST')
|
|
10010 FORMAT (' NODE', I10,
|
|
& ' IS NOT AN IDENTIFIER OF A NODE IN THIS MESH')
|
|
|
|
END
|
|
|