
*     NTUPLES file

      SUBROUTINE ABUNIT(LUNA,LUNB)
*
*     assignment of unit numbers and initialization (for negative args)
*
      COMMON/ABTUPL/LUND(2)
      LOGICAL LUNDEF,OPENED,EXS,OPN
      SAVE /ABTUPL/,LUNDEF,OPENED
      DATA LUNDEF/.FALSE./,OPENED/.FALSE./
*     ...
C     WRITE(*,*) LUNA,LUNB,' ARE LUNA AND LUNB IN ABUNIT'
      IF(.NOT.LUNDEF) THEN
         LUNDEF=.TRUE.
         LUND(1)=IABS(LUNA)
         LUND(2)=IABS(LUNB)
      END IF
C     IF(LUNA.GT.0) RETURN
      IF(OPENED) RETURN
      OPENED=.TRUE.
      DO ILUN=1,2
       LUNIT=LUND(ILUN)
       IF(LUNIT.NE.0) THEN
*         inquire for given unit
          INQUIRE (UNIT=LUNIT,IOSTAT=IOS,EXIST=EXS,OPENED=OPN)
          IF(IOS.NE.0) THEN
             WRITE(*,*) 'Inquire failed for unit',LUNIT,
     +                  ' Error code=',IOS
             STOP
          END IF
          IF(.NOT.OPN) THEN
*            open sequential, unformattted scratch file
             OPEN (UNIT=LUNIT,STATUS='SCRATCH',ACCESS='SEQUENTIAL',
     +             FORM='UNFORMATTED',IOSTAT=IOS)
             WRITE(*,*) 'OPEN UNIT =',LUNIT
             IF(IOS.NE.0) THEN
                WRITE(*,*) 'Open failed for unit',LUNIT,
     +                     ' Error code=',IOS
                STOP
             END IF
          END IF
       END IF
      END DO
      END

      SUBROUTINE UEVENT(NAME,NY,WT,X,Y)
*     write one event
*        CALL UVENT(NAME,NY,WT,X,Y)
*
*     at end
*        CALL UEVENT('any ',-1,WT,X,Y)
*
*
      REAL Y(*)
      COMMON/UNCOMA/DUMMY,DUMMI,REC(102)
      CHARACTER*(*) NAME
      CHARACTER*4   CHA
      SAVE CHA,ID
      DATA CHA/'    '/
*     ...
      IF(NY.LT.0) THEN
*        write buffer
         CALL ASTORE(ID,REC,-1)
      ELSE
*        write array
         IF(NAME.NE.CHA) THEN
            CHA=NAME
*           convert from character to hollerith
            ID =((ICHAR(CHA(1:1))*256+ICHAR(CHA(2:2)))*256
     +           +ICHAR(CHA(3:3)))*256+ICHAR(CHA(4:4))
         END IF
         IF(CHA.NE.'    ') THEN
            MY=MIN(100,NY)
            REC(1)=WT
            REC(2)=X
            DO I=1,MY
             REC(2+I)=Y(I)
            END DO
            CALL ASTORE(ID,REC,2+MY)
         END IF
      END IF
      END
      SUBROUTINE ASTORE(ID,IARR,ND)
*
*     store array (write)      CALL ASTORE(ID,IARR,ND)
*                              ID = identifier (integer)
*                              IARR(1)...IARR(ND) = array
*                              ND = 0 is allowed
*                              ND < 0 means write buffer (at end)
*
*     fetch array (read)       CALL AFETCH(ID,IARR,ND)
*                              ND = -1 means end-of-data
*
*
*     store after start        means: write (previous data on the
*                              data set is lost)
*
*     store after fetch        means: read until end-of-data, then
*                              backspace, and write (previous data
*                              on data set kept)
*
*     fetch after store        means: rewind data set, and read
*
*     fetch after eod          means: rewind data set, and read
*
*     (BLKSIZE=4244)
*
      INTEGER IARR(*)
*     IO-buffer for ntuples
      PARAMETER (NWDIM=1060)
      INTEGER IBUF(0:NWDIM)
      EQUIVALENCE (I,IBUF(0))
