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.
 
 
 
 
 
 

81 lines
2.4 KiB

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 PRMAP (OPTION, NOUT, TYPE, NUMEL, MAPEL)
C=======================================================================
C --*** PRMAP *** (EXPLORE) Display database node/element number map
C --
C --PRMAP displays the node/element number map.
C --
C --Parameters:
C -- OPTION - IN - '*' to print all, else print options:
C -- NOUT - IN - the output file, <=0 for standard
C -- NUMEL - IN - the number of node/elements
C -- MAPEL - IN - the node/element number map
CHARACTER*(*) OPTION
C ... TYPE = Node or Element
CHARACTER*(*) TYPE
INTEGER MAPEL(*)
CHARACTER*4 FMT
CHARACTER*32 STRA, STRB
C ... True if map is one-to-one
LOGICAL MAPONE
IF (NOUT .GT. 0) WRITE (NOUT, 10000) TYPE
IF (NOUT .GT. 0) THEN
WRITE (NOUT, 10010) TYPE
ELSE
WRITE (*, 10010) TYPE
END IF
WRITE (STRA, '(I12)', IOSTAT=IDUM) NUMEL
CALL SQZSTR (STRA, LSTRA)
WRITE (FMT, '(''(I'', I1, '')'')', IOSTAT=IDUM) LSTRA
C ... Check for 1-1 mapping
mapone = .TRUE.
do 80 i = 1, numel
if (mapel(i) .ne. i) then
mapone = .FALSE.
go to 90
end if
80 continue
90 continue
if (mapone) then
IF (NOUT .GT. 0) THEN
write (nout, 10030) TYPE
ELSE
write (*, 10030) TYPE
END IF
else
DO 100 IEL = 1, NUMEL, 8
NE = MIN (IEL+7, NUMEL)
WRITE (STRA, FMT, IOSTAT=IDUM) IEL
WRITE (STRB, FMT, IOSTAT=IDUM) NE
IF (NOUT .GT. 0) THEN
WRITE (NOUT, 10020, IOSTAT=IDUM)
& STRA(:LSTRA), STRB(:LSTRA), (MAPEL(N), N=IEL,NE)
ELSE
WRITE (*, 10020, IOSTAT=IDUM)
& STRA(:LSTRA), STRB(:LSTRA), (MAPEL(N), N=IEL,NE)
END IF
100 CONTINUE
end if
RETURN
10000 FORMAT (/, 1X, A,' NUMBER MAP')
10010 FORMAT (/, 1X, A,' Number Map:')
10020 FORMAT (1X, 3X, A, '..', A, 3X, 8I12)
10030 format (1x, 3x, 'Map does not modify local ',
& A, ' ids (X maps to X)')
END