SUBROUTINE OPNFIL C*********************************************************************** C C Author: Nick Bourgeois Version: 90l06a C 9605 Giddings Ave. NE C Albuquerque, NM 87109 C (505) 828-9566 C C C Description: C C Open the output dev:filnam.ext to receive the directory. C C Call a routine to prompt for and accept the dev:filnam.ext. If C none is entered, default to the line printer. Open the output C dev:filnam.ext. If an error occurs while attempting to open C the file, set the error flag, display an error message, and exit C this subroutine. Call a routine to get the current system date. C Call a routine to get the current system time. Write the C program ID, the date, and the time, to the output. Write a C blank line to the output. If an error occurrs, set the error C flag, display an error message, and exit this subroutine. C C C Edit Record: C C 12-Oct-90: Original creation started. C 31-Oct-90: Original creation completed. C 06-Dec-90: Cleaned up documentation. C C C Calling sequence: C C LinPrn = C OutLun = C ProgID = C CALL OPNFIL C C C Returns: C C DateSt C Error C OutFil C TimeST C C C Called By: C C TDINIT C C C Routines Called: C C DATE C GTLIN C TIME C C*********************************************************************** INCLUDE 'TAPEDR.DAT' !Common & variables declarations CALL GTLIN (Answer, * 'Enter the output dev:filnam.ext, ') IF (AnsweB(1) .EQ. 0) THEN OutFil = LinPrn ELSE OutFil = Answer END IF OPEN * ( * ACCESS = 'SEQUENTIAL', * CARRIAGECONTROL = 'FORTRAN', * DISPOSE = 'SAVE', * ERR = 800, * FILE = OutFil, * STATUS = 'NEW', * UNIT = OutLun * ) CALL DATE (DateSt) CALL TIME (TimeSt) WRITE (OutLun,*,ERR=850) ProgID,' ',DateSt,' ',TimeSt WRITE (OutLun,*,Err=850) GOTO 900 800 CONTINUE Error = .TRUE. TYPE *, 'OPNFIL: open failed for ',OutFil GOTO 900 850 CONTINUE Error = .TRUE. Type *, 'OPNFIL: write error' 900 CONTINUE RETURN END !OPNFIL.FOR.