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.
176 lines
6.2 KiB
176 lines
6.2 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,
|
||
|
|
& NAMELB, EBNAME, NVAREL, NAMEEV, ISEVOK, LISEV,
|
||
|
|
* MAPEL, MAPND)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** PRELB *** (BLOT) Display database element blocks
|
||
|
|
C -- Written by Amy Gilkey - revised 01/18/88
|
||
|
|
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 -- NAMELB - 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(j,i)
|
||
|
|
C -- LISEV - SCRATCH - size = NVAREL (if 'V' in OPTION)
|
||
|
|
|
||
|
|
CHARACTER*(*) OPTION
|
||
|
|
INTEGER NLISEL(0:*)
|
||
|
|
INTEGER LISEL(0:*)
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
INTEGER LENE(0:*)
|
||
|
|
INTEGER NUMLNK(*)
|
||
|
|
INTEGER NUMATR(*)
|
||
|
|
INTEGER LINK(*)
|
||
|
|
REAL ATRIB(*)
|
||
|
|
CHARACTER*(*) NAMELB(*)
|
||
|
|
CHARACTER*(*) EBNAME(*)
|
||
|
|
CHARACTER*(*) NAMEEV(*)
|
||
|
|
LOGICAL ISEVOK(NELBLK,NVAREL)
|
||
|
|
INTEGER LISEV(*)
|
||
|
|
INTEGER MAPEL(*), MAPND(*)
|
||
|
|
|
||
|
|
LOGICAL ISABRT
|
||
|
|
LOGICAL DONAM, DOVTBL, DOCONN, DOATR
|
||
|
|
LOGICAL BLK1
|
||
|
|
CHARACTER*32 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))
|
||
|
|
|
||
|
|
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
|
||
|
|
|
||
|
|
WRITE (STRA, 10000, IOSTAT=IDUM) NELBLK
|
||
|
|
10000 FORMAT ('(#', I5, ')')
|
||
|
|
CALL PCKSTR (1, STRA)
|
||
|
|
LSTRA = LENSTR (STRA)
|
||
|
|
WRITE (STRB, 10010, IOSTAT=IDUM) LENE(NELBLK), LENE(NELBLK)
|
||
|
|
10010 FORMAT ('(', I10, '..', I10, ')')
|
||
|
|
CALL PCKSTR (1, STRB)
|
||
|
|
LSTRB = LENSTR (STRB)
|
||
|
|
|
||
|
|
DO 110 IELB = 1, NELBLK
|
||
|
|
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
|
||
|
|
|
||
|
|
NUME = LENE(IELB) - LENE(IELB-1)
|
||
|
|
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(NAMELB(IELB))
|
||
|
|
LNM = LENSTR(EBNAME(IELB))
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, 10040) EBNAME(IELB)(:LNM),
|
||
|
|
$ NAMELB(IELB)(:LNAM)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10040) EBNAME(IELB)(:LNM),
|
||
|
|
$ NAMELB(IELB)(:LNAM)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (DOVTBL) THEN
|
||
|
|
lname = 0
|
||
|
|
NSEL = 0
|
||
|
|
DO 100 I = 1, NVAREL
|
||
|
|
IF (ISEVOK(IELB,I)) THEN
|
||
|
|
l = lenstr(nameev(i))
|
||
|
|
if (l .gt. lname) lname = l
|
||
|
|
NSEL = NSEL + 1
|
||
|
|
LISEV(NSEL) = I
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
IF (NOUT .GT. 0) THEN
|
||
|
|
WRITE (NOUT, 10050, IOSTAT=IDUM)
|
||
|
|
& (NAMEEV(LISEV(I))(:lname), I=1,NSEL)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10050, IOSTAT=IDUM)
|
||
|
|
& (NAMEEV(LISEV(I))(:lname), I=1,NSEL)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (DOCONN .OR. DOATR) THEN
|
||
|
|
IF (DOCONN) ISLNK = IDBLNK (IELB, 0, LENE, NUMLNK)
|
||
|
|
IF (DOATR) ISATR = IDBLNK (IELB, 0, LENE, NUMATR)
|
||
|
|
CALL PREB1 (OPTION, NOUT, IEL-1,
|
||
|
|
& NLISEL(IELB), LISEL(IEL), NUMLNK(IELB), NUMATR(IELB),
|
||
|
|
& LINK(ISLNK), ATRIB(ISATR), MAPEL, MAPND)
|
||
|
|
IF (ISABRT ()) RETURN
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10020 FORMAT (/, 1X, 'ELEMENT BLOCKS', :, ' - ', A)
|
||
|
|
10030 FORMAT (1X, 'Block', I9, 1X, A, ':',
|
||
|
|
& I9, ' elements', 1X, A,
|
||
|
|
& I4, '-node', I4, ' attributes')
|
||
|
|
10040 FORMAT (4X, 'Element block name = "',A
|
||
|
|
$ ,'", type = "', A, '"')
|
||
|
|
10050 FORMAT (4X, 'Defined variables:', :, 3X, 4 (2X, A), :, /
|
||
|
|
& (4X, 1X, 6 (2X, A)))
|
||
|
|
END
|