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-18410 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACREI - ROUTINE TO READ A RESPONSE FROM THE INPUT DEVICE/FILE 
C 
C     CALLING SEQUENCE:  CALL ACREI(IBUF,IERR)
C                WHERE
C                        IBUF  = BUFFER INTO WHICH TO READ
C                        IERR  = ACERR RETURN WORD
C 
C 
      SUBROUTINE ACREI(IBUF,IERR) ,92067-16361 REV.1940 790309  
      DIMENSION LU(2) 
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG 
      DIMENSION IBUF(40),IPBUF(11)
      DATA IPNTR / 17 / 
      DATA LU /0,0 /
      IERR=0
C 
C     RESET ERROR FLAG
C 
C 
C     READING FROM? 
C 
C       MEMORY (LDCB) 
   50 IF(ITTY.LE.0) GO TO 400 
C       FILE:SC:CR
      IF(ITTY.GT.255) GO TO 300 
C 
C       LU
C 
      LU(1)=IOR(ITTY,100000B) 
      LU(2)=KECHO 
      CALL XLUEX(1,LU,IBUF,-80) 
      CALL ABREG(IA,ITLOG)
      IB=(ITLOG+1)/2
C 
C     ECHO IF REQUIRED
C 
  100 IF(IB.NE.0) GO TO 120 
      CALL ACWRI(2HTR,1)
      GO TO 130 
  120 CALL ACWRI(IBUF,-IB)
C 
C     FILL END OF BUFFER WITH BLANKS
C 
  130 IF(IB.GE.40) RETURN 
      DO 200 J=IB+1,40
  200 IBUF(J)=2H
C 
C     CHECK FOR "/TR" OR CONTROL "D"
C 
      ISTRC=1 
      IF(IB.EQ.0) GO TO 250 
      CALL NAMR(IPBUF,IBUF,80,ISTRC)
      IF(IPBUF(1).NE.2H/T.OR.MBYTE(IPBUF(2)).NE.122B) GO TO 275 
  250 IERR=0
      CALL ACXFR(IBUF,ISTRC,IERR) 
      IF(IERR.EQ.0) GO TO 280 
      IF(IERR.EQ.10) IERR=0 
      CALL ACERR(IERR)
      GO TO 280 
C 
C     TEST FOR "/HE"
C 
  275 IF(IPBUF(1).NE.2H/H.OR.MBYTE(IPBUF(2)).NE.105B) RETURN
      IERFG=-1
      CALL ACHLP (IBUF,ISTRC) 
      IERFG=0 
  280 CALL ACPRM(IBUF,-1) 
      GO TO 50
C 
C     READ FROM FILE
C 
  300 CALL READF(ITDCB,IERR,IBUF,40,IB) 
      IF(IERR.LT.0.OR.IB.LT.0) IB=0 
      GO TO 700 
C 
C     READ FROM MEMORY (LDCB) FOR INITIALIZATION
C 
  400 DO 500 IB=1,41
      IBUF(IB)=LDCB(IPNTR)
      IPNTR=IPNTR+1 
      IF(IBUF(IB).EQ.0) GO TO 600 
  500 CONTINUE
C 
C     ADJUST IB 
C 
  600 IB=IB-1 
  700 ITLOG=2*IB
      GO TO 100 
      END 
                                                                                                                                                  