| Attachment 17: |
sort3.f
*trigger
128
*oned
2000 s 16384
3000..3001 s 16384
3010..3015 s 16384
*twod
4000..4003 s 4096 4096
4010..4013 s 256 256
*vars
*sort
C----67---------------------------------------------------------------72------80
SUBROUTINE init
IMPLICIT none
SAVE
C
C External functions
C
EXTERNAL dtime
C
INTEGER and, int, rshift
C
C REAL dtime
REAL float, rand
C
C Parameter variables
C
INTEGER max
PARAMETER (max = 2048)
C
C Local variables
C
INTEGER asic, channel, ch, adc_data, range
INTEGER ch_old( 2 ), count2
INTEGER events, events_old, items, items_old
INTEGER i, j, k, l, m, m_p, m_n
INTEGER*2 i2(2), i2_2(4)
INTEGER i4, i4_2(2), ierr, iflag, ireturn
INTEGER module, mbs_data, information_index, information
INTEGER channel_ident
INTEGER id, ts1, ts2, ts3, ts28, ts48
INTEGER i_old(2), adc_data_old
INTEGER ts1_old(2), ts2_old(2), ts3_old(2)
INTEGER dt, dt1, dt2, dt3, iy, w(0:31)
INTEGER time_warp, invalid_id, noadcs, tag, type
INTEGER data( 0:4095 ), count, total
integer*8 i8, ts, ts_old, e_time, e_time_old
INTEGER m_1_p_hec, e_1_p_hec
INTEGER m_1_n_hec, e_1_n_hec
INTEGER m_2_p_hec, e_2_p_hec
INTEGER m_2_n_hec, e_2_n_hec
INTEGER m_3_p_hec, e_3_p_hec
INTEGER m_3_n_hec, e_3_n_hec
INTEGER mp, mn
C
REAL c(0:7), e, gain(0:max-1), offset(0:max-1), ediff
REAL rate, time(2), mean
REAL t1, t2, t2_old, secnds, delta_t
C
LOGICAL hit( 0:4095 ), 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, i4_2(1) )
EQUIVALENCE ( i4, i2(1) )
C
C----67---------------------------------------------------------------72------80
WRITE ( 6, * ) ' *** AIDA @ RIKEN - May 2015'
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 = '/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, 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, 100000000 ).EQ.0 ) THEN
t2 = SECNDS( t1 )
delta_t = t2 - t2_old
rate = FLOAT( items - items_old ) / delta_t
WRITE( 6, * ) ' *** item:', items, ' (', rate,' items/s)'
items_old = items
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
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
IF ( ts28.LT.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
ELSEIF( type.EQ.3 ) THEN
C----67---------------------------------------------------------------72------80
C RESUME timestamp
ts48 = information
i8 = 0
IF ( ts28.LT.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
ELSEIF( type.EQ.4 ) THEN
C----67---------------------------------------------------------------72------80
C SYNC100 timestamp
ts48 = information
i8 = 0
IF ( ts28.LT.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
ELSEIF( type.EQ.6 ) THEN
C----67---------------------------------------------------------------72------80
C FEE64 discriminator
i8 = 0
IF ( ts28.LT.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
... 231 more lines ...
|