*trigger 128 *oned 2000 s 16384 3000..3001 s 16384 3010..3015 s 16384 *twod 4000..4003 s 4096 4096 4010..4013 s 256 256 *vars *sort C----67---------------------------------------------------------------72------80 SUBROUTINE init IMPLICIT none SAVE C C External functions C EXTERNAL dtime C INTEGER and, int, rshift C C REAL dtime REAL float, rand C C Parameter variables C INTEGER max PARAMETER (max = 2048) C C Local variables C INTEGER asic, channel, ch, adc_data, range INTEGER ch_old( 2 ), count2 INTEGER events, events_old, items, items_old INTEGER i, j, k, l, m, m_p, m_n INTEGER*2 i2(2), i2_2(4) INTEGER i4, i4_2(2), ierr, iflag, ireturn INTEGER module, mbs_data, information_index, information INTEGER channel_ident INTEGER id, ts1, ts2, ts3, ts28, ts48 INTEGER i_old(2), adc_data_old INTEGER ts1_old(2), ts2_old(2), ts3_old(2) INTEGER dt, dt1, dt2, dt3, iy, w(0:31) INTEGER time_warp, invalid_id, noadcs, tag, type INTEGER data( 0:4095 ), count, total integer*8 i8, ts, ts_old, e_time, e_time_old INTEGER m_1_p_hec, e_1_p_hec INTEGER m_1_n_hec, e_1_n_hec INTEGER m_2_p_hec, e_2_p_hec INTEGER m_2_n_hec, e_2_n_hec INTEGER m_3_p_hec, e_3_p_hec INTEGER m_3_n_hec, e_3_n_hec INTEGER mp, mn C REAL c(0:7), e, gain(0:max-1), offset(0:max-1), ediff REAL rate, time(2), mean REAL t1, t2, t2_old, secnds, delta_t C LOGICAL hit( 0:4095 ), first C C Namelists C NAMELIST /variables/ gain, offset, c, w C C Common variables C INTEGER*2 gdata(0:max-1) C COMMON /fdata/ gdata C C Common variables C INTEGER*2 gid(0:max-1) C COMMON /fid/ gid C C Common variables C INTEGER mult C COMMON /fmult/ mult C EQUIVALENCE ( i8, i4_2(1) ) EQUIVALENCE ( i4, i2(1) ) C C----67---------------------------------------------------------------72------80 WRITE ( 6, * ) ' *** AIDA @ RIKEN - May 2015' WRITE ( 6, * ) ' *** Entry init commences' C Initialise counters events = 0 events_old = 0 time_warp = 0 invalid_id = 0 C Initialise event data DO i = 0, 2047 data( i ) = 0 hit( i ) = .FALSE. ENDDO first = .true. ts_old = 0 e_time_old = 0 count = 0 total = 0 DO i = 0, 127 gain( i ) = 1.0 offset( i ) = 0.0 ENDDO DO i = 0, 31 w( i ) = 0 ENDDO DO i = 0, 7 c( i ) = 1.0 ENDDO C Initialise time t1 = SECNDS(0.0) C Read program variables via NAMELIST I/O OPEN( 1, FILE = '/homes/npg/td/GREAT/variables.dat', + IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** OPEN I/O error:', ierr RETURN ENDIF READ( 1, NML = variables, IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** READ I/O error:', ierr ENDIF CLOSE( 1, IOSTAT = ierr ) IF ( ierr.NE.0 ) THEN WRITE( 6, * ) ' *** CLOSE I/O error:', ierr RETURN ENDIF C Display program variables DO i = 0, 127, 8 WRITE( 6, 9001 ) i, i+7, ( gain( j ), j = i, i+7 ) ENDDO DO i = 0, 127, 8 WRITE( 6, 9002 ) i, i+7, ( offset( j ), j = i, i+7 ) ENDDO DO i = 0, 7, 8 WRITE( 6, 9003 ) i, i+7, ( c(j), j = 1, 8 ) ENDDO DO i = 0, 31, 8 WRITE( 6, 9004 ) i, i+7, ( w(j), j = i, i+7 ) ENDDO WRITE ( 6, * ) ' *** Entry init ends' RETURN C----67---------------------------------------------------------------72------80 ENTRY sortin items = items + 1 IF ( MOD( items, 100000000 ).EQ.0 ) THEN t2 = SECNDS( t1 ) delta_t = t2 - t2_old rate = FLOAT( items - items_old ) / delta_t WRITE( 6, * ) ' *** item:', items, ' (', rate,' items/s)' items_old = items t2_old = t2 ENDIF C----67---------------------------------------------------------------72------80 C Event data C For Linux/x64 & Windows/x86 least significant 16-bit word i2(1) C For Solaris/SPARC least significant 16-bit word i2(2) C GREAT 3.2.1 format C C Other information C gid[0]=-1 C gdata[0]=module number C gdata[1]=information type (2=Pause, 3=Resume, 4=SYNC100, 6=FEE64 disc etc) C gdata[2]=information field (bits 16-19) C gdata[3]=information field (bits 0-15) C gdata[4]=time stamp (bits 16-27) C gdata[5]=time stamp (bits 0-15) C C ADC data format C C gid[0]=channel ident (FEE64 module bits 6-11, channel bits 0-5) C gdata[0]=fail/veto bits (AIDA: fail=0, veto=0 LEC/MEC, veto=1 HEC) C gdata[1]=? C gdata[2]=ADC data C gdata[3]=time stamp (bits 16-27) C gdata[4]=time stamp (bits 0-15) C----67---------------------------------------------------------------72------80 IF ( gid(0).EQ.-1 ) THEN i2(2) = 0 i2(1) = gdata(0) module = AND( i4, Z'0000003f' ) i2(1) = gdata(1) type = AND( i4, Z'0000000f' ) i2(2) = gdata(2) i2(1) = gdata(3) information = AND( i4, Z'000fffff' ) i2(2) = gdata(4) i2(1) = gdata(5) ts28 = AND( i4, Z'0fffffff' ) IF ( type.EQ.2 ) THEN C----67---------------------------------------------------------------72------80 C PAUSE timestamp ts48 = information i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 ELSEIF( type.EQ.3 ) THEN C----67---------------------------------------------------------------72------80 C RESUME timestamp ts48 = information i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 ELSEIF( type.EQ.4 ) THEN C----67---------------------------------------------------------------72------80 C SYNC100 timestamp ts48 = information i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 ELSEIF( type.EQ.6 ) THEN C----67---------------------------------------------------------------72------80 C FEE64 discriminator i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 ELSEIF( type.EQ.8 ) THEN C----67---------------------------------------------------------------72------80 C MBS information i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 information_index = AND( RSHIFT(information,16), Z'0000000f' ) mbs_data = AND( information, Z'0000ffff' ) ELSE C----67---------------------------------------------------------------72------80 C Something else ... i8 = 0 IF ( ts28.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 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.LT.Z'00000A0' ) THEN i4_2( 1 ) = ts48 + 1 ELSE i4_2( 1 ) = ts48 ENDIF ts = LSHIFT( i8, 28 ) i8 = 0 i4_2(1) = ts28 ts = ts + i8 ch = channel + ( module - 1 ) * 64 + ( range * 2048 ) CALL inc2d( 4000, RSHIFT( adc_data, 5 ), ch ) IF ( count.LE.100 ) THEN write( 6, 9800 ) gid(0), gid(1), + gdata(0), gdata(1), gdata(2), gdata(3), gdata(4) 9800 format( 7(1x, z4.4) ) write( 6, 9900 ) module, channel, range, adc_data, ts , ch 9900 format( ' module:', i4, ' channel:', i4, ' range:', i2, + ' adc_data:', z4.4, ' ts:', z12.12, ' ch:', i5 ) ENDIF count = count + 1 ENDIF C----67---------------------------------------------------------------72------80 C Build multiparameter ADC event (dt < 32us/10ns < 3200 ticks) IF ( gid(0).NE.-1 ) THEN IF ( first ) THEN hit( ch ) = .TRUE. data( ch ) = adc_data first = .false. C ts_old = ts dt = 0 e_time = ts ELSE dt = ts - ts_old ts_old = ts IF ( dt.LT.0 ) THEN WRITE( 6, * ) ' *** time warp: event:', events time_warp = time_warp + 1 ENDIF IF( dt.GE.0 .AND. dt.LE. 3200 ) THEN IF( hit(ch) ) then C write (6, *) ' *** ch:', ch, ' dt:', dt count2 = count2 + 1 endif hit( ch ) = .TRUE. data( ch ) = adc_data ELSEIF ( dt.LT.0 .OR. dt.GT.3200 ) THEN CALL inc1d( 2000, INT( (e_time-e_time_old) * 0.001 ) ) e_time_old = e_time GOTO 100 ENDIF ENDIF ENDIF RETURN 100 CONTINUE C----67---------------------------------------------------------------72------80 C Sort multiparameter ADC event events = events + 1 m = 0 DO i = 0, 2047 IF ( hit( i ) ) THEN m = m + 1 CALL inc1d( 3000, i ) ENDIF ENDDO CALL inc1d( 3001, m ) C LEC ADC data C DSSSD #1 FEE modules 11 & 12, 13 & 14 => 640-767, 768-895 mp = 0 DO i = 640, 767 IF ( hit( i ) ) THEN data( i ) = INT( ABS( data( i ) - 32768 ) - offset( i ) + 0.5 ) CALL inc2d( 4010, INT( 0.080 * data( i ) + 0.5 ), i - 640 ) mp = mp + 1 ENDIF ENDDO CALL inc1d( 3001, mp + 1000 ) mn = 0 DO i = 768, 895 IF ( hit( i ) ) THEN data( i ) = INT( ABS( data( i ) - 32768 ) - offset( i ) + 0.5 ) CALL inc2d( 4010, INT( 0.080 * data( i ) + 0.5 ), i - 640 ) mn = mn + 1 ENDIF ENDDO CALL inc1d( 3001, mn + 2000 ) IF ( mp.EQ.1 .AND. mn.EQ.1 ) THEN DO i = 640, 767 DO j = 768, 895 IF ( hit ( i ) .AND. hit( j ) ) THEN CALL inc2d( 4011, INT( 0.080 * data( i ) + 0.5 ), + INT( 0.080 * data( j ) + 0.5 ) ) ediff = 0.080 * ( data( i ) - data( j ) ) + 1000.0 CALL inc1d( 3010, INT( ediff + 1000 + 0.5 ) ) IF ( ediff.GT.990.0 .AND. ediff.LT.1010.0 ) THEN CALL inc2d( 4012, INT( 0.080 * data( i ) + 0.5 ), + INT( 0.080 * data( j ) + 0.5 ) ) CALL inc2d( 4013, INT( 0.080 * data( i ) + 0.5 ), i - 640 ) CALL inc2d( 4013, INT( 0.080 * data( j ) + 0.5 ), j - 640 ) ENDIF 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. ENDIF ENDDO first = .true. RETURN C----67---------------------------------------------------------------72------80 ENTRY finish write( 6, * ) ' *** items:', items, ' events:', events, + ' count:', count write( 6, * ) ' *** time warp:', time_warp, ' count2:', count2 t2 = SECNDS( t1 ) write( 6, * ) ' *** elapsed time:', t2, ' s', + ' items:', FLOAT(items)/t2, + ' events:', FLOAT(events)/t2, + ' count:', FLOAT(count)/t2 WRITE ( 6, * ) ' *** Entry finish ' 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 ) C----67---------------------------------------------------------------72------80 END C----67---------------------------------------------------------------72------80