PROGRAM T2F
C1    PROGRAM: T2F (MAIN)
C-    --------
C0    FUNCTION: CONVERTS A TEXT FILE TO FIXED BLOCK FORMAT
C-    ---------
C0    AUTHOR: R.A.WELLS, MAR81
C-    -------
C-    ---> SEE THE COMMENTS IN F2T FOR CONVERSION PROCEDURE <---
C
      LOGICAL*1 TXTFIL(32),FIXFIL(32),HY,HN,IYN,BELL,
     *   TXTBUF(3,256),TXT768(768),
     *   TXT1(64),TXT2(64),TXT3(64),TXT4(64),TXT5(64),TXT6(64),
     *   TXT7(64),TXT8(64),TXT9(64),TXTA(64),TXTB(64),TXTC(64)
      DATA BELL /7/
      INTEGER*2 FIXBF1(128),FIXBF2(256),K2,MORE,RETRY
      INTEGER*4 K4,I64,I4096
C
      EQUIVALENCE (TXT768( 65),TXT2(1)),(TXT768(129),TXT3(1)),
     *            (TXT768(193),TXT4(1)),(TXT768(257),TXT5(1)),
     *            (TXT768(321),TXT6(1)),(TXT768(385),TXT7(1)),
     *            (TXT768(449),TXT8(1)),(TXT768(513),TXT9(1))
      EQUIVALENCE (TXT768(577),TXTA(1)),(TXT768(641),TXTB(1)),
     *            (TXT768(705),TXTC(1)),(K2,K4),
     *            (TXT768(1),TXT1(1),TXTBUF(1,1))
      EQUIVALENCE (FIXBF1(1),FIXBF2(1))
C
      DATA ITRMI,ITRMO,LUNFIX,LUNTXT/5,6,7,8/, I64,I4096/64,4096/,
     *   HN,HY/1HN,1HY/
C - THE FOLLOWING DECLARATIONS ARE TO GET ALLOCATIONS IN MACRO-11 CODE
      DATA I,IBLK,KFIX,LBLK,LFFIX,LFTXT/6*0/,
     *   IYN/0/, FIXFIL,TXTFIL/64*0/
C     *****************************************************************
C
      WRITE (ITRMO,1001)
 1001 FORMAT (//20('*'),' PSDI *** T2F *** V1.0 ',20('*'),/)
      WRITE (ITRMO,1002)
 1002 FORMAT (' Converts text files from F2T to fixed block files'/)
 1600 FORMAT (64A1)
      ASSIGN 16 TO MORE
 16   ASSIGN 17 TO RETRY
 17   WRITE (ITRMO,1700)
 1700 FORMAT (' Enter full text file name: ',$)
      READ (ITRMI,1710,END=9999) LFTXT,TXTFIL
 1710 FORMAT (Q,32A1)
      IF (LFTXT.LE.0) GO TO RETRY
      TXTFIL(LFTXT+1)=0
C
C     OPEN THE TEXT FILE
      OPEN (UNIT=LUNTXT,NAME=TXTFIL,TYPE='OLD',ERR=90,READONLY)
C
      READ (LUNTXT,2000) FIXFIL,LBLK
 2000 FORMAT (32A1,I3)
      WRITE (ITRMO,2010) FIXFIL,LBLK
 2010 FORMAT (' Original file name: ',32A1,' Block size:',I4)
C
      ASSIGN 2090 TO RETRY
 2090 WRITE (ITRMO,2100)
 2100 FORMAT (' Enter full name of new file: ',$)
      READ (ITRMI,1710) LFFIX,FIXFIL
      IF (LFFIX.LE.0) GO TO RETRY
      FIXFIL(LFFIX+1)=0
C
C     OPEN THE DRAWING FILE
C
      OPEN (UNIT=LUNFIX,NAME=FIXFIL,ACCESS='DIRECT',
     *   TYPE='NEW',RECORDSIZE=LBLK/4,ASSOCIATEVARIABLE=KFIX,ERR=91)
C
      IBLK=0
C
 25   READ (LUNTXT,1600,END=50) TXT1
      READ (LUNTXT,1600) TXT2
      READ (LUNTXT,1600) TXT3
      READ (LUNTXT,1600) TXT4
      READ (LUNTXT,1600) TXT5
      READ (LUNTXT,1600) TXT6
      IF (LBLK.EQ.256) GO TO 28
      READ (LUNTXT,1600) TXT7
      READ (LUNTXT,1600) TXT8
      READ (LUNTXT,1600) TXT9
      READ (LUNTXT,1600) TXTA
      READ (LUNTXT,1600) TXTB
      READ (LUNTXT,1600) TXTC
C
 28   DO 35 I=1,LBLK/2
      K4=TXTBUF(1,I)-32 +(TXTBUF(2,I)-32)*I64 +(TXTBUF(3,I)-32)*I4096
      FIXBF2(I)=K2
 35   CONTINUE
C
      IBLK=IBLK+1
      IF (LBLK.EQ.256) WRITE (LUNFIX'IBLK) FIXBF1
      IF (LBLK.EQ.512) WRITE (LUNFIX'IBLK) FIXBF2
      GO TO 25
C
C     FINISHED. LOOP FOR MORE.
C
50    CLOSE (UNIT=LUNTXT)
      CLOSE (UNIT=LUNFIX)
      GO TO MORE
C
C	Here for open error.
C
 90   WRITE (ITRMO,9000) TXTFIL, BELL
 9000 FORMAT (' Unable to open file "',32A1,'" please try again.', A1)
      GO TO RETRY
 91   WRITE (ITRMO,9000) FIXFIL, BELL
      GO TO RETRY
C
 9999 CALL EXIT(1)
      END