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