*trigger
128
*oned
1..32 s 65536
101..132 s 65536
*twod
1000 s 4096 4096
*vars
*sort
C----67---------------------------------------------------------------72------80
SUBROUTINE init
IMPLICIT none
SAVE
C
C External functions
C
EXTERNAL dtime
C
INTEGER and, lshift, rshift
C
LOGICAL btest
C
REAL float, secnds
C
C Parameter variables
C
INTEGER max
PARAMETER (max = 2048)
C
C Local variables
C
INTEGER adc_data, asic, ch, channel, channel_ident
INTEGER count, data(0:4095), disc
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
INTEGER ierr, information, information_index, int
INTEGER invalid_id, items, items_old, j, j1, j1_old, j2, j2_old, k
INTEGER l, mbs_data(0:3), module, m_disc
INTEGER range, time_warp, total
INTEGER*8 ts
INTEGER ts28
INTEGER ts48
INTEGER*8 ts_old
INTEGER type, w(0:31)
C
LOGICAL first, hit(0:4095)
C
REAL c(0:7), delta_t, gain(0:max-1), offset(0:max-1)
REAL t1, t2, t2_old
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, i4_2(1) )
EQUIVALENCE ( i4, i2(1) )
C
C----67---------------------------------------------------------------72------80
WRITE ( 6, * ) ' *** AIDA @ RIKEN - sync check - October 2016'
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, 2047
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
C Initialise time
t1 = SECNDS(0.0)
C Read program variables via NAMELIST I/O
OPEN( 1, FILE = '/home/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, 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 = 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
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
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
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 )
... 186 more lines ...
|