! ------------------------------------------------------------------------------
! PP&L VAX Computer Systems <> Systems Applications Utility
! ---------------------------------------------------------
!
! Read an IBM non-labled (NL) tape, writing the contents to DEC disk file(s)
!
! The files on the tape must be fixed-length, with no record control fields
!
! The resulting disk file(s) will be fixed-length of the same record size.
! The record size will be aligned to a longword boundary.
!
! Processing is directed via a control file, which is formatted as follows:
!
!	a. output file name (can be NL: if bypass of the file is desired)
!	b. record size (in bytes) of file (both input and output)
!
! The above pair of descriptors is repeated for as many files as is desired.
! It is assumed that the control file will be created via a text editor.
!
! The input (tape) drive is opened as device TAPE, so a logical name should
! be defined which points to the appropriate unit.
!
! This program requires PHY_IO privilege
!
! M. Latshaw <> 07/16/86
! ------------------------------------------------------------------------------


!			---------------------------
	PROGRAM		I B M _ N L _ T O _ D I S K
!			---------------------------


	IMPLICIT NONE


	INTEGER*4 NTBLEN			! True string length function
	INTEGER*4 SYS$ASSIGN
	INTEGER*4 SYS$QIOW


	CHARACTER*9999 CBUF			! Output buffer
	CHARACTER*64   CTL_FILE			! Name of control file
	CHARACTER*64   DEC_FILE			! Name of output file
	CHARACTER*10   RSBUF			! Record size (ASCII)

	BYTE IBUF(9999)				! Input buffer

	INTEGER*2 IOSB(4)			! QIOW IOSB
	INTEGER*2 MTCHAN			! Tape channel number

	INTEGER*4 ADJ_REC_LN			! Longword-aligned record length
	INTEGER*4 CTL_FILE_LN			! Length of control file name
	INTEGER*4 CTL_LUN			! Control file logical unit #
	INTEGER*4 DEC_FILE_LN			! Length of output file name
	INTEGER*4 DEC_LUN			! Output file logical unit #
	INTEGER*4 FIL_CNT			! Number of files processed
	INTEGER*4 I				! General index
	INTEGER*4 IOF				! I/O function code
	INTEGER*4 IRC				! Internal return status
	INTEGER*4 ISTAT				! File I/O status code
	INTEGER*4 LN				! String length
	INTEGER*4 REC_CNT			! Number of records processed
	INTEGER*4 REC_LN			! File record length (bytes)


	EQUIVALENCE (CBUF, IBUF)		! Overlay the buffers


	EXTERNAL IO$_PACKACK
	EXTERNAL IO$_READPBLK
	EXTERNAL SS$_ENDOFFILE
	EXTERNAL SS$_ENDOFVOLUME
	EXTERNAL SS$_NORMAL


	DATA FIL_CNT / 0 /


! ----------------------------------
! Fetch the name of the control file
! ----------------------------------

	TYPE *,'Enter the name of the control file (64 characters maximum)'
	ACCEPT '(A)',CTL_FILE

	CTL_FILE_LN = NTBLEN (CTL_FILE)


! ---------------------
! Open the control file
! ---------------------

	CALL GETALUN (CTL_LUN)			! Allocate a LUN

	OPEN (UNIT=CTL_LUN,
	1     FILE=CTL_FILE(1:CTL_FILE_LN),
	1     STATUS='OLD',
	1     READONLY,
	1     SHARED,
	1     IOSTAT=ISTAT)

	IF (ISTAT .NE. 0) THEN

	    TYPE *,'Unable to open file '//CTL_FILE(1:CTL_FILE_LN)
	    CALL EXIT
	    END IF


! ---------------------------------------------------------------------------
! Attach to the tape drive. Note that physical I/O will be performed on that
! drive, which means that the volume should not be mounted (it must be online
! and at BOT, of course).
! ---------------------------------------------------------------------------

	IRC = SYS$ASSIGN ('TAPE', MTCHAN,, )

	IF (IRC .NE. %LOC (SS$_NORMAL)) THEN

	    TYPE *,'Unable to connect to the tape drive'
	    CLOSE (UNIT=CTL_LUN)
	    CALL EXIT
	    END IF


! --------------------
! Ready the tape drive
! --------------------

	IOF = %LOC (IO$_PACKACK)

	IRC = SYS$QIOW (, %VAL (MTCHAN), %VAL (IOF),IOSB,,,,,,,,, )

	IF (IOSB(1) .NE. %LOC (SS$_NORMAL)) THEN

	    TYPE *,'Unable to place the tape drive into a ready state'
	    CLOSE (UNIT=CTL_LUN)
	    CALL EXIT
	    END IF


