*trigger 128 *oned 1..32 s 65536 101..132 s 65536 *twod 1000 s 4096 4096 *vars *sort C----67---------------------------------------------------------------72------80 SUBROUTINE init IMPLICIT none SAVE C C External functions C EXTERNAL dtime C INTEGER and, lshift, rshift C LOGICAL btest C REAL float, secnds C C Parameter variables C INTEGER max PARAMETER (max = 2048) C C Local variables C INTEGER adc_data, asic, ch, channel, channel_ident INTEGER count, data(0:4095), disc INTEGER*8 dt INTEGER events, events_old INTEGER*8 e_time, e_time_old INTEGER i INTEGER*2 i2(2), i2_2(4) INTEGER i4, i4_2(2) INTEGER*8 i8 INTEGER ierr, information, information_index, int INTEGER invalid_id, items, items_old, j, j1, j1_old, j2, j2_old, k INTEGER l, mbs_data(0:3), module, m_disc INTEGER range, time_warp, total INTEGER*8 ts INTEGER ts28 INTEGER ts48 INTEGER*8 ts_old INTEGER type, w(0:31) C LOGICAL first, hit(0:4095) C REAL c(0:7), delta_t, gain(0:max-1), offset(0:max-1) REAL t1, t2, t2_old 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 - sync check - October 2016' 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 = '/home/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, 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 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 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 + 100, 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' ) 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 ) ENDDO ENDDO ENDIF CALL inc1d( module, j1 ) 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 ENDIF ch = channel + ( module - 1 ) * 64 + ( range * 2048 ) CALL inc2d( 1000, ch/16, j2 ) j2_old = j2 ENDIF C----67---------------------------------------------------------------72------80 C Build multiparameter ADC event (dt < 2us/10ns < 200 ticks) IF ( gid(0).NE.-1 ) THEN IF ( first ) THEN hit( ch ) = .TRUE. data( ch ) = adc_data first = .false. ts_old = ts dt = 0 e_time = ts ELSE dt = ts - ts_old 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 GOTO 100 ELSEIF( dt.GE.0 .AND. dt.LE.200 ) THEN hit(ch) = .TRUE. data(ch) = adc_data ENDIF ENDIF ENDIF RETURN 100 CONTINUE C----67---------------------------------------------------------------72------80 C Sort multiparameter ADC event events = events + 1 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, 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 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 ) 9010 FORMAT( ' *** data items: ', i10, ' (', F10.2,' Hz)', + ' events: ', i10, ' (', 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