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.
 
 
 
 
 
 

104 lines
3.2 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
SUBROUTINE MXPRNT (NAME1, UNIT, NAME2, MYV, RMYV, OFFSET,
* DICT, DPOINT, LDICT, NNAMES, CHRCOL, NCOLP, LASTER)
IMPLICIT INTEGER (A-Z)
INCLUDE 'params.inc'
C***********************************************************************
C NAME1 Name of array to be printed
CHARACTER*8 NAME1
C UNIT Output unit number.
C NAME2 Type of array to be printed
CHARACTER*(*) NAME2
C MYV Internal integer array
INTEGER MYV(*)
C RMYV Internal real array
REAL RMYV(*)
C DICT Dictionary name table
C DPOINT Dictionary pointer table
C LDICT Dimension of dictionary
C NNAMES Number of names in the dictionary
CHARACTER*8 DICT(LDICT,CHRCOL)
DIMENSION DPOINT(LDICT,CHRCOL,2), NNAMES(2)
C CHRCOL Number of column for character names.
C NCOLP Number of print columns
C LASTER Error return
C***********************************************************************
C FIND NAME1 IN DICTIONARY
CALL MXFIND (NAME1, DICT, DPOINT, LDICT, NNAMES,
* CHRCOL, LASTER, ROW)
IF (LASTER .NE. SUCCESS) RETURN
DELTA = DPOINT(ROW,1,1) - 1
WRITE(UNIT,10000) DICT(ROW,1), DPOINT(ROW,1,1)+OFFSET,
* DPOINT(ROW,1,2)
IF (DPOINT(ROW,1,2) .LT. 0) THEN
LASTER = DEFRON
WRITE (UNIT, *) 'THIS VECTOR WAS RESERVED IN THE DEFERRED '//
* 'MODE AND IS NOT YET RESOLVED.'
RETURN
END IF
IF (NAME2(1:1) .EQ. 'R') THEN
C VECTOR IS REAL
NCOL=(NCOLP-11)/13
NROW=DPOINT(ROW,1,2)/NCOL+1
NGRP=NROW/10+1
DO 110 IGRP=1,NGRP
WRITE(UNIT,10010)
NPRT=(IGRP-1)*10*NCOL
NREM=DPOINT(ROW,1,2)-NPRT
NROW=(NREM+NCOL-1)/NCOL
NROW=MIN0(10,NROW)
DO 100 IROW=1,NROW
J=NPRT+1+(IROW-1)*NCOL
KU=MIN0(DPOINT(ROW,1,2),J+NCOL-1)
WRITE(UNIT,10020)J,(RMYV(K),K=J+DELTA,KU+DELTA)
100 CONTINUE
110 CONTINUE
ELSE IF (NAME2(1:1) .EQ. 'I') THEN
C VECTOR IS INTEGER
NCOL=(NCOLP-11)/10
NROW=DPOINT(ROW,1,2)/NCOL+1
NGRP=NROW/10+1
DO 130 IGRP=1,NGRP
WRITE(UNIT,10010)
NPRT=(IGRP-1)*10*NCOL
NREM=DPOINT(ROW,1,2)-NPRT
NROW=(NREM+NCOL-1)/NCOL
NROW=MIN0(10,NROW)
DO 120 IROW=1,NROW
J=NPRT+1+(IROW-1)*NCOL
KU=MIN0(DPOINT(ROW,1,2),J+NCOL-1)
WRITE(UNIT,10030)J,(MYV(K),K=J+DELTA,KU+DELTA)
120 CONTINUE
130 CONTINUE
ELSE
C TYPE IS UNKNOWN
LASTER = BDTYPE
RETURN
END IF
LASTER = SUCCESS
RETURN
10000 FORMAT(//' ARRAY NAME = ',A,3X,'LOCATION = ',I16,3X,
* 'LENGTH = ',I8)
10010 FORMAT(' ')
10020 FORMAT(1X,I6,':',9(2X,1PE11.4))
10030 FORMAT(1X,I6,':',12(2X,I8))
END