! ------------------------------------
! Here starts the main processing loop
! ------------------------------------

	IOF = %LOC (IO$_READPBLK)

	DO WHILE (.TRUE.)


	! ---------------------------------------------------
	! Read the control information for the next tape file
	! ---------------------------------------------------

	    READ (UNIT=CTL_LUN, FMT='(Q,A)', IOSTAT=ISTAT)
	1                                            DEC_FILE_LN,
	1                                            DEC_FILE(1:DEC_FILE_LN)

	    IF (ISTAT .EQ. -1) THEN

	        TYPE *,' '
	        TYPE *,'Total files processed:',FIL_CNT

	        CLOSE (UNIT=CTL_LUN)

	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)

	    ELSE IF (ISTAT .NE. 0) THEN

	        TYPE *,'Unable to read output file name'
	        CLOSE (UNIT=CTL_LUN)
	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	        END IF

	    READ (UNIT=CTL_LUN, FMT='(Q,A)', IOSTAT=ISTAT) LN, RSBUF(1:LN)

	    IF (ISTAT .NE. 0) THEN

	        TYPE *,'Unable to read record size of file '//
	1              DEC_FILE(1:DEC_FILE_LN)
	        CLOSE (UNIT=CTL_LUN)
	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	        END IF

	    READ (UNIT=RSBUF(1:LN), FMT='(I<LN>)', IOSTAT=ISTAT) REC_LN

	    IF (ISTAT .NE. 0) THEN

	        TYPE *,RSBUF(1:LN)//' is an invalid record size specification'
	        CLOSE (UNIT=CTL_LUN)
	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	        END IF


	! ---------------------------------------------------------------
	! Make sure that the record size is an even multiple of longwords
	! ---------------------------------------------------------------

	    IF (MOD (REC_LN, 4) .NE. 0) THEN

	        ADJ_REC_LN = ((REC_LN/4)+1) * 4

	        DO I = REC_LN+1, ADJ_REC_LN	! Pad the extra part with nulls

	            IBUF(I) = 0
	            END DO

	    ELSE

	        ADJ_REC_LN = REC_LN
	        END IF


	! ---------------------------
	! Open the output (disk) file
	! ---------------------------

	    CALL GETALUN (DEC_LUN)		! Allocate a logical unit #

	    OPEN (UNIT=DEC_LUN,
	1         FILE=DEC_FILE(1:DEC_FILE_LN),
	1         STATUS='NEW',
	1         RECORDTYPE='FIXED',
	1         FORM='UNFORMATTED',
	1         RECL=ADJ_REC_LN/4,
	1         CARRIAGECONTROL='NONE',
	1         ORGANIZATION='SEQUENTIAL',
	1         ACCESS='SEQUENTIAL',
	1         IOSTAT=ISTAT)

	    IF (ISTAT .NE. 0) THEN

	        TYPE *,'Unable to open output file '//DEC_FILE(1:DEC_FILE_LN)
	        CLOSE (UNIT=CTL_LUN)
	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	        END IF


	! --------------------------------------------------
	! Process the input (tape) file until EOF is reached
	! --------------------------------------------------

	    IOSB(1) = %LOC (SS$_NORMAL)
	    REC_CNT = 0

	    TYPE *,' '
	    TYPE *,'Processing file '//DEC_FILE(1:DEC_FILE_LN)

	    DO WHILE (IOSB(1) .EQ. %LOC (SS$_NORMAL))


		! ------------------
		! Read a tape record
		! ------------------

	        IRC = SYS$QIOW (,
	1                       %VAL (MTCHAN),
	1                       %VAL (IOF),
	1                       IOSB,,,
	1                       IBUF,
	1                       %VAL (REC_LN),,,, )


			! ------------------
			! Successfully read?
			! ------------------

	        IF (IOSB(1) .EQ. %LOC (SS$_NORMAL)) THEN



				! ----------------------------------
				! Make record size consistency check
				! ----------------------------------

	            IF (IOSB(2) .NE. REC_LN) THEN

	                TYPE *,
	1              'Actual record size does not match expected record size'

	                CLOSE (UNIT=CTL_LUN)
	                CLOSE (UNIT=DEC_LUN, STATUS='DELETE')

	                CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	                END IF


			! ----------------------
			! Write the data to disk
			! ----------------------

	            WRITE (UNIT=DEC_LUN, IOSTAT=ISTAT) CBUF(1:ADJ_REC_LN)

	            IF (ISTAT .NE. 0) THEN

	                TYPE *,'Error during write to file '//
	1                      DEC_FILE(1:DEC_FILE_LN)

	                CLOSE (UNIT=CTL_LUN)
	                CLOSE (UNIT=DEC_LUN, STATUS='DELETE')

	                CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	                END IF

	            REC_CNT = REC_CNT + 1


			! ------------------
			! Error during read?
			! ------------------

	        ELSE IF ((IOSB(1) .NE. %LOC (SS$_ENDOFFILE))    .AND.
	1                (IOSB(1) .NE. %LOC (SS$_ENDOFVOLUME)))       THEN

	            TYPE *,'Error during reading of file '//
	1                  DEC_FILE(1:DEC_FILE_LN)

	            CLOSE (UNIT=CTL_LUN)
	            CLOSE (UNIT=DEC_LUN, STATUS='DELETE')

	            CALL IBM_NL_TO_DISK_EXIT (MTCHAN)
	            END IF

	        END DO


	! -----------------------------------
	! Report the statistics for this file
	! -----------------------------------

	    TYPE *,'Records written:',REC_CNT

	    CLOSE (UNIT=DEC_LUN, STATUS='KEEP')

	    FIL_CNT = FIL_CNT + 1


	! ------------
	! End of tape?
	! ------------

	    IF (IOSB(1) .EQ. %LOC (SS$_ENDOFVOLUME)) THEN

	        TYPE *,' '
	        TYPE *,'Total files processed:',FIL_CNT

	        CLOSE (UNIT=CTL_LUN)

	        CALL IBM_NL_TO_DISK_EXIT (MTCHAN)

	        END IF

	    END DO

	END
