*trigger
128  
*oned
1..32       s 65536
101..132    s 65536
200..201    s 4096
301..332    s 65536
2130..2135  s 65536
2030..2035  s 65536
2200..2205  s 65536
*twod
1000..1001  s 4096 4096
2000..2005  s 128 128
2010..2015  s 128 128
2020..2025  s 512 512
2100..2105  s 128 128
2110..2115  s 128 128
2120..2125  s 512 512
*vars
*sort
C----67---------------------------------------------------------------72------80
      SUBROUTINE init

      IMPLICIT none

      SAVE                                 
C
C     External functions
C
      EXTERNAL dtime
C
      INTEGER and, lshift, rshift, bb18order
C
      LOGICAL btest
C
      REAL float, secnds
C
C     Parameter variables
C
      INTEGER max
      PARAMETER (max = 4096)
C
C     Local variables
C
      INTEGER adc_data, asic, ch, channel, channel_ident
      INTEGER count, data(0:4095), disc
      INTEGER dsssd_a( 6 ), dsssd_b( 6 ), dsssd_c( 6 ), dsssd_d( 6 )
      INTEGER*8 dt
      INTEGER events, events_old
      INTEGER*8 e_time, e_time_old
      INTEGER i
      INTEGER*2 i2(2), i2_2(4)
      INTEGER i4, i4_2(2)
      INTEGER*8 i8, first_ts_value
      INTEGER idata(0:4095), ierr, information, information_index
      INTEGER invalid_id, items, items_old, j, j1, j1_old, j2, j2_old, k
      INTEGER l, mbs_data(0:3), module, m_disc, m_p, m_n, ptr
      INTEGER sc_channel
      INTEGER scaler( 32 ), scaler_old( 32 ), range, time_warp, total
      INTEGER*8 ts
      INTEGER ts28
      INTEGER ts48
      INTEGER*8 old_ts( 8, 2 ), ts_old 
      INTEGER*8 implant_ts( 0:127, 0:127, 1:8 )
      INTEGER*8 decay_ts( 0:127, 0:127, 1:8 )
      INTEGER type, w(0:31), zzz
C
      LOGICAL first, first_ts, hit(0:4095), ihit(0:4095)
      REAL c(0:7), delta_t, gain(0:max-1), offset(0:max-1)
      REAL t1, t2, t2_old
      DOUBLE PRECISION rates( 32 ), t3, t4, t4_old

C----67---------------------------------------------------------------72------80
C
C     Namelists
C
      NAMELIST /variables/ gain, offset, c, w,
     +                     dsssd_a, dsssd_b, dsssd_c, dsssd_d

C----67---------------------------------------------------------------72------80
C
C     Common variables
C
      INTEGER*2 gdata(0:15)
C
      COMMON /fdata/ gdata
C
C     Common variables
C
      INTEGER*2 gid(0:15)
C
      COMMON /fid/ gid
C
C     Common variables
C
      INTEGER mult
C
      COMMON /fmult/ mult
C
      EQUIVALENCE ( i8, i4_2(1) )
      EQUIVALENCE ( i4, i2(1) )
C
C----67---------------------------------------------------------------72------80

      WRITE ( 6, * ) ' *** AIDA @ RIKEN - implants - November 2016'
      WRITE ( 6, * ) ' *** Entry init commences'

C     Initialise counters

      events = 0
      events_old = 0

      time_warp = 0
      invalid_id = 0

      first_ts = .TRUE.
      t3 = 0.0D+00
      t4 = 0.0D+00
      t4_old = 0.0D+00

C     Initialise event data

      DO i = 0, 4095
       data( i ) = 0
       hit( i ) = .FALSE.
      ENDDO

      first = .true.
      ts_old = 0
      e_time_old = 0
      count = 0
      total = 0

      DO i = 0, 127
       gain( i ) = 1.0
       offset( i ) = 0.0
      ENDDO
 
      DO i = 0, 31
       w( i ) = 0
      ENDDO

      DO i = 0, 7
       c( i ) = 1.0
      ENDDO

      DO i = 1, 32
       scaler( i ) = 0
       scaler_old( i ) = 0
       rates( i ) = 0.0
      ENDDO

      DO i = 1, 6
       DO j = 1, 2
        old_ts( i, j ) = 0
       ENDDO
      ENDDO

