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-18413 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C 
C     WRITE TO LIST LU OR FILE
C 
C 
C     CALLING SEQUENCE
C      CALL ACWRL(IBUF,NO,IERR) 
C 
C       WHERE: IBUF IS OUTPUT BUFFER
C              NO   IS NUMBER WORDS IN BUFFER 
C 
C 
      SUBROUTINE ACWRL(IBUF,NO,IERR) ,92067-16361 REV.1940 790606 
      LOGICAL IFBNR,XFTTY,IFBRK 
      DIMENSION LU2(2)
      COMMON /ACOM2/ LRTRN
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      DIMENSION IBUF(2) 
      IF(IFBRK(IDUM)) GO TO 300 
      IERR=0
      LU2(2)=LIST(2)
      IF(LIST(4).EQ.3) GO TO 100
      IF(LIST(4).EQ.0) GO TO 200
C 
C     WRITE TO LU 
C 
      LU2(1)=IOR(LIST,100000B)
      IF=1
      IF(XFTTY(LU2)) IF=2 
      IF(IFBNR(2,LIST)) IF=1
      CALL XLUEX(2,LU2,IBUF(IF),NO-IF+1)
      RETURN
C 
C     WRITE TO FILE 
C 
  100 IF(LIST(1).LT.0) GO TO 150
      CALL WRITF(LDCB,IERR,IBUF,NO) 
      RETURN
C 
C     WRITE LOGICAL LIST FILE 
C 
  150 CALL WRITF(LLDCB,IERR,IBUF,NO)
      RETURN
C 
C     WRITE TO INPUT DEVICE 
C 
  200 CALL ACWRI(IBUF(2),NO-1)
      RETURN
  300 CALL ACERR(0) 
      CALL ACCLL
      GO TO LRTRN 
      END 
                                                                                        