C C AUTHOR: C R. STODOLA C THE INSTITUTE FOR CANCER RESEARCH C 7701 BURHOLME AVE. C PHILADELPHIA, PA. 19111 C C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C * * C * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V2.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* C C MAGNETIC TAPE DIRECT I/O ROUTINES C C ATTAPE -- ATTACH TAPE UNIT AND INITIALIZE CHARACTERISTICS. C ---------------------------------------------------------- C CALL ATTAPE(LUN,ISCHR,ICHAR,ISTAT,ISW) C LUN -- LOGICAL UNIT OF MAG-TAPE C ISCHR -- DESIRED TAPE CHARACTERISTICS(SEE LIST BELOW) C ICHAR -- ACTUAL TAPE CHARACTERISTICS(SEE LIST BELOW) C ISTAT -- TWO WORD I/O STATUS BLOCK C ISW -- DIRECTIVE STATUS WORD C C TAPE CHARACTERISTICS: C BIT OCTAL USAGE C --- ----- --------------------------------------- C 15 100000 TAPE IS PAST LEOV(*) C 14 40000 TAPE IS AT LEOV(*) C 13 20000 TAPE IS AT BOT(*) C 12 10000 TAPE IS SEVEN CHANNEL(*) C 11 4000 SPECIFY 1600 BPI PE (**) C 10 2000 TAPE UNIT IS WRITE LOCKED (*) C 9 1000 UNIT IS REWINDING(*) C 8 400 SELECT ERROR ON UNIT(*) C 7 200 INHIBIT WRITE WITH EXTENDED INTERRECORD GAP (**) C 6 100 INHIBIT WRITE(**) C 5 40 EOF OCCURED DURING LAST COMMAND(*) C 4 20 TAPE IS PAST EOT (*) C 3 10 READ AND WRITE WITH EVEN PARITY (**,+) C 2 4 7 CHANNEL CORE DUMP MODE (**) C 1 2 7 CHANNEL 200 BPI (**) C 0 1 7 CHANNEL 556 BPI (**) C * READ ONLY C ** READ/WRITE C + CANNOT READ OR WRITE BINARY ZERO WITH EVEN PARITY SO C THIS CODE IS TRANSLATED TO OCTAL 020. C C DTTAPE -- DETACH TAPE UNIT. C ---------------------------- C CALL DTTAPE(LUN) C LUN -- LOGICAL UNIT OF TAPE UNIT. C C RDTAPE -- READ A LOGICAL TAPE RECORD. C ------------------------------------- C CALL RDTAPE(LUN,IBUF,NBYTES,ISTAT,ISW) C LUN -- LOGICAL UNIT OF TAPE UNIT. C IBUF -- BUFFER TO RECEIVE RECORD C NBYTES-- NUMBER OF BYTES TO READ C ISTAT -- TAPE STATUS RETURNED. IF SUCCESSFUL, ACTUAL NUMBER C OF BYTES TRANSFERED IS IN ISTAT(2). C ISW -- DIRECTIVE STATUS RETURNED. C C WRTAPE -- WRITE A LOGICAL RECORD TO TAPE. C ----------------------------------------- C CALL WRTAPE(LUN,IBUF,NBYTES,ISTAT,ISW) C (SAME CALLING SEQUENCE AS FOR RDTAPE). C C WEOF -- WRITE EOF MARK. C -------------------------- C CALL WEOF(LUN,ISTAT,ISW) C LUN -- LOGICAL UNIT NUMBER OF TAPE UNIT. C ISTAT -- TWO WORD ARRAY FOR STATUS RETURN. C ISW -- DIRECTIVE STATUS RETURNED. C C TREWND -- REWIND MAG-TAPE. C --------------------------- C CALL TREWND(LUN,ISTAT,ISW) C CALLING SEQUENCE SAME AS WEOF. C C TOFLIN -- REWIND AND TURN TAPE OFFLINE. C ---------------------------------------- C CALL TOFLIN(LUN,ISTAT,ISW) C CALLING SEQUENCE SAME AS WEOF. C C SPBTAP -- SPACE OVER BLOCKS. C ----------------------------- C CALL SPBTAP(LUN,NBLKS,ISTAT,ISW) C LUN -- LOGICAL UNIT OF TAPE UNIT. C NBLKS -- NUMBER OF BLOCKS TO SKIP(NEGATIVE FOR BACKWORDS). C ISTAT -- TWO WORD STATUS ARRAY RETURNED. SECOND WORD C CONTAINS ACTUAL NUMBER OF BLOCKS SKIPPED. C ISW -- DIRECTIVE STATUS RETURNED. C C SPFTAP -- SPACE OVER FILES. C ---------------------------- C CALL SPFTAP(LUN,NFILS,ISTAT,ISW) C CALLING SEQUENCE IS SAME AS SPBTAP EXCEPT NFILS IS NUMBER C OF FILES TO SKIP. C ***** NOTE: IF NFILS OR NBLKS IS ZERO, NO MOTION IS SPECIFIED. C SUBROUTINE ATTAPE(LUN,ISCHR,ICHAR,ISTAT,ISW) INCLUDE 'LB:[1,1]QIOSYS.FTN' INCLUDE 'TCOM.FTN' CALL WTQIO(IOATT,LUN,MTEVN,,ISTAT,,ISW) IF(ISW.LT.0.OR.ISTAT(1).LT.0)RETURN CALL SCHART(LUN,ISCHR,ICHAR) CALL SXTEND(ISTAT) RETURN END SUBROUTINE DTTAPE(LUN) INCLUDE 'LB:[1,1]QIOSYS.FTN/NOLIST' INCLUDE 'TCOM.FTN/NOLIST' CALL WTQIO(IODET,LUN,MTEVN) RETURN END SUBROUTINE RDTAPE(LUN,IBUF,NBYTES,ISTAT,ISW) INCLUDE 'LB:[1,1]QIOSYS.FTN/NOLIST' INCLUDE 'TCOM.FTN/NOLIST' BYTE IBUF(NBYTES) IFCD=IORLB GO TO 10 C ENTRY WRTAPE(LUN,IBUF,NBYTES,ISTAT,ISW) IFCD=IOWLB C 10 CALL GETADR(IPRAM,IBUF) IPRAM(2)=NBYTES CALL WTQIO(IFCD,LUN,MTEVN,,ISTAT,IPRAM,ISW) CALL SXTEND(ISTAT) RETURN END SUBROUTINE WEOF(LUN,ISTAT,ISW) INCLUDE 'LB:[1,1]QIOSYS.FTN/NOLIST' INCLUDE 'TCOM.FTN/NOLIST' IFCD=IOEOF GO TO 10 C ENTRY TREWND(LUN,ISTAT,ISW) IFCD=IORWD GO TO 10 C ENTRY TOFLIN(LUN,ISTAT,ISW) IFCD=IORWU C 10 CALL WTQIO(IFCD,LUN,MTEVN,,ISTAT,,ISW) CALL SXTEND(ISTAT) RETURN END SUBROUTINE SPBTAP(LUN,NPIN,ISTAT,ISW) INCLUDE 'LB:[1,1]QIOSYS.FTN/NOLIST' INCLUDE 'TCOM.FTN/NOLIST' IFCD=IOSPB GO TO 10 C ENTRY SPFTAP(LUN,NPIN,ISTAT,ISW) IFCD=IOSPF C 10 IPRAM(1)=NPIN CALL WTQIO(IFCD,LUN,MTEVN,,ISTAT,IPRAM,ISW) CALL SXTEND(ISTAT) RETURN END SUBROUTINE SCHART(LUN,ISCHR,ICHAR) INCLUDE 'LB:[1,1]QIOSYS.FTN/NOLIST' INCLUDE 'TCOM.FTN/NOLIST' IPRAM(1)=ISCHR CALL WTQIO(IOSTC,LUN,MTEVN,,ISTAT,IPRAM,ISW) C ENTRY RCHART(LUN,ICHAR) CALL WTQIO(IOSEC,LUN,MTEVN,,ISTAT) ICHAR=ISTAT(2) RETURN END SUBROUTINE SXTEND(IW) IF((IW.AND."200).NE.0)IW=IW.OR."177400 RETURN END