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.
314 lines
10 KiB
314 lines
10 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 PRESS (OPTION, NOUT, NUMESS, LISESS, LESSEL, LESSNL,
|
||
|
|
& IDESS, NEESS, NNESS, IXEESS, IXNESS, LTEESS, LTSESS, FACESS,
|
||
|
|
* NAME, nvar, namvar, isvok, lisvar, NDFSID, NODSID,
|
||
|
|
* MAPEL, MAPND, DOMAPE, DOMAPN)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** PRESS *** (EXPLORE) Display database element side set
|
||
|
|
C --
|
||
|
|
C --PRESS displays the element side sets.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- OPTION - IN - '*' to print all, else print options:
|
||
|
|
C -- ' ' - set summary (number of nodes, etc)
|
||
|
|
C -- 'E' - elements in set (may not be combined with 'N' or 'F')
|
||
|
|
C -- 'N' - nodes in set (may not be combined with 'E')
|
||
|
|
C -- 'F' - distribution factors for set (may not be combined with 'E')
|
||
|
|
C -- NOUT - IN - the output file, <=0 for standard
|
||
|
|
C -- NUMESS - IN - the number of element side sets
|
||
|
|
C -- LISESS - IN - the indices of the selected element side sets
|
||
|
|
C -- LESSEL - IN - the number of elements for all sets
|
||
|
|
C -- LESSNL - IN - the number of nodes for all sets
|
||
|
|
C -- IDESS - IN - the element side set ID for each set
|
||
|
|
C -- NEESS - IN - the number of elements for each set
|
||
|
|
C -- NNESS - IN - the number of nodes for each set
|
||
|
|
C -- IXEESS - IN - the index of the first element for each set
|
||
|
|
C -- IXNESS - IN - the index of the first node for each set
|
||
|
|
C -- LTEESS - IN - the elements for all sets
|
||
|
|
C -- LTSESS - IN - the element sides for all sets
|
||
|
|
C -- FACESS - IN - the distribution factors for all sets
|
||
|
|
C -- NVAR - IN - the number of variables
|
||
|
|
C -- NAMVAR - IN - the names of the variables
|
||
|
|
C -- NDFSID - IN - the number of df per face
|
||
|
|
C -- ISVOK - IN - the variable truth table;
|
||
|
|
C -- variable i of set j exists iff ISVOK(i,j) is NOT 0
|
||
|
|
C -- LISVAR - SCRATCH - size = NVAR (if 'V' in OPTION)
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
INCLUDE 'exp_dbase.blk'
|
||
|
|
|
||
|
|
CHARACTER*(*) OPTION
|
||
|
|
INTEGER LISESS(0:*)
|
||
|
|
INTEGER IDESS(*)
|
||
|
|
INTEGER NEESS(*)
|
||
|
|
INTEGER NNESS(*)
|
||
|
|
INTEGER IXEESS(*)
|
||
|
|
INTEGER IXNESS(*)
|
||
|
|
INTEGER LTEESS(*)
|
||
|
|
INTEGER LTSESS(*)
|
||
|
|
INTEGER NDFSID(*)
|
||
|
|
INTEGER NODSID(*)
|
||
|
|
REAL FACESS(*)
|
||
|
|
CHARACTER*(*) NAME(*)
|
||
|
|
CHARACTER*(*) NAMVAR(*)
|
||
|
|
INTEGER ISVOK(NVAR,*)
|
||
|
|
INTEGER LISVAR(*)
|
||
|
|
INTEGER MAPEL(*)
|
||
|
|
INTEGER MAPND(*)
|
||
|
|
LOGICAL DOMAPE, DOMAPN
|
||
|
|
|
||
|
|
LOGICAL ALLSAM
|
||
|
|
LOGICAL DOELE, DONOD, DOFAC, DOVTBL
|
||
|
|
CHARACTER*20 STRA, STRB, STRC
|
||
|
|
|
||
|
|
INTEGER GETPRC, PRTLEN
|
||
|
|
CHARACTER*128 FMT1, FMTE, FMTM
|
||
|
|
|
||
|
|
INTEGER NODES(27)
|
||
|
|
REAL FACTORS(27)
|
||
|
|
|
||
|
|
PRTLEN = GETPRC() + 7
|
||
|
|
WRITE(FMT1,20) PRTLEN, PRTLEN-7
|
||
|
|
CALL SQZSTR(FMT1, LFMT)
|
||
|
|
WRITE(FMTE, 10055) FMT1(:LFMT)
|
||
|
|
WRITE(FMTM, 10100) FMT1(:LFMT)
|
||
|
|
|
||
|
|
DOELE = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'E') .GT. 0))
|
||
|
|
DONOD = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'N') .GT. 0))
|
||
|
|
DOFAC = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'F') .GT. 0))
|
||
|
|
DOVTBL = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'V') .GT. 0))
|
||
|
|
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
IF (DOELE) THEN
|
||
|
|
WRITE (NOUT, 10020) 'ELEMENT LIST'
|
||
|
|
ELSE IF (DONOD .AND. DOFAC) THEN
|
||
|
|
WRITE (NOUT, 10020) 'ELEM.FACE LIST AND DISTRIBUTION FACTORS'
|
||
|
|
ELSE IF (DONOD) THEN
|
||
|
|
WRITE (NOUT, 10020) 'ELEM.FACE LIST'
|
||
|
|
ELSE IF (DOFAC) THEN
|
||
|
|
WRITE (NOUT, 10020) 'DISTRIBUTION FACTORS'
|
||
|
|
ELSE
|
||
|
|
WRITE (NOUT, 10020)
|
||
|
|
END IF
|
||
|
|
if (domape) then
|
||
|
|
write (nout, 10025)
|
||
|
|
end if
|
||
|
|
ELSE
|
||
|
|
if (domape) then
|
||
|
|
write (*, 10025)
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, *)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, *)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
WRITE (STRA, 10000, IOSTAT=IDUM) NUMESS
|
||
|
|
10000 FORMAT ('(#', I4, ')')
|
||
|
|
CALL PCKSTR (1, STRA)
|
||
|
|
LSTRA = LENSTR (STRA)
|
||
|
|
WRITE (STRB, 10010, IOSTAT=IDUM) LESSEL
|
||
|
|
10010 FORMAT ('(index=', I12, ')')
|
||
|
|
CALL PCKSTR (1, STRB)
|
||
|
|
LSTRB = LENSTR (STRB)
|
||
|
|
WRITE (STRC, 10010, IOSTAT=IDUM) LESSNL
|
||
|
|
CALL PCKSTR (1, STRC)
|
||
|
|
LSTRC = LENSTR (STRC)
|
||
|
|
|
||
|
|
DO 100 IX = 1, LISESS(0)
|
||
|
|
IESS = LISESS(IX)
|
||
|
|
WRITE (STRA, 10000, IOSTAT=IDUM) IESS
|
||
|
|
CALL PCKSTR (1, STRA)
|
||
|
|
WRITE (STRB, 10010, IOSTAT=IDUM) IXEESS(IESS)
|
||
|
|
CALL PCKSTR (1, STRB)
|
||
|
|
WRITE (STRC, 10010, IOSTAT=IDUM) IXNESS(IESS)
|
||
|
|
CALL PCKSTR (1, STRC)
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, 10030, IOSTAT=IDUM)
|
||
|
|
& IDESS(IESS), STRA(:LSTRA),
|
||
|
|
& NEESS(IESS), STRB(:LSTRB), NNESS(IESS), STRC(:LSTRC),
|
||
|
|
$ NAME(IESS)(:LENSTR(NAME(IESS)))
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10030, IOSTAT=IDUM)
|
||
|
|
& IDESS(IESS), STRA(:LSTRA),
|
||
|
|
& NEESS(IESS), STRB(:LSTRB), NNESS(IESS), STRC(:LSTRC),
|
||
|
|
$ NAME(IESS)(:LENSTR(NAME(IESS)))
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (DOELE .AND. (NEESS(IESS) .GT. 0)) THEN
|
||
|
|
IS = IXEESS(IESS)
|
||
|
|
IE = IS + NEESS(IESS) - 1
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
if (domape) then
|
||
|
|
WRITE (NOUT, 10040, IOSTAT=IDUM)
|
||
|
|
& (MAPEL(LTEESS(I)), I=IS,IE)
|
||
|
|
else
|
||
|
|
WRITE (NOUT, 10040, IOSTAT=IDUM)
|
||
|
|
& (LTEESS(I), I=IS,IE)
|
||
|
|
end if
|
||
|
|
ELSE
|
||
|
|
if (domape) then
|
||
|
|
WRITE (*, 10040, IOSTAT=IDUM)
|
||
|
|
& (MAPEL(LTEESS(I)), I=IS,IE)
|
||
|
|
else
|
||
|
|
WRITE (*, 10040, IOSTAT=IDUM)
|
||
|
|
& (LTEESS(I), I=IS,IE)
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C ... This used to print the nodes of the sideset faces, it now prints
|
||
|
|
C the local element faces of the sideset
|
||
|
|
IF (DONOD .AND. (NEESS(IESS) .GT. 0)) THEN
|
||
|
|
IS = IXEESS(IESS)
|
||
|
|
IE = IS + NEESS(IESS) - 1
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
if (domape) then
|
||
|
|
WRITE (NOUT, 10045, IOSTAT=IDUM)
|
||
|
|
& (MAPEL(LTEESS(I)),LTSESS(I), I=IS,IE)
|
||
|
|
else
|
||
|
|
WRITE (NOUT, 10045, IOSTAT=IDUM)
|
||
|
|
& (LTEESS(I),LTSESS(I), I=IS,IE)
|
||
|
|
endif
|
||
|
|
ELSE
|
||
|
|
if (domape) then
|
||
|
|
WRITE (*, 10045, IOSTAT=IDUM)
|
||
|
|
& (MAPEL(LTEESS(I)),LTSESS(I), I=IS,IE)
|
||
|
|
else
|
||
|
|
WRITE (*, 10045, IOSTAT=IDUM)
|
||
|
|
& (LTEESS(I),LTSESS(I), I=IS,IE)
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (DOVTBL) THEN
|
||
|
|
NSEL = 0
|
||
|
|
mxnam = 0
|
||
|
|
DO 30 I = 1, NVAR
|
||
|
|
IF (ISVOK(I,IESS) .NE. 0) THEN
|
||
|
|
NSEL = NSEL + 1
|
||
|
|
LISVAR(NSEL) = I
|
||
|
|
LNAM = lenstr(namvar(i))
|
||
|
|
mxnam = max(lnam, mxnam)
|
||
|
|
END IF
|
||
|
|
30 CONTINUE
|
||
|
|
|
||
|
|
if (nsel .gt. 0) then
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
if (mxnam .gt. 24) then
|
||
|
|
WRITE (NOUT, 10090, IOSTAT=IDUM)
|
||
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
||
|
|
else
|
||
|
|
WRITE (NOUT, 10070, IOSTAT=IDUM)
|
||
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
||
|
|
endif
|
||
|
|
write (nout, 10080)
|
||
|
|
ELSE
|
||
|
|
if (mxnam .gt. 24) then
|
||
|
|
WRITE (*, 10090, IOSTAT=IDUM)
|
||
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
||
|
|
else
|
||
|
|
WRITE (*, 10070, IOSTAT=IDUM)
|
||
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
||
|
|
endif
|
||
|
|
write (*, 10080)
|
||
|
|
END IF
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (DOFAC) THEN
|
||
|
|
IF (NNESS(IESS) .GT. 0) THEN
|
||
|
|
IS = IXNESS(IESS)
|
||
|
|
IE = IS + NNESS(IESS) - 1
|
||
|
|
C ... See if all values are the same
|
||
|
|
val = facess(is)
|
||
|
|
allsam = .TRUE.
|
||
|
|
do 50 i=is+1, ie
|
||
|
|
if (facess(i) .ne. val) then
|
||
|
|
allsam = .FALSE.
|
||
|
|
go to 90
|
||
|
|
end if
|
||
|
|
50 continue
|
||
|
|
90 continue
|
||
|
|
if (allsam) then
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, FMTE, IOSTAT=IDUM) VAL
|
||
|
|
ELSE
|
||
|
|
WRITE (*, FMTE, IOSTAT=IDUM) VAL
|
||
|
|
END IF
|
||
|
|
else
|
||
|
|
C ... Get the number of df/nodes per face...
|
||
|
|
C ... NOTE: facess is contiguous over all sidesets,
|
||
|
|
C nodsid is only for the current sideset.
|
||
|
|
call exgssn(ndb, idess(iess), ndfsid, nodsid, ierr)
|
||
|
|
ISE = IXEESS(IESS)
|
||
|
|
IEE = ISE + NEESS(IESS) - 1
|
||
|
|
IDS = IS
|
||
|
|
idf = 1
|
||
|
|
idn = 1
|
||
|
|
do i=ise, iee
|
||
|
|
NDFPE = ndfsid(idf)
|
||
|
|
idf=idf+1
|
||
|
|
if (domape) then
|
||
|
|
iel = mapel(lteess(i))
|
||
|
|
else
|
||
|
|
iel = lteess(i)
|
||
|
|
end if
|
||
|
|
do j=1,ndfpe
|
||
|
|
factors(j) = facess(j+ids-1)
|
||
|
|
nodes(j) = nodsid(j+idn-1)
|
||
|
|
end do
|
||
|
|
|
||
|
|
if (domapn) then
|
||
|
|
do j=1,ndfpe
|
||
|
|
nodes(j) = mapnd(nodes(j))
|
||
|
|
end do
|
||
|
|
end if
|
||
|
|
|
||
|
|
if (nout .gt. 0) then
|
||
|
|
write (nout, FMTM) iel, ltsess(i),
|
||
|
|
* (nodes(j), factors(j),j=1,ndfpe)
|
||
|
|
else
|
||
|
|
write (*, FMTM) iel, ltsess(i),
|
||
|
|
* (nodes(j), factors(j),j=1,ndfpe)
|
||
|
|
end if
|
||
|
|
ids = ids + ndfpe
|
||
|
|
idn = idn + ndfpe
|
||
|
|
end do
|
||
|
|
end if
|
||
|
|
else
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, 10060, IOSTAT=IDUM)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10060, IOSTAT=IDUM)
|
||
|
|
END IF
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
20 FORMAT('1PE',I2.2,'.',I2.2)
|
||
|
|
10020 FORMAT (/, 1X, 'ELEMENT SIDE SETS', :, ' - ', A)
|
||
|
|
10025 FORMAT (1x, 'Element Ids are Global')
|
||
|
|
10030 FORMAT (1X, 'Set', I12, 1X, A, ':',
|
||
|
|
& I12, ' elements', 1X, A,
|
||
|
|
& I12, ' nodes/df', 1X, A, ' name = "',A,'"')
|
||
|
|
10040 FORMAT ((1X, 8I12))
|
||
|
|
10045 FORMAT ((1X, 8(I12,'.',I1)))
|
||
|
|
10055 FORMAT ('(10x, ''All distribution factors are equal to ''', A,')')
|
||
|
|
10060 FORMAT (10x, 'Distribution factors not stored in file.')
|
||
|
|
10070 FORMAT ((2x,4(2X, A)))
|
||
|
|
10090 FORMAT ((2x,3(2X, A)))
|
||
|
|
10080 FORMAT (1X)
|
||
|
|
10100 FORMAT ('((1X, I12,''.'',I1,8x,(8(1x,I12,1x,',A,')))))')
|
||
|
|
END
|