C   07/06/96 606071836  MEMBER NAME  BWRS     (S4)          FORTRAN
      SUBROUTINE BWRS(IUN,NBUFL,INIW)
C     BOS SUBPROGRAM =3.5=
      EXTERNAL BOUTP
#include "acs.for"
      COMMON/BCS/IW(1)
      REAL RW(1)
      EQUIVALENCE (RW(1),IW(1))
      INTEGER ITWO/2/
      EQUIVALENCE (TWO,ITWO)
      INTEGER HIDD/'HIDD'/
      REAL OR
      EXTERNAL OR
C
C     ISAVB=0 INTO ACS
C
C
C     BUFFER FOR OUTPUT = BANK ('+BUF',IUN), LENGTH = 10 + NRECL
C
C     IBF+ 1   =2 (OUTPUT)
C          2   BUFFER SIZE
C          3   OUTPUT MODE (0 = SINGLE RECORDS, NO RECORD, IF TOO LARGE
C                           1 = SINGLE RECORD OR SEVEREAL RECORDS
C                           2 = LSB-RECORDS)
C          4   NR OF RECORDS
C          5   NR OF EVENTS ACCEPTED
C          6   NR OF EVENTS, WHICH ARE TOO LARGE
C          7   SUM OF NR OF WORDS IN ALL EVENTS
C          8   MAX NR OF WORDS IN AN EVENT
C          9   HIDD-NR
C         10   POINTER WITHIN RECORD TO NEXT EVENT
C         ----------------
C         11   NTOT (= NR OF WORDS IN THE RECORD FOLLOWING)
C         12   RECORD
C          .   . . .
C          .   . . .
C
C     LOCATE BUFFER BANK
   10 IF(IBFI.EQ.0) IBFI=IBLN('+BUF')+1
      IBF=IBFI
    2 IBF=IW(IBF-1)
      IF(IBF.EQ.0)        GOTO    90
      IF(IW(IBF-2).LT.IUN) GOTO 2
      IF(IW(IBF-2).GT.IUN) GOTO    90
      IF(IW(IBF+1).EQ.2) GOTO 11
C     UNIT IS INCORRECT
      ICOND=24
      CALL BDMP
   11 IF(IW(IBF+10)+3.NE.0) GOTO 12
      IF(ISAVB.NE.0) IW(ISAVB)=NSAVB
      ISAVB=0
  111 IW(IBF+10)=0
      INIW=0
      GOTO 100
   12 IF(IW(IBF).NE.16) GOTO 13
      IER=0
      IF(IN.GT.0.AND.IW(IBF+3).NE.0) CALL BCHF(IBF,IW(IBF+2)+10,IER)
      IF(IER.NE.0) GOTO 92
   13 ISTAT=1
      IF(IW(IBF+10)+1) 14,16,18
   14 ISTAT=ISTAT+1
   16 ISTAT=ISTAT+1
      IW(IBF+10)=0
   18 IF(IW(IBF+10).NE.0) GOTO 20
      IW(IBF+ 9)=0
      IW(IBF+10)=12
C
   20 INDH=IBF+IW(IBF+10)
      NL  =IBF+IW(IBF)-INDH+1
      IF(IN.LE.0) GOTO 71
      IF(IW(IBF+3).EQ.0) GOTO 21
      IF(NL.LT.9) GOTO 71
C     NEW HIDD-BANK
   21 IW(IBF+9)=IW(IBF+9)+1
      IW(INDH  )=HIDD
      IW(INDH+1)=IW(IBF+9)
      IW(INDH+2)=0
      IW(INDH+3)=1
      IW(INDH+4)=0
      IBIC=INDH+4
      INDH=INDH+5
      NL  =NL  -5
      GOTO (30,50,60),ISTAT
C     NEW EVENT
   30 IC=0
      IW(IBF+5)=IW(IBF+5)+1
      NTOTE=0
      IF(IW(IBF+3).EQ.2) GOTO 31
C     CHECK ORDER AND LENGTH EXCEPT FOR MODE=2
      NTOT=IW(IBF+3)
      INIA=IW(IBF+2)
      CALL BORDP(NTOT,INIA)
      IBF=IBFI
   33 IBF=IW(IBF-1)
      IF(IBF.EQ.0) GOTO 92
      IF(IW(IBF-2)-IUN) 33,35,92
   35 IF(NTOT.EQ.0) GOTO 111
      IF(IW(IBF+3).EQ.1) GOTO 37
C     MODE=0
      IF(INIA.NE.0) GOTO 36
C     TOO LARGE
      IW(IBF+5)=IW(IBF+5)-1
      IW(IBF+6)=IW(IBF+6)+1
      IW(IBF+8)=MAX0(IW(IBF+8),NTOT)
      GOTO 111
