FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C THIS ROUTINE DEACTRM INES IF LU CAN HANDLE BINARY DATA C C IRW=0 IF BOTH REA AND WRITE C IRW=1 IF READING C IRW=2 IF WRITING C IRW=3 IF BINARY C LOGICAL FUNCTION IFBNR(IRW,LU) 1 ,92067-16361 REV.1940 790104 DIMENSION LU2(2) C C SOURCE PART NUMBER : 92067-18420 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C GET DRIVER STATUS C LU2(1)=IOR(LU,100000B) LU2(2)=600B CALL XLUEX(100003B,LU2,IEQ5,IEQ4) GO TO 100 80 LU2(2)=0 CALL XLUEX(100015B,LU2,IEQ5,IEQ4) GO TO 100 90 IDVRT=IAND(IEQ5,37400B)/256 ISTAT=IAND(4,IEQ5) IUNIT=IAND(IEQ4,3700B)/64 IF(IAND(IRW,IDVRT).NE.0.AND.IDVRT.LE.2) GO TO 300 IF(IDVRT.EQ.5.AND.(IUNIT.EQ.2.OR.IUNIT.EQ.1)) GO TO 200 IF(IDVRT.EQ.22B.OR.IDVRT.EQ.23B) GO TO 200 100 IFBNR=.FALSE. RETURN C C LU OK FOR THE BINARY IO C C CHECK FOR WRITE PROTECT ON DVR 5,22,23 C 200 IF((IRW.EQ.0.OR.IRW.EQ.2).AND.ISTAT.EQ.4) GO TO 100 300 IFBNR=.TRUE. RETURN END