*     common with unit numbers
      COMMON/ABTUPL/LUND(2)
      LOGICAL START
      SAVE /ABTUPL/,I,IBUF,ISTAT,NR,NARR,NREC,START,LUN,NRD 
      DATA ISTAT/1/,NR/0/,NARR/0/,NREC/0/,START/.TRUE./,LUN/0/,NRD/0/
*     ...
      IF(START) THEN
*        initialization
         START=.FALSE.
         CALL ABUNIT(-51,-52)
*        ... in this routine the first  unit is used
         LUN=LUND(1)
      END IF
*     ISTAT
*     -----  ------------------
*       1    initial status
*       2    status is read
*       3    status is read/eof
*       4    status is write
      IF(ND.LT.0) THEN
*        write buffer
         IF(ISTAT.EQ.4) THEN
            IF(I.NE.0) THEN
               WRITE(LUN) IBUF
               NREC=NREC+1
            END IF
            WRITE(*,101) LUN,NARR,NREC
         END IF
         IF(ISTAT.NE.1) REWIND LUN
         ISTAT=1
         NREC =0
         NARR =0
         GOTO 100
      END IF
      IF(ISTAT.NE.4) THEN
         IF(ISTAT.EQ.1) THEN
*           initial status
            REWIND LUN
         ELSE
*           status is read or read/eof
            IF(ISTAT.EQ.2) THEN
*              status was read
   11          READ(LUN,END=12)
               GOTO 11
            END IF
*           status was read/eof
   12       BACKSPACE LUN
         END IF
*        switch to status write
         ISTAT=4
         I    =0
      END IF
*     status is write
      NARR=NARR+1
      IBUF(I+1)=ID
      IBUF(I+2)=ND
      I=I+2
      J=0
   10 M=MIN(ND-J,NWDIM-I)
      DO K=1,M
       IBUF(I+K)=IARR(J+K)
      END DO
      J=J+M
      I=I+M
      IF(J.NE.ND.OR.I.GE.NWDIM-1) THEN
         WRITE(LUN) IBUF
         I=0
         NREC=NREC+1
C        WRITE(*,*) NREC,' is record number '
         GOTO 10
      END IF
C     IF(NARR.LE.100) WRITE(*,*)' A out',ID,ND,(IARR(LL),LL=1,ND)
      GOTO 100
*
      ENTRY AFETCH(ID,IARR,ND)
      IF(START) THEN
         START=.FALSE.
         CALL ABUNIT(-51,-52)
         LUN=LUND(1)
      END IF
      IF(ISTAT.NE.2) THEN
         IF(ISTAT.EQ.4) THEN
*           status was write - write buffer
            IF(I.NE.0) THEN
               WRITE(LUN) IBUF
               NREC=NREC+1
            END IF
            WRITE(*,101) LUN,NARR,NREC
         END IF
*        switch to status read
         REWIND LUN
         NR=0
         I =0
         ISTAT=2
      END IF
*     status is read
      IF(I.EQ.NR) THEN
         READ(LUN,END=50) IBUF
         NR=I
         I =0
      END IF
      ID=IBUF(I+1)
      ND=IBUF(I+2)
      I=I+2
      J=0
   30 M=MIN(ND-J,NR-I)
      DO K=1,M
       IARR(J+K)=IBUF(I+K)
      END DO
      I=I+M
      J=J+M
      IF(J.NE.ND) THEN
         READ(LUN,END=50) IBUF
         NR=I
         I =0
         GOTO 30
      END IF
      NRD=NRD+1
C     IF(NRD.LE.100) WRITE(*,*)' A in',ID,ND,(IARR(LL),LL=1,ND)
      GOTO 100
*     status will become read/eof
   50 ND=-1
      ISTAT=3
  100 RETURN
  101 FORMAT(/' Ntuple-File A(',I2,') -',I8,
     +        ' ntuples stored in',I8,' records'/)
      END
      SUBROUTINE BSTORE(ID,IARR,ND)