C     DIRECT WRITE
   36 INIW=INIA-1
      NBUFL=NTOT+1
      IW(IBF+7)=IW(IBF+7)+NTOT
      IW(IBF+8)=MAX0(IW(IBF+8),NTOT)
      IW(IBF+4)=IW(IBF+4)+1
      IW(IBF+10)=-3
      ISAVB=INIW
      NSAVB=IW(ISAVB)
      IW(ISAVB)=NTOT
      GOTO 100
C     MODE=1
   37 IF(INIA.GT.0) GOTO 36
      GOTO 39
C     EVENT LOOP FOR MODE=1 AND 2
   31 NROUT=NROUT+1
   39 J=0
   32 J=J+1
      IF(J.LE.IN) GOTO 40
C     ALL BANKS DONE
      IF(IC.NE.0) IC=3
      IW(IBIC  )=IC
      IW(IBIC-1)=INDH-IBIC
      IF(IW(IBIC-1).LE.1) INDH=INDH-5
      IW(IBF+10)=INDH-IBF
   34 INIW=0
      IW(IBF+7)=IW(IBF+7)+NTOTE
      IW(IBF+8)=MAX0(IW(IBF+8),NTOTE)
      IF(IW(IBF+3).EQ.2) GOTO 100
      IW(IBF+4)=IW(IBF+4)+1
      INIW=IBF+11
      IF(IC.NE.3) INIW=IBF+16
      IW(INIW)=INDH-IBF-12
      IF(IC.NE.3) IW(INIW)=INDH-IBF-17
      NBUFL=IW(INIW)+1
      IW(IBF+10)=-3
      GOTO 100
C     NEXT NAME
   40 IND=IW(NLST+J)
      NIND=IW(IND)
      IF(NIND.NE.0) RW(IOLST+IND)=OR(RW(IOLST+IND),TWO)
   42 IND=NIND
      IF(IND.LE.0) GOTO 32
      NIND=IW(IND-1)
C     NEXT BANK
   50 LENG=IW(IND)+4
      IF(NL.LT.4) GOTO 64
      NTOTE=NTOTE+LENG
      NC=MIN0(LENG,NL)
      CALL UCOPY(IW(IND-3),IW(INDH),NC)
      IW(INDH+3)=NC-4
      INDH=INDH+NC
      NL  =NL  -NC
      LENG=LENG-NC
      IF(LENG.LE.0) GOTO 42
      NLC=NC
      GOTO 62
C     COPY INTERRUPTED BANK
   60 CALL UCOPY(IW(IND-3),IW(INDH),4)
      NC=MIN0(LENG,NL-4)
      IW(INDH+3)=NC
      CALL UCOPY(IW(IND-3+NLC),IW(INDH+4),NC)
      INDH=INDH+4+NC
      NL  =NL  -4-NC
      LENG=LENG-NC
      IF(LENG.LE.0) GOTO 42
      NLC=NLC+NC
C     BANK DIVIDED BETWEEN RECORDS
   62 IW(IBF+10)=-2
      GOTO 70
C     LAST BANK COMPLETED IN LAST RECORD
   64 IW(IBF+10)=-1
C
   70 IF(IC.LT.2) IC=IC+1
      IW(IBIC  )=IC
      IW(IBIC-1)=INDH-IBIC
      GOTO 72
   71 IW(IBF+10)=0
   72 IW(IBF+11)=INDH-IBF-12
      INIW=IBF+11
      IF(IW(INIW).EQ.0) INIW=0
      IF(INIW.EQ.0) IW(IBF+10)=0
      IF(INIW.NE.0.AND.IW(IBF+3).GE.1) IW(IBF+4)=IW(IBF+4)+1
      NBUFL=IW(IBF)-10
      IF(IW(IBF+3).EQ.2) GOTO 100
      IF(INIW.NE.0) NBUFL=IW(INIW)+1
      GOTO 100
C
   90 CALL BCRE(IBF,'+BUF',IUN,16,&92,IER)
      IW(IBF+1)=2
      IW(IBF+2)=NRECL
      GOTO 12
C
   92 ICOND=13
      CALL BDMP
C     OPEN OUTPUT BUFFER
      ENTRY BWRO(IUN,NBUFL,INIW)
C     ARGUMENTS UNIT BUFFERSIZE MODE
      CALL BDLS('+BUF',IUN)
      CALL BCRE(IBF,'+BUF',IUN,16,&92,IER)
      IW(IBF+1)=2
      IW(IBF+2)=NBUFL
      IW(IBF+3)=INIW
      IF(IW(IBF+3).LT.0.OR.IW(IBF+3).GT.2) IW(IBF+3)=0
  100 RETURN
      END
