SUBROUTINE WRTDIR C*********************************************************************** C C Author: Nick Bourgeois Version: 90l04a C 9605 Giddings Ave. NE C Albuquerque, NM 87109 C (505) 828-9566 C C C Description: C C Write the three lines of directory information to the output C file. C C If a write error occurs, set the error flag, display an error C message, and exit this subroutine. C C C Edit Record: C C 04-Dec-90: Original creation started. C 04-Dec-90: Original creation completed. C C C Calling sequence: C C FieldC = C FieldI() = C FldIdI = C FldLnI = C OutLun = C CALL WRTDIR C C C Returns: C C Error C C C Called By: C C GETDIR C C*********************************************************************** INCLUDE 'SVSTDR.DAT' !Common & variables declarations INTEGER*2 I !Loop index. IF (FldIdI .EQ. 42) THEN WRITE (OutLun,*,ERR=850) 'File Name: ',FieldC(1:FldLnI) END IF IF (FldIdI .EQ. 46) THEN WRITE (OutLun,*,ERR=850) 'File Length: ',FieldI(1) END IF IF (FldIdI .EQ. 55) THEN WRITE (OutLun,*,ERR=850) 'File Date: ',(FieldI(I),I=1,4) END IF GOTO 900 850 CONTINUE Error = .TRUE. TYPE * ,'WRTDIR: write error' 900 CONTINUE RETURN END !WRTDIR.FOR.