*
*     store array (write)      CALL ASTORE(ID,IARR,ND)
*                              ID = identifier (integer)
*                              IARR(1)...IARR(ND) = array
*                              ND = 0 is allowed
*                              ND < 0 means write buffer (at end)
*
*     fetch array (read)       CALL AFETCH(ID,IARR,ND)
*                              ND = -1 means end-of-data
*
*
*     store after start        means: write (previous data on the
*                              data set is lost)
*
*     store after fetch        means: read until end-of-data, then
*                              backspace, and write (previous data
*                              on data set kept)
*
*     fetch after store        means: rewind data set, and read
*
*     fetch after eod          means: rewind data set, and read
*
*     (BLKSIZE=4244)
*
      INTEGER IARR(*)
*     IO-buffer for ntuples
      PARAMETER (NWDIM=1060)
      INTEGER IBUF(0:NWDIM)
      EQUIVALENCE (I,IBUF(0))
*     common with unit numbers
      COMMON/ABTUPL/LUND(2)
      LOGICAL START
      SAVE /ABTUPL/,I,IBUF,ISTAT,NR,NARR,NREC,START,LUN 
      DATA ISTAT/1/,NR/0/,NARR/0/,NREC/0/,START/.TRUE./,LUN/0/
*     ...
      IF(START) THEN
*        initialization
         START=.FALSE.
         CALL ABUNIT(-51,-52)
*        ... in this routine the second unit is used
         LUN=LUND(2)
      END IF
*     ISTAT
*     -----  ------------------
*       1    initial status
*       2    status is read
*       3    status is read/eof
*       4    status is write
      IF(ND.LT.0) THEN
*        write buffer
         IF(ISTAT.EQ.4) THEN
            IF(I.NE.0) THEN
               WRITE(LUN) IBUF
               NREC=NREC+1
            END IF
            WRITE(*,101) LUN,NARR,NREC
         END IF
         IF(ISTAT.NE.1) REWIND LUN
         ISTAT=1
         NREC =0
         NARR =0
         GOTO 100
      END IF
      IF(ISTAT.NE.4) THEN
         IF(ISTAT.EQ.1) THEN
*           initial status
            REWIND LUN
         ELSE
*           status is read or read/eof
            IF(ISTAT.EQ.2) THEN
*              status was read
   11          READ(LUN,END=12)
               GOTO 11
            END IF
*           status was read/eof
   12       BACKSPACE LUN
         END IF
*        switch to status write
         ISTAT=4
         I    =0
      END IF
*     status is write
      NARR=NARR+1
      IBUF(I+1)=ID
      IBUF(I+2)=ND
      I=I+2
      J=0
   10 M=MIN(ND-J,NWDIM-I)
      DO K=1,M
       IBUF(I+K)=IARR(J+K)
      END DO
      J=J+M
      I=I+M
      IF(J.NE.ND.OR.I.GE.NWDIM-1) THEN
         WRITE(LUN) IBUF
         I=0
         NREC=NREC+1
         GOTO 10
      END IF
      GOTO 100
*
      ENTRY BFETCH(ID,IARR,ND)
      IF(START) THEN
         START=.FALSE.
         CALL ABUNIT(-51,-52)
         LUN=LUND(2)
      END IF
      IF(ISTAT.NE.2) THEN
         IF(ISTAT.EQ.4) THEN
*           status was write - write buffer
            IF(I.NE.0) THEN
               WRITE(LUN) IBUF
               NREC=NREC+1
            END IF
C           WRITE(*,101) LUN,NARR,NREC
         END IF
*        switch to status read
         REWIND LUN
         NR=0
         I =0
         ISTAT=2
      END IF
*     status is read
      IF(I.EQ.NR) THEN
         READ(LUN,END=50) IBUF
         NR=I
         I =0
      END IF
      ID=IBUF(I+1)
      ND=IBUF(I+2)
      I=I+2
      J=0
   30 M=MIN(ND-J,NR-I)
      DO K=1,M
       IARR(J+K)=IBUF(I+K)
      END DO
      I=I+M
      J=J+M
      IF(J.NE.ND) THEN
         READ(LUN,END=50) IBUF
         NR=I
         I =0
         GOTO 30
      END IF
      GOTO 100
*     status will become read/eof
   50 ND=-1
      ISTAT=3
  100 RETURN
  101 FORMAT(/' Ntuple-File B(',I2,') -',I8,
     +        ' ntuples stored in',I8,' records'/)
      END


























