*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 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 IF ( first_ts ) THEN t3 = DFLOAT( ts ) * 10.0D-09 first_ts = .FALSE. C write( 6, * ) ' *** t3:', t3 ENDIF 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 + 200, 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 ) ELSEIF( type.EQ.8 ) THEN C----67---------------------------------------------------------------72------80 C MBS information 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 information_index = AND( RSHIFT(information,16), Z'0000000f' ) mbs_data( information_index ) = AND( information, Z'0000ffff' ) DO i = 0, 15 IF ( btest( mbs_data( information_index ), i ) ) THEN CALL inc1d( 400, i + ( information_index * 16 ) ) ENDIF ENDDO ELSE C----67---------------------------------------------------------------72------80 C Something else ... 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 ENDIF ELSE C----67---------------------------------------------------------------72------80 C ADC data i2(2) = gdata(0) i2(1) = gdata(1) range = AND( i4, Z'00000001' ) i2(1) = gid(0) channel_ident = AND( i4, Z'00000fff' ) module = AND( RSHIFT( channel_ident, 6 ), Z'0000003f' ) channel = AND( channel_ident, Z'0000003f' ) i2(1) = gdata(2) adc_data = AND( i4, Z'0000ffff' ) i2(2) = gdata(3) i2(1) = gdata(4) ts28 = AND( i4, Z'0fffffff' ) 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 C Increment ts spectra per FEE64 module j1 = MOD( RSHIFT( ts, 11 ), 65536 ) IF ( j1.LT.j1_old ) THEN DO l = 1, 24 DO k = 0, 65535 CALL set1d( l, k, 0 ) CALL set1d( l + 100, k, 0 ) CALL set1d( l + 200, k, 0 ) ENDDO ENDDO ENDIF IF ( range.EQ.0 ) THEN CALL inc1d( module, j1 ) ELSE CALL inc1d( module + 100, j1 ) ENDIF j1_old = j1 C Increment ts spectra per FEE64 module j2 = MOD( RSHIFT( ts, 11 ), 65536 ) IF ( j2.LT.j2_old ) THEN DO l = 0, 195 DO k = 0, 4095 CALL set2d( 1000, l, k, 0 ) ENDDO ENDDO DO l = 200, 295 DO k = 0, 4095 CALL set2d( 1000, l, k, 0 ) ENDDO ENDDO ENDIF ch = channel + ( module - 1 ) * 64 + ( range * 2048 ) adc_data = INT( RSHIFT( ABS( adc_data - 32768 ), 3 ) + - offset(ch) + 0.5 ) IF ( ch.LT.1536 ) THEN CALL inc2d( 1000, ch/16, j2 ) ELSEIF ( ch.GE.2048 ) THEN CALL inc2d( 1000, ch/16 + 72, j2 ) ENDIF j2_old = j2 ENDIF C----67---------------------------------------------------------------72------80 C Build multiparameter ADC event (dt < 2us/10ns < 200 ticks) IF ( gid(0).NE.-1 ) THEN channel = bb18order( channel ) ch = channel + ( module - 1 ) * 64 + ( range * 2048 ) IF ( .NOT.first_ts ) THEN IF ( first ) THEN hit( ch ) = .TRUE. data( ch ) = adc_data hit_ts( ch ) = ts fee(module) = 1 first = .false. ts_old = ts dt = 0 e_time = ts C if ( ctr.le.100 ) then C write( 6, 10 ) ctr, module, ts C 10 format( ' *** 1 ', i3, 1x, i3, 1x, z12.12 ) C endif C ctr = ctr + 1 ELSE dt = ts - ts_old C if ( ctr.le.100 ) then C write( 6, * ) ' *** ts_old, e_time:', ts_old, e_time, ts, dt C endif IF ( dt.LT.0 ) THEN WRITE( 6, * ) ' *** time warp: event:', events, ts, ts_old, dt time_warp = time_warp + 1 ENDIF ts_old = ts IF ( dt.GT.200 ) THEN next_ch = ch next_ts = ts next_adc_data = adc_data next_module = module C if ( ctr.le.100 ) then C write( 6, 11 ) ctr, module, ts C 11 format( ' *** 2 ', i3, 1x, i3, 1x, z12.12 ) C endif C ctr = ctr + 1 GOTO 100 ELSEIF( dt.GE.0 .AND. dt.LE.200 ) THEN hit(ch) = .TRUE. hit_ts(ch) = ts data(ch) = adc_data fee(module) = 1 C if ( ctr.le.100 ) then C write( 6, 12 ) ctr, module, ts C 12 format( ' *** 3 ', i3, 1x, i3, 1x, z12.12 ) C endif C ctr = ctr + 1 ENDIF ENDIF ENDIF ENDIF RETURN 100 CONTINUE C----67---------------------------------------------------------------72------80 C Sort multiparameter ADC event events = events + 1 C DSSSD # FEE64 # C A B C D C 1 17 20 22 23 C 2 18 19 21 24 C 3 9 12 14 15 C 4 10 11 13 16 C 5 1 4 6 7 C 6 2 3 5 8 DO i = 1, 8 m_p_lec(i) = 0 m_n_lec(i) = 0 m_p_hec(i) = 0 m_n_hec(i) = 0 lec(i) = 0 ENDDO z_lec = 0 z_lec_veto = 0 z_hec = 0 m = 0 DO i = 0, 4095 IF ( hit(i) ) THEN CALL inc1d( 251, i ) m = m + 1 ENDIF ENDDO CALL inc1d( 252, m ) C Reject pulser events IF ( m.GT.500 ) GOTO 200 C----67---------------------------------------------------------------72------80 C Re-order LEC data DO j = 1, 6 k = ( dsssd_a( j ) - 1 ) * 64 l = ( j - 1 ) * 256 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l ) = data( i ) ihit( l ) = .TRUE. ihit_ts( l ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_c( j ) - 1 ) * 64 l = ( j - 1 ) * 256 DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 64 ) = data( i ) ihit( l + 64 ) = .TRUE. ihit_ts( l + 64 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_b( j ) - 1 ) * 64 l = ( j - 1 ) * 256 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 128 ) = data( i ) ihit( l + 128 ) = .TRUE. ihit_ts( l + 128 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_d( j ) - 1 ) * 64 l = ( j - 1 ) * 256 DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 192 ) = data( i ) ihit( l + 192 ) = .TRUE. ihit_ts( l + 192 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO ENDDO C----67---------------------------------------------------------------72------80 C Re-order HEC data DO j = 1, 6 k = ( dsssd_a( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 256 + 2048 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l ) = data( i ) ihit( l ) = .TRUE. ihit_ts( l ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_c( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 256 + 2048 DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 64 ) = data( i ) ihit( l + 64 ) = .TRUE. ihit_ts( l + 64 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_b( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 256 + 2048 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 128 ) = data( i ) ihit( l + 128 ) = .TRUE. ihit_ts( l + 128 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO k = ( dsssd_d( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 256 + 2048 DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 192 ) = data( i ) ihit( l + 192 ) = .TRUE. ihit_ts( l + 192 ) = hit_ts( i ) ENDIF l = l + 1 ENDDO ENDDO DO i = 0, 4095 IF ( ihit(i) ) THEN CALL inc1d( 250, i ) CALL inc2d( 1001, i, idata(i) ) ENDIF ENDDO C----67---------------------------------------------------------------72------80 C HEC events ptr = 2048 DO i = ptr, ptr+127 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec( 1 ) = m_p_hec( 1 ) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+128, ptr+255 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec( 1 ) = m_n_hec( 1 ) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2100, m_p_hec(1), m_n_hec(1) ) DO i = ptr+256, ptr+383 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec(2) = m_p_hec(2) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+384, ptr+511 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec(2) = m_n_hec(2) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2101, m_p_hec(2), m_n_hec(2) ) DO i = ptr+512, ptr+639 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec(3) = m_p_hec(3) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+640, ptr+767 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec(3) = m_n_hec(3) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2102, m_p_hec(3), m_n_hec(3) ) DO i = ptr+768, ptr+895 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec(4) = m_p_hec(4) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+896, ptr+1023 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec(4) = m_n_hec(4) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2103, m_p_hec(4), m_n_hec(4) ) DO i = ptr+1024, ptr+1151 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec(5) = m_p_hec(5) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+1152, ptr+1279 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec(5) = m_n_hec(5) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2104, m_p_hec(5), m_n_hec(5) ) DO i = ptr+1280, ptr+1407 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_p_hec(6) = m_p_hec(6) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO DO i = ptr+1408, ptr+1535 IF ( ihit( i ) .AND. idata( i ).GT.1 ) THEN m_n_hec(6) = m_n_hec(6) + 1 ELSE idata( i ) = 0 ihit( i ) = .FALSE. ENDIF ENDDO CALL inc2d( 2105, m_p_hec(6), m_n_hec(6) ) IF ( m_p_hec(1).GT.0 .AND. m_p_hec(1).LT.8 + .AND. + m_n_hec(1).GT.0 .AND. m_n_hec(1).LT.8 ) THEN z_hec = z_hec + 1 ENDIF C *** Adjust m_n_hec requirement due to missing y strips! *** IF ( m_p_hec(2).GT.0 .AND. m_p_hec(2).LT.8 + .AND. + m_n_hec(2).GT.0 .AND. m_n_hec(2).LT.8 ) THEN z_hec = z_hec + 2 ENDIF IF ( m_p_hec(3).GT.0 .AND. m_p_hec(3).LT.8 + .AND. + m_n_hec(3).GT.0 .AND. m_n_hec(3).LT.8 ) THEN z_hec = z_hec + 4 ENDIF IF ( m_p_hec(4).GT.0 .AND. m_p_hec(4).LT.8 + .AND. + m_n_hec(4).GT.0 .AND. m_n_hec(4).LT.8 ) THEN z_hec = z_hec + 8 ENDIF IF ( m_p_hec(5).GT.0 .AND. m_p_hec(5).LT.8 + .AND. + m_n_hec(5).GT.0 .AND. m_n_hec(5).LT.8 ) THEN z_hec = z_hec + 16 ENDIF IF ( m_p_hec(6).GT.0 .AND. m_p_hec(6).LT.8 + .AND. + m_n_hec(6).GT.0 .AND. m_n_hec(6).LT.8 ) THEN z_hec = z_hec + 32 ENDIF hec_e_sum_x = 0 hec_e_sum_y = 0 DO i = ptr, ptr+127 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO DO i = ptr+256, ptr+383 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO DO i = ptr+512, ptr+639 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO DO i = ptr+768, ptr+895 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO DO i = ptr+1024, ptr+1151 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO DO i = ptr+1280, ptr+1407 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) ENDDO IF ( z_hec.EQ.0 ) GOTO 150 C----67---------------------------------------------------------------72------80 C DSSSD #1 IF ( m_p_hec(1).GT.0 .AND. m_p_hec(1).LT.8 + .AND. z_hec.EQ.1 .AND. + m_n_hec(1).GT.0 .AND. m_n_hec(1).LT.8 ) THEN scaler( 7 ) = scaler( 7 ) + 1 CALL inc1d( 2130, RSHIFT( e_time - old_ts( 1, 2 ) , 8 ) ) old_ts( 1, 2 ) = e_time DO i = ptr, ptr+127 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+128, ptr+255 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2110, i - ptr, j - (ptr+128) ) CALL inc2d( 2120, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - ptr, j - (ptr+128), 1 ) = e_time implant_e( i-ptr, j-(ptr+128), 1 ) = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #2 C *** Adjust m_n_hec requirement due to missing y strips! *** IF ( m_p_hec(2).GT.0 .AND. m_p_hec(2).LT.8 + .AND. z_hec.GT.1 .AND. z_hec.LE.3 .AND. + m_n_hec(2).GT.0 .AND. m_n_hec(2).LT.8 ) THEN scaler( 8 ) = scaler( 8 ) + 1 CALL inc1d( 2131, RSHIFT( e_time - old_ts( 2, 2 ) , 8 ) ) old_ts( 2, 2 ) = e_time DO i = ptr+256, ptr+383 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+384, ptr+511 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2111, i- (ptr+256), j - (ptr+384) ) CALL inc2d( 2121, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - (ptr+256), j - (ptr+384), 2 ) = e_time implant_e( i-(ptr+256), j-(ptr+384), 2 ) + = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #3 IF ( m_p_hec(3).GT.0 .AND. m_p_hec(3).LT.8 + .AND. z_hec.GT.3 .AND. z_hec.LE.7 .AND. + m_n_hec(3).GT.0 .AND. m_n_hec(3).LT.8 ) THEN scaler( 9 ) = scaler( 9 ) + 1 CALL inc1d( 2132, RSHIFT( e_time - old_ts( 3, 2 ) , 8 ) ) old_ts( 3, 2 ) = e_time DO i = ptr+512, ptr+639 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+640, ptr+767 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2112, i - (ptr+512), j - (ptr+640) ) CALL inc2d( 2122, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - (ptr+512), j - (ptr+640), 3 ) = e_time implant_e( i-(ptr+512), j-(ptr+640), 3 ) + = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #4 IF ( m_p_hec(4).GT.0 .AND. m_p_hec(4).LT.8 + .AND. z_hec.GT.7 .AND. z_hec.LE.15 .AND. + m_n_hec(4).GT.0 .AND. m_n_hec(4).LT.8 ) THEN scaler( 10 ) = scaler( 10 ) + 1 CALL inc1d( 2133, RSHIFT( e_time - old_ts( 4, 2 ) , 8 ) ) old_ts( 4, 2 ) = e_time DO i = ptr+768, ptr+895 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+896, ptr+1023 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2113, i - (ptr+768), j - (ptr+896) ) CALL inc2d( 2123, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - (ptr+768), j - (ptr+896), 4 ) = e_time implant_e( i-(ptr+768), j-(ptr+896), 4 ) + = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #5 IF ( m_p_hec(5).GT.0 .AND. m_p_hec(5).LT.8 + .AND. z_hec.GT.15 .AND. z_hec.LE.31 .AND. + m_n_hec(5).GT.0 .AND. m_n_hec(5).LT.8 ) THEN scaler( 11 ) = scaler( 11 ) + 1 CALL inc1d( 2134, RSHIFT( e_time - old_ts( 5, 2 ) , 8 ) ) old_ts( 5, 2 ) = e_time DO i = ptr+1024, ptr+1151 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+1152, ptr+1279 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2114, i - (ptr+1024), j - (ptr+1152) ) CALL inc2d( 2124, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = e_time implant_e( i-(ptr+1024), j-(ptr+1152), 5 ) + = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #6 IF ( m_p_hec(6).GT.0 .AND. m_p_hec(6).LT.8 + .AND. z_hec.GT.31 .AND. z_hec.LE.63 .AND. + m_n_hec(6).GT.0 .AND. m_n_hec(6).LT.8 ) THEN scaler( 12 ) = scaler( 12 ) + 1 CALL inc1d( 2135, RSHIFT( e_time - old_ts( 6, 2 ) , 8 ) ) old_ts( 6, 2 ) = e_time DO i = ptr+1280, ptr+1407 IF ( ihit(i) ) hec_e_sum_x = hec_e_sum_x + idata(i) DO j = ptr+1408, ptr+1535 IF ( ihit(j) ) hec_e_sum_y = hec_e_sum_y + idata(j) IF ( ihit( i ) .AND. ihit( j ) ) THEN CALL inc2d( 2115, i - (ptr+1280), j - (ptr+1408) ) CALL inc2d( 2125, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) implant_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = e_time implant_e( i-(ptr+1280), j-(ptr+1408), 6 ) + = 0.14*(idata(i)+idata(j)) ENDIF ENDDO ENDDO ENDIF CALL inc1d( 252, z_hec + 2000 ) CALL inc1d( 253, hec_e_sum_x ) CALL inc1d( 254, hec_e_sum_y ) IF ( z_hec.GT.0 ) GOTO 200 C----67---------------------------------------------------------------72------80 C LEC events 150 CONTINUE ptr = 0 DO i = ptr, ptr+127 IF ( ihit( i ) ) THEN m_p_lec(1) = m_p_lec(1) + 1 ENDIF ENDDO DO i = ptr+128, ptr+255 IF ( ihit( i ) ) THEN m_n_lec(1) = m_n_lec(1) + 1 ENDIF ENDDO CALL inc2d( 2000, m_p_lec(1), m_n_lec(1) ) DO i = ptr+256, ptr+383 IF ( ihit( i ) ) THEN m_p_lec(2) = m_p_lec(2) + 1 ENDIF ENDDO DO i = ptr+384, ptr+511 IF ( ihit( i ) ) THEN m_n_lec(2) = m_n_lec(2) + 1 ENDIF ENDDO CALL inc2d( 2001, m_p_lec(2), m_n_lec(2) ) DO i = ptr+512, ptr+639 IF ( ihit( i ) ) THEN m_p_lec(3) = m_p_lec(3) + 1 ENDIF ENDDO DO i = ptr+640, ptr+767 IF ( ihit( i ) ) THEN m_n_lec(3) = m_n_lec(3) + 1 ENDIF ENDDO CALL inc2d( 2002, m_p_lec(3), m_n_lec(3) ) DO i = ptr+768, ptr+895 IF ( ihit( i ) ) THEN m_p_lec(4) = m_p_lec(4) + 1 ENDIF ENDDO DO i = ptr+896, ptr+1023 IF ( ihit( i ) ) THEN m_n_lec(4) = m_n_lec(4) + 1 ENDIF ENDDO CALL inc2d( 2003, m_p_lec(4), m_n_lec(4) ) DO i = ptr+1024, ptr+1151 IF ( ihit( i ) ) THEN m_p_lec(5) = m_p_lec(5) + 1 ENDIF ENDDO DO i = ptr+1152, ptr+1279 IF ( ihit( i ) ) THEN m_n_lec(5) = m_n_lec(5) + 1 ENDIF ENDDO CALL inc2d( 2004, m_p_lec(5), m_n_lec(5) ) DO i = ptr+1280, ptr+1407 IF ( ihit( i ) ) THEN m_p_lec(6) = m_p_lec(6) + 1 ENDIF ENDDO DO i = ptr+1408, ptr+1535 IF ( ihit( i ) ) THEN m_n_lec(6) = m_n_lec(6) + 1 ENDIF ENDDO CALL inc2d( 2005, m_p_lec(6), m_n_lec(6) ) IF ( m_p_lec(1).GT.0 .AND. m_p_lec(1).LT.8 + .AND. + m_n_lec(1).GT.0 .AND. m_n_lec(1).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( m_p_lec(2).GT.0 .AND. m_p_lec(2).LT.8 + .AND. + m_n_lec(2).GT.0 .AND. m_n_lec(2).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( m_p_lec(3).GT.0 .AND. m_p_lec(3).LT.8 + .AND. + m_n_lec(3).GT.0 .AND. m_n_lec(3).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( m_p_lec(4).GT.0 .AND. m_p_lec(4).LT.8 + .AND. + m_n_lec(4).GT.0 .AND. m_n_lec(4).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( m_p_lec(5).GT.0 .AND. m_p_lec(5).LT.8 + .AND. + m_n_lec(5).GT.0 .AND. m_n_lec(5).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( m_p_lec(6).GT.0 .AND. m_p_lec(6).LT.8 + .AND. + m_n_lec(6).GT.0 .AND. m_n_lec(6).LT.8 ) THEN z_lec = z_lec + 1 ENDIF IF ( z_lec.EQ.0 ) GOTO 200 C c. 2Hz modulated, c. 3kHz noise filter C IF ( fee(12)+fee(13).GE.2 ) GOTO 200 C----67---------------------------------------------------------------72------80 C DSSSD #1 ctr = 0 IF ( m_p_lec(1).GT.0 .AND. m_p_lec(1).LT.8 + .AND. z_hec.EQ.0 .AND. + m_n_lec(1).GT.0 .AND. m_n_lec(1).LT.8 ) THEN DO i = ptr, ptr+127 DO j = ptr+128, ptr+255 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 500, tdiff1 + 2000 ) CALL inc1d( 506, tdiff2 + 2000 ) CALL inc2d( 2600, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 1 ) = scaler( 1 ) + 1 CALL inc2d( 2010, i - ptr, j - (ptr+128) ) CALL inc2d( 2020, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - ptr, j - (ptr+128), 1 ) = e_time dt = decay_ts( i - ptr, j - (ptr+128), 1 ) - + implant_ts( i - ptr, j - (ptr+128), 1 ) CALL inc1d( 2200, RSHIFT( dt , 8 ) ) CALL inc1d( 2210, RSHIFT( dt , 14 ) ) C implant_e( i-ptr, j-(ptr+128), 1 ) CALL inc2d( 2300, implant_e( i-ptr, j-(ptr+128), 1 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2310, implant_e( i-ptr, j-(ptr+128), 1 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2400, INT( idata(i) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2410, INT( idata(i) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2500, i-ptr, RSHIFT( dt, 14 ) ) CALL inc2d( 2510, i-ptr, RSHIFT( dt, 8 ) ) CALL inc2d( 2500, j-(ptr+128)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2510, j-(ptr+128)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2700, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2710, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2800, m_p_lec(1), RSHIFT( dt, 14 ) ) CALL inc2d( 2800, m_n_lec(1)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2800, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2800, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2810, m_p_lec(1), RSHIFT( dt, 8 ) ) CALL inc2d( 2810, m_n_lec(1)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2810, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2810, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2030, RSHIFT( e_time - old_ts( 1, 1 ) , 8 ) ) C CALL inc2d( 2900, RSHIFT( e_time - old_ts( 1, 1 ) , 11 ), C + RSHIFT( dt, 14 ) ) C CALL inc2d( 2910, RSHIFT( e_time - old_ts( 1, 1 ) , 8 ), C + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - ptr, j - (ptr+128), 1 ) + - old_decay_ts( i - ptr, j - (ptr+128), 1 ) dt2 = old_decay_ts( i - ptr, j - (ptr+128), 1 ) + - older_decay_ts( i - ptr, j - (ptr+128), 1 ) CALL inc2d( 2900, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2910, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3000, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3010, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3100, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - ptr, j - (ptr+128), 1 ) = + old_decay_ts( i - ptr, j - (ptr+128), 1 ) old_decay_ts( i - ptr, j - (ptr+128), 1 ) = + decay_ts( i - ptr, j - (ptr+128), 1 ) z_lec_veto = z_lec_veto + 1 lec(1) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #2 ctr = 0 IF ( m_p_lec(2).GT.0 .AND. m_p_lec(2).LT.8 + .AND. z_hec.LE.1 .AND. + m_n_lec(2).GT.0 .AND. m_n_lec(2).LT.8 ) THEN DO i = ptr+256, ptr+383 DO j = ptr+384, ptr+511 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 501, tdiff1 + 2000 ) CALL inc1d( 507, tdiff2 + 2000 ) CALL inc2d( 2601, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 2 ) = scaler( 2 ) + 1 CALL inc2d( 2011, i- (ptr+256), j - (ptr+384) ) CALL inc2d( 2021, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - (ptr+256), j - (ptr+384), 2 ) = e_time dt = decay_ts( i - (ptr+256), j - (ptr+384), 2 ) - + implant_ts( i - (ptr+256), j - (ptr+384), 2 ) CALL inc1d( 2201, RSHIFT( dt , 8 ) ) CALL inc1d( 2211, RSHIFT( dt , 14 ) ) CALL inc2d( 2301, implant_e( i-(ptr+256), j-(ptr+384), 2 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2311, implant_e( i-(ptr+256), j-(ptr+384), 2 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2401, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2411, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2501, i-(ptr+256), RSHIFT( dt, 14 ) ) CALL inc2d( 2511, i-(ptr+256), RSHIFT( dt, 8 ) ) CALL inc2d( 2501, j-(ptr+384)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2511, j-(ptr+384)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2701, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2711, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2801, m_p_lec(2), RSHIFT( dt, 14 ) ) CALL inc2d( 2801, m_n_lec(2)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2801, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2801, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2811, m_p_lec(2), RSHIFT( dt, 8 ) ) CALL inc2d( 2811, m_n_lec(2)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2811, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2811, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2031, RSHIFT( e_time - old_ts( 2, 1 ) , 8 ) ) C CALL inc2d( 2901, RSHIFT( e_time - old_ts( 2, 1 ) , 11 ), C + RSHIFT( dt, 14 ) ) C CALL inc2d( 2911, RSHIFT( e_time - old_ts( 2, 1 ) , 8 ), C + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - (ptr+256), j - (ptr+384), 2 ) + - old_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) dt2 = old_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) + - older_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) CALL inc2d( 2901, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2911, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3001, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3011, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3101, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) = + old_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) old_decay_ts( i - (ptr+256), j - (ptr+384), 2 ) = + decay_ts( i - (ptr+256), j - (ptr+384), 2 ) z_lec_veto = z_lec_veto + 1 lec(2) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #3 ctr = 0 C 21.6.18 C IF ( m_p_lec(3).GT.0 .AND. m_p_lec(3).LT.8 C + .AND. z_hec.LE.3 .AND. C + m_n_lec(3).GT.0 .AND. m_n_lec(3).LT.8 C + .AND.fee(15).NE.1 ) THEN IF ( m_p_lec(3).GT.0 .AND. m_p_lec(3).LT.8 + .AND. z_hec.LE.3 .AND. + m_n_lec(3).GT.0 .AND. m_n_lec(3).LT.8 ) THEN DO i = ptr+512, ptr+639 DO j = ptr+640, ptr+767 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 502, tdiff1 + 2000 ) CALL inc1d( 508, tdiff2 + 2000 ) CALL inc2d( 2602, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 3 ) = scaler( 3 ) + 1 CALL inc2d( 2012, i - (ptr+512), j - (ptr+640) ) CALL inc2d( 2022, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - (ptr+512), j - (ptr+640), 3 ) = e_time dt = decay_ts( i - (ptr+512), j - (ptr+640), 3 ) - + implant_ts( i - (ptr+512), j - (ptr+640), 3 ) CALL inc1d( 2202, RSHIFT( dt , 8 ) ) CALL inc1d( 2212, RSHIFT( dt , 14 ) ) CALL inc2d( 2302, implant_e( i-(ptr+512), j-(ptr+640), 3 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2312, implant_e( i-(ptr+512), j-(ptr+640), 3 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2402, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2412, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2502, i-(ptr+512), RSHIFT( dt, 14 ) ) CALL inc2d( 2512, i-(ptr+512), RSHIFT( dt, 8 ) ) CALL inc2d( 2502, j-(ptr+640)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2512, j-(ptr+640)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2702, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2712, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2802, m_p_lec(3), RSHIFT( dt, 14 ) ) CALL inc2d( 2802, m_n_lec(3)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2802, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2802, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2812, m_p_lec(3), RSHIFT( dt, 8 ) ) CALL inc2d( 2812, m_n_lec(3)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2812, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2812, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2032, RSHIFT( e_time - old_ts( 3, 1 ) , 8 ) ) C CALL inc2d( 2902, RSHIFT( e_time - old_ts( 3, 1 ) , 11 ), C + RSHIFT( dt, 14 ) ) C CALL inc2d( 2912, RSHIFT( e_time - old_ts( 3, 1 ) , 8 ), C + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - (ptr+512), j - (ptr+640), 3 ) + - old_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) dt2 = old_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) + - older_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) CALL inc2d( 2902, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2912, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3002, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3012, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3102, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) = + old_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) old_decay_ts( i - (ptr+512), j - (ptr+640), 3 ) = + decay_ts( i - (ptr+512), j - (ptr+640), 3 ) z_lec_veto = z_lec_veto + 1 lec(3) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #4 ctr = 0 IF ( m_p_lec(4).GT.0 .AND. m_p_lec(4).LT.8 + .AND. z_hec.LE.7 .AND. + m_n_lec(4).GT.0 .AND. m_n_lec(4).LT.8 ) THEN DO i = ptr+768, ptr+895 DO j = ptr+896, ptr+1023 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 503, tdiff1 + 2000 ) CALL inc1d( 509, tdiff2 + 2000 ) CALL inc2d( 2603, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 4 ) = scaler( 4 ) + 1 CALL inc2d( 2013, i - (ptr+768), j - (ptr+896) ) CALL inc2d( 2023, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - (ptr+768), j - (ptr+896), 4 ) = e_time dt = decay_ts( i - (ptr+768), j - (ptr+896), 4 ) - + implant_ts( i - (ptr+768), j - (ptr+896), 4 ) CALL inc1d( 2203, RSHIFT( dt , 8 ) ) CALL inc1d( 2213, RSHIFT( dt , 14 ) ) CALL inc2d( 2303, implant_e( i-(ptr+768), j-(ptr+896), 4 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2313, implant_e( i-(ptr+768), j-(ptr+896), 4 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2403, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2413, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2503, i-(ptr+768), RSHIFT( dt, 14 ) ) CALL inc2d( 2513, i-(ptr+768), RSHIFT( dt, 8 ) ) CALL inc2d( 2503, j-(ptr+896)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2513, j-(ptr+896)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2703, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2713, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2803, m_p_lec(4), RSHIFT( dt, 14 ) ) CALL inc2d( 2803, m_n_lec(4)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2803, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2803, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2813, m_p_lec(4), RSHIFT( dt, 8 ) ) CALL inc2d( 2813, m_n_lec(4)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2813, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2813, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2033, RSHIFT( e_time - old_ts( 4, 1 ) , 8 ) ) C CALL inc2d( 2903, RSHIFT( e_time - old_ts( 4, 1 ) , 11 ), C + RSHIFT( dt, 14 ) ) C CALL inc2d( 2913, RSHIFT( e_time - old_ts( 4, 1 ) , 8 ), C + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - (ptr+768), j - (ptr+896), 4 ) + - old_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) dt2 = old_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) + - older_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) CALL inc2d( 2903, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2913, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3003, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3013, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3103, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) = + old_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) old_decay_ts( i - (ptr+768), j - (ptr+896), 4 ) = + decay_ts( i - (ptr+768), j - (ptr+896), 4 ) z_lec_veto = z_lec_veto + 1 lec(4) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #5 ctr = 0 IF ( m_p_lec(5).GT.0 .AND. m_p_lec(5).LT.8 + .AND. z_hec.LE.15 .AND. + m_n_lec(5).GT.0 .AND. m_n_lec(5).LT.8 ) THEN DO i = ptr+1024, ptr+1151 DO j = ptr+1152, ptr+1279 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 504, tdiff1 + 2000 ) CALL inc1d( 510, tdiff2 + 2000 ) CALL inc2d( 2604, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 5 ) = scaler( 5 ) + 1 CALL inc2d( 2014, i - (ptr+1024), j - (ptr+1152) ) CALL inc2d( 2024, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = e_time dt = decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) - + implant_ts( i - (ptr+1024), j - (ptr+1152), 5 ) CALL inc1d( 2204, RSHIFT( dt , 8 ) ) CALL inc1d( 2214, RSHIFT( dt , 14 ) ) CALL inc2d( 2304, implant_e( i-(ptr+1024), j-(ptr+1152), 5 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2314, implant_e( i-(ptr+1024), j-(ptr+1152), 5 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2404, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2414, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2504, i-(ptr+1024), RSHIFT( dt, 14 ) ) CALL inc2d( 2504, j-(ptr+1152)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2514, i-(ptr+1024), RSHIFT( dt, 8 ) ) CALL inc2d( 2514, j-(ptr+1152)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2704, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2714, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2804, m_p_lec(5), RSHIFT( dt, 14 ) ) CALL inc2d( 2804, m_n_lec(5)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2804, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2804, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2814, m_p_lec(5), RSHIFT( dt, 8 ) ) CALL inc2d( 2814, m_n_lec(5)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2814, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2814, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2034, RSHIFT( e_time - old_ts( 5, 1 ) , 8 ) ) C CALL inc2d( 2904, RSHIFT( e_time - old_ts( 5, 1 ) , 11 ), C + RSHIFT( dt, 14 ) ) C CALL inc2d( 2914, RSHIFT( e_time - old_ts( 5, 1 ) , 8 ), C + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) + - old_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) dt2 = old_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) + - older_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) CALL inc2d( 2904, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2914, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3004, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3014, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3104, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = + old_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) old_decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = + decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) z_lec_veto = z_lec_veto + 1 lec(5) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #6 ctr = 0 IF ( m_p_lec(6).GT.0 .AND. m_p_lec(6).LT.8 + .AND. z_hec.LE.31 .AND. + m_n_lec(6).GT.0 .AND. m_n_lec(6).LT.8 ) THEN DO i = ptr+1280, ptr+1407 DO j = ptr+1408, ptr+1535 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time CALL inc1d( 505, tdiff1 + 2000 ) CALL inc1d( 511, tdiff2 + 2000 ) CALL inc2d( 2605, tdiff1, tdiff2 ) IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN scaler( 6 ) = scaler( 6 ) + 1 CALL inc2d( 2015, i - (ptr+1280), j - (ptr+1408) ) CALL inc2d( 2025, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = e_time dt = decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) - + implant_ts( i - (ptr+1280), j - (ptr+1408), 6 ) CALL inc1d( 2205, RSHIFT( dt , 8 ) ) CALL inc1d( 2215, RSHIFT( dt , 14 ) ) CALL inc2d( 2305, implant_e( i-(ptr+1280), j-(ptr+1408), 6 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2315, implant_e( i-(ptr+1280), j-(ptr+1408), 6 ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2405, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2415, INT( 0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 8 ) ) CALL inc2d( 2505, i-(ptr+1280), RSHIFT( dt, 14 ) ) CALL inc2d( 2505, j-(ptr+1408)+256, RSHIFT( dt, 14 ) ) CALL inc2d( 2515, i-(ptr+1280), RSHIFT( dt, 8 ) ) CALL inc2d( 2515, j-(ptr+1408)+256, RSHIFT( dt, 8 ) ) CALL inc2d( 2705, ediff+500, RSHIFT( dt, 14 ) ) CALL inc2d( 2715, ediff+500, RSHIFT( dt, 8 ) ) CALL inc2d( 2805, m_p_lec(6), RSHIFT( dt, 14 ) ) CALL inc2d( 2805, m_n_lec(6)+100, RSHIFT( dt, 14 ) ) CALL inc2d( 2805, z_lec+200, RSHIFT( dt, 14 ) ) ctr = ctr + 1 CALL inc2d( 2805, ctr+300, RSHIFT( dt, 14 ) ) CALL inc2d( 2815, m_p_lec(6), RSHIFT( dt, 8 ) ) CALL inc2d( 2815, m_n_lec(6)+100, RSHIFT( dt, 8 ) ) CALL inc2d( 2815, z_lec+200, RSHIFT( dt, 8 ) ) CALL inc2d( 2815, ctr+300, RSHIFT( dt, 8 ) ) CALL inc1d( 2035, RSHIFT( e_time - old_ts( 6, 1 ) , 8 ) ) CALL inc2d( 2905, RSHIFT( e_time - old_ts( 6, 1 ) , 11 ), + RSHIFT( dt, 14 ) ) CALL inc2d( 2915, RSHIFT( e_time - old_ts( 6, 1 ) , 8 ), + RSHIFT( dt, 8 ) ) dt1 = decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) + - old_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) dt2 = old_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) + - older_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) CALL inc2d( 2905, RSHIFT( dt1, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 2915, RSHIFT( dt1, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3005, RSHIFT( dt2, 14 ), RSHIFT( dt, 14 ) ) CALL inc2d( 3015, RSHIFT( dt2, 8 ), RSHIFT( dt, 8 ) ) CALL inc2d( 3105, RSHIFT( dt1, 14 ), RSHIFT( dt2, 14 ) ) older_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = + old_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) old_decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) = + decay_ts( i - (ptr+1280), j - (ptr+1408), 6 ) z_lec_veto = z_lec_veto + 1 lec(6) = 1 ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF CALL inc1d( 252, z_lec + 2100 ) CALL inc2d( 1100, z_hec, z_lec ) k = 0 DO i = 1, 8 k = k + lec(i) ENDDO C----67---------------------------------------------------------------72------80 C Re-Check DSSSD #4 versus z_lec IF ( m_p_lec(4).GT.0 .AND. m_p_lec(4).LT.8 + .AND. z_hec.LE.7 .AND. + m_n_lec(4).GT.0 .AND. m_n_lec(4).LT.8 ) THEN DO i = ptr+768, ptr+895 DO j = ptr+896, ptr+1023 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN decay_ts( i - (ptr+768), j - (ptr+896), 4 ) = e_time dt = decay_ts( i - (ptr+768), j - (ptr+896), 4 ) - + implant_ts( i - (ptr+768), j - (ptr+896), 4 ) IF ( RSHIFT( dt, 8 ).LT.65536 ) THEN CALL inc2d( 1103, i-(ptr+768), z_lec ) CALL inc2d( 1103, j-(ptr+896)+256, z_lec ) CALL inc2d( 1103, i-(ptr+768), z_lec_veto+100 ) CALL inc2d( 1103, j-(ptr+896)+256, z_lec_veto+100 ) CALL inc2d( 1103, i-(ptr+768), k+10 ) CALL inc2d( 1103, j-(ptr+896)+256, k+10 ) ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C Re-Check DSSSD #5 versus z_lec IF ( m_p_lec(5).GT.0 .AND. m_p_lec(5).LT.8 + .AND. z_hec.LE.15 .AND. + m_n_lec(5).GT.0 .AND. m_n_lec(5).LT.8 ) THEN DO i = ptr+1024, ptr+1151 DO j = ptr+1152, ptr+1279 IF ( ihit( i ) .AND. ihit( j ) ) THEN tdiff1 = ihit_ts(i)-e_time tdiff2 = ihit_ts(j)-e_time IF ( ABS(tdiff1).LT.w(3) .AND. ABS(tdiff2).LT.w(4) ) THEN decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) = e_time dt = decay_ts( i - (ptr+1024), j - (ptr+1152), 5 ) - + implant_ts( i - (ptr+1024), j - (ptr+1152), 5 ) IF ( RSHIFT( dt, 8 ).LT.65536 ) THEN CALL inc2d( 1104, i-(ptr+1024), z_lec ) CALL inc2d( 1104, j-(ptr+1152)+256, z_lec ) CALL inc2d( 1104, i-(ptr+1024), z_lec_veto+100 ) CALL inc2d( 1104, j-(ptr+1152)+256, z_lec_veto+100 ) CALL inc2d( 1104, i-(ptr+1024), k+10 ) CALL inc2d( 1104, j-(ptr+1152)+256, k+10 ) ENDIF ENDIF ENDIF ENDDO ENDDO ENDIF IF ( z_lec.GT.0 .AND. z_hec.EQ.0 ) THEN DO i = 1, 32 DO j = 1, 32 IF ( fee( i ).EQ.1 .AND. fee( j ).EQ.1 ) THEN CALL inc2d( 4000, i, j ) ENDIF ENDDO ENDDO ENDIF 200 CONTINUE C----67---------------------------------------------------------------72------80 C Re-initialise event data DO i = 0, 4095 IF ( hit(i) ) THEN data( i ) = 0 hit( i ) = .false. hit_ts( i ) = 0 ENDIF IF ( ihit(i) ) THEN idata( i ) = 0 ihit( i ) = .false. ihit_ts( i ) = 0 ENDIF ENDDO DO i = 1, 32 fee(i) = 0 ENDDO C Remember first data of next event hit(next_ch) = .TRUE. hit_ts(next_ch) = next_ts data(next_ch) = next_adc_data fee(next_module) = 1 ts_old = next_ts dt = 0 e_time = next_ts C if ( ctr.le.100 ) then C write( 6, * ) ' *** return ts_old, e_time:', ts_old, e_time C endif C first = .true. RETURN C----67---------------------------------------------------------------72------80 ENTRY finish WRITE( 6, 9100 ) t2 = SECNDS( t1 ) WRITE( 6, 9110 ) items, FLOAT( items ) / t2 WRITE( 6, 9120 ) events, FLOAT( events ) / t2 WRITE( 6, 9130 ) time_warp, FLOAT( time_warp ) / t2 t4 = DFLOAT( ts ) * 10.0D-9 - t3 DO i = 1, 32 rates( i ) = scaler( i ) / t4 ENDDO DO i = 1, 6 WRITE( 6, 9020 ) i, scaler( i ), scaler_old( i ), + t4, rates( i ) ENDDO DO i = 7, 12 WRITE( 6, 9030 ) i-6, scaler( i ), scaler_old( i ), + t4, rates( i ) ENDDO WRITE( 6, 9140 ) 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 ) 9005 FORMAT( ' DSSSD #', i1, 4(1x,i2) ) 9010 FORMAT( ' *** data items: ', i10, ' (', F10.2,' Hz)', + ' events: ', i10, ' (', F10.2,' Hz)' ) 9020 FORMAT( ' *** DSSSD #', i2, ' count:', i10, ' old count:', i10, + ' dt:', F10.2, ' s LEC rate:', F10.2, ' Hz' ) 9030 FORMAT( ' *** DSSSD #', i2, ' count:', i10, ' old count:', i10, + ' dt:', F10.2, ' s HEC rate:', F10.2, ' Hz' ) 9100 FORMAT(/' *** ENTRY finish') 9110 FORMAT(/' *** data items: ', i10, ' (', F10.2,' Hz)' ) 9120 FORMAT( ' *** ADC events: ', i10, ' (', F10.2,' Hz)' ) 9130 FORMAT( ' *** time warps: ', i10, ' (', F10.2,' Hz)' ) 9140 FORMAT(/' *** ENTRY finish ends') C----67---------------------------------------------------------------72------80 END C----67---------------------------------------------------------------72------80 FUNCTION bb18order( channel ) INTEGER array( 0:63 ), bb18order, channel C ASIC # 0 channel # 0 = array(0) C ASIC # 1 channel # 0 = array(16) C ASIC # 2 channel # 0 = array(32) C ASIC # 3 channel # 0 = array(48) C Array contents correspond to the MSL type BB18 adaptor J1 connector C strip sequence # 0-63 DATA array / + 62, 63, 59, 60, 61, 56, 57, 58, 52, 53, 54, 55, 49, 50, 51, 45, + 46, 47, 48, 42, 43, 44, 38, 39, 40, 41, 35, 36, 37, 31, 32, 33, + 34, 28, 29, 30, 24, 25, 26, 27, 21, 22, 23, 17, 18, 19, 20, 14, + 15, 16, 10, 11, 12, 7, 3, 0, 8, 4, 1, 9, 5, 2, 13, 6 / bb18order = array( channel ) RETURN C----67---------------------------------------------------------------72------80 END C----67---------------------------------------------------------------72------80