! ------------------------------------------------------------------------------
! PP&L VAX Computer Systems <> IBM / DEC Data Format Conversion
! -------------------------------------------------------------
!
! Load a new record format descriptor
!
!
! M. Latshaw <> 07/03/86
! ------------------------------------------------------------------------------


!			---------------------------
	SUBROUTINE	I B M _ T O _ D E C _ F M T
!			---------------------------

	1 ( CTL_LUN,	! I*4	Input	Control file logical unit number
			!
	1   IBM_LUN,	! I*4	Input	Input file logical unit number
			!
	1   DEC_LUN,	! I*4	Input	Output file logical unit number
			!
	1   NRECS,	! I*4	Output	Number of input records that will apply
			!
	1   FMT_CNT,	! I*4	Output	Number of items in format record
			!
	1   FMT_ITM,	! C*(*)	Output	Format items
			!
	1   FMT_RPT )	! I4(*)	Output	Repeat counts to be applied against
			!		the format items


	IMPLICIT NONE


	CHARACTER*133 BUF		! Control file record buffer
	CHARACTER*1   FMT_ITM(*)	! Format item list

	BYTE FMT_BUF(133)		! Control file record buffer

	INTEGER*4 CTL_LUN		! Control file LUN
	INTEGER*4 DEC_LUN		! DEC (output) file logical unit number
	INTEGER*4 FMT_CNT		! Count of items in format record
	INTEGER*4 FMT_RPT(*)		! Format item repeat count
	INTEGER*4 I			! General index
	INTEGER*4 IBM_LUN		! IBM (input) file logical unit number
	INTEGER*4 ISTAT			! File I/O status code
	INTEGER*4 J			! General index
	INTEGER*4 LN			! String length
	INTEGER*4 NRECS			! Applicable record count
	INTEGER*4 REC_LN		! Record length

	EQUIVALENCE (BUF, FMT_BUF)


! -----------------------------
! Fetch the repeat count, first
! -----------------------------

	READ (UNIT=CTL_LUN, FMT='(Q,A)', IOSTAT=ISTAT) REC_LN, BUF

	IF (ISTAT .EQ. -1) THEN		! End-of-file?

	    TYPE *,'Warning - input file only partially processed'

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

	    CALL EXIT

	ELSE IF (ISTAT .NE. 0) THEN	! Something else went wrong?

	    TYPE *,'Unable to read control file repeat factor'

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

	    CALL EXIT
	    END IF


	! -----------------------
	! Convert it into numeric
	! -----------------------

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

	IF ((ISTAT .NE. 0) .OR. ((NRECS .LT. 1) .AND. (NRECS .NE. -1))) THEN

	    TYPE *,BUF(1:REC_LN)//' is an invalid repeat count'

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

	    CALL EXIT
	    END IF


! -------------------------
! Next, get the format line
! -------------------------

	READ (UNIT=CTL_LUN, FMT='(Q,A)', IOSTAT=ISTAT) REC_LN, BUF

	IF (ISTAT .NE. 0) THEN

	    TYPE *,'Unable to read format line'

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

	    CALL EXIT
	    END IF

	TYPE *,BUF(1:REC_LN)


! -----------------------------------------------
! Break it apart into the individual format items
! -----------------------------------------------

	FMT_CNT = 0
	I       = 1			! I points to beginning of field

	DO WHILE (I .LE. REC_LN)


	! -----------------------------------
	! Look for the beginning of the field
	! -----------------------------------

	    IF (FMT_BUF(I) .LE. 32) THEN

	        I = I + 1

	        IF (I .GT. REC_LN) RETURN

	        DO WHILE (FMT_BUF(I) .LE. 32)

	            IF (I .EQ. REC_LN) RETURN

	            I = I + 1
	            END DO

	        END IF


	! -----------------------------
	! Look for the end of the field
	! -----------------------------

	    IF (I .LT. REC_LN) THEN

	        J = I + 1

	        DO WHILE ((J .LE. REC_LN) .AND. (FMT_BUF(J) .GT. 32))

	            J = J + 1
	            END DO

	        J = J - 1

	    ELSE

	        J = I
	        END IF			! J points to the end of the field


	! ----------------------------------------------------
	! Extract the repeat count for this item (if supplied)
	! ----------------------------------------------------

	    FMT_CNT = FMT_CNT + 1	! Count this format item
	    FMT_ITM(FMT_CNT) = BUF(I:I)

	    IF (J .GT. I) THEN		! If supplied

	        LN = J - I

	        READ (UNIT=BUF(I+1:),
	1             FMT='(I<LN>)',
	1             IOSTAT=ISTAT)     FMT_RPT(FMT_CNT)

	        IF ((ISTAT .NE. 0) .OR. (FMT_RPT(FMT_CNT) .LE. 0)) THEN

	            TYPE *,'Invalid format item repeat count'

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

	            CALL EXIT
	            END IF

	    ELSE			! If not supplied

	        FMT_RPT(FMT_CNT) = 1
	        END IF

	    I = J + 1
	    END DO

	END
