*trigger
128  
*oned
0..127  s 4096
2000  s 4096
3000..3005  s 65536
4000  s 4096
4001..4002  s 512
4004  s 4096
4006..4007 s 4096
4104  s 4096
4106..4107 s 4096
*twod
4003  s 512 512
4005  s 512 512
4008  s 16 16
4009  s 512 512
4010  s 512 512 
4103  s 512 512
4105  s 512 512
4108  s 16 16
4109  s 512 512 
*vars
*sort
C----67---------------------------------------------------------------72------80
      SUBROUTINE init

      IMPLICIT none

      SAVE
C
C     External functions
C
      EXTERNAL dtime
C
      INTEGER and, int, rshift
C
      REAL dtime, float, rand
C
C     Parameter variables
C
      INTEGER max
      PARAMETER (max = 128)
C
C     Local variables
C
      INTEGER asic, channel, adc_data, range
      INTEGER events, events_old
      INTEGER i, j, k, l, m_i, m_d
      INTEGER*2 i2(2), i2_2(4)
      INTEGER i4, ierr, iflag, ireturn
      INTEGER id, ts1, ts2, ts3
      INTEGER i_old(2), adc_data_old
      INTEGER ts1_old(2), ts2_old(2), ts3_old(2)
      INTEGER dt, dt1, dt2, dt3, iy
      INTEGER time_warp, invalid_id, noadcs
      INTEGER data( 0:127 ), count, total, ediff, w(32)
      integer*8 i8, ts, ts_old, timestamp, i_ts_array( 0:15, 0:15 )
      integer*8 decay_time
C
      REAL c(8), e, gain(0:max-1), offset(0:max-1)
      REAL rate, time(2), mean
C
      LOGICAL hit( 0:127 ), first
C
C     Namelists
C
      NAMELIST /variables/ gain, offset, c, w
C
C     Common variables
C
      INTEGER*2 gdata(0:max-1)
C
      COMMON /fdata/ gdata
C
C     Common variables
C
      INTEGER*2 gid(0:max-1)
C
      COMMON /fid/ gid
C
C     Common variables
C
      INTEGER mult
C
      COMMON /fmult/ mult
C
      EQUIVALENCE ( i8, i2_2(1) )
      EQUIVALENCE ( i4, i2(1) )
C
C----67---------------------------------------------------------------72------80

      WRITE ( 6, * ) ' *** AIDA sort2 - August 2011'
      WRITE ( 6, * ) ' *** Entry init commences'

C     Initialise counters

      events = 0
      events_old = 0

      time_warp = 0
      invalid_id = 0

C     Initialise event data

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

      first = .true.
      count = 0
      total = 0

