SUBROUTINE WRTDIR C*********************************************************************** C C Author: Nick Bourgeois Version: 90j31a C 9605 Giddings Ave. NE C Albuquerque, NM 87109 C (505) 828-9566 C C C Description: C C Write directory data to the output file. C C Extract the data of interest from saveset record number one and C write it out to the file. The selection is based on the data C field identification number. If a write error occurs, set the C error flag, display an error message, and exit this subroutine. C C C Edit Record: C C 28-Oct-90: Original creation started. C 31-Oct-90: Original creation completed. C C C Calling sequence: C C FieldC = C FldIdI = C FldLnI = C OutLun = C CALL WRTDIR C C C Returns: C C Error C C C Called By: C C DORCD1 C C*********************************************************************** INCLUDE 'TAPEDR.DAT' !Common & variables declarations INTEGER*2 I !Loop index. IF (FldIdI .EQ. 2) THEN WRITE (OutLun,*,ERR=850) 'VMS command string: ', * FieldC(1:FldLnI) ELSE IF (FLDIDI .EQ. 4) THEN WRITE (OutLun,*,ERR=850) 'Written by: ', * FieldC(1:FldLnI) ELSE IF (FldIdI .EQ. 6) THEN WRITE (OutLun,*,ERR=850) 'Saveset date: ', * (FieldI(I),I=1,4) ELSE IF (FldIdI .EQ. 9) THEN WRITE (OutLun,*,ERR=850) 'Node name: ', * FieldC(1:FldLnI) ELSE IF (FldIdI .EQ. 11) THEN WRITE (OutLun,*,ERR=850) 'Written on: ', * FieldC(1:FldLnI) ELSE IF (FldIdI .EQ. 14) THEN WRITE (OutLun,*,ERR=850) 'XOR group size: ', * FieldI(1) ELSE ! Simply skip over the field. END IF GOTO 900 850 CONTINUE Error = .TRUE. TYPE *, 'WRTDIR: write error' 900 CONTINUE RETURN END !WRTDIR.FOR.