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 SOURCE PART NUMBER :92067-18418 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACWRI - ROUTINE TO WRITE TO THE INPUT DEVICE C C CALLING SEQUENCE: CALL ACWRI(IBUF,ILEN) C WHERE C IBUF = BUFFER TO WRITE C ILEN = BUFFER LENGTH (WORDS) C IF ILEN<0 ECHO CALL FROM ACREI C C SUBROUTINE ACWRI(IBUF,ILEN) ,92067-16361 REV.1940 781024 COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMC/ IECHO,LU LOGICAL XFTTY DIMENSION IBUF(40) DIMENSION ITTY2(2),LU2(2) DATA ID0 /0 / DATA ITTY2,LU2 /0,0,0,0 / C C IF ECHO CALL FROM ACREI C THEN BYPASS FIRST WRITE C ITTY2(1)=IOR(ITTY,100000B) ISAVE=IBUF(ID0) IBUF(ID0)=2H * IF(ILEN.GT.0) GO TO 50 ILEN=-ILEN IBUF(ID0)=2H GO TO 75 C C IF INTERACTIVE AND A LU THEN PRINT C 50 IF(ITTY.GT.0.AND.ITTY.LE.255.AND.XFTTY(ITTY2)) 1 CALL XLUEX(2,ITTY2,IBUF,ILEN) C C IF THERE IS A LIST FILE OR LU C THE WRITE TO IT C 75 IF(LLIST.LE.0) GO TO 200 IF(LLIST.LE.255) GO TO 100 C C WRITE TO FILE CALL WRITF(LLDCB,IERR,IBUF(ID0),ILEN+1) GO TO 200 C C WRITE TO LIST LU C 100 LU2(1)=IOR(LLIST,100000B) CALL XLUEX(2,LU2,IBUF(ID0),ILEN+1) C C IF ECHOING AND NOT SAME AS ITTY C THEN ECHO C 200 LU2(1)=IOR(LU,100000B) IF(IECHO.EQ.1.AND.LU.NE.ITTY) CALL XLUEX(2,LU2,IBUF,ILEN) IBUF(ID0)=ISAVE RETURN END