Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

242 lines
8.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 PRELB (OPTION, NOUT, NELBLK, NLISEL, LISEL,
& IDELB, LENE, NUMLNK, NUMATR, LINK, ATRIB,
& EBTYPE, EBNAME, NVAREL, NAMEEV, ISEVOK, LISEV,
* ATNAME, MAPN, DOMAPN, MAPE, DOMAPE)
C=======================================================================
C --*** PRELB *** (BLOT) Display database element blocks
C --
C --PRELB displays the element blocks.
C --
C --Parameters:
C -- OPTION - IN - '*' to print all, else print options:
C -- ' ' to print block summary
C -- 'N' to print element block name
C -- 'V' to print element variable truth table
C -- 'C' to print connectivity
C -- 'A' to print attributes
C -- NOUT - IN - the output file, <=0 for standard
C -- NELBLK - IN - the number of element blocks
C -- NLISEL - IN - the number of selected elements by block
C -- LISEL - IN - the indices of the selected elements by block
C -- IDELB - IN - the element block ID for each block
C -- LENE - IN - the cumulative element counts by element block
C -- NUMLNK - IN - the number of nodes per element for each block
C -- NUMATR - IN - the number of attributes for each block
C -- LINK - IN - the connectivity array for all blocks
C -- ATRIB - IN - the attribute array for all blocks
C -- EBTYPE - IN - the names of the element block types
C -- NVAREL - IN - the number of element variables
C -- NAMEEV - IN - the names of the element variables
C -- ISEVOK - IN - the element block variable truth table;
C -- variable i of block j exists iff ISEVOK(i,j) is NOT 0
C -- LISEV - SCRATCH - size = NVAREL (if 'V' in OPTION)
include 'exodusII.inc'
CHARACTER*(*) OPTION
INTEGER NLISEL(0:NELBLK)
INTEGER LISEL(0:*)
INTEGER IDELB(*)
INTEGER LENE(0:NELBLK)
INTEGER NUMLNK(*)
INTEGER NUMATR(*)
INTEGER LINK(*)
REAL ATRIB(*)
CHARACTER*(MXSTLN) EBTYPE(*)
CHARACTER*(*) EBNAME(*)
CHARACTER*(*) NAMEEV(*)
CHARACTER*(*) ATNAME(*)
INTEGER ISEVOK(NVAREL,*)
INTEGER LISEV(*)
INTEGER MAPN(*), MAPE(*)
LOGICAL DOMAPN, DOMAPE
LOGICAL ISABRT
LOGICAL DONAM, DOVTBL, DOCONN, DOATR
LOGICAL BLK1
CHARACTER*40 STRA, STRB
DONAM = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'N') .GT. 0))
DOVTBL = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'V') .GT. 0))
DOCONN = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'C') .GT. 0))
DOATR = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'A') .GT. 0))
DONAM = .TRUE.
BLK1 = .TRUE.
IF (NOUT .GT. 0) THEN
IF (DOCONN .AND. DOATR) THEN
WRITE (NOUT, 10020) 'CONNECTIVITY and ATTRIBUTES'
ELSE IF (DOCONN) THEN
WRITE (NOUT, 10020) 'CONNECTIVITY'
ELSE IF (DOATR) THEN
WRITE (NOUT, 10020) 'ATTRIBUTES'
ELSE
WRITE (NOUT, 10020)
END IF
END IF
if (nout .gt. 0) then
if (domape) write (nout, 10060) 'Element'
if (domapn) write (nout, 10060) 'Nodal'
else
if (domape) write (*, 10060) 'Element'
if (domapn) write (*, 10060) 'Nodal'
end if
WRITE (STRA, 10000, IOSTAT=IDUM) NELBLK
10000 FORMAT ('(#', I12, ')')
CALL PCKSTR (1, STRA)
LSTRA = LENSTR (STRA)
WRITE (STRB, 10010, IOSTAT=IDUM) LENE(NELBLK), LENE(NELBLK)
10010 FORMAT ('(', I12, '..', I12, ')')
CALL PCKSTR (1, STRB)
LSTRB = LENSTR (STRB)
ISLNK = 1
ISATR = 1
ISATN = 1
DO 110 IELB = 1, NELBLK
NUME = LENE(IELB) - LENE(IELB-1)
if (ebtype(ielb) .eq. 'nsided' .or.
* ebtype(ielb) .eq. 'NSIDED') THEN
numnod = numlnk(ielb)
else
numnod = numlnk(ielb)*nume
end if
IF (ISABRT ()) RETURN
IF (NLISEL(IELB) .GT. 0) THEN
IEL = LENE(IELB-1)+1
LEL = LENE(IELB)
IF (BLK1 .OR. DOCONN .OR. DOATR) THEN
BLK1 = .FALSE.
IF (NOUT .GT. 0) THEN
WRITE (NOUT, *)
ELSE
WRITE (*, *)
END IF
END IF
WRITE (STRA, 10000, IOSTAT=IDUM) IELB
CALL PCKSTR (1, STRA)
WRITE (STRB, 10010, IOSTAT=IDUM) IEL, LEL
CALL PCKSTR (1, STRB)
IF (NOUT .GT. 0) THEN
WRITE (NOUT, 10030, IOSTAT=IDUM)
& IDELB(IELB), STRA(:LSTRA),
& NUME, STRB(:LSTRB), NUMLNK(IELB), NUMATR(IELB)
ELSE
WRITE (*, 10030, IOSTAT=IDUM)
& IDELB(IELB), STRA(:LSTRA),
& NUME, STRB(:LSTRB), NUMLNK(IELB), NUMATR(IELB)
END IF
IF (DONAM) THEN
LNAM = LENSTR(EBTYPE(IELB))
LNM = LENSTR(EBNAME(IELB))
IF (NOUT .GT. 0) THEN
WRITE (NOUT, 10040) EBNAME(IELB)(:LNM),
$ EBTYPE(IELB)(:LNAM)
ELSE
WRITE (*, 10040) EBNAME(IELB)(:LNM), EBTYPE(IELB)(:LNAM)
END IF
if (numatr(ielb) .gt. 0) then
mxnam = 0
DO I = 1, numatr(ielb)
LNAM = lenstr(atname(isatn+i-1))
mxnam = max(lnam, mxnam)
END DO
if (mxnam .gt. 1) then
IF (NOUT .GT. 0) THEN
WRITE (NOUT, 10090, IOSTAT=IDUM)
& (ATNAME(I)(:mxnam),
* I=ISATN,ISATN+NUMATR(IELB)-1)
ELSE
WRITE (*, 10090, IOSTAT=IDUM)
& (ATNAME(I)(:mxnam),
* I=ISATN,ISATN+NUMATR(IELB)-1)
END IF
end if
end if
END IF
IF (DOVTBL) THEN
NSEL = 0
mxnam = 0
DO 100 I = 1, NVAREL
IF (ISEVOK(I,IELB) .NE. 0) THEN
NSEL = NSEL + 1
LISEV(NSEL) = I
LNAM = lenstr(nameev(i))
mxnam = max(lnam, mxnam)
END IF
100 CONTINUE
IF (NOUT .GT. 0) THEN
if (mxnam .gt. 24) then
WRITE (NOUT, 10070, IOSTAT=IDUM)
& (NAMEEV(LISEV(I))(:mxnam), I=1,NSEL)
else
WRITE (NOUT, 10050, IOSTAT=IDUM)
& (NAMEEV(LISEV(I))(:mxnam), I=1,NSEL)
endif
write (nout, 10080)
ELSE
if (mxnam .gt. 24) then
WRITE (*, 10070, IOSTAT=IDUM)
& (NAMEEV(LISEV(I))(:mxnam), I=1,NSEL)
else
WRITE (*, 10050, IOSTAT=IDUM)
& (NAMEEV(LISEV(I))(:mxnam), I=1,NSEL)
endif
write (*, 10080)
END IF
END IF
IF (DOCONN .OR. DOATR) THEN
if (ebtype(ielb) .eq. 'nsided' .or.
* ebtype(ielb) .eq. 'NSIDED') THEN
CALL PREBN (OPTION, NOUT, IELB,
* nume, IDELB(IELB),
* IEL-1, NLISEL(IELB), LISEL(IEL),
* NUMATR(IELB),
& LINK(ISLNK), ATRIB(ISATR), max(1,numatr(ielb)),
* MAPN, DOMAPN, MAPE, DOMAPE)
else
CALL PREB1 (OPTION, NOUT, IEL-1,
& NLISEL(IELB), LISEL(IEL), NUMLNK(IELB), NUMATR(IELB),
& LINK(ISLNK), ATRIB(ISATR), max(1,numatr(ielb)),
* MAPN, DOMAPN, MAPE, DOMAPE)
end if
IF (ISABRT ()) RETURN
END IF
END IF
IF (DOCONN) ISLNK = ISLNK + numnod
IF (DOATR) ISATR = ISATR + NUME * NUMATR(IELB)
ISATN = ISATN + NUMATR(IELB)
110 CONTINUE
RETURN
10020 FORMAT (/, 1X, 'ELEMENT BLOCKS', :, ' - ', A)
C ... NOTE: Normal elements have a a mximum of <100 nodes, but superelements
C Or other "strange" elements may have lots of nodes; keep format high
10030 FORMAT (1X, 'Block', I12, 1X, A, ':',
& I12, ' elements', 1X, A,
& I6, '-node', I4, ' attributes')
10040 FORMAT (2X, 'Element block name = "',A
$ ,'", Element type = "', A, '"')
10050 FORMAT ((2x,4(2X, A)))
10060 FORMAT (1x, A, ' IDs are global')
10070 FORMAT ((2x,3(2X, A)))
10080 FORMAT (1X)
10090 FORMAT (2X, 'Attributes: ', 10(2X, A))
END