| Attachment 19: |
implantdecay.f
*trigger
128
*oned
1..32 s 65536
101..132 s 65536
200..202 s 4096
301..332 s 65536
400 s 64
2130..2135 s 65536
2030..2035 s 65536
2200..2205 s 65536
2210..2215 s 65536
*twod
1000..1001 s 4096 4096
1100 s 64 64
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
2400..2405 s 1024 1024
2500..2505 s 1024 1024
*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, m, mbs_data(0:3), module, m_disc, ptr
INTEGER m_p_lec(8), m_n_lec(8), m_p_hec(8), m_n_hec(8)
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 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 type, w(0:31), zzz
INTEGER z_lec, z_hec
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
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
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)
... 1039 more lines ...
|