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.

72 lines
2.2 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 CPYRGT (NOUT, YEAR)
C=======================================================================
C --*** CPYRGT *** (ETCLIB) Print copyright notice
C -- Written by Greg Sjaardema - revised 5-13-92 -
C --
C --CPYRGT prints the copyright notice at the start of any program.
C --The copyright notice is printed to the standard output device or
C --an output file.
C --
C --Parameters:
C -- NOUT - IN - the output file number; 0 if standard output device
C -- YEAR - IN - the year of the copyright
C --Routines Called:
C -- LENSTR - (STRLIB) Find string length
PARAMETER (NLIN = 3)
INTEGER NOUT
CHARACTER*(*) YEAR
CHARACTER*80 BANR
CHARACTER*40 BLANK
CHARACTER*60 TEXT(NLIN)
SAVE BLANK
DATA BLANK / ' ' /
DATA TEXT /
* 'Under the terms of Contract',
* 'DE-NA0003525 with NTESS, the' ,
* 'U.S. Government retains certain rights in this software.'/
NCEN(LEN) = MAX (1, (80 - LEN + 1) / 2)
write (banr, 100) year(:lenstr(year))
100 format (' Copyright ', a, ' NTESS')
CALL SQZSTR (BANR, LBANR)
IF (NOUT .LE. 0) THEN
WRITE (*, 10000) BLANK(:NCEN(LBANR+8)),
& '+++ ', BANR(:LBANR), ' +++'
ELSE
WRITE (NOUT, 10000) BLANK(:NCEN(LBANR+8)),
& '+++ ', BANR(:LBANR), ' +++'
END IF
do 120 i=1, nlin
write (banr, 110) text(i)(:lenstr(text(i)))
110 format (A)
CALL SQZSTR (BANR, LBANR)
IF (NOUT .LE. 0) THEN
WRITE (*, 10000) BLANK(:NCEN(LBANR+8)),
& '+++ ', BANR(:LBANR), ' +++'
ELSE
WRITE (NOUT, 10000) BLANK(:NCEN(LBANR+8)),
& '+++ ', BANR(:LBANR), ' +++'
END IF
120 continue
IF (NOUT .LE. 0) THEN
WRITE (*, *)
ELSE
WRITE (NOUT, *)
END IF
10000 format (8A)
RETURN
END