C     Initialise time

      t1 = SECNDS(0.0)

C     Read program variables via NAMELIST I/O

      OPEN( 1, FILE = '/homes/npg/td/GREAT/variables.dat',
     +         IOSTAT = ierr )
      IF ( ierr.NE.0 ) THEN
       WRITE( 6, * ) ' *** OPEN I/O error:', ierr
       RETURN
      ENDIF
      READ( 1, NML = variables, IOSTAT = ierr )
      IF ( ierr.NE.0 ) THEN
       WRITE( 6, * ) ' *** READ I/O error:', ierr
      ENDIF
      CLOSE( 1, IOSTAT = ierr )
      IF ( ierr.NE.0 ) THEN
       WRITE( 6, * ) ' *** CLOSE I/O error:', ierr
       RETURN
      ENDIF  

C     Display program variables

      DO i = 0, 4095, 8
       WRITE( 6, 9001 ) i, i+7, ( gain( j ), j = i, i+7 )
      ENDDO

      DO i = 0, 4095, 8
       WRITE( 6, 9002 ) i, i+7, ( offset( j ), j = i, i+7 )
      ENDDO

      DO i = 0, 7, 8
       WRITE( 6, 9003 ) i, i+7, ( c(j), j = 1, 8 )
      ENDDO

      DO i = 0, 31, 8
       WRITE( 6, 9004 ) i, i+7, ( w(j), j = i, i+7 )
      ENDDO

      DO i = 1, 6
       WRITE( 6, 9005 ) i, dsssd_a(i), dsssd_b(i),
     +                     dsssd_c(i), dsssd_d(i)
      ENDDO

      WRITE ( 6, * ) ' *** Entry init ends'

      RETURN

C----67---------------------------------------------------------------72------80

      ENTRY sortin

      items = items + 1

      IF ( MOD( items, 10000000 ).EQ.0 ) THEN

       t2 = SECNDS( t1 )
       delta_t = t2 - t2_old
       WRITE( 6, 9010 ) items, FLOAT( items - items_old ) / delta_t,
     +                  events, FLOAT( events - events_old ) / delta_t
       items_old = items
       events_old = events
       t2_old = t2

      ENDIF

      IF ( MOD( items, 50000 ).EQ.0 ) THEN

       t4 = DFLOAT( ts ) * 10.0D-9 - t3
       delta_t = t4 - t4_old

       IF ( delta_t.GE.1.0D+00 ) THEN

        DO i = 1, 32
         rates( i ) = DFLOAT( scaler( i ) - scaler_old( i ) ) / delta_t
        ENDDO
        WRITE( 6, * ) ' '
        DO i = 1, 6
         WRITE( 6, 9020 ) i, scaler( i ), scaler_old( i ),
     +                    delta_t, rates( i )
         sc_channel = INT ( MOD( t4, 65536.0 ) + 0.5 )
         CALL set1d( i+300, sc_channel, INT( rates( i ) + 0.5 ) )
        ENDDO
        DO i = 7, 12
         WRITE( 6, 9030 ) i-6, scaler( i ), scaler_old( i ),
     +                    delta_t, rates( i )
         sc_channel = INT ( MOD( t4, 65536.0 ) + 0.5 )
         CALL set1d( i+300, sc_channel, INT( rates( i ) + 0.5 ) )
        ENDDO
        DO i = 1, 32
         scaler_old( i ) = scaler( i )
        ENDDO
        t4_old = t4
       ENDIF

      ENDIF

C----67---------------------------------------------------------------72------80
C     Event data

