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.
59 lines
2.0 KiB
59 lines
2.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 See packages/seacas/LICENSE for details
|
|
|
|
C=======================================================================
|
|
SUBROUTINE STRTUP (QAINFO)
|
|
C=======================================================================
|
|
|
|
C --*** STRTUP *** (ETCLIB) Startup program
|
|
C -- Written by Amy Gilkey - revised 11/24/87
|
|
C --
|
|
C --STRTUP should be called at the start of any program. It performs
|
|
C --initialization details common to all programs. Specifically, it
|
|
C -- Initializes the CPU time
|
|
C -- Sets the program name, time, and date
|
|
C --
|
|
C --Parameters:
|
|
C -- QAINFO - IN/OUT - the current program version information:
|
|
C -- QAINFO(1..3) input, QAINFO(4..6) set
|
|
C -- (1) = program name
|
|
C -- (2) = revision date
|
|
C -- (3) = version as "QA xx.xx" or "X xx.xx" or " xx.xx"
|
|
C -- (4) = program name with version appended
|
|
C -- (5) = date of current run
|
|
C -- (6) = time of current run
|
|
|
|
C --Routines Called:
|
|
C -- LENSTR - (STRLIB) Find string length
|
|
|
|
CHARACTER*(*) QAINFO(6)
|
|
CHARACTER*8 MEMDBG
|
|
|
|
C --Initialize the CPU time
|
|
CALL EXCPUS (CPUSEC)
|
|
|
|
C --Set the program information array
|
|
QAINFO(4) = QAINFO(1)
|
|
L = MIN (LENSTR(QAINFO(4))+1, 7)
|
|
QAINFO(4)(L:L+1) = QAINFO(3)(4:5)
|
|
IF (QAINFO(4)(L:L) .EQ. ' ') QAINFO(4)(L:L) = '0'
|
|
QAINFO(5) = ' '
|
|
QAINFO(6) = ' '
|
|
CALL EXDATE (QAINFO(5))
|
|
CALL EXTIME (QAINFO(6))
|
|
|
|
C ... If EXT99 Environment variable set, turn on supes memory debugging
|
|
C The numeric value of the variable is used as the unit to write
|
|
C debug information to.
|
|
CALL EXNAME (-99, MEMDBG, L)
|
|
IF (L .GE. 1) THEN
|
|
READ(MEMDBG(:L), '(I8)', ERR=20) IUNIT
|
|
CALL MDDEBG(IUNIT)
|
|
END IF
|
|
20 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|