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.

52 lines
1.6 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 prnshd (nelblk, idelb, ishdcl, shdcol, ielbst)
C-----------------------------------------------------------------------
INTEGER IDELB(*)
INTEGER ISHDCL(3,NELBLK)
REAL SHDCOL(7,NELBLK)
INTEGER IELBST(NELBLK)
CHARACTER*132 ELBLIN
do 110 iblk = 1, nelblk
if (ishdcl(1, iblk) .eq. iblk) then
if (ishdcl(2, iblk) .gt. 1) then
elblin = ' Shades'
else
elblin = ' Shade'
end if
write (*, 920) (shdcol(i,iblk),i=1,6), ishdcl(2, iblk),
* elblin(:lenstr(elblin))
ELBLIN = ' Block IDs: '
N = 2
do 100 i = iblk, nelblk
if (ishdcl(1, i) .eq. ishdcl(1, iblk)) then
n = n + 1
WRITE (ELBLIN((N-1)*6+1:N*6), '(I6)', IOSTAT=IDUM)
* idelb(i)
IF (N .GE. 12) THEN
WRITE (*, 940) ELBLIN(1:LENSTR(ELBLIN))
N = 0
ELBLIN = ' '
END IF
end if
100 continue
IF (N .GT. 0) THEN
WRITE (*, 940) ELBLIN(1:LENSTR(ELBLIN))
write (*,*) ' '
END IF
end if
110 continue
920 FORMAT (' Block Shading: RGB =', 6(f6.3),', ',i3,A)
940 FORMAT (A)
RETURN
end