C     For Linux/x64 & Windows/x86 least significant 16-bit word i2(1)
C     For Solaris/SPARC least significant 16-bit word i2(2)

C     GREAT 3.2.1 format
C
C     Other information
C      gid[0]=-1
C     gdata[0]=module number
C     gdata[1]=information type (2=Pause, 3=Resume, 4=SYNC100, 6=FEE64 disc etc)
C     gdata[2]=information field (bits 16-19)
C     gdata[3]=information field (bits 0-15)
C     gdata[4]=time stamp (bits 16-27)
C     gdata[5]=time stamp (bits 0-15) 
C
C     ADC data format
C
C       gid[0]=channel ident (FEE64 module bits 6-11, channel bits 0-5)
C     gdata[0]=fail/veto bits (AIDA: fail=0, veto=0 LEC/MEC, veto=1 HEC)
C     gdata[1]=?
C     gdata[2]=ADC data
C     gdata[3]=time stamp (bits 16-27)
C     gdata[4]=time stamp (bits 0-15) 

C----67---------------------------------------------------------------72------80
C     gid = - 1   Other information

      IF ( gid(0).EQ.-1 ) THEN

       i2(2) = 0
       i2(1) = gdata(0)
       module = AND( i4, Z'0000003f' )
       i2(1) = gdata(1)
       type = AND( i4, Z'0000000f' )
       i2(2) = gdata(2)
       i2(1) = gdata(3)
       information = AND( i4, Z'000fffff' )
       i2(2) = gdata(4)
       i2(1) = gdata(5)
       ts28 = AND( i4, Z'0fffffff' )

       IF ( type.EQ.2 ) THEN

C----67---------------------------------------------------------------72------80
C     PAUSE timestamp

        ts48 = information

        i8 = 0
        i4_2( 1 ) = ts48
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

       ELSEIF( type.EQ.3 ) THEN

C----67---------------------------------------------------------------72------80
C     RESUME timestamp

        ts48 = information

        i8 = 0
        i4_2( 1 ) = ts48
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

       ELSEIF( type.EQ.4 ) THEN

C----67---------------------------------------------------------------72------80
C     SYNC100 timestamp

        ts48 = information

        i8 = 0
        i4_2( 1 ) = ts48
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

        IF ( first_ts ) THEN
         t3 = DFLOAT( ts ) * 10.0D-09
         first_ts = .FALSE.
C         write( 6, * ) ' *** t3:', t3
        ENDIF

       ELSEIF( type.EQ.6 ) THEN

C----67---------------------------------------------------------------72------80
C     FEE64 discriminator

        i8 = 0
        IF ( ts28.LE.Z'00000A0' ) THEN
         i4_2( 1 ) = ts48 + 1
        ELSE
         i4_2( 1 ) = ts48
        ENDIF
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

        disc = AND( information, Z'0000ffff' )
        asic = AND( RSHIFT( information, 16 ), Z'0000000f' )
        m_disc = 0
        DO i = 0, 15
         IF ( btest( disc, i ) ) THEN
          m_disc = m_disc + 1
         ENDIF
        ENDDO

C       Increment ts spectra per FEE64 module
        j1 = MOD( RSHIFT( ts, 11 ), 65536 )
        CALL incv1d( module + 100, j1, m_disc)

C       Increment ts spectra per FEE64 module
        j2 = MOD( RSHIFT( ts, 11 ), 65536 )
        ch = ( ( module - 1 ) * 4 ) + asic + 100
        CALL incv2d( 1000, ch, j2, m_disc )

       ELSEIF( type.EQ.8 ) THEN

C----67---------------------------------------------------------------72------80
C     MBS information

        i8 = 0
        IF ( ts28.LE.Z'00000A0' ) THEN
         i4_2( 1 ) = ts48 + 1
        ELSE
         i4_2( 1 ) = ts48
        ENDIF
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

        information_index = AND( RSHIFT(information,16), Z'0000000f' )
        mbs_data( information_index ) = AND( information, Z'0000ffff' )

       ELSE

