*trigger 128 *oned 0..15 s 65536 20..35 s 65536 40..55 s 65536 60..75 s 64 80..96 s 64 100..115 s 65536 120..135 s 65536 140..155 s 65536 200..215 s 65536 250..254 s 4096 300..331 s 65536 400..405 s 65536 1400..1403 s 65536 2130..2131 s 65536 2030..2031 s 65536 2200..2201 s 65536 2210..2211 s 65536 2220..2229 s 1024 3030..3033 s 4096 *twod 1000..1001 s 4096 4096 1100..1101 s 512 512 2000..2003 s 512 512 2010..2011 s 512 512 2020..2021 s 1024 1024 2040..2049 s 512 512 2100..2101 s 512 512 2110..2113 s 512 512 2120..2127 s 1024 1024 2300..2301 s 1024 1024 2400..2401 s 1024 1024 2500..2501 s 1024 1024 2600..2601 s 1024 1024 3000..3001 s 512 512 3010..3011 s 1024 1024 3020..3021 s 512 512 3040..3041 s 512 512 *vars *sort C 201..232 s 65536 C 250..254 s 4096 C 2500..2505 s 1024 1024 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, chx, channel, channel_ident INTEGER count, data(0:4095), disc INTEGER dsssd_a( 6 ), dsssd_b( 6 ), dsssd_c( 6 ), dsssd_d( 6 ) INTEGER dsssd_e( 6 ), dsssd_f( 6 ), dsssd_g( 6 ), dsssd_h( 6 ) INTEGER*8 dt, tsdata(0:4096), itsdata(0:4096) INTEGER ediff, fee(32) INTEGER hec_e_sum_x(2), hec_e_sum_y(2) INTEGER hec_e_x_max(2), hec_e_y_max(2) INTEGER hec_e_x_max_ch(2), hec_e_y_max_ch(2) INTEGER lec_e(2), lec_x(2), lec_y(2) INTEGER hec_x(2), hec_y(2) INTEGER m_veto, veto( 1:64 ) 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*8 items, items_old, events, events_old INTEGER idata(0:4095), ierr, information, information_index INTEGER invalid_id, j, j1, j1_old, j2, j2_old, k INTEGER j3, j3_old, j4, j4_old 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 sc_channel INTEGER scaler( 32 ), scaler_old( 32 ), range, time_warp, total INTEGER*8 timestamp, ts INTEGER ts28, ts48, ts64 INTEGER*8 old_ts( 8, 2 ), ts_old INTEGER implant_e( 0:383, 0:127, 1:8 ) INTEGER*8 implant_ts( 0:383, 0:127, 1:8 ) INTEGER*8 decay_ts( 0:383, 0:127, 1:8 ) INTEGER*8 dts( 0:511 ), cts( 0:511 ), min_dts( 0:511 ) INTEGER type, w(0:31), zzz, pulser, pulser_old INTEGER z_lec, z_lec_veto, z_hec C LOGICAL hit(0:4095), ihit(0:4095) LOGICAL first_event, next_event, first_ts LOGICAL implant1, implant2, decay1, decay2, other1, other2 LOGICAL dt_tag, warp LOGICAL first_info_code_4, first_info_code_5 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, t5 C----67---------------------------------------------------------------72------80 C C Namelists C NAMELIST /variables/ gain, offset, c, w, + dsssd_a, dsssd_b, dsssd_c, dsssd_d, + dsssd_e, dsssd_f, dsssd_g, dsssd_h, veto 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, * ) ' *** FEB25 - implantdecay - March 2025' WRITE ( 6, * ) ' *** Entry init commences' C Initialise counters events = 0 events_old = 0 pulser = 0 pulser_old = 0 time_warp = 0 invalid_id = 0 first_ts = .TRUE. first_info_code_4 = .false. first_info_code_5 = .false. t3 = 0.0D+00 t4 = 0.0D+00 t4_old = 0.0D+00 C Initialise event data DO i = 0, 4095 data( i ) = 0 tsdata(i) = 0 hit( i ) = .FALSE. ENDDO DO i = 1, 32 fee(i) = 0 ENDDO DO i = 0, 511 min_dts( i ) = 999999999 cts( i ) = 0 ENDDO first_event = .true. next_event = .false. ts_old = 0 e_time_old = 0 count = 0 total = 0 DO i = 0, 4095 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, 64 veto(i) = -1 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 DO i = 0, 383 DO j = 0, 127 DO k = 1, 8 implant_ts( i, j, k ) = 0 decay_ts( i, j , k ) = 0 implant_e( i, j, k ) = 0 ENDDO ENDDO ENDDO C Initialise time t1 = SECNDS(0.0) C Read program variables via NAMELIST I/O OPEN( 1, FILE = '/home/td/FEB25/variables.dat', + IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** OPEN I/O error:', ierr 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 ENDIF OPEN( 20, FILE = '/home/td/FEB25/20',STATUS='NEW',IOSTAT=ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** OPEN I/O error:', ierr ENDIF OPEN( 21, FILE = '/home/td/FEB25/21',STATUS='NEW',IOSTAT=ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** OPEN I/O error:', ierr ENDIF C Display program variables DO i = 0, 511, 8 WRITE( 6, 9001 ) i, i+7, ( gain( j ), j = i, i+7 ) ENDDO DO i = 0, 511, 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, 2 WRITE( 6, 9005 ) i, dsssd_a(i), dsssd_b(i), + dsssd_c(i), dsssd_d(i), + dsssd_e(i), dsssd_f(i), + dsssd_g(i), dsssd_h(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, + pulser, FLOAT( pulser - pulser_old ) / delta_t items_old = items events_old = events pulser_old = pulser t2_old = t2 ENDIF IF ( MOD( items, 5000 ).EQ.0 ) THEN t4 = DFLOAT( ts ) * 1.0D-9 - t3 delta_t = t4 - t4_old IF ( delta_t.GE.0.2D+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 ) C sc_channel = INT ( MOD( t4, 65536.0 ) + 0.5 ) sc_channel = INT( 5.0 * t4 + 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 ) C sc_channel = INT ( MOD( t4, 65536.0 ) + 0.5 ) sc_channel = INT( 10.0 * t4 + 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 ts = timestamp( ts64, ts48, ts28, type ) ELSEIF( type.EQ.3 ) THEN C----67---------------------------------------------------------------72------80 C RESUME timestamp ts48 = information ts = timestamp( ts64, ts48, ts28, type ) ELSEIF( type.EQ.4 ) THEN C----67---------------------------------------------------------------72------80 C SYNC100 timestamp ts48 = information ts = timestamp( ts64, ts48, ts28, type ) first_info_code_4 = .true. IF ( first_ts ) THEN t3 = DFLOAT( ts ) * 1.0D-09 first_ts = .FALSE. ENDIF ELSEIF( type.EQ.5 ) THEN C----67---------------------------------------------------------------72------80 C White Rabbit Timestamp Marker (bits 48-63) ts64 = information ts = timestamp( ts64, ts48, ts28, type ) first_info_code_5 = .true. ELSEIF( type.EQ.6 ) THEN C----67---------------------------------------------------------------72------80 C FEE64 discriminator ts = timestamp( ts64, ts48, ts28, type ) 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 ) C 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 C CALL incv2d( 1000, ch, j2, m_disc ) ELSEIF( type.EQ.8 ) THEN C----67---------------------------------------------------------------72------80 C MBS information ts = timestamp( ts64, ts48, ts28, type ) information_index = AND( RSHIFT(information,16), Z'0000000f' ) mbs_data( information_index ) = AND( information, Z'0000ffff' ) ELSE C----67---------------------------------------------------------------72------80 C Something else ... ts = timestamp( ts64, ts48, ts28, type ) ENDIF ELSE C----67---------------------------------------------------------------72------80 C ADC data IF ( next_event ) THEN data(ch) = adc_data hit(ch) = .TRUE. tsdata(ch) = ts next_event = .false. ts_old = ts dt = 0 e_time = ts C----67---------------------------------------------------------------72------80 C write( 6,* ) ' next: ch:', ch, ' adc_data:', adc_data, C + ' dt:', dt ENDIF 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' ) ts = timestamp( ts64, ts48, ts28, type ) C Increment ts spectra per FEE64 module j1 = MOD( RSHIFT( ts, 28 ), 65536 ) IF ( j1.LT.j1_old ) THEN DO l = 0, 15 DO k = 0, 65535 CALL set1d( l, k, 0 ) CALL set1d( l+10, k, 0 ) CALL set1d( l+20, k, 0 ) CALL set1d( l + 100, k, 0 ) CALL set1d( l+110, k, 0 ) CALL set1d( l+120, k, 0 ) C CALL set1d( l + 200, k, 0 ) ENDDO ENDDO ENDIF IF ( range.EQ.0 ) THEN k = channel + ( module * 64 ) + ( range * 2048 ) l = INT( RSHIFT( ABS( adc_data - 32768 ), 3 ) + - offset(k) + 0.5 ) IF ( l.GT.27 .AND. l.LT.270 ) THEN CALL inc1d( module + 20, j1 ) CALL inc1d( module + 60, channel ) ELSEIF ( l.GE.270 ) THEN CALL inc1d( module + 40, j1 ) CALL inc1d( module + 80, channel ) ENDIF CALL inc1d( module, j1 ) ELSE k = channel + ( module * 64 ) + ( range * 2048 ) l = INT( RSHIFT( ABS( adc_data - 32768 ), 3 ) + - offset(k) + 0.5 ) IF ( l.GT.18 .AND. l.LT.180 ) THEN CALL inc1d( module + 120, j1 ) ELSEIF ( l.GE.180 ) THEN CALL inc1d( module + 140, j1 ) ENDIF CALL inc1d( module + 100, j1 ) ENDIF j1_old = j1 C Increment ts spectra per FEE64 module j2 = MOD( RSHIFT( ts, 28 ), 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 * 64 ) + ( range * 2048 ) adc_data = INT( RSHIFT( ABS( adc_data - 32768 ), 3 ) + - offset(ch) + 0.5 ) IF ( ch.EQ.2532 ) THEN RETURN ENDIF IF ( ch.GT.2047 ) THEN scaler(10+module)=scaler(10+module)+1 C write(6,*) ' ch:', ch, ' adc_data:', adc_data ENDIF IF ( ch.LE.1024 ) THEN CALL inc2d( 1000, ch/16, j2 ) ELSEIF ( ch.GE.2048 ) THEN CALL inc2d( 1000, ch/16 + 72, j2 ) ENDIF j2_old = j2 C channel = bb18order( channel ) C ch = channel + ( module * 64 ) + ( range * 2048 ) ENDIF C----67---------------------------------------------------------------72------80 C Build multiparameter ADC event (dt < 2us/1ns < 2000 ticks) IF ( first_info_code_4 .AND. first_info_code_5 + .AND. gid(0).NE.-1 ) THEN ENDIF IF ( first_event ) THEN hit( ch ) = .TRUE. data( ch ) = adc_data tsdata( ch ) = ts C IF ( ch.GT.2047 ) THEN C write(6,*) '2 ch:', ch, ' adc_data:', adc_data C ENDIF fee(module) = 1 first_event = .false. ts_old = ts dt = 0 e_time = ts C----67---------------------------------------------------------------72------80 C write( 6,* ) ' first: ch:', ch, ' adc_data:', adc_data, C + ' dt:', dt ELSE dt = ts - ts_old C IF ( dt.LT.0 ) THEN C WRITE( 6, * ) ' *** time warp: event:', events, ts, ts_old, dt C time_warp = time_warp + 1 C ENDIF C ts_old = ts IF ( dt.GT.2500 .OR. (ts_old-e_time).GT.33000 ) THEN C IF ( dt.GT.2500 ) THEN CALL inc1d( 1402, ts_old - e_time ) CALL inc1d( 1403, dt ) C----67---------------------------------------------------------------72------80 C write( 6,* ) ' end: ch:', ch, ' adc_data:', adc_data, C + ' dt:', dt C IF ( ch.GT.2047 ) THEN C write(6,*) '3 ch:', ch, ' adc_data:', adc_data C ENDIF GOTO 100 ELSEIF( dt.GE.0 .OR. dt.LE.2499 ) THEN hit(ch) = .TRUE. data(ch) = adc_data tsdata( ch ) = ts fee(module) = 1 C IF ( ch.GT.2047 ) THEN C write(6,*) '4 ch:', ch, ' adc_data:', adc_data C ENDIF C----67---------------------------------------------------------------72------80 C write( 6,* ) ' data: ch:', ch, ' adc_data:', adc_data, C + ' dt:', dt C ELSEIF ( dt.GT.0 .AND. dt.LT.2000 ) THEN C write( 6,* ) ' inter: ch:', ch, ' adc_data:', adc_data, C + ' dt:', dt C RETURN ENDIF IF ( dt.LT.0 ) THEN C WRITE( 6, * ) ' *** time warp: event:', events, ts, ts_old, dt C write(6,*) ts64, ts48, ts28, module time_warp = time_warp + 1 warp = .true. ELSE ts_old = ts ENDIF C*** added C ts_old=ts ENDIF C 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 C DESPEC December 2023 test C 1x MSL type BB18(DS)-1000 'triple' DSSSD C C Beam into page C C aida05 aida01 aida06 C aida02 aida04 C aida07 aida03 aida08 C C a b c C g h C d e f 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_e(i) = 0 lec_x(i) = -1 lec_y(i) = -1 hec_x(i) = -1 hec_y(i) = -1 ENDDO z_lec = 0 z_lec_veto = 0 z_hec = 0 implant1 = .false. implant2 = .false. decay1 = .false. decay2 = .false. other1 = .false. other2 = .false. C IF ( INT( 0.001*( ts_old-e_time) ).GT.8 ) GOTO 200 IF ( warp ) GOTO 250 m = 0 DO i = 0, 1023 IF ( hit(i) ) THEN C write( 6,* ) ' event: ch:', i, ' adc_data:', data(i), ' dt:', dt CALL inc1d( 251, i ) m = m + 1 ENDIF ENDDO IF ( m.GT.384 ) THEN pulser = pulser + 1 ENDIF DO i = 2048, 3071 IF ( hit(i) ) THEN C write( 6,* ) ' event: ch:', i, ' adc_data:', data(i), ' dt:', dt CALL inc1d( 251, i ) m = m + 1 ENDIF ENDDO C IF ( dt_tag ) write( 6, * ) ' *** double tap m:', m CALL inc1d( 252, m ) C Energy cuts to remove events below threshold or non beta energies DO i = 0, 1023 IF ( hit(i) ) THEN IF ( data( i ) .LT. 27 .OR. data(i).GT.180 ) THEN C IF ( data( i ) .LT. 27 ) THEN hit( i ) = .FALSE. data( i ) = 0 tsdata( i ) = 0 ENDIF ENDIF ENDDO DO i = 2048, 3071 IF ( hit(i) ) THEN C write(6,*) ' i:', i, 'data:', data(i) IF ( data( i ) .LT. 20 ) THEN hit( i ) = .FALSE. data( i ) = 0 tsdata( i ) = 0 ENDIF ENDIF ENDDO C----67---------------------------------------------------------------72------80 C Re-order LEC data DO j = 1, 2 k = ( dsssd_a( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l ) = data( i ) itsdata( l ) = tsdata( i ) ihit( l ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_b( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 128 ) = data( i ) itsdata( l + 128 ) = tsdata( i ) ihit( l + 128 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_c( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 256 ) = data( i ) itsdata( l + 256 ) = tsdata( i ) ihit( l + 256 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_d( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k, k + 63 C DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 64 ) = data( i ) itsdata( l + 64 ) = tsdata( i ) ihit( l + 64 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_e( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k, k + 63 C DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 192 ) = data( i ) itsdata( l + 192 ) = tsdata( i ) ihit( l + 192 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_f( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k, k + 63 C DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 320 ) = data( i ) itsdata( l + 320 ) = tsdata( i ) ihit( l + 320 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_g( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 384 ) = data( i ) itsdata( l + 384 ) = tsdata( i ) ihit( l + 384 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_h( j ) - 1 ) * 64 l = ( j - 1 ) * 512 DO i = k, k + 63 C DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 448 ) = data( i ) itsdata( l + 448 ) = tsdata( i ) ihit( l + 448 ) = .TRUE. ENDIF l = l + 1 ENDDO ENDDO IF ( ihit(130) ) THEN ihit(130) = .FALSE. idata(130) = 0 itsdata(130) = 0 ENDIF IF ( ihit(136) ) THEN ihit(136) = .FALSE. idata(136) = 0 itsdata(136) = 0 ENDIF goto 888 IF ( ihit(315) ) THEN ihit(315) = .FALSE. idata( 315 ) = 0 itsdata( 315 ) = 0 ENDIF IF ( ihit(318) ) THEN ihit(318) = .FALSE. idata( 318 ) = 0 itsdata( 318 ) = 0 ENDIF IF ( ihit(321) ) THEN ihit(321) = .FALSE. idata( 321 ) = 0 itsdata( 321 ) = 0 ENDIF IF ( ihit(324) ) THEN ihit(324) = .FALSE. idata( 324 ) = 0 itsdata( 324 ) = 0 ENDIF 888 continue m_veto = 0 DO i = 1,64 IF ( ihit( veto(i) ) ) THEN m_veto = m_veto+1 ENDIF ENDDO CALL inc1d( 96, m_veto ) C----67---------------------------------------------------------------72------80 C Re-order HEC data DO j = 1, 2 k = ( dsssd_a( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l ) = data( i ) itsdata( l ) = tsdata( i ) ihit( l ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_b( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 128 ) = data( i ) itsdata( l + 128 ) = tsdata( i ) ihit( l + 128 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_c( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 256 ) = data( i ) itsdata( l + 256 ) = tsdata( i ) ihit( l + 256 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_d( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 C DO i = k + 63, k, -1 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 64 ) = data( i ) itsdata( l + 64 ) = tsdata( i ) ihit( l + 64 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_e( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 C DO i = k + 63, k, -1 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 192 ) = data( i ) itsdata( l + 192 ) = tsdata( i ) ihit( l + 192 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_f( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 C DO i = k + 63, k, -1 DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 320 ) = data( i ) itsdata( l + 320 ) = tsdata( i ) ihit( l + 320 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_g( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 DO i = k + 63, k, -1 C DO i = k, k + 63 IF ( hit( i ) ) THEN idata( l + 384 ) = data( i ) itsdata( l + 384 ) = tsdata( i ) ihit( l + 384 ) = .TRUE. ENDIF l = l + 1 ENDDO k = ( dsssd_h( j ) - 1 ) * 64 + 2048 l = ( j - 1 ) * 512 + 2048 DO i = k, k + 63 C DO i = k + 63, k, -1 IF ( hit( i ) ) THEN idata( l + 448 ) = data( i ) itsdata( l + 448 ) = tsdata( i ) ihit( l + 448 ) = .TRUE. 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+383 IF ( ihit( i ) ) THEN m_p_hec( 1 ) = m_p_hec( 1 ) + 1 ENDIF ENDDO DO i = ptr+384, ptr+511 IF ( ihit( i ) ) THEN m_n_hec( 1 ) = m_n_hec( 1 ) + 1 ENDIF ENDDO CALL inc2d( 2100, m_p_hec(1), m_n_hec(1) ) DO i = ptr+512, ptr+895 IF ( ihit( i ) ) THEN m_p_hec(2) = m_p_hec(2) + 1 ENDIF ENDDO DO i = ptr+896, ptr+1023 IF ( ihit( i ) ) THEN m_n_hec(2) = m_n_hec(2) + 1 ENDIF ENDDO CALL inc2d( 2101, m_p_hec(2), m_n_hec(2) ) IF ( m_p_hec(1).GT.0 .OR. m_n_hec(1).GT.0 ) THEN DO i = 0, 383 IF ( ihit( i ) ) THEN m_p_lec(1) = m_p_lec(1) + 1 ENDIF ENDDO DO i = 384, 511 IF ( ihit( i ) ) THEN m_n_lec(1) = m_n_lec(1) + 1 ENDIF ENDDO CALL inc2d( 2002, m_p_lec(1), m_n_lec(1) ) z_hec = z_hec + 1 ENDIF IF ( m_p_hec(2).GT.0 .OR. m_n_hec(2).GT.0 ) THEN DO i = 512, 895 IF ( ihit( i ) ) THEN m_p_lec(2) = m_p_lec(2) + 1 ENDIF ENDDO DO i = 896, 1023 IF ( ihit( i ) ) THEN m_n_lec(2) = m_n_lec(2) + 1 ENDIF ENDDO CALL inc2d( 2003, m_p_lec(2), m_n_lec(2) ) z_hec = z_hec + 2 ENDIF DO i = 1, 2 hec_e_sum_x(i) = 0 hec_e_sum_y(i) = 0 hec_e_x_max(i) = 0 hec_e_y_max(i) = 0 hec_e_x_max_ch(i) = 0 hec_e_y_max_ch(i) = 0 lec_e(i) = 0 ENDDO IF ( z_hec.EQ.0 ) GOTO 150 C----67---------------------------------------------------------------72------80 C DSSSD #1 IF ( m_p_hec(1).GT.0 + .AND. + m_n_hec(1).GT.0 ) THEN CALL inc1d( 1400, INT( 0.0005*(ts_old-e_time)+0.5) ) scaler( 3 ) = scaler( 3 ) + 1 DO i = ptr, ptr+383 IF ( ihit(i) ) THEN hec_e_sum_x(1) = hec_e_sum_x(1) + idata(i) IF ( hec_e_x_max(1).LT.idata(i) ) THEN hec_e_x_max(1) = idata(i) hec_e_x_max_ch(1) = i ENDIF ENDIF ENDDO DO j = ptr+384, ptr+511 IF ( ihit(j) ) THEN hec_e_sum_y(1) = hec_e_sum_y(1) + idata(j) IF ( hec_e_y_max(1).LT.idata(j) ) THEN hec_e_y_max(1) = idata(j) hec_e_y_max_ch(1) = j ENDIF ENDIF ENDDO i = hec_e_x_max_ch(1) j = hec_e_y_max_ch(1) ediff = hec_e_sum_x(1) - hec_e_sum_y(1) IF ( ediff.LT.w(3) .AND. ediff.GT.w(4) ) THEN CALL inc1d( 3030, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+2000 ) implant1 = .true. hec_x(1) = i-ptr hec_y(1) = j-ptr-384 CALL inc1d( 2130, RSHIFT( e_time - old_ts( 1, 2 ) , 12 ) ) old_ts( 1, 2 ) = e_time CALL inc2d( 2110, i-ptr, j-ptr-384 ) CALL inc2d( 2120, INT( 0.28 * hec_e_sum_x(1) + 0.5 ), + INT( 0.28 * hec_e_sum_y(1) + 0.5 ) ) IF ( z_hec.EQ.1 + .AND. + hec_e_sum_x(1).GT.w(7) .AND. hec_e_sum_x(1).LT.w(8) + .AND. + hec_x(1).GT.75 .AND. hec_x(1).LT.150 + .AND. + hec_y(1).GT.30 .AND. hec_y(1).LT.120 + ) THEN CALL inc2d( 2122, INT( 0.28 * hec_e_sum_x(1) + 0.5 ), + INT( 0.28 * hec_e_sum_y(1) + 0.5 ) ) CALL inc2d( 2112, i-ptr, j-ptr-384 ) implant_ts( i-ptr, j-ptr-384, 1 ) = e_time implant_e( i-ptr, j-ptr-384, 1 ) = + 0.1*( hec_e_sum_x(1)+hec_e_sum_y(1) ) IF ( decay_ts( i-ptr, j - ptr - 384, 1 ).GT. 0 ) THEN dt = implant_ts( i-ptr, j - ptr - 384, 1 ) + - decay_ts( i-ptr, j - ptr - 384, 1 ) CALL inc1d( 2222, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc1d( 2224, RSHIFT( dt, 22 ) ) IF ( RSHIFT( dt, 22 ).LT.255 ) THEN write( 6, * ) ' b:', implant_ts( i-ptr, j - ptr - 384, 1 ), + decay_ts( i-ptr, j - ptr - 384, 1 ), + dt write( 21, * ) implant_ts( i-ptr, j - ptr - 384, 1 ), + decay_ts( i-ptr, j - ptr - 384, 1 ), + dt ENDIF ELSE dt = -1 ENDIF ENDIF C----67---------------------------------------------------------------72------80 C ENDIF ENDIF C ENDDO C ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #2 IF ( m_p_hec(2).GT.0 + .AND. + m_n_hec(2).GT.0 ) THEN scaler( 4 ) = scaler( 4 ) + 1 CALL inc1d( 1401, INT( 0.0005*(ts_old-e_time)+0.5) ) DO i = ptr+512, ptr+895 IF ( ihit(i) ) THEN hec_e_sum_x(2) = hec_e_sum_x(2) + idata(i) IF ( hec_e_x_max(2).LT.idata(i) ) THEN hec_e_x_max(2) = idata(i) hec_e_x_max_ch(2) = i ENDIF ENDIF ENDDO DO j = ptr+896, ptr+1023 IF ( ihit(j) ) THEN hec_e_sum_y(2) = hec_e_sum_y(2) + idata(j) IF ( hec_e_y_max(2).LT.idata(j) ) THEN hec_e_y_max(2) = idata(j) hec_e_y_max_ch(2) = j ENDIF ENDIF ENDDO i = hec_e_x_max_ch(2) j = hec_e_y_max_ch(2) ediff = hec_e_sum_x(2) - hec_e_sum_y(2) IF ( ediff.LT.w(3) .AND. ediff.GT.w(4) ) THEN implant2 = .true. hec_x(2) = i-ptr-512 hec_y(2) = j-ptr-896 C----67---------------------------------------------------------------72------80 CALL inc1d( 3031, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+2000 ) CALL inc1d( 2131, RSHIFT( e_time - old_ts( 1, 2 ) , 12 ) ) old_ts( 1, 2 ) = e_time CALL inc2d( 2111, i-ptr-512, j-ptr-896 ) CALL inc2d( 2121, INT( 0.28 * hec_e_sum_x(2) + 0.5 ), + INT( 0.28 * hec_e_sum_y(2) + 0.5 ) ) IF ( z_hec.EQ.3 + .AND. + hec_e_sum_x(2).GT.w(9) .AND. hec_e_sum_x(2).LT.w(10) + ) THEN CALL inc2d( 2123, INT( 0.28 * hec_e_sum_x(2) + 0.5 ), + INT( 0.28 * hec_e_sum_y(2) + 0.5 ) ) CALL inc2d( 2113, i-ptr-512, j-ptr-896 ) implant_ts( i-ptr-512, j-ptr-896, 2 ) = e_time implant_e( i-ptr-512, j-ptr-896, 2 ) = + 0.1*( hec_e_sum_x(2)+hec_e_sum_y(2) ) IF ( decay_ts( i-ptr-512, j - ptr - 896, 2 ).GT. 0 ) THEN dt = implant_ts( i - ptr - 512, j - ptr - 896, 2 ) + - decay_ts( i - ptr - 512, j - ptr - 896, 2 ) CALL inc1d( 2223, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc1d( 2225, INT( RSHIFT( dt, 24 ) / 178.814 ) ) ELSE dt = -1 ENDIF ENDIF C----67---------------------------------------------------------------72------80 C ENDIF ENDIF C ENDDO C ENDDO ENDIF IF ( m_p_hec(2).GT.0.AND.m_n_hec(2).GT.0 + .AND. m_p_hec(1).GT.0.AND.m_n_hec(1).GT.0 ) THEN IF ( z_hec.EQ.3 ) THEN CALL inc2d( 2124, INT( 0.28 * hec_e_sum_x(2) + 0.5 ), + INT( 0.28 * hec_e_sum_x(1) + 0.5 ) ) ENDIF ENDIF IF ( hec_y(1).GT.0.AND.hec_y(1).GT.0 + .AND. hec_x(2).GT.0.AND.hec_x(2).GT.0 ) THEN C IF ( z_hec.EQ.0 ) THEN CALL inc2d( 2125, hec_x(1) - hec_x(2) + 512, + hec_y(1) - hec_y(2) + 512 ) C ENDIF ENDIF C----67---------------------------------------------------------------72------80 C LEC events IF ( z_hec.GT.0 ) GOTO 200 150 CONTINUE ptr = 0 DO i = ptr, ptr+383 IF ( ihit( i ) ) THEN m_p_lec(1) = m_p_lec(1) + 1 ENDIF ENDDO DO i = ptr+384, ptr+511 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+512, ptr+895 IF ( ihit( i ) ) THEN m_p_lec(2) = m_p_lec(2) + 1 ENDIF ENDDO DO i = ptr+896, ptr+1023 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) ) 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 + 2 ENDIF IF ( z_lec.EQ.0 ) GOTO 200 C----67---------------------------------------------------------------72------80 C DSSSD #1 IF ( m_p_lec(1).GT.0 .AND. m_p_lec(1).LT.2 + .AND. + m_n_lec(1).GT.0 .AND. m_n_lec(1).LT.2 ) THEN DO i = ptr, ptr+383 DO j = ptr+384, ptr+511 IF ( ihit( i ) .AND. ihit( j ) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN CALL inc1d( 3032, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+2000 ) CALL inc2d( 3040, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+255, + ediff+255 ) decay1 = .true. lec_e(1) = idata(i) lec_x(1) = i lec_y(1) = j-384 scaler( 1 ) = scaler( 1 ) + 1 CALL inc1d( 2030, RSHIFT( e_time - old_ts( 1, 1 ), 12 ) ) old_ts( 1, 1 ) = e_time CALL inc2d( 2010, i, j - 384 ) CALL inc2d( 2020, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i, j - 384, 1 ) = e_time IF ( implant_ts( i, j - 384, 1 ).GT. 0 ) THEN dt = decay_ts( i, j - 384, 1 ) - + implant_ts( i, j - 384, 1 ) IF ( lec_x(1).GT.75 .AND. lec_x(1).LT.150 + .AND. + lec_y(1).GT.30 .AND. lec_y(1).LT.120 ) THEN CALL inc1d( 2200, RSHIFT( dt , 12 ) ) CALL inc1d( 2210, RSHIFT( dt , 16 ) ) CALL inc1d( 2220, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc1d( 2226, RSHIFT( dt, 22 ) ) IF ( RSHIFT( dt, 22 ).LT.255 ) THEN write( 6, * ) implant_ts( i, j - 384, 1 ), + decay_ts( i, j - 384, 1 ), + dt write( 20, * ) implant_ts( i, j - 384, 1 ), + decay_ts( i, j - 384, 1 ), + dt ENDIF IF ( RSHIFT( dt, 16 ).LT.10000 ) THEN CALL inc2d( 2040, i, j - 384 ) ENDIF IF( RSHIFT( dt, 16 ).LT.1000000 ) THEN CALL inc2d( 2041, i, j - 384 ) ENDIF CALL inc2d( 2300, implant_e( i, j - 384, 1 ), + RSHIFT( dt, 22 ) ) CALL inc2d( 2400, INT( 0.28*0.5*(idata(i)+idata(j)) ), + RSHIFT( dt, 22 ) ) CALL inc2d( 2500, i, RSHIFT( dt, 22 ) ) CALL inc2d( 2500, j, RSHIFT( dt, 22 ) ) CALL inc2d( 2600, ediff+500, RSHIFT( dt, 22 ) ) ENDIF ELSE dt = -1 ENDIF z_lec_veto = z_lec_veto + 1 lec(1) = 1 ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #2 IF ( m_p_lec(2).GT.0 .AND. m_p_lec(2).LT.2 + .AND. + m_n_lec(2).GT.0 .AND. m_n_lec(2).LT.2 ) THEN DO i = ptr+512, ptr+895 DO j = ptr+896, ptr+1023 IF ( ihit( i ) .AND. ihit( j ) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(1) .AND. ediff.GT.w(2) ) THEN CALL inc1d( 3033, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+2000 ) C----67---------------------------------------------------------------72------80 CALL inc2d( 3041, INT(0.0005*(itsdata(i)-itsdata(j))+0.5)+255, + ediff+255 ) lec_e(2) = idata(i) lec_x(2) = i-512 lec_y(2) = j-896 decay2 = .true. scaler( 2 ) = scaler( 2 ) + 1 CALL inc1d( 2031, RSHIFT( e_time - old_ts( 2, 1 ) , 12 ) ) old_ts( 2, 1 ) = e_time CALL inc2d( 2011, i - 512, j - 896 ) CALL inc2d( 2021, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) decay_ts( i - 512, j - 896, 2 ) = e_time IF ( implant_ts( i-512, j - 896, 2 ).GT. 0 ) THEN dt = decay_ts( i - 512, j - 896, 2 ) - + implant_ts( i - 512, j - 896, 2 ) ELSE dt = -1 ENDIF CALL inc1d( 2201, RSHIFT( dt , 12 ) ) CALL inc1d( 2211, RSHIFT( dt , 16 ) ) CALL inc1d( 2221, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc1d( 2227, INT( RSHIFT( dt, 24 ) / 178.814 ) ) IF ( RSHIFT( dt, 16 ).LT.10000 ) THEN CALL inc2d( 2045, i - 512, j - 896 ) ENDIF IF( RSHIFT( dt, 16 ).LT.1000000 ) THEN CALL inc2d( 2046, i - 512, j - 896 ) ENDIF CALL inc2d( 2301, implant_e( i - 512, j - 896, 2 ), + INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc2d( 2401, INT( 0.5*(idata(i)+idata(j)) ), + INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc2d( 2501, i-512, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc2d( 2501, j-896, INT( RSHIFT( dt, 24 ) / 59.605 ) ) CALL inc2d( 2601, ediff+500, RSHIFT( dt, 22 ) ) z_lec_veto = z_lec_veto + 1 lec(2) = 1 ENDIF ENDIF ENDDO ENDDO ENDIF IF ( m_p_lec(1).GT.0.AND.m_n_lec(1).GT.0 + .AND. m_p_lec(2).GT.0.AND.m_n_lec(2).GT.0 ) THEN C IF ( z_hec.EQ.0 ) THEN CALL inc2d( 2127, INT( 0.28 * lec_e(2) + 0.5 ), + INT( 0.28 * lec_e(1) + 0.5 ) ) C ENDIF ENDIF IF ( lec_y(1).GT.0.AND.lec_y(1).GT.0 + .AND. lec_x(2).GT.0.AND.lec_x(2).GT.0 ) THEN C IF ( z_hec.EQ.0 ) THEN CALL inc2d( 2126, lec_x(1) - lec_x(2) + 512, + lec_y(1) - lec_y(2) + 512 ) C ENDIF ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #1 Other IF ( ( m_p_hec(1).EQ.0 .OR. m_n_hec(1).EQ.0 ) + .AND. + ( m_p_lec(1).GE.8 .OR. m_n_lec(1).GE.8 ) ) THEN CALL inc2d( 3020, m_p_lec(1), m_n_lec(1) ) scaler( 5 ) = scaler( 5 ) + 1 DO i = ptr, ptr+383 DO j = ptr+384, ptr+511 IF ( ihit( i ) .AND. ihit( j ) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(5) .AND. ediff.GT.w(6) ) THEN other1 = .true. CALL inc2d( 3000, i-ptr, j-ptr-384 ) CALL inc2d( 3010, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) ENDIF ENDIF ENDDO ENDDO ENDIF C----67---------------------------------------------------------------72------80 C DSSSD #2 Other IF ( ( m_p_hec(2).EQ.0 .OR. m_n_hec(2).EQ.0 ) + .AND. + ( m_p_lec(2).GE.8 .OR. m_n_lec(2).GE.8 ) ) THEN CALL inc2d( 3021, m_p_lec(2), m_n_lec(2) ) scaler( 6 ) = scaler( 6 ) + 1 old_ts( 2, 2 ) = e_time DO i = ptr+512, ptr+895 DO j = ptr+896, ptr+1023 IF ( ihit( i ) .AND. ihit( j ) ) THEN ediff = idata(i) - idata(j) IF ( ediff.LT.w(5) .AND. ediff.GT.w(6) ) THEN other2 = .true. CALL inc2d( 3001, i-ptr-512, j-ptr-896 ) CALL inc2d( 3011, INT( 0.28 * idata( i ) + 0.5 ), + INT( 0.28 * idata( j ) + 0.5 ) ) 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 200 CONTINUE j3 = MOD( RSHIFT( e_time, 18 ), 65536 ) IF ( j3.LT.j3_old ) THEN DO k = 0, 65535 CALL set1d( 400, k, 0 ) CALL set1d( 401, k, 0 ) CALL set1d( 402, k, 0 ) CALL set1d( 403, k, 0 ) CALL set1d( 404, k, 0 ) CALL set1d( 405, k, 0 ) ENDDO ENDIF IF ( decay1 ) THEN CALL inc1d( 400, j3 ) ELSEIF ( implant1 ) THEN CALL inc1d( 401, j3 ) ELSEIF ( other1 ) THEN CALL inc1d( 402, j3 ) ELSEIF ( decay2 ) THEN CALL inc1d( 403, j3 ) ELSEIF ( implant2 ) THEN CALL inc1d( 404, j3 ) ELSEIF ( other2 ) THEN CALL inc1d( 405, j3 ) ENDIF j3_old = j3 250 CONTINUE decay1 = .false. implant1 = .false. other1 = .false. decay2 = .false. implant2 = .false. other2 = .false. dt_tag = .false. warp = .false. C----67---------------------------------------------------------------72------80 C Re-initialise event data DO i = 0, 4095 IF ( hit(i) ) THEN data( i ) = 0 hit( i ) = .false. ENDIF IF ( ihit(i) ) THEN idata( i ) = 0 ihit( i ) = .false. ENDIF ENDDO DO i = 1, 32 fee(i) = 0 ENDDO next_event = .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, 32 WRITE( 6, 9020 ) i, scaler( i ), scaler_old( i ), + t4, rates( i ) ENDDO CLOSE( 20, IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** CLOSE I/O error:', ierr ENDIF CLOSE( 21, IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** CLOSE I/O error:', ierr ENDIF 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: ', i32, ' (', F10.2,' Hz)', + ' events: ', i32, ' (', F10.2,' Hz)', + ' pulser: ', i32, ' (', F10.2,' Hz)' ) 9020 FORMAT( ' *** scaler #', i2, ' count:', i10, ' old count:', i10, + ' dt:', F10.2, ' s LEC rate:', F10.2, ' Hz' ) 9030 FORMAT( ' *** scaler #', i2, ' count:', i10, ' old count:', i10, + ' dt:', F10.2, ' s HEC rate:', F10.2, ' Hz' ) 9100 FORMAT(/' *** ENTRY finish') 9110 FORMAT(/' *** data items: ', i32, ' (', F10.2,' Hz)' ) 9120 FORMAT( ' *** ADC events: ', i32, ' (', F10.2,' Hz)' ) 9130 FORMAT( ' *** time warps: ', i32, ' (', 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 C Assemble 64bit WR timestamp - POSIX epoch (ns) INTEGER*8 FUNCTION timestamp( ts64, ts48, ts28, type ) INTEGER lshift, btest, ibset C C Argument variables C INTEGER ts28, ts48, ts64, type C C Local variables C INTEGER i timestamp = ts28 DO i = 0, 19 IF ( BTEST( ts48, i ) ) THEN timestamp = IBSET( timestamp, i + 28 ) ENDIF ENDDO DO i = 0, 15 IF ( BTEST( ts64, i ) ) THEN timestamp = IBSET( timestamp, i + 48 ) ENDIF ENDDO RETURN C----67---------------------------------------------------------------72------80 END C----67---------------------------------------------------------------72------80