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.
172 lines
5.7 KiB
172 lines
5.7 KiB
C Copyright(C) 1999-2020, 2023 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 PREB1 (OPTION, NOUT, IEL0, NLISEL, LISEL,
|
|
& NLINK, NATR, LINK, ATRIB, natrdm,
|
|
* MAPN, DOMAPN, MAPE, DOMAPE)
|
|
C=======================================================================
|
|
|
|
C --*** PREB1 *** (BLOT) Display database element block information
|
|
C --
|
|
C --PREB1 displays the element block internal information (either the
|
|
C --connectivity or the attributes.
|
|
C --
|
|
C --Parameters:
|
|
C -- OPTION - IN - '*' to print all, else print options:
|
|
C -- 'C' to print connectivity
|
|
C -- 'A' to print attributes
|
|
C -- NOUT - IN - the output file, <=0 for standard
|
|
C -- IEL0 - IN - the element offset of the elements in the block
|
|
C -- NLISEL - IN - the number of selected elements
|
|
C -- LISEL - IN - the indices of the selected elements
|
|
C -- NLINK - IN - the number of nodes per element
|
|
C -- NATR - IN - the number of attributes per element
|
|
C -- LINK - IN - the connectivity array for this block
|
|
C -- ATRIB - IN - the attribute array for this block
|
|
|
|
include 'exp_dbnums.blk'
|
|
CHARACTER*(*) OPTION
|
|
INTEGER LISEL(*)
|
|
INTEGER LINK(NLINK,*)
|
|
REAL ATRIB(natrdm,*)
|
|
INTEGER MAPN(*), MAPE(*)
|
|
CHARACTER*32 STRA
|
|
LOGICAL DOMAPN, DOMAPE
|
|
|
|
LOGICAL ALLSAM
|
|
LOGICAL DOCONN, DOATR
|
|
|
|
IF (NLISEL .LE. 0) RETURN
|
|
|
|
DOCONN = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'C') .GT. 0))
|
|
& .AND. (NLINK .GT. 0)
|
|
DOATR = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'A') .GT. 0))
|
|
& .AND. (NATR .GT. 0)
|
|
IF (.NOT. (DOCONN .OR. DOATR)) RETURN
|
|
|
|
if (doconn) then
|
|
if (domapn) then
|
|
stra = '(Global Node IDs)'
|
|
else
|
|
stra = '(Local Node IDs)'
|
|
end if
|
|
|
|
if (nout .gt. 0) then
|
|
if (domape) then
|
|
WRITE (NOUT, 10000) 'Connectivity', STRA(:LENSTR(STRA))
|
|
else
|
|
WRITE (NOUT, 10001) 'Connectivity', STRA(:LENSTR(STRA))
|
|
end if
|
|
else
|
|
if (domape) then
|
|
WRITE (*, 10000) 'Connectivity', STRA(:LENSTR(STRA))
|
|
else
|
|
WRITE (*, 10001) 'Connectivity', STRA(:LENSTR(STRA))
|
|
end if
|
|
end if
|
|
nprnt = 0
|
|
do ix=1, numel - iel0
|
|
IEL = LISEL(IX)
|
|
if (iel .eq. 0) cycle
|
|
if (domape) then
|
|
ID = MAPE(IEL)
|
|
else
|
|
id = iel
|
|
end if
|
|
NE = IEL - IEL0
|
|
IF (NOUT .GT. 0) THEN
|
|
if (domapn) then
|
|
WRITE (NOUT, 10010, IOSTAT=IDUM)
|
|
& NE, ID, (MAPN(LINK(I,NE)), I=1,NLINK)
|
|
else
|
|
WRITE (NOUT, 10010, IOSTAT=IDUM)
|
|
& NE, ID, (LINK(I,NE), I=1,NLINK)
|
|
end if
|
|
ELSE
|
|
if (domapn) then
|
|
WRITE (*, 10010, IOSTAT=IDUM)
|
|
& NE, ID, (MAPN(LINK(I,NE)), I=1,NLINK)
|
|
else
|
|
WRITE (*, 10010, IOSTAT=IDUM)
|
|
& NE, ID, (LINK(I,NE), I=1,NLINK)
|
|
end if
|
|
END IF
|
|
nprnt = nprnt + 1
|
|
if (nprnt .ge. nlisel) exit
|
|
end do
|
|
END IF
|
|
|
|
if (doatr) then
|
|
C ... See if all attributes are the same
|
|
allsam = .true.
|
|
ifrst = 0
|
|
do i=1, numel
|
|
if (lisel(i) .gt. 0) then
|
|
ifrst = i
|
|
exit
|
|
end if
|
|
end do
|
|
|
|
if (ifrst .eq. 0) return
|
|
|
|
do ia = 1, natr
|
|
iel = lisel(ifrst)-iel0
|
|
aval = atrib(ia, iel)
|
|
do ix = ifrst+1, numel - iel0
|
|
iel = lisel(ix)
|
|
if (iel .eq. 0) cycle
|
|
ne = iel - iel0
|
|
if (aval .ne. atrib(ia, ne)) then
|
|
allsam = .false.
|
|
go to 190
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
C ... Print either all values (if not all same), or the common values
|
|
190 continue
|
|
if (allsam) then
|
|
ne = lisel(ifrst) - iel0
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10025, IOSTAT=IDUM)
|
|
& (ATRIB(I,NE), I=1,NATR)
|
|
ELSE
|
|
WRITE (*, 10025, IOSTAT=IDUM)
|
|
& (ATRIB(I,NE), I=1,NATR)
|
|
END IF
|
|
else
|
|
if (nout .gt. 0) then
|
|
WRITE (NOUT, 10000) 'Attributes'
|
|
else
|
|
WRITE (*, 10000) 'Attributes'
|
|
end if
|
|
DO IX = ifrst, numel - iel0
|
|
IEL = LISEL(IX)
|
|
if (iel .eq. 0) cycle
|
|
NE = IEL - IEL0
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10020, IOSTAT=IDUM)
|
|
& NE, IEL, (ATRIB(I,NE), I=1,NATR)
|
|
ELSE
|
|
WRITE (*, 10020, IOSTAT=IDUM)
|
|
& NE, IEL, (ATRIB(I,NE), I=1,NATR)
|
|
END IF
|
|
end do
|
|
end if
|
|
end if
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (1X, ' Blk Index Global ID ', A, ' ', A)
|
|
10001 FORMAT (1X, ' Blk Index Local ID ', A, ' ', A)
|
|
10010 FORMAT (1X, I11, I11, 5X, 8I11, :, /,
|
|
& (18X, 8I11))
|
|
10020 FORMAT (1X, I11, I11, 3X, 4 (1X, 1pE11.4), :, /,
|
|
& (16X, 4 (2X, 1pE11.4)))
|
|
10025 FORMAT (2X, 'All attributes are equal. Values are: ',
|
|
& (3 (1x, 1pE11.4)), :, /,
|
|
& (3X, 6 (1X, 1pE11.4)))
|
|
END
|
|
|