C PROGRAM TO WRITE AN ASCII CARD IMAGE MAG TAPE.
C FILED--6-MAY-81, G. BEVER.
C
C
C COMPILE AS FOLLOWS:
C
C  .FORTRA MTWRIT
C
C LINK AS FOLLOWS:
C
C  .LINK MTWRIT
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)
      REAL*4 RMINEU,RMAXEU
      REAL*4 EXT(2)
      DATA EXT/6RLSTLST,6RLSTDAT/
      DATA JSWI/'M',3*0/
      DATA LU/2HLP,2H: /
C
C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES.
C  *MT:=FILE.FOR
C   WHERE 'FILE.FOR' SPECIFIES INPUT SOURCE FILE.
C         'MT:' SPECIFIES MAG TAPE TO OUTPUT TO.
C
C GET INPUT SOURCE FILE NAME FROM SYSTEM CONSOLE (1ST TIME).
    5 IF(ICSI(ISPEC,EXT,,JSWI,1).NE.0) GO TO 5
C SET SYSTEM TO IGNORE FORTRAN RUN TIME ERROR # 5.
      CALL SETERR(5,255)
C FETCH INPUT DEVICE HANDLER INTO MEMORY.
      IF(IFETCH(ISPEC(1)).NE.0) STOP 'BAD IN FETCH'
C GET CHANNEL NUMBER.
      ICHAN=IGETC()
      IF(ICHAN.LT.0) STOP 'NO CHANNEL'
C PERFORM NON FILE STRUCTURED LOOKUP OF DEVICE.
      I=LOOKUP(ICHAN,ISPEC(1))
      IF(I.LT.0) GO TO 50
	GO TO 13
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.
13    CALL IASIGN(2,ISPEC(16),ISPEC(17),0,0)
C 'REWIND' FILE.
   11 IBLK=0
C
C CLEAR OUT BUFFER.
   20 DO 25 I=1,40
   25 IBUF(I)="020040
C READ RECORD FROM INPUT FILE.
      READ(2,101,END=9998)(IBUF(I),I=1,40)
  101 FORMAT(40A2)
C WRITE TAPE RECORD
      I=IWRITW(40,IBUF,IBLK,ICHAN)
      IBLK=IBLK+1
      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
�����������������������������������������������������������������������������������������������������������