C     Read program variables via NAMELIST I/O

      OPEN( 1, FILE = 'D:/AIDA_0811/online/sort/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, 127, 8
       WRITE( 6, 9001 ) i, i+7, ( gain( j ), j = i, i+7 )
      ENDDO

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

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

      DO i = 1, 32, 8
       WRITE( 6, 9004 ) i, i+7, ( w(j), j = i, i+7 )
      ENDDO

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

      RETURN

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

      ENTRY sortin

      events = events + 1

      IF ( MOD( events, 1000000 ).EQ.0 ) THEN
       rate = FLOAT( events - events_old ) / dtime(time)
       WRITE( 6, * ) ' *** event:', events, ' (', rate,' events/s)'
       events_old = events
      ENDIF

C----67---------------------------------------------------------------72------80
C     Event data
C
C     ID for ADC data
C     0x4400 + GroupBase + [(asic-1)*32] + [range*16] + channel = 0x4401-0x4480
C     GroupBase = 1
C     asic = 0..3
C     range = 0..1
C     channel = 0..15
C
C     ID for fast comparator data
C     0x4400 + GroupBase + 128 = 0x4481
C
C     For Linux/x64 least significant 16-bit word i2(1)
C     For Sun/Solaris least significant 16-bit word i2(2)
C 
      i2(1) = gid(0)
      id = AND( i4, z'000000ff' ) - 1
      i2(1) = gdata(0)  
      adc_data = i4
      i2(1) = gid(1)
      ts1 = i4
      i2(1) = gdata(1)
      ts2 = i4
      i2(1) = gid(2)
      ts3 = i4

C     ADC data

      IF ( id.LT.128 ) THEN

       channel = AND( id, z'000f' )
       range = AND( RSHIFT( id, 4 ), z'0001' )
       asic = AND( RSHIFT( id, 5 ), z'0007' ) 
       i = (asic*16) + (range*64) + channel
       IF ( i.GE.32 .AND. i.LE.47 ) adc_data = 32768 - adc_data
       IF ( i.GE.48 .AND. i.LE.63 ) adc_data = adc_data - 32768
       IF ( i.GE.96 .AND. i.LE.111 ) adc_data = 32768 - adc_data
       IF ( i.GE.112 .AND. i.LE.127 ) adc_data = adc_data - 32768
       i2_2(1) = ts1
       i2_2(2) = ts2
       i2_2(3) = ts3
       i2_2(4) = 0
       ts = i8
       dt = ts - ts_old

       IF ( dt.LT.0 ) THEN 

        WRITE( 6, 9100 ) events, dt
        time_warp = time_warp + 1

       ENDIF

C      dt for ADC data clock units (5ns timestamp)

       CALL inc1d( 2000, INT( dt / 200.0 + 0.5 ) )
       dt1 = ts1 - ts1_old(1)
       dt2 = ts2 - ts2_old(1)
       dt3 = ts3 - ts3_old(1)
       CALL inc1d( 3000, ts1 )
       CALL inc1d( 3001, ts2 )
       CALL inc1d( 3002, ts3 )

      ELSEIF ( id.GT.128 ) THEN

       WRITE( 6, 9200 ) events, mult, id 
       invalid_id = invalid_id + 1

      ENDIF

C----67---------------------------------------------------------------72------80
C     Store current ADC event data

      IF ( id.LT.128 ) THEN
       i_old(1) = i
       adc_data_old = adc_data
       ts1_old(1) = ts1
       ts2_old(1) = ts2
       ts3_old(1) = ts3
       ts_old = ts
      ENDIF

C     Build multiparameter ADC event (dt < 8us/5ns < 1600 ticks)

      IF ( id.LT.128 ) THEN
       IF ( first ) THEN
        hit( i ) = .TRUE.
        data( i ) = adc_data
        first = .FALSE.
        timestamp = ts
       ELSE
        IF( dt.GE.0 .AND. dt.LE. 1600 ) THEN
         hit( i ) = .TRUE.
         data( i ) = adc_data
        ELSEIF ( dt.LT.0 .OR. dt.GT.1600 ) THEN
         GOTO 100
        ENDIF
       ENDIF 
      ENDIF

      RETURN

  100 CONTINUE

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

      m_d = 0
      m_i = 0

      DO i = 0, 63
       IF ( hit( i ) ) THEN
        m_d = m_d + 1 
        CALL inc1d( 4001, i )
       ENDIF
      ENDDO
      CALL inc1d( 4002, m_d )

      DO i = 64, 127
       IF ( hit( i ) ) THEN
        m_i = m_i + 1 
        CALL inc1d( 4001, i )
       ENDIF
      ENDDO
      CALL inc1d( 4002, m_i + 100 )

      IF ( m_i.GT.0 ) THEN 
       CALL inc1d( 4002, m_d + 200 )
      ENDIF

      DO i = 32, 47
       DO j = 48, 63
        IF ( hit(i) .AND. hit(j) ) THEN
         k = INT( gain(i) * ( data(i) - offset(i) ) + 0.5 ) 
         CALL inc1d( i, k )
         l = INT( gain(j) * ( data(j) - offset(j) ) + 0.5 )
         CALL inc1d( j, l )
         CALL inc2d( 4003, RSHIFT(k,2), RSHIFT(l,2) )
         ediff = k - l + 2048
         CALL inc1d( 4004, ediff )
         IF ( ediff.GE.w(1) .AND. ediff.LE.w(2) ) THEN
          CALL inc2d( 4005, RSHIFT(k,2), RSHIFT(l,2) ) 
          CALL inc1d( 4006, ediff )
          CALL inc1d( 4007, INT( 0.5*(k + l) + 0.5 ) )
          CALL inc2d( 4008, i-32, j-48 )
          CALL inc2d( 4009, i, RSHIFT(k,2) )
          CALL inc2d( 4009, j, RSHIFT(l,2) )
          decay_time = timestamp - i_ts_array( i-32, j-48 )
          CALL inc2d( 4010, RSHIFT(k,2), 
     +                INT( decay_time/200000.0 + 0.5 ) )
         ENDIF
        ENDIF
       ENDDO
      ENDDO

      DO i = 96, 111
       DO j = 112, 127
        IF ( hit(i) .AND. hit(j) ) THEN
         k = RSHIFT( data(i), 3 ) 
         CALL inc1d( i, k )
         l = RSHIFT( data(j), 3 ) 
         CALL inc1d( j, l )
         CALL inc2d( 4103, RSHIFT(k,3), RSHIFT(l,3) )
         ediff = k - l + 2048
         CALL inc1d( 4104, ediff )
         IF ( ediff.GE.w(3) .AND. ediff.LE.w(4) ) THEN
          CALL inc2d( 4105, RSHIFT(k,3),RSHIFT(l,3) ) 
          CALL inc1d( 4106, ediff )
          CALL inc1d( 4107, INT( 0.5*(k + l) + 0.5 ) )
          CALL inc2d( 4108, i-96, j-112 )
          CALL inc2d( 4109, i, RSHIFT(k,3) )
          CALL inc2d( 4109, j, RSHIFT(l,3) )
          i_ts_array( i-96, j-112 ) = timestamp
         ENDIF
        ENDIF
       ENDDO
      ENDDO

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

      DO i = 0, 127
       data( i ) = 0
       hit( i ) = .false.
      ENDDO

      first = .true.
      count = count + 1

      RETURN 

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

      ENTRY finish

      WRITE( 6, * ) ' *** Entry finish begins'

      WRITE( 6, * ) ' ***      events: ', events
      WRITE( 6, * ) ' ***  time warps: ', time_warp
      WRITE( 6, * ) ' *** invalid IDs: ', invalid_id
      WRITE( 6, * ) ' ***       count: ', count

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

      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 )
 9100 FORMAT( ' *** ERROR: event: ', i10, ' dt: ', i10, ' timewarp')
 9200 FORMAT( ' *** ERROR: event: ', i10, ' mult:', i4,
     +        ' unexpected id:', i4 )

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

      END

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