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.
248 lines
7.9 KiB
248 lines
7.9 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 WRGENS (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
|
& NPNBC, NPSBC, IUNIT, 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 WRGENS = WRITES GENESIS DATABASE MESH OUTPUT
|
|
|
|
C***********************************************************************
|
|
|
|
PARAMETER (IGUESS = 1000)
|
|
|
|
C IGUESS IS THE NUMBER OF ELEMENT BLOCKS, FOR USE WITH THE ENAME
|
|
C VARIABLE. IF THIS VARIABLE IS NOT AS LARGE AS NUMMAT, IT WILL NOT
|
|
C RESULT IN A FATAL ERROR, BUT SIMPLY A WARNING, AND NO ELEMENT
|
|
C NAMES WILL BE WRITTEN.
|
|
|
|
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)
|
|
|
|
CHARACTER*72 TITLE, HOLD*80
|
|
CHARACTER*8 DATE, TIME, VERSN1, VERSN2, XNAME, YNAME
|
|
CHARACTER*8 ENAME (IGUESS)
|
|
CHARACTER*10 VERSN
|
|
|
|
LOGICAL ERR, EIGHT, NINE
|
|
|
|
integer lcon(9)
|
|
integer lbar(3)
|
|
|
|
data lcon /1,3,5,7,2,4,6,8,9/
|
|
data lbar /1,3,2/
|
|
|
|
CALL EXDATE (DATE)
|
|
CALL EXTIME (TIME)
|
|
VERSN1 = ' '
|
|
VERSN2 = ' '
|
|
VERSN1 = VERSN (1:5)
|
|
VERSN2 = VERSN (6:10)
|
|
ERR = .TRUE.
|
|
HOLD = TITLE
|
|
XNAME = 'X'
|
|
YNAME = 'Y'
|
|
|
|
C CHECK TO MAKE SURE THAT THERE IS ENOUGH ROOM FOR ELEMENT NAMES
|
|
|
|
IF (NUMMAT.GT.IGUESS) THEN
|
|
CALL MESSAGE('WARNING: THE NUMBER OF ELEMENT BLOCKS EXCEEDS')
|
|
CALL MESSAGE(' THE CAPACITY TO NAME EACH BLOCK.')
|
|
CALL MESSAGE(' NO ELEMENT NAMES WILL BE WRITTEN.')
|
|
ENDIF
|
|
|
|
C WRITE OUT HEADER INFORMATION
|
|
|
|
WRITE (IUNIT, ERR = 110)HOLD
|
|
IJK = 2
|
|
IVERS = 1
|
|
C ... Fix up side set nodes for 8 and 9 node elements.
|
|
C ... At this point, they are treated as two linear segments,
|
|
C ... They should be ends followed by middle
|
|
|
|
C 1-----3-----2 Now: 1 3 3 2 Correct: 1 2 3
|
|
|
|
if (eight .or. nine) then
|
|
nvlst = nvlist / 4 * 3
|
|
if (nslist .gt. 1) then
|
|
nslst = nslist / 2
|
|
else
|
|
nslst = nslist
|
|
end if
|
|
else
|
|
nvlst = nvlist
|
|
nslst = nslist
|
|
end if
|
|
|
|
WRITE (IUNIT, ERR = 110)NNN, IJK, KKK, NUMMAT, NBCNOD, NNLIST,
|
|
& NBCSID, NSLST, NVLST, IVERS
|
|
|
|
C WRITE OUT NODE BLOCK
|
|
|
|
WRITE (IUNIT, ERR = 110) (XN (I), I = 1, NNN),
|
|
& (YN (I), I = 1, NNN)
|
|
WRITE (IUNIT, ERR = 110) (MAPDXG (I), I = 1, KKK)
|
|
|
|
C WRITE OUT ELEMENT BLOCKS
|
|
|
|
DO 100 I = 1, NUMMAT
|
|
IF (NXK (3, MATMAP (2, I)) .EQ. 0) THEN
|
|
INODE = 2
|
|
NATTR = 1
|
|
ATTR = 1.
|
|
IF (I.LE.IGUESS)ENAME (I) = 'BEAM'
|
|
ELSEIF (NXK (4, MATMAP (2, I)) .EQ. 0) THEN
|
|
INODE = 3
|
|
NATTR = 1
|
|
ATTR = 1.
|
|
IF (I.LE.IGUESS)ENAME (I) = 'BEAM'
|
|
CALL MESSAGE('NOTE: The connectivity numbering for 3-node')
|
|
CALL MESSAGE(' beams/trusses has been fixed to')
|
|
CALL MESSAGE(' conform to EXODUS convention (1-3-2)')
|
|
ELSEIF (EIGHT) THEN
|
|
INODE = 8
|
|
NATTR = 0
|
|
IF (I.LE.IGUESS)ENAME (I) = 'QUAD'
|
|
ELSEIF (NINE) THEN
|
|
INODE = 9
|
|
NATTR = 0
|
|
IF (I.LE.IGUESS)ENAME (I) = 'QUAD'
|
|
ELSE
|
|
INODE = 4
|
|
NATTR = 0
|
|
IF (I.LE.IGUESS)ENAME (I) = 'QUAD'
|
|
ENDIF
|
|
|
|
C NLOOP IS NEEDED TO WRITE SOMETHING OUT THE CURRENT COUNTER IS ZERO.
|
|
C THIS IS DONE TO SOLVE A CRAY OPERATING SYSTEM [CTSS] PROBLEM
|
|
C WHERE NULL RECORD WRITES ARE NOT DONE APPROPRIATELY
|
|
|
|
WRITE (IUNIT, ERR = 110) MATMAP (1, I),
|
|
& MATMAP (3, I) - MATMAP (2, I)+1, INODE, NATTR
|
|
C... 8 or 9 node quads
|
|
IF (INODE .EQ. 8 .or. inode .eq. 9) THEN
|
|
write (iunit, err = 110) ((nxk(lcon(ii), k), ii=1, nnxk),
|
|
$ k = matmap(2,i), matmap(3,i))
|
|
C... 3 node beam/truss
|
|
ELSEIF (INODE .EQ. 3) THEN
|
|
write (iunit, err = 110) ((nxk(lbar(ii), k), ii=1, inode),
|
|
$ k = matmap(2,i), matmap(3,i))
|
|
C... 4 node quad or 2 node beam/truss
|
|
ELSE
|
|
WRITE (IUNIT, ERR = 110) ((NXK (J, K), J = 1, INODE),
|
|
& K = MATMAP (2, I), MATMAP (3, I))
|
|
ENDIF
|
|
NLOOP = MAX0 (1, NATTR*KKK)
|
|
WRITE (IUNIT, ERR = 110) (ATTR, J = 1, NLOOP)
|
|
100 CONTINUE
|
|
|
|
C WRITE OUT NODAL BOUNDARY FLAGS
|
|
|
|
NLOOP = MAX0 (1, NBCNOD)
|
|
WRITE (IUNIT, ERR = 110) (NNFLG (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NNLEN (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NNPTR (I), I = 1, NLOOP)
|
|
NLOOP = MAX0 (1, NNLIST)
|
|
WRITE (IUNIT, ERR = 110) (NODES (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (WTNODE (I), I = 1, NLOOP)
|
|
|
|
C WRITE OUT SIDE BOUNDARY FLAGS
|
|
|
|
C ... Fix up side set nodes and elements for 8 and 9 node elements.
|
|
C ... At this point, they are treated as two linear segments,
|
|
C ... They should be ends followed by middle
|
|
|
|
C 1-----3-----2 Now: 1 3 3 2 Correct: 1 2 3
|
|
|
|
if (eight .or. nine) then
|
|
ipn = 1
|
|
ipe = 1
|
|
do 130 ibc = 1, nbcsid
|
|
|
|
ibee = nsptr(ibc)
|
|
iene = nsptr(ibc) + nslen(ibc) - 1
|
|
nsptr(ibc) = ipe
|
|
nslen(ibc) = max(1, nslen(ibc)/2)
|
|
do 115 iel = ibee, iene, 2
|
|
nelems(ipe) = nelems(iel)
|
|
ipe = ipe + 1
|
|
115 continue
|
|
|
|
ibeg = nvptr(ibc)
|
|
iend = nvptr(ibc) + nvlen(ibc) - 1
|
|
nvptr(ibc) = ipn
|
|
nvlen(ibc) = nvlen(ibc) / 4 * 3
|
|
|
|
do 120 inod = ibeg, iend, 4
|
|
nsiden(ipn) = nsiden(inod)
|
|
nsiden(ipn+2) = nsiden(inod+1)
|
|
nsiden(ipn+1) = nsiden(inod+3)
|
|
wtside(ipn) = wtside(inod)
|
|
wtside(ipn+2) = wtside(inod+1)
|
|
wtside(ipn+1) = wtside(inod+3)
|
|
ipn = ipn + 3
|
|
120 continue
|
|
130 continue
|
|
nvlist = ipn - 1
|
|
nslist = ipe - 1
|
|
end if
|
|
|
|
NLOOP = MAX0 (1, NBCSID)
|
|
WRITE (IUNIT, ERR = 110) (NSFLG (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NSLEN (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NVLEN (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NSPTR (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (NVPTR (I), I = 1, NLOOP)
|
|
NLOOP = MAX0 (1, NSLIST)
|
|
WRITE (IUNIT, ERR = 110) (NELEMS (I), I = 1, NLOOP)
|
|
NLOOP = MAX0 (1, NVLIST)
|
|
WRITE (IUNIT, ERR = 110) (NSIDEN (I), I = 1, NLOOP)
|
|
WRITE (IUNIT, ERR = 110) (WTSIDE (I), I = 1, NLOOP)
|
|
|
|
C WRITE OUT THE QA INFORMATION
|
|
|
|
IHOLD = 1
|
|
WRITE (IUNIT, ERR = 110)IHOLD
|
|
WRITE (IUNIT, ERR = 110)VERSN1, VERSN2, DATE, TIME
|
|
|
|
C WRITE THE HEADER INFORMATION
|
|
|
|
IHOLD = 0
|
|
WRITE (IUNIT, ERR = 110)IHOLD
|
|
|
|
C WRITE THE COORDINATE NAMES AND ELEMENT NAMES
|
|
|
|
WRITE (IUNIT)XNAME, YNAME
|
|
IF (NUMMAT.LE.IGUESS)WRITE (IUNIT) (ENAME (I), I = 1, NUMMAT)
|
|
|
|
C SUCCESSFUL WRITE COMPLETED
|
|
|
|
CALL MESSAGE(' ')
|
|
CALL MESSAGE(' ')
|
|
CALL MESSAGE('GENESIS OUTPUT FILE SUCCESSFULLY WRITTEN')
|
|
CALL MESSAGE(' ')
|
|
ERR = .FALSE.
|
|
RETURN
|
|
|
|
C ERR DURING WRITE PROBLEMS
|
|
|
|
110 CONTINUE
|
|
CALL MESSAGE('ERR DURING WRITE TO OUTPUT FILE')
|
|
CALL MESSAGE(' - NO FILE SAVED -')
|
|
RETURN
|
|
|
|
END
|
|
|