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.
87 lines
3.0 KiB
87 lines
3.0 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 MYPRNT (NAME1, UNIT, MYCV, OFFSET, TOFFST,
|
|
* DICT, DPOINT, LDICT, NNAMES, CHRNUM,
|
|
* CHRCOL, NCOLP, WRDSIZ, 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 MYCV Internal character array
|
|
CHARACTER*1 MYCV(*)
|
|
C OFFSET Offset between internal reference and users reference
|
|
C string.
|
|
C TOFFST Offset between internal reference and internal character
|
|
C array.
|
|
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,3), NNAMES(2)
|
|
C CHRCOL Number of column for character names.
|
|
C NCOLP Number of print columns
|
|
C WRDSIZ Number of characters to group together in printing.
|
|
C LASTER Error return
|
|
|
|
C***********************************************************************
|
|
|
|
C Check worklength
|
|
|
|
IF (WRDSIZ .LT. 1 .OR. WRDSIZ+2+11 .GT. NCOLP) THEN
|
|
LASTER = BADLEN
|
|
RETURN
|
|
END IF
|
|
C FIND NAME1 IN DICTIONARY
|
|
|
|
CALL MYFIND (NAME1, DICT, DPOINT, LDICT, NNAMES,
|
|
* CHRCOL, LASTER, ROW)
|
|
IF (LASTER .NE. SUCCESS) RETURN
|
|
DELTA = (DPOINT(ROW,CHRCOL,1) - 1) * CHRNUM + 1 + OFFSET
|
|
WRITE(UNIT,10000) DICT(ROW,CHRCOL),
|
|
* DELTA,
|
|
* DPOINT(ROW,CHRCOL,3)
|
|
IF (DPOINT(ROW,CHRCOL,2) .LT. 0) THEN
|
|
LASTER = DEFRON
|
|
WRITE (UNIT, *) 'THIS VECTOR WAS RESERVED IN THE DEFERRED '//
|
|
* 'MODE AND IS NOT YET RESOLVED.'
|
|
RETURN
|
|
END IF
|
|
|
|
DELTA = (DPOINT(ROW,CHRCOL,1) - 1) * CHRNUM + TOFFST
|
|
NCOL = (NCOLP - 11) / (WRDSIZ + 2)
|
|
NROW = (DPOINT(ROW,CHRCOL,3) + WRDSIZ * NCOL - 1)
|
|
* / (WRDSIZ * NCOL)
|
|
NGRP = (NROW + 9) / 10
|
|
DO 110 IGRP = 1, NGRP
|
|
WRITE(UNIT,10010)
|
|
NPRT = (IGRP - 1) * 10 * NCOL * WRDSIZ
|
|
NREM = DPOINT(ROW,CHRCOL,3) - NPRT
|
|
NROW = (NREM + WRDSIZ * NCOL - 1) / (NCOL * WRDSIZ)
|
|
NROW = MIN(10, NROW)
|
|
J = NPRT + 1
|
|
DO 100 IROW = 1, NROW
|
|
WRITE (UNIT, 10020) J,
|
|
* ((MYCV(K), K=J+DELTA+WRDSIZ*(IWRD-1),
|
|
* MIN(DELTA+DPOINT(ROW,CHRCOL,3),
|
|
* J+DELTA+WRDSIZ*IWRD-1)),
|
|
* ' ', ' ', IWRD = 1, NCOL)
|
|
J = J + NCOL * WRDSIZ
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
LASTER = SUCCESS
|
|
RETURN
|
|
10000 FORMAT('0'/'0ARRAY NAME = ',A,3X,'LOCATION = ',I16,3X,
|
|
* 'LENGTH = ',I8)
|
|
10010 FORMAT(' ')
|
|
10020 FORMAT(1X,I6,':',132A1)
|
|
END
|
|
|