C----67---------------------------------------------------------------72------80
C     Something else ...

        i8 = 0
        IF ( ts28.LE.Z'00000A0' ) THEN
         i4_2( 1 ) = ts48 + 1
        ELSE
         i4_2( 1 ) = ts48
        ENDIF
        ts = LSHIFT( i8, 28 )
        i8 = 0
        i4_2(1) = ts28
        ts = ts + i8

       ENDIF
 
      ELSE

C----67---------------------------------------------------------------72------80
C     ADC data

       i2(2) = gdata(0)
       i2(1) = gdata(1)
       range = AND( i4, Z'00000001' )
       i2(1) = gid(0)
       channel_ident = AND( i4, Z'00000fff' )
       module = AND( RSHIFT( channel_ident, 6 ), Z'0000003f' )
       channel = AND( channel_ident, Z'0000003f' )
       i2(1) = gdata(2)
       adc_data = AND( i4, Z'0000ffff' )
       i2(2) = gdata(3)
       i2(1) = gdata(4)
       ts28 = AND( i4, Z'0fffffff' )

       i8 = 0
       IF ( ts28.LE.Z'00000A0' ) THEN
        i4_2( 1 ) = ts48 + 1
       ELSE
        i4_2( 1 ) = ts48
       ENDIF
       ts = LSHIFT( i8, 28 )
       i8 = 0
       i4_2(1) = ts28
       ts = ts + i8

C      Increment ts spectra per FEE64 module
       j1 = MOD( RSHIFT( ts, 11 ), 65536 )
       IF ( j1.LT.j1_old ) THEN
        DO l = 1, 24
         DO k = 0, 65535
          CALL set1d( l, k, 0 )
          CALL set1d( l + 100, k, 0 )
         ENDDO
        ENDDO
       ENDIF
       CALL inc1d( module, j1 )
       j1_old = j1

C      Increment ts spectra per FEE64 module
       j2 = MOD( RSHIFT( ts, 11 ), 65536 )
       IF ( j2.LT.j2_old ) THEN
        DO l = 0, 195 
         DO k = 0, 4095
          CALL set2d( 1000, l, k, 0 )
         ENDDO
        ENDDO
        DO l = 200, 295 
         DO k = 0, 4095
          CALL set2d( 1000, l, k, 0 )
         ENDDO
        ENDDO
       ENDIF
       ch = channel + ( module - 1 ) * 64 + ( range * 2048 )
       adc_data = INT( ABS( adc_data - 32768 ) - offset(ch) + 0.5 )
       IF ( ch.LT.1536 ) THEN
        CALL inc2d( 1000, ch/16, j2 )
       ELSEIF ( ch.GE.2048 ) THEN
        CALL inc2d( 1000, ch/16 + 72, j2 )
       ENDIF
       j2_old = j2

      ENDIF

C----67---------------------------------------------------------------72------80
C     Build multiparameter ADC event (dt < 2us/10ns < 200 ticks)

      IF ( gid(0).NE.-1 ) THEN

       channel = bb18order( channel )
       ch = channel + ( module - 1 ) * 64 + ( range * 2048 )

       IF ( first ) THEN
        hit( ch ) = .TRUE.
        data( ch ) = adc_data
        first = .false.
        ts_old = ts
        dt = 0
        e_time = ts
       ELSE

        dt = ts - ts_old
        IF ( dt.LT.0 ) THEN 
         WRITE( 6, * ) ' *** time warp: event:', events, ts, ts_old, dt
         time_warp = time_warp + 1
        ENDIF
        ts_old = ts

        IF ( dt.GT.200 ) THEN
         GOTO 100
        ELSEIF( dt.GE.0 .AND. dt.LE.200 ) THEN
         hit(ch) = .TRUE.
         data(ch) = adc_data
        ENDIF
       ENDIF 
      ENDIF

      RETURN

  100 CONTINUE

