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.
124 lines
3.9 KiB
124 lines
3.9 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 RDESS (NDB, NUMESS, LESSEL, LESSNL,
|
||
|
& IDESS, NEESS, NDESS, IXEESS, IXDESS,
|
||
|
& LTEESS, LTSESS, FACESS, NAME, ISEOF, NAMLEN)
|
||
|
C=======================================================================
|
||
|
|
||
|
C --*** RDESS *** (EXPLORE) Read database element side sets
|
||
|
C --
|
||
|
C --RDESS reads the element side set information from the database.
|
||
|
C --An error message is displayed if the end of file is read.
|
||
|
C --
|
||
|
C --Parameters:
|
||
|
C -- NDB - IN - the database file
|
||
|
C -- NUMESS - IN - the number of side sets
|
||
|
C -- LESSEL - IN - the length of the element side sets element list
|
||
|
C -- LESSNL - IN - the length of the element side sets distribution list
|
||
|
C -- IDESS - OUT - the element side set ID for each set
|
||
|
C -- NEESS - OUT - the number of elements for each set
|
||
|
C -- NDESS - OUT - the number of factors for each set
|
||
|
C -- IXEESS - OUT - the index of the first element for each set
|
||
|
C -- IXDESS - OUT - the index of the first factor for each set
|
||
|
C -- LTEESS - OUT - the elements for all sets
|
||
|
C -- LTESSS - OUT - the elements for all sets
|
||
|
C -- LTSESS - OUT - the element sides for all sets
|
||
|
C -- FACESS - OUT - the distribution factors for all sets
|
||
|
C -- ISEOF - IN/OUT - set true if end of file read
|
||
|
|
||
|
include 'exodusII.inc'
|
||
|
INTEGER IDESS(*)
|
||
|
INTEGER NEESS(*)
|
||
|
INTEGER NDESS(*)
|
||
|
INTEGER IXEESS(*)
|
||
|
INTEGER IXDESS(*)
|
||
|
INTEGER LTEESS(*)
|
||
|
INTEGER LTSESS(*)
|
||
|
REAL FACESS(*)
|
||
|
CHARACTER*(NAMLEN) NAME(*)
|
||
|
LOGICAL ISEOF
|
||
|
|
||
|
CHARACTER*80 ERRMSG
|
||
|
CHARACTER*32 STRA
|
||
|
|
||
|
if (numess .le. 0) return
|
||
|
|
||
|
CALL INIINT (NUMESS, 0, IDESS)
|
||
|
CALL INIINT (NUMESS, 0, NEESS)
|
||
|
CALL INIINT (NUMESS, 0, NDESS)
|
||
|
CALL INIINT (NUMESS, 0, IXEESS)
|
||
|
CALL INIINT (NUMESS, 0, IXDESS)
|
||
|
CALL INIINT (LESSEL, 0, LTEESS)
|
||
|
CALL INIINT (LESSEL, 0, LTSESS)
|
||
|
CALL INIREA (LESSNL, 0.0, FACESS)
|
||
|
|
||
|
C ... Read sideset ids
|
||
|
call exgssi(ndb, idess, ierr)
|
||
|
if (ierr .ne. 0) go to 100
|
||
|
|
||
|
c ... Check that all ids are unique
|
||
|
do 80 i = 1, numess
|
||
|
if (locint (idess(i), i-1, idess) .gt. 0) then
|
||
|
call intstr (1, 0, idess(i), stra, lstra)
|
||
|
call prterr ('CMDERR',
|
||
|
& 'sideset id ' // stra(:lstra) // ' is not unique')
|
||
|
end if
|
||
|
80 continue
|
||
|
|
||
|
ies = 1
|
||
|
ifs = 1
|
||
|
do 90 i = 1, numess
|
||
|
ixeess(i) = ies
|
||
|
ixdess(i) = ifs
|
||
|
|
||
|
C ... Read sideset parameters
|
||
|
call exgsp (ndb, idess(i), neess(i), ndess(i), ierr)
|
||
|
kk = neess(i)
|
||
|
kkk = ndess(i)
|
||
|
if (ierr .ne. 0) go to 110
|
||
|
|
||
|
C ... Read sideset elements and faces
|
||
|
if (neess(i) .gt. 0) then
|
||
|
call exgss (ndb, idess(i), lteess(ies), ltsess(ies), ierr)
|
||
|
if (ierr .ne. 0) go to 150
|
||
|
end if
|
||
|
|
||
|
C ... Read sideset distribution factors
|
||
|
if (ndess(i) .gt. 0) then
|
||
|
call exgssd (ndb, idess(i), facess(ifs), ierr)
|
||
|
if (ierr .ne. 0) go to 170
|
||
|
end if
|
||
|
|
||
|
ies = ies + neess(i)
|
||
|
ifs = ifs + ndess(i)
|
||
|
90 continue
|
||
|
|
||
|
C ... Read names (if they exist)
|
||
|
CALL EXGNAMS(NDB, EXSSET, numess, name, ierr)
|
||
|
RETURN
|
||
|
|
||
|
100 CONTINUE
|
||
|
WRITE (ERRMSG, 10000) 'IDS of element side sets'
|
||
|
GOTO 180
|
||
|
110 CONTINUE
|
||
|
WRITE (ERRMSG, 10000) 'NUMBERS OF ELEMENTS in element side sets'
|
||
|
GOTO 180
|
||
|
150 CONTINUE
|
||
|
WRITE (ERRMSG, 10000) 'Element side set ELEMENTS'
|
||
|
GOTO 180
|
||
|
170 CONTINUE
|
||
|
WRITE (ERRMSG, 10000) 'Element side set FACTORS'
|
||
|
GOTO 180
|
||
|
180 CONTINUE
|
||
|
CALL WDBERR (IERR, ERRMSG)
|
||
|
ISEOF = .TRUE.
|
||
|
|
||
|
RETURN
|
||
|
|
||
|
10000 FORMAT (A)
|
||
|
END
|