PROGRAM GREAT
C Read and analyse GREAT format data - version 3.3.0
C
C See:
C http://npg.dl.ac.uk/documents/edoc504/edoc504.html
C http://npg.dl.ac.uk/DataAcq/TSformat.html
IMPLICIT NONE
C
C External functions
C
EXTERNAL timestamp
C
DOUBLE PRECISION dfloat
C
INTEGER and
INTEGER*8 iargc
INTEGER rshift
INTEGER*8 timestamp
C
REAL secnds
C
C Parameter variables
C
INTEGER block_length
PARAMETER (block_length = 16384)
C
C Local variables
C
CHARACTER*255 arg
CHARACTER*(block_length*4) buffer
CHARACTER*255 filename
C
INTEGER adc_data, block_number, block_ptr, ch, channel
INTEGER channel_ident, data_block(block_length)
INTEGER*8 dead(32)
INTEGER event, fail
INTEGER*8 first_ts
INTEGER i
INTEGER*2 i2(2), i2_2(4)
INTEGER i4, i4_2(2)
INTEGER*8 i8, idle(32)
INTEGER information, information_index, io_error, items(0:32,0:31)
INTEGER j, j4
INTEGER*8 last_ts
INTEGER mbs_data, module
INTEGER*8 pause(32)
INTEGER range
INTEGER*8 resume(32)
INTEGER sample_length, sum(0:31)
INTEGER*8 sync(32)
INTEGER tag, tag_old
INTEGER*8 ts
INTEGER ts28, ts48, ts64
INTEGER*8 ts_old
INTEGER type, type_old
C
LOGICAL verbose
C
REAL dt, t1, t2
EQUIVALENCE ( data_block, buffer )
EQUIVALENCE ( i4, i2( 1 ) )
EQUIVALENCE ( i8, i4_2(1) )
SAVE data_block, block_ptr, block_number, event
C----67---------------------------------------------------------------72------80
C Announce program
WRITE( 6, 9000 )
C Initialise variables
block_ptr = 1
block_number = 0
event = 0
i4 = 0
i8 = 0
ts_old = 0
tag_old = 0
type_old = 0
first_ts = 0
last_ts = 0
ts28 = 0
ts48 = 0
ts64 = 0
type = 0
verbose = .FALSE.
DO i = 0, 32
DO j = 0, 31
sum( j ) = 0
items( i, j ) = 0
ENDDO
ENDDO
DO i = 1, 32
pause( i ) = -1
resume( i ) = -1
dead( i ) = 0
sync( i ) = 0
idle( i ) = 0
ENDDO
C Get input filename from command line argument
DO i = 1, iargc()
CALL getarg( i, arg )
IF ( arg.EQ.'v') THEN
verbose = .TRUE.
write(6,*) ' verbose'
ELSE
filename = arg
ENDIF
ENDDO
IF ( iargc().LT.1 .OR. iargc().GT.2 ) THEN
WRITE( 6, * ) ' Usage: ./a.exe [v] <filename>'
STOP
ENDIF
t1 = SECNDS( 0.0 )
C Open file
OPEN( 10, RECL = 4 * block_length,
+ FILE = filename, STATUS = 'OLD', ACCESS = 'DIRECT' )
1 CONTINUE
C Read next block
C Note: for FORTRAN direct I/O first block/record number is 1
C for GREAT data format first (encoded) block/record number is 0
block_number = block_number + 1
READ( 10, REC = block_number, iostat=io_error, ERR=1000 ) buffer
DO block_ptr = 7, data_block( 6 ) / 4 + 4, 2
i4 = data_block( block_ptr )
j4 = data_block( block_ptr + 1 )
tag = AND( RSHIFT( i4, 30 ), Z'00000003' )
module = 0
type = 0
C tag = 3 = ADC data format
C tag = 2 = Other data
C tag = 1 = Sample trace buffer format
C tag = 0 = undefined?
C----67---------------------------------------------------------------72------80
C ADC data
IF ( tag.EQ.3 ) THEN
fail = AND( RSHIFT( i4, 29 ), Z'00000001' )
IF ( fail.NE.0 ) THEN
WRITE( 6, 9600 ) block_number, block_ptr, i4
ENDIF
range = AND( RSHIFT( i4, 28 ), Z'00000001' )
channel_ident = AND( RSHIFT( i4, 16 ), Z'00000fff' )
module = AND( RSHIFT( channel_ident, 6 ), Z'0000003f' )
IF ( range.EQ.1 ) THEN
items(module, 19 ) = items(module, 19 ) + 1
ENDIF
channel = AND( channel_ident, Z'0000003f' )
adc_data = AND( i4, Z'0000ffff' )
items(module, 0 ) = items(module, 0 ) + 1
ts28 = AND( data_block( block_ptr + 1 ), Z'0fffffff' )
ts = timestamp( ts64, ts48, ts28, type )
IF ( ts.LT.ts_old ) THEN
items(module, 20 ) = items(module, 20 ) + 1
WRITE( 6, 9710 ) block_number, block_ptr, i4, module, fail,
+ range, channel_ident, channel, adc_data, ts, ts_old, ts_old-ts,
+ tag_old, type_old
ENDIF
ts_old = ts
tag_old = tag
type_old = 0
IF ( verbose ) THEN
WRITE( 6, 9700 ) block_number, block_ptr, i4, module, fail,
+ range, channel_ident, channel, adc_data, ts
ENDIF
ch = channel + ( module - 1 ) * 64 + ( range * 2048 )
C----67---------------------------------------------------------------72------80
C Other information
ELSEIF( tag.EQ.2 ) THEN
module = AND( RSHIFT( i4, 24 ), Z'0000003f' )
type = AND( RSHIFT( i4, 20 ), Z'0000000f' )
information = AND( i4, Z'000fffff' )
items(module, 1 ) = items(module, 1 ) + 1
ts28 = AND( data_block( block_ptr + 1 ), Z'0fffffff' )
IF ( type.EQ.2 ) THEN
C----67---------------------------------------------------------------72------80
C PAUSE timestamp
items(module, 4 ) = items(module, 4 ) + 1
ts48 = information
C ts = timestamp( ts48, ts28, type )
ts = timestamp( ts64, ts48, ts28, type )
IF ( ts.LT.ts_old ) THEN
items(module, 21 ) = items(module, 21 ) + 1
ENDIF
ts_old = ts
type_old = type
tag_old = tag
pause( module ) = ts
IF ( verbose ) THEN
WRITE( 6, 9800 ) block_number, block_ptr, i4, module, type,
+ information, ts
ENDIF
ELSEIF( type.EQ.3 ) THEN
C----67---------------------------------------------------------------72------80
C RESUME timestamp
items(module, 5 ) = items(module, 5 ) + 1
ts48 = information
C ts = timestamp( ts48, ts28, type )
ts = timestamp( ts64, ts48, ts28, type )
IF ( ts.LT.ts_old ) THEN
items(module, 22 ) = items(module, 22 ) + 1
ENDIF
ts_old = ts
type_old = type
tag_old = tag
resume( module ) = ts
IF ( resume( module ).GE.0
+ .AND.
+ pause( module ).GE.0
+ .AND.
+ resume( module ).GE.pause( module ) ) THEN
dead( module ) = ( resume( module ) - pause( module ) )
+ + dead( module )
pause( module ) = -1
resume( module ) = -1
ENDIF
IF ( verbose ) THEN
WRITE( 6, 9810 ) block_number, block_ptr, i4, module, type,
+ information, ts
ENDIF
ELSEIF( type.EQ.4 ) THEN
C----67---------------------------------------------------------------72------80
C SYNC100 timestamp/White Rabbit Timestamp Marker (bits 28-47)
items(module, 6 ) = items(module, 6 ) + 1
ts48 = information
C ts = timestamp( ts48, ts28, type )
ts = timestamp( ts64, ts48, ts28, type )
IF ( first_ts.EQ.0 ) THEN
first_ts = ts
... 446 more lines ...
|