C----67---------------------------------------------------------------72------80      
C     Sort multiparameter ADC event

      events = events + 1

C     DSSSD #   FEE64 #
C               A  B  C  D
C     1         17 20 22 23
C     2         18 19 21 24
C     3          9 12 14 15
C     4         10 11 13 16
C     5          1  4  6  7
C     6          2  3  5  8

      DO i = 0, 4095
       IF ( hit(i) ) THEN
        CALL inc1d( 201, i )
       ENDIF
      ENDDO

C----67---------------------------------------------------------------72------80
C     Re-order LEC data

      DO j = 1, 6
       k = ( dsssd_a( j ) - 1 ) * 64
       l = ( j - 1 ) * 256
       DO i = k, k + 63
        IF ( hit( i ) ) THEN
         idata( l ) = data( i )
         ihit( l ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_c( j ) - 1 ) * 64
       l = ( j - 1 ) * 256
       DO i = k + 63, k, -1
        IF ( hit( i ) ) THEN
         idata( l + 64 ) = data( i )
         ihit( l + 64 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_b( j ) - 1 ) * 64
       l = ( j - 1 ) * 256
       DO i = k, k + 63
        IF ( hit( i ) ) THEN
         idata( l + 128 ) = data( i )
         ihit( l + 128 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_d( j ) - 1 ) * 64
       l = ( j - 1 ) * 256
       DO i = k + 63, k, -1
        IF ( hit( i ) ) THEN
         idata( l + 192 ) = data( i )
         ihit( l + 192 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
      ENDDO

C----67---------------------------------------------------------------72------80      
C     Re-order HEC data

      DO j = 1, 6
       k = ( dsssd_a( j ) - 1 ) * 64 + 2048
       l = ( j - 1 ) * 256 + 2048
       DO i = k, k + 63
        IF ( hit( i ) ) THEN
         idata( l ) = data( i )
         ihit( l ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_c( j ) - 1 ) * 64 + 2048
       l = ( j - 1 ) * 256 + 2048
       DO i = k + 63, k, -1
        IF ( hit( i ) ) THEN
         idata( l + 64 ) = data( i )
         ihit( l + 64 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_b( j ) - 1 ) * 64 + 2048
       l = ( j - 1 ) * 256 + 2048
       DO i = k, k + 63
        IF ( hit( i ) ) THEN
         idata( l + 128 ) = data( i )
         ihit( l + 128 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
       k = ( dsssd_d( j ) - 1 ) * 64 + 2048
       l = ( j - 1 ) * 256 + 2048
       DO i = k + 63, k, -1
        IF ( hit( i ) ) THEN
         idata( l + 192 ) = data( i )
         ihit( l + 192 ) = .TRUE.
        ENDIF
        l = l + 1
       ENDDO
      ENDDO

      DO i = 0, 4095
       IF ( ihit(i) ) THEN
        CALL inc1d( 200, i )
        CALL inc2d( 1001, i, RSHIFT( idata(i), 4 ) )
       ENDIF
      ENDDO

C----67---------------------------------------------------------------72------80      

      ptr = 0

C     DSSSD #1

      m_p = 0
      DO i = ptr, ptr+127
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+128, ptr+255
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2000, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 1 ) = scaler( 1 ) + 1
       CALL inc1d( 2030, RSHIFT( e_time - old_ts( 1, 1 ) , 8 ) )
       old_ts( 1, 1 ) = e_time
       DO i = ptr, ptr+127
        DO j = ptr+128, ptr+255
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2010, i - ptr, j - (ptr+128) )
          CALL inc2d( 2020, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - ptr, j - (ptr+128), 1 ) = e_time
          dt = decay_ts( i - ptr, j - (ptr+128), 1 ) - 
     +         implant_ts( i - ptr, j - (ptr+128), 1 )
          CALL inc1d( 2200, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #2

      m_p = 0
      DO i = ptr+256, ptr+383
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+384, ptr+511
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2001, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 2 ) = scaler( 2 ) + 1
       CALL inc1d( 2031, RSHIFT( e_time - old_ts( 2, 1 ) , 8 ) )
       old_ts( 2, 1 ) = e_time
       DO i = ptr+256, ptr+383
        DO j = ptr+384, ptr+511
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2011, i- (ptr+256), j - (ptr+384) )
          CALL inc2d( 2021, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - (ptr+256), j - (ptr+384), 2 ) = e_time
          dt = decay_ts( i - (ptr+256), j - (ptr+384), 2  ) - 
     +         implant_ts( i - (ptr+256), j - (ptr+384), 2  )
          CALL inc1d( 2201, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #3

      m_p = 0
      DO i = ptr+512, ptr+639
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+640, ptr+767
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2002, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 3 ) = scaler( 3 ) + 1
       CALL inc1d( 2032, RSHIFT( e_time - old_ts( 3, 1 ) , 8 ) )
       old_ts( 3, 1 ) = e_time
       DO i = ptr+512, ptr+639
        DO j = ptr+640, ptr+767
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2012, i - (ptr+512), j - (ptr+640) )
          CALL inc2d( 2022, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - (ptr+512), j - (ptr+640), 3 ) = e_time
          dt = decay_ts( i - (ptr+512), j - (ptr+640), 3  ) - 
     +         implant_ts( i - (ptr+512), j - (ptr+640), 3  )
          CALL inc1d( 2202, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #4

      m_p = 0
      DO i = ptr+768, ptr+895
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+896, ptr+1023
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2003, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 4 ) = scaler( 4 ) + 1
       CALL inc1d( 2033, RSHIFT( e_time - old_ts( 4, 1 ) , 8 ) )
       old_ts( 4, 1 ) = e_time
       DO i = ptr+768, ptr+895
        DO j = ptr+896, ptr+1023
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2013, i - (ptr+768), j - (ptr+896) )
          CALL inc2d( 2023, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - (ptr+768), j - (ptr+896), 4 ) = e_time
          dt = decay_ts( i - (ptr+768), j - (ptr+896), 4 ) - 
     +         implant_ts( i - (ptr+768), j - (ptr+896), 4  )
          CALL inc1d( 2203, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #5

      m_p = 0
      DO i = ptr+1024, ptr+1151
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+1152, ptr+1279
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2004, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 5 ) = scaler( 5 ) + 1
       CALL inc1d( 2034, RSHIFT( e_time - old_ts( 5, 1 ) , 8 ) )
       old_ts( 5, 1 ) = e_time
       DO i = ptr+1024, ptr+1151
        DO j = ptr+1152, ptr+1279
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2014, i - (ptr+1024), j - (ptr+1152) )
          CALL inc2d( 2024, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = e_time
          dt = decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) - 
     +         implant_ts( i - (ptr+1024), j - (ptr+1152), 5  )
          CALL inc1d( 2204, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #6

      m_p = 0
      DO i = ptr+1280, ptr+1407
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+1408, ptr+1535
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2005, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 6 ) = scaler( 6 ) + 1
       CALL inc1d( 2035, RSHIFT( e_time - old_ts( 6, 1 ) , 8 ) )
       old_ts( 6, 1 ) = e_time
       DO i = ptr+1280, ptr+1407
        DO j = ptr+1408, ptr+1535
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2015, i - (ptr+1280), j - (ptr+1408) )
          CALL inc2d( 2025, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = e_time
          dt = decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) - 
     +         implant_ts( i - (ptr+1280), j - (ptr+1408), 6  )
          CALL inc1d( 2205, RSHIFT( dt , 8 ) )
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C----67---------------------------------------------------------------72------80
      ptr = 2048

