| Attachment 6: |
implantdecay4.f
*trigger
128
*oned
1..32 s 65536
101..132 s 65536
201..232 s 65536
250..254 s 4096
301..332 s 65536
400 s 64
500..511 s 4096
2130..2135 s 65536
2030..2035 s 65536
2200..2205 s 65536
2210..2215 s 65536
*twod
1000..1001 s 4096 4096
1100..1105 s 512 512
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
2300..2305 s 1024 1024
2310..2315 s 1024 1024
2400..2405 s 1024 1024
2410..2415 s 1024 1024
2500..2505 s 1024 1024
2510..2515 s 1024 1024
2600..2605 s 256 256
2700..2705 s 1024 1024
2710..2715 s 1024 1024
2800..2805 s 1024 1024
2810..2815 s 1024 1024
2900..2905 s 1024 1024
2910..2915 s 1024 1024
3000..3005 s 1024 1024
3010..3015 s 1024 1024
3100..3105 s 1024 1024
4000 s 64 64
*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, ctr, data(0:4095), disc
INTEGER dsssd_a( 6 ), dsssd_b( 6 ), dsssd_c( 6 ), dsssd_d( 6 )
INTEGER*8 dt, dt1, dt2
INTEGER ediff, events, events_old, fee(32)
INTEGER hec_e_sum_x, hec_e_sum_y
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, m, mbs_data(0:3), module, m_disc, ptr, lec(8)
INTEGER m_p_lec(8), m_n_lec(8), m_p_hec(8), m_n_hec(8)
INTEGER next_ch, next_adc_data, next_module
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, next_ts
INTEGER implant_e( 0:127, 0:127, 1:8 )
INTEGER*8 implant_ts( 0:127, 0:127, 1:8 )
INTEGER*8 decay_ts( 0:127, 0:127, 1:8 )
INTEGER*8 old_decay_ts( 0:127, 0:127, 1:8 )
INTEGER*8 older_decay_ts( 0:127, 0:127, 1:8 )
INTEGER type, w(0:31), zzz
INTEGER z_lec, z_lec_veto, z_hec
INTEGER*8 hit_ts(0:4095), ihit_ts(0:4095), tdiff1, tdiff2
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 - implant-decay - June 2017'
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.
hit_ts( i ) = 0
ihit_ts( i ) = 0
ENDDO
DO i = 1, 32
fee(i) = 0
ENDDO
first = .true.
ts_old = 0
e_time_old = 0
count = 0
total = 0
ctr = 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
C WRITE( 6, * ) ' '
DO i = 1, 6
C WRITE( 6, 9020 ) i, scaler( i ), scaler_old( i ),
C + 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
C WRITE( 6, 9030 ) i-6, scaler( i ), scaler_old( i ),
C + 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
... 1616 more lines ...
|