C PROGRAM TO READ AN ASCII MAGTAPE, 100 CHARS/RECORD..
C FILED--24-SEP-80, G. BEVER.
C TRAILING BLANKS IGNORED--21-JUL-81, G. BEVER.
C MODIFIED TO READ MS1, SETTABLE # CHARS/RECORD--5-NOV-85, G. BEVER.
C IMPROVE TRAILING BLANKS ELIMINATION--12-NOV-85, G. BEVER.
C
C COMPILE AS FOLLOWS:
C
C  .R FORTRA
C  *ELXSI=ELXSI/U/R:189.
C
C LINK AS FOLLOWS:
C
C  .LINK ELXSI
C
      INTEGER*2 ICLID(5),IPRMID(4),IPRMNM(15),IDATE(4),IENG(4),
     C MINDEC,MAXDEC,IREFP(4),IREFCT,IORDER
      INTEGER*2 ISPEC(39),JSWI(4,1),IBUF(256),LU(2),MTIN(4)
      REAL*4 RMINEU,RMAXEU
      REAL*4 EXT(2)
      DATA EXT/6RLSTLST,6RLSTDAT/
      DATA JSWI/'M',3*0/
      DATA LU/2HLP,2H: /
      DATA MTIN/3RMS1,3*0/
C
C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES.
C  *ELXSI.LST=
C   WHERE CALFIL.LST SPECIFIES OUTPUT LIST FILE.
C
C SET SYSTEM TO IGNORE FORTRAN RUN TIME ERROR # 5.
      CALL SETERR(5,255)
C GET CHANNEL NUMBER.
      ICHAN=IGETC()
      IF(ICHAN.LT.0) STOP 'NO CHANNEL'
C FETCH INPUT DEVICE HANDLER INTO MEMORY.
      IF(IFETCH(MTIN(1)).NE.0) STOP 'BAD IN FETCH'
C PERFORM LOOKUP OF FILE.
      I=LOOKUP(ICHAN,MTIN(1))
      IF(I.LT.0) GO TO 50
	TYPE 107
107	FORMAT(' ENTER NUMBER OF CHARACTERS PER RECORD (up to 132):')
	ACCEPT 106,NCHARS
106	FORMAT(I6)
	NCHARS=NCHARS/2.+.5	! CONVERT # CHARACTERS TO # WORDS.
13	TYPE 105
105	FORMAT(' ENTER FILE NAME TO WRITE TO AS "FILENM.DAT="'/)
   12 IF(ICSI(ISPEC,EXT,,JSWI,1).NE.0) GO TO 12
C ASSIGN DISC FILE FOR LIST OUTPUT.
      CALL IASIGN(2,ISPEC(1),ISPEC(2),ISPEC(5),16)
C 'REWIND' FILE.
   11 IBLK=0
C
C CLEAR OUT BUFFER.
   20 DO 25 I=1,NCHARS
   25 IBUF(I)="020040
C READ TAPE RECORD
      I=IREADW(NCHARS,IBUF,IBLK,ICHAN)
      IBLK=IBLK+1
C EOF CHECK
      IF(I.EQ.-1) GO TO 9998
C
C IGNORE TRAILING BLANKS.
      LAST=NCHARS
      DO 30 I=1,NCHARS
C IF THERE ARE NO TRAILING BLANKS LEFT, GO TO 35.
      IF(IBUF(NCHARS+1-I).NE."020040) GO TO 35
C DECREMENT 'LAST NON-BLANK WORD IN RECORD' COUNT.
      LAST=LAST-1
   30 CONTINUE
C
C WRITE 'COMPRESSED' RECORD TO OUTPUT FILE.
   35 WRITE(2,101)(IBUF(I),I=1,LAST)
  101 FORMAT(66A2)
      GO TO 20
C************
   50 WRITE(7,100)I,J
  100 FORMAT(1X,2I7)
      STOP 'BAD LOOKUP'
 9998 TYPE 103
  103 FORMAT(' NEXT FILE (Y/N->1/0):')
      ACCEPT 104,N
  104 FORMAT(I5)
      CALL CLOSE(2)
      IF(N.EQ.1) GO TO 13
      STOP 'XFER OK'
      END
��������������������������������������������������������������������������������������������������������������