C     DSSSD #1

      m_p = 0
      DO i = ptr, ptr+127
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+128, ptr+255
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2100, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 7 ) = scaler( 7 ) + 1
       CALL inc1d( 2130, RSHIFT( e_time - old_ts( 1, 2 ) , 8 ) )
       old_ts( 1, 2 ) = e_time
       DO i = ptr, ptr+127
        DO j = ptr+128, ptr+255
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2110, i - ptr, j - (ptr+128) )
          CALL inc2d( 2120, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - ptr, j - (ptr+128), 1 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #2

      m_p = 0
      DO i = ptr+256, ptr+383
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+384, ptr+511
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2101, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 8 ) = scaler( 8 ) + 1
       CALL inc1d( 2131, RSHIFT( e_time - old_ts( 2, 2 ) , 8 ) )
       old_ts( 2, 2 ) = e_time
       DO i = ptr+256, ptr+383
        DO j = ptr+384, ptr+511
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2111, i- (ptr+256), j - (ptr+384) )
          CALL inc2d( 2121, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - (ptr+256), j - (ptr+384), 2 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #3

      m_p = 0
      DO i = ptr+512, ptr+639
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+640, ptr+767
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2102, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 9 ) = scaler( 9 ) + 1
       CALL inc1d( 2132, RSHIFT( e_time - old_ts( 3, 2 ) , 8 ) )
       old_ts( 3, 2 ) = e_time
       DO i = ptr+512, ptr+639
        DO j = ptr+640, ptr+767
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2112, i - (ptr+512), j - (ptr+640) )
          CALL inc2d( 2122, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - (ptr+512), j - (ptr+640), 3 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #4

      m_p = 0
      DO i = ptr+768, ptr+895
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+896, ptr+1023
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2103, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 10 ) = scaler( 10 ) + 1
       CALL inc1d( 2133, RSHIFT( e_time - old_ts( 4, 2 ) , 8 ) )
       old_ts( 4, 2 ) = e_time
       DO i = ptr+768, ptr+895
        DO j = ptr+896, ptr+1023
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2113, i - (ptr+768), j - (ptr+896) )
          CALL inc2d( 2123, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - (ptr+768), j - (ptr+896), 4 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #5

      m_p = 0
      DO i = ptr+1024, ptr+1151
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+1152, ptr+1279
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2104, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 11 ) = scaler( 11 ) + 1
       CALL inc1d( 2134, RSHIFT( e_time - old_ts( 5, 2 ) , 8 ) )
       old_ts( 5, 2 ) = e_time
       DO i = ptr+1024, ptr+1151
        DO j = ptr+1152, ptr+1279
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2114, i - (ptr+1024), j - (ptr+1152) )
          CALL inc2d( 2124, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF

C     DSSSD #6

      m_p = 0
      DO i = ptr+1280, ptr+1407
       IF ( ihit( i ) ) THEN
        m_p = m_p + 1
       ENDIF
      ENDDO
      m_n = 0
      DO i = ptr+1408, ptr+1535
       IF ( ihit( i ) ) THEN
        m_n = m_n + 1
       ENDIF
      ENDDO
      CALL inc2d( 2105, m_p, m_n )

      IF ( m_p.GT.0 .AND. m_p.LT.8 
     +     .AND.
     +     m_n.GT.0 .AND. m_n.LT.8 ) THEN
       scaler( 12 ) = scaler( 12 ) + 1
       CALL inc1d( 2135, RSHIFT( e_time - old_ts( 6, 2 ) , 8 ) )
       old_ts( 6, 2 ) = e_time
       DO i = ptr+1280, ptr+1407
        DO j = ptr+1408, ptr+1535
         IF ( ihit( i ) .AND. ihit( j ) ) THEN
          CALL inc2d( 2115, i - (ptr+1280), j - (ptr+1408) )
          CALL inc2d( 2125, INT( 0.07 * idata( i ) + 0.5 ),
     +                      INT( 0.07 * idata( j ) + 0.5 ) )
          implant_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = e_time
         ENDIF
        ENDDO
       ENDDO
      ENDIF


  200 CONTINUE

C----67---------------------------------------------------------------72------80      
C     Re-initialise event data

      DO i = 0, 4095
       IF ( hit(i) ) THEN
        data( i ) = 0
        hit( i ) = .false.
       ENDIF
       IF ( ihit(i) ) THEN
        idata( i ) = 0
        ihit( i ) = .false.
       ENDIF
      ENDDO

      first = .true.

      RETURN 

C----67---------------------------------------------------------------72------80      

      ENTRY finish

      WRITE( 6, 9100 )

      t2 = SECNDS( t1 )

      WRITE( 6, 9110 ) items, FLOAT( items ) / t2
      WRITE( 6, 9120 ) events, FLOAT( events ) / t2
      WRITE( 6, 9130 ) time_warp, FLOAT( time_warp ) / t2

      t4 = DFLOAT( ts ) * 10.0D-9 - t3
      DO i = 1, 32
       rates( i ) = scaler( i ) / t4
      ENDDO
      DO i = 1, 6
       WRITE( 6, 9020 ) i, scaler( i ), scaler_old( i ), 
     +                  t4, rates( i )
      ENDDO
      DO i = 7, 12
       WRITE( 6, 9030 ) i-6, scaler( i ), scaler_old( i ), 
     +                  t4, rates( i )
      ENDDO

      WRITE( 6, 9140 )

      RETURN

C----67---------------------------------------------------------------72------80

 9001 FORMAT( '   gain(', i4, '-', i4, ')', 8f8.5 )
 9002 FORMAT( ' offset(', i4, '-', i4, ')', 8f8.2 )
 9003 FORMAT( '      c(', i4, '-', i4, ')', 8f8.3 )
 9004 FORMAT( '      w(', i4, '-', i4, ')', 8i8 )
 9005 FORMAT( ' DSSSD #', i1, 4(1x,i2) )

 9010 FORMAT( ' *** data items: ', i10, ' (', F10.2,' Hz)',
     +        '  events: ', i10, ' (', F10.2,' Hz)' )
 9020 FORMAT( ' *** DSSSD #', i2, ' count:', i10, ' old count:', i10,
     +        ' dt:', F10.2, ' s  LEC rate:', F10.2, ' Hz' )
 9030 FORMAT( ' *** DSSSD #', i2, ' count:', i10, ' old count:', i10,
     +        ' dt:', F10.2, ' s  HEC rate:', F10.2, ' Hz' )

 9100 FORMAT(/' *** ENTRY finish')
 9110 FORMAT(/' *** data items: ', i10, ' (', F10.2,' Hz)' )
 9120 FORMAT( ' *** ADC events: ', i10, ' (', F10.2,' Hz)' )
 9130 FORMAT( ' *** time warps: ', i10, ' (', F10.2,' Hz)' )
 9140 FORMAT(/' *** ENTRY finish ends')

C----67---------------------------------------------------------------72------80

      END

C----67---------------------------------------------------------------72------80

      FUNCTION bb18order( channel )

      INTEGER array( 0:63 ), bb18order, channel

C     ASIC # 0 channel # 0 = array(0)
C     ASIC # 1 channel # 0 = array(16)
C     ASIC # 2 channel # 0 = array(32)
C     ASIC # 3 channel # 0 = array(48)
C     Array contents correspond to the MSL type BB18 adaptor J1 connector
C     strip sequence # 0-63
 
      DATA array /
     +  62, 63, 59, 60, 61, 56, 57, 58, 52, 53, 54, 55, 49, 50, 51, 45,
     +  46, 47, 48, 42, 43, 44, 38, 39, 40, 41, 35, 36, 37, 31, 32, 33,
     +  34, 28, 29, 30, 24, 25, 26, 27, 21, 22, 23, 17, 18, 19, 20, 14,
     +  15, 16, 10, 11, 12,  7,  3,  0,  8,  4,  1,  9,  5,  2, 13,  6 /
  
      bb18order = array( channel )

      RETURN

C----67---------------------------------------------------------------72------80

      END

C----67---------------------------------------------------------------72------80