PROGRAM GREAT
C Read and analyse GREAT format data - version 3.20
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 Parameter variables
C
INTEGER block_length
PARAMETER (block_length = 16384)
C
C Argument variables
C
CHARACTER*255 filename
C
INTEGER max_data_words, nowords
C
C Local variables
C
CHARACTER*(block_length*4) buffer
CHARACTER*255 arg
C
INTEGER block_number, block_ptr, data_block(block_length), event
INTEGER header_data(6), high_water_mark, i
INTEGER*2 i2(2), i2_2(4)
INTEGER i4, j4, i4_2(2), io_error, tag, items( 0:31 )
INTEGER fail, range, channel_ident, adc_data, module
INTEGER channel, type, information, ts28, ts48, sample_length
INTEGER information_index, mbs_data, ch, tag_old, type_old
integer*8 i8, ts, ts_old, iargc, first_ts, last_ts, sync_old
integer*8 pause(32), resume(32), dead(32)
REAL dt, t1, t2, secnds
LOGICAL verbose
EQUIVALENCE ( data_block, buffer )
EQUIVALENCE ( i4, i2( 1 ) )
EQUIVALENCE ( i8, i4_2(1) )
SAVE data_block, block_ptr, block_number, event, high_water_mark
C----67---------------------------------------------------------------72------80
C Announce program
WRITE( 6, 9000 )
C Initialise variables
block_ptr = 1
block_number = 0
event = 0
ts_old = 0
tag_old = 0
type_old = 0
first_ts = 0
last_ts = 0
verbose = .FALSE.
DO i = 0, 31
items( i ) = 0
ENDDO
DO i = 1, 32
pause( i ) = -1
resume( i ) = -1
dead( 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 )
C IF ( block_number.EQ.1 ) THEN
C IF ( block_ptr.LE.16 .OR. block_ptr.gt.16200 ) THEN
C WRITE( 6, 9500 ) block_ptr, i4, j4
C ENDIF
C ENDIF
tag = AND( RSHIFT( i4, 30 ), Z'00000003' )
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
items( 0 ) = items( 0 ) + 1
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' )
IF ( range.EQ.1 ) THEN
items( 19 ) = items( 19 ) + 1
ENDIF
channel_ident = AND( RSHIFT( i4, 16 ), Z'00000fff' )
module = AND( RSHIFT( channel_ident, 6 ), Z'0000003f' )
channel = AND( channel_ident, Z'0000003f' )
adc_data = AND( i4, Z'0000ffff' )
ts28 = AND( data_block( block_ptr + 1 ), 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
IF ( ts.LT.ts_old ) THEN
items( 20 ) = items( 20 ) + 1
WRITE( 6, 9710 ) block_number, block_ptr, i4, module, fail,
+ range, channel_ident, channel, adc_data, ts, ts_old, 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
items( 1 ) = items( 1 ) + 1
module = AND( RSHIFT( i4, 24 ), Z'0000003f' )
type = AND( RSHIFT( i4, 20 ), Z'0000000f' )
information = AND( i4, Z'000fffff' )
ts28 = AND( data_block( block_ptr + 1 ), Z'0fffffff' )
IF ( type.EQ.2 ) THEN
C----67---------------------------------------------------------------72------80
C PAUSE timestamp
items( 4 ) = items( 4 ) + 1
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
IF ( ts.LT.ts_old ) THEN
items( 21 ) = items( 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( 5 ) = items( 5 ) + 1
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
IF ( ts.LT.ts_old ) THEN
items( 22 ) = items( 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
items( 6 ) = items( 6 ) + 1
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
IF ( first_ts.EQ.0 ) THEN
first_ts = ts
C WRITE( 6, 9920 ) first_ts
C 9920 FORMAT( ' first ts: 0x', Z16.16 )
ENDIF
... 334 more lines ...
|