C PROGRAM TO READ AN ASCII MAGTAPE, 100 CHARS/RECORD.. C FILED--27-NOV-85, G. BEVER. C 'READ' CHANGED TO 'WRITE' IN FORMAT 105--17-JAN-86, G. BEVER. C OUTPUT TAPE UN-HARDCODED, DOUBLE BUFFERING ADDED--21-MAR-86, G. BEVER. C C COMPILE AS FOLLOWS: C C .R FORTRA C *ELXSIW=ELXSIW/U/R:189. C C LINK AS FOLLOWS: C C .LINK ELXSIW 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(512),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 *MS1:=FILE.FOR C WHERE FILE.FOR SPECIFIES INPUT SOURCE FILE. C MS1: SPECIFIES MAG TAPE OUTPUT. C IFIRST=0 !INIT IFIRST C SET SYSTEM TO IGNORE FORTRAN RUN TIME ERROR # 5. CALL SETERR(5,255) C 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 "MS1:=FILENM.DAT"'/) C C GET INPUT SOURCE FILE NAME FROM SYSTEM CONSOLE. 12 IF(ICSI(ISPEC,EXT,,JSWI,1).NE.0) GO TO 12 C ASSIGN DISC FILE FOR SOURCE INPUT. CALL IASIGN(2,ISPEC(16),ISPEC(17),0,0) IF(IFIRST.NE.0) GO TO 11 IFIRST=1 ! SIGNIFY NOT 1ST TIME THRU. C ASSIGN OUTPUT FILE. C GET CHANNEL NUMBER. ICHAN=IGETC() IF(ICHAN.LT.0) STOP 'NO CHANNEL' IF(ISPEC(1).EQ.0) ISPEC(1)="052127 ! IF NO OUTPUT FILE SPECIFIED C ! SET TO 'MS1'. C FETCH INPUT DEVICE HANDLER INTO MEMORY. IF(IFETCH(ISPEC(1)).NE.0) STOP 'BAD IN FETCH' C PERFORM NON FILE STRUCTURED LOOKUP OF DEVICE. I=LOOKUP(ICHAN,ISPEC(1)) IF(I.LT.0) GO TO 50 C C 'REWIND' FILE. 11 IBLK=0 C C DOUBLE BUFFER I/O. 20 DO 40 J=1,2 C READ RECORD FROM INPUT FILE. READ(2,101,END=9998)(IBUF((J-1)*NCHARS+I),I=1,NCHARS) 101 FORMAT(66A2) C WRITE TAPE RECORD IF(IWAIT(ICHAN).NE.0) STOP 'WAIT ERROR'! WAIT FOR TAPE TO COMPLETE C ! LAST XFER. I=IWRITE(NCHARS,IBUF((J-1)*NCHARS+1),IBLK,ICHAN) IBLK=IBLK+1 40 CONTINUE GO TO 20 C************ 50 WRITE(7,100)I,J 100 FORMAT(1X,2I7) STOP 'BAD LOOKUP' 104 FORMAT(I5) 9998 CALL CLOSE(2) C WRITE EOF ON MT. CALL ISPFNW("377,ICHAN) TYPE 103 103 FORMAT(' NEXT FILE (Y/N->1/0):') ACCEPT 104,N IF(N.EQ.1) GO TO 12 STOP 'XFER OK' END