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.
125 lines
4.3 KiB
125 lines
4.3 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
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE WRESS (A, IA, IDFRO, IDBCK,
|
||
|
|
& ISSFRO, ISSBCK, NSSUR, NSSFRO, NSSBCK,
|
||
|
|
& IDESS, NEES3, NNES3, IXEES3, IXNES3, LTEES3, LTSSS3, FACES3, *)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** WRESS *** (GEN3D) Write 3D node sets
|
||
|
|
C -- Written by Amy Gilkey - revised 05/05/86
|
||
|
|
C --
|
||
|
|
C --WRESS writes the side set information for the 3D database.
|
||
|
|
C --Calculations have been done elsewhere.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- IDFRO - IN - ids for front surface side sets; (0) = length
|
||
|
|
C -- IDBCK - IN - ids for back surface side sets; (0) = length
|
||
|
|
C -- ISSFRO - IN - the elements in the front surface side set
|
||
|
|
C -- ISSBCK - IN - the elements in the back surface side set
|
||
|
|
C -- NSSUR - IN - the number of nodes in the surface side set
|
||
|
|
C -- NSSFRO - IN - the nodes in the front surface side set
|
||
|
|
C -- NSSBCK - IN - the nodes in the back surface side set
|
||
|
|
C -- IDESS - IN - the ids for each 2D set
|
||
|
|
C -- NEES3 - IN - the number of elements for each 3D set
|
||
|
|
C -- NNES3 - IN - the number of nodes for each 3D set
|
||
|
|
C -- IXEES3 - IN - the index of the first element for each 3D set
|
||
|
|
C -- IXNES3 - IN - the index of the first node for each 3D set
|
||
|
|
C -- LTEES3 - IN - the elements for all 3D sets
|
||
|
|
C -- LTSSS3 - IN - the element sides for all 3D sets
|
||
|
|
C -- FACES3 - IN - the distribution factors for all 3D sets
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses NDBOUT of /DBASE/
|
||
|
|
C -- Uses NUMESS, LESSEL, LESSNL of /DBNUMS/
|
||
|
|
C -- Uses LESSEO, LESSNO of /DBNUM3/
|
||
|
|
C -- Uses NNREPL, NEREPL of /PARAMS/
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
INCLUDE 'gs_dbase.blk'
|
||
|
|
INCLUDE 'gs_dbnums.blk'
|
||
|
|
INCLUDE 'gs_dbnum3.blk'
|
||
|
|
|
||
|
|
REAL A(*)
|
||
|
|
INTEGER IA(*)
|
||
|
|
INTEGER IDFRO(0:*)
|
||
|
|
INTEGER IDBCK(0:*)
|
||
|
|
INTEGER ISSFRO(NUMEL), ISSBCK(NUMEL)
|
||
|
|
INTEGER NSSFRO(*), NSSBCK(*)
|
||
|
|
INTEGER IDESS(*)
|
||
|
|
INTEGER NEES3(*)
|
||
|
|
INTEGER NNES3(*)
|
||
|
|
INTEGER IXEES3(*)
|
||
|
|
INTEGER IXNES3(*)
|
||
|
|
INTEGER LTEES3(*)
|
||
|
|
INTEGER LTSSS3(*)
|
||
|
|
REAL FACES3(*)
|
||
|
|
|
||
|
|
LOGICAL ANYESS
|
||
|
|
|
||
|
|
NFRO = IDFRO(0)
|
||
|
|
NBCK = IDBCK(0)
|
||
|
|
ANYESS = (NFRO .GT. 0) .OR. (NBCK .GT. 0) .OR. (NUMESS .GT. 0)
|
||
|
|
|
||
|
|
C --Write 3D Sidesets
|
||
|
|
IF (.NOT. ANYESS) RETURN
|
||
|
|
|
||
|
|
C Each sideset has numel elements and faces, and NSSUR distribution factors
|
||
|
|
if ((nfro .gt. 0) .or. (nbck .gt. 0)) then
|
||
|
|
C ... Allocate array to store side data for front and/or back sidesets
|
||
|
|
call mdrsrv('LSTSID', klst, numel)
|
||
|
|
C ... Allocate array for distribution factors
|
||
|
|
call mdrsrv('DISTF', kdistf, nssur)
|
||
|
|
call mdstat(nerr, mem)
|
||
|
|
if (nerr .gt. 0) go to 400
|
||
|
|
call inirea(nssur, 1.0, a(kdistf))
|
||
|
|
|
||
|
|
C ... Write Front Sidesets
|
||
|
|
if (nfro .gt. 0) then
|
||
|
|
C ... Fill the side list
|
||
|
|
call iniint(numel, 1, ia(klst))
|
||
|
|
end if
|
||
|
|
do 100 i=1, nfro
|
||
|
|
call expsp (ndbout, idfro(i), numel, nssur, ierr)
|
||
|
|
call expss (ndbout, idfro(i), issfro, ia(klst), ierr)
|
||
|
|
call expssd (ndbout, idfro(i), a(kdistf), ierr)
|
||
|
|
100 continue
|
||
|
|
|
||
|
|
C ... Write Back Sidesets
|
||
|
|
if (nbck .gt. 0) then
|
||
|
|
C ... Fill the side list
|
||
|
|
call iniint(numel, 2, ia(klst))
|
||
|
|
end if
|
||
|
|
do 200 i=1, nbck
|
||
|
|
call expsp (ndbout, idbck(i), numel, nssur, ierr)
|
||
|
|
call expss (ndbout, idbck(i), issbck, ia(klst), ierr)
|
||
|
|
call expssd (ndbout, idbck(i), a(kdistf), ierr)
|
||
|
|
200 continue
|
||
|
|
call mddel('LSTSID')
|
||
|
|
call mddel('DISTF')
|
||
|
|
end if
|
||
|
|
|
||
|
|
C ... Write 2D-generated Sidesets
|
||
|
|
C ... Fix the side list. Assuming input is quads, then the
|
||
|
|
C following should hold newside = oldside + 2
|
||
|
|
do 300 i=1, lesseo
|
||
|
|
ltsss3(i) = ltsss3(i) + 2
|
||
|
|
300 continue
|
||
|
|
|
||
|
|
do 310 i=1, numess
|
||
|
|
call expsp (ndbout, idess(i), nees3(i), nnes3(i), ierr)
|
||
|
|
call expss (ndbout, idess(i), ltees3(ixees3(i)),
|
||
|
|
& ltsss3(ixees3(i)), ierr)
|
||
|
|
call expssd (ndbout, idess(i), faces3(ixnes3(i)), ierr)
|
||
|
|
310 continue
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
400 CONTINUE
|
||
|
|
RETURN 1
|
||
|
|
END
|