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.
150 lines
4.5 KiB
150 lines
4.5 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 ADJMSH (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, MCOM, ICOM, JCOM, CIN, RIN, IIN, KIN,
|
||
|
|
& NNN, KKK, NNXK, NODES, NELEMS, NNFLG, NNPTR, NNLEN, NSFLG,
|
||
|
|
& NSPTR, NSLEN, NVPTR, NVLEN, NSIDEN, MAPDXG, XN, YN, NXK, MAT,
|
||
|
|
& MAPGXD, MATMAP, WTNODE, WTSIDE, NBCNOD, NNLIST, NBCSID, NSLIST,
|
||
|
|
& NVLIST, NUMMAT, LINKM, TITLE, ERR, EIGHT, NINE, VERSN)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE ADJMSH = ADJUSTS A GENESIS DATABASE OUTPUT
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION XN (NPNODE), YN (NPNODE), NXK (NNXK, NPELEM)
|
||
|
|
DIMENSION MAT (NPELEM)
|
||
|
|
DIMENSION NODES (NPNBC), NELEMS (NPSBC), NSIDEN (NPSBC)
|
||
|
|
DIMENSION NNFLG (MXNFLG), NNLEN (MXNFLG)
|
||
|
|
DIMENSION NNPTR (MXNFLG), WTNODE (NPNBC)
|
||
|
|
DIMENSION NSFLG (MXSFLG), NSLEN (MXSFLG)
|
||
|
|
DIMENSION NSPTR (MXSFLG), WTSIDE (NPSBC)
|
||
|
|
DIMENSION NVLEN (MXSFLG), NVPTR (MXSFLG), LINKM (2, (MS+MR))
|
||
|
|
DIMENSION MAPDXG (NPNODE), MAPGXD (NPNODE), MATMAP (3, NPREGN)
|
||
|
|
DIMENSION KIN (MCOM), IIN (MCOM), RIN (MCOM)
|
||
|
|
|
||
|
|
LOGICAL FOUND, ERR
|
||
|
|
|
||
|
|
CHARACTER*72 TITLE, CIN (MCOM)
|
||
|
|
CHARACTER*10 VERSN
|
||
|
|
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('*********************************************************')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('** MESH ADJUST OPTION IS CURRENTLY LIMITED TO DELETING **')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('** ELEMENTS SIDE BOUNDARY FLAGS BY MATERIAL **')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('*********************************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
|
||
|
|
C ADJUST SIDE BOUNDARY FLAGS BY MATERIALS
|
||
|
|
|
||
|
|
CALL MESSAGE('ENTER DATA IN THE FOLLOWING FORMAT:')
|
||
|
|
CALL MESSAGE('[ MATERIAL NUMBER, FLAG ID ]')
|
||
|
|
CALL MESSAGE('HIT RETURN TO END INPUT')
|
||
|
|
100 CONTINUE
|
||
|
|
IF (ICOM .GT. JCOM) THEN
|
||
|
|
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN, IIN,
|
||
|
|
& RIN)
|
||
|
|
ICOM = 1
|
||
|
|
END IF
|
||
|
|
IF ((ICOM .GT. JCOM) .OR. (CIN (ICOM) (1:1) .EQ. ' ')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
GOTO 190
|
||
|
|
ELSE
|
||
|
|
I1 = IIN (ICOM)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF ((ICOM .LE. JCOM) .AND. (KIN (ICOM) .GT. 0)) THEN
|
||
|
|
I2 = IIN (ICOM)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
ELSE
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL MESSAGE('** NOT ENOUGH INFORMATION IS SUPPLIED **')
|
||
|
|
GOTO 100
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C NOW THAT THE MATERIAL (I1) AND THE FLAG ID (I2) ARE ENTERED
|
||
|
|
C FIRST CHECK TO MAKE SURE THAT THAT MATERIAL IS PRESENT
|
||
|
|
|
||
|
|
DO 110 I = 1, NUMMAT
|
||
|
|
IF (MATMAP (1, I) .EQ. I1) THEN
|
||
|
|
J1 = MATMAP (2, I)
|
||
|
|
J2 = MATMAP (3, I)
|
||
|
|
GOTO 120
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
CALL MESSAGE('** THAT MATERIAL IS NOT PRESENT IN THE MESH **')
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
|
||
|
|
C NOW FIND THE ELEMENT SIDE FLAG
|
||
|
|
|
||
|
|
DO 130 I = 1, NBCSID
|
||
|
|
IF (NSFLG (I) .EQ. I2) THEN
|
||
|
|
II = I
|
||
|
|
GOTO 140
|
||
|
|
ENDIF
|
||
|
|
130 CONTINUE
|
||
|
|
CALL MESSAGE('** THAT ELEMENT BOUNDARY FLAG IS NOT IN THE '//
|
||
|
|
& 'MESH **')
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
140 CONTINUE
|
||
|
|
|
||
|
|
C NOW SEARCH THE LOOP FOR ELEMENTS ATTACHED TO THAT BOUNDARY FLAG
|
||
|
|
C OF THE SPECIFIED MATERIAL
|
||
|
|
|
||
|
|
IBEGIN = NSPTR (II)
|
||
|
|
IEND = NSPTR (II) + NSLEN (I) - 1
|
||
|
|
|
||
|
|
FOUND = .FALSE.
|
||
|
|
KOUNT = 0
|
||
|
|
|
||
|
|
DO 180 I = IBEGIN, IEND
|
||
|
|
IF ((NELEMS (I - KOUNT) .GE. J1) .AND.
|
||
|
|
& (NELEMS (I - KOUNT) .LE. J2)) THEN
|
||
|
|
|
||
|
|
C AN ELEMENT SIDE FLAG HAS BEEN FOUND - NOW DELETE IT
|
||
|
|
|
||
|
|
FOUND = .TRUE.
|
||
|
|
|
||
|
|
DO 150 J = I - KOUNT, NSLIST - 1
|
||
|
|
NELEMS (J) = NELEMS (J + 1)
|
||
|
|
150 CONTINUE
|
||
|
|
NSLIST = NSLIST - 1
|
||
|
|
|
||
|
|
DO 160 J = (((I - KOUNT) * 2) -1), NVLIST - 2
|
||
|
|
NSIDEN (J) = NSIDEN (J + 2)
|
||
|
|
WTSIDE (J) = WTSIDE (J + 2)
|
||
|
|
160 CONTINUE
|
||
|
|
NVLIST = NVLIST - 2
|
||
|
|
|
||
|
|
NSLEN (II) = NSLEN (II) - 1
|
||
|
|
NVLEN (II) = NVLEN (II) - 2
|
||
|
|
DO 170 J = II + 1, NBCSID
|
||
|
|
NSPTR (J) = NSPTR (J) - 1
|
||
|
|
NVPTR (J) = NVPTR (J) - 2
|
||
|
|
170 CONTINUE
|
||
|
|
|
||
|
|
KOUNT = KOUNT + 1
|
||
|
|
ENDIF
|
||
|
|
180 CONTINUE
|
||
|
|
IF (.NOT. FOUND) THEN
|
||
|
|
CALL MESSAGE('** NO MATCHES OF ELEMENTS WITH THAT BOUNDARY '//
|
||
|
|
& 'FLAG AND MATERIAL **')
|
||
|
|
ENDIF
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
190 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|