PROGRAM VERSUM
C
C To verify and summarise the contents of Nimbus 4, 5 and 6
C ORBIT, RAD_GRID, RAT and DT2 files
C
IMPLICIT NONE
C
INTEGER CXSUM, DXSUM, MAXLEN
INTEGER DAYNO, YEAR, NORBIT, NMF
INTEGER I, IDENT, ID, IOSTAT, LUN, LBYTE, LWORD, K, KREC
INTEGER LASTK, LASTDY
C
C Integer function to decode F2 Number format
EXTERNAL IF2FMT
INTEGER IF2FMT
C
CHARACTER*1 YN
LOGICAL BUFOUT, BYSWAP
CHARACTER*80 STRING
C
C Documentated word count starts from zero
INTEGER*2 IBUFW(0:5000)
BYTE IBUFB(-1:10000)
EQUIVALENCE (IBUFW,IBUFB)
C
C----------------------------------------------------------------------------
C
BYSWAP = .FALSE.
MAXLEN = 0
KREC = 0
LASTK = 0
LASTDY = 0
C
C Set up destination for output
LUN = 6
PRINT *, 'Output to terminal (Y/N=file) ? [Default=Y]'
READ ( *, '(A)' ) YN
IF ( YN.EQ.'N' .OR. YN.EQ.'n' ) LUN = 1
C
C Decide if data buffers are to be printed. (Can produce LOTS of output)
BUFOUT = .FALSE.
PRINT *, 'Output data buffers (Y/N) ? [Default=N]'
READ ( *, '(A)' ) YN
IF ( YN.EQ.'Y' .OR. YN.EQ.'y' ) BUFOUT = .TRUE.
C
C Open the data file (named CDFILE) on unit 3 (arbitrary)
OPEN ( 3, FILE='CDFILE', STATUS='OLD', IOSTAT=IOSTAT )
IF ( IOSTAT .NE. 0 ) THEN
PRINT *, 'Error', IOSTAT, ' opening CDFILE (data file)'
STOP
ENDIF
C
C**** Read in the data from CDFILE
10 READ ( 3, '(A)', IOSTAT=IOSTAT ) STRING
IF ( IOSTAT .NE. 0 ) GOTO 999
READ ( STRING(1:12), '(6Z2)' ) (IBUFB(I),I=-1,4)
IF ( IBUFW(0) .EQ. 17934 .AND. IBUFW(1) .EQ. 17934 ) THEN
C Assume byte ordering does not follow original DEC convention
BYSWAP = .TRUE.
CALL SWAPBY ( IBUFB, -1, 4 )
ELSE IF ( IBUFW(0).NE.3654 .OR. IBUFW(1).NE.3654 ) THEN
PRINT *, 'Unexpected initial words', IBUFW(0), IBUFW(1)
STOP
ENDIF
C Set pointers to last word and byte in record
LWORD = IBUFW(2) - 1
LBYTE = 2*LWORD
READ ( STRING(13:), '(34Z2)' ) (IBUFB(I),I=5,MIN(38,LBYTE))
DO K = 39, LBYTE, 40
READ ( 3, '(40Z2)' ) (IBUFB(I),I=K,MIN(K+39,LBYTE))
ENDDO
IF ( BYSWAP ) CALL SWAPBY ( IBUFB, 5, LBYTE )
C****
C
C Dump record if required
IF ( BUFOUT ) THEN
WRITE ( LUN, * ) ' '
WRITE ( LUN, * ) (IBUFW(I), I=0,LWORD)
WRITE ( LUN, * ) ' '
ENDIF
C
C Check original checksum from data tape
DXSUM = IBUFW(LWORD)
CALL NIMXSM ( LWORD, IBUFW, CXSUM )
IF ( CXSUM-DXSUM.NE.0 .AND. CXSUM-DXSUM.NE.4095 ) THEN
PRINT *, 'Checksum error: calc: ', CXSUM, ' data: ', DXSUM
PRINT *, 'Continue (Y/N) [Y]'
READ ( *, '(A)' ) YN
IF ( YN.EQ.'N' .OR. YN.EQ.'n' ) THEN
WRITE ( 2, * ) (IBUFW(I), I=0,LWORD)
STOP
ENDIF
ENDIF
C
C Check record identifier
ID = IBUFW(4)
IF ( ID.NE.192 .AND. ID.NE.193 .AND. ID.NE.194 .AND.
+ ID.NE.195 .AND. ID.NE.384 .AND. ID.NE.448 .AND.
+ ID.NE.449 .AND. ID.NE.450 .AND. ID.NE.451 .AND.
+ ID.NE.453 .AND. ID.NE.454 .AND. ID.NE.461 .AND.
+ ID.NE.465 .AND. ID.NE.470 .AND. ID.NE.577 .AND.
+ ID.NE.3280 .AND. ID.NE.3281 .AND.
+ ID.NE.4032 .AND. ID.NE.4033 .AND. ID.NE.4095 ) THEN
PRINT *, 'Error: Unexpected identifier found', ID
PRINT *, (IBUFW(I), I=0,9)
STOP
ENDIF
C
C Produce summary information
IF ( ID .EQ. 470 ) THEN
C Orbit file record
DAYNO = IBUFW(9)
YEAR = IBUFW(10)
NORBIT = IF2FMT ( IBUFW, 5, 6 )
IF ( LBYTE .EQ. 1058 ) THEN
WRITE ( LUN, '(A,I7,A,2I5)' )
+ ' N4 Orbit file record for orbit', NORBIT, '. Day', DAYNO, YEAR
ELSE IF ( LBYTE .EQ. 1550 ) THEN
WRITE ( LUN, '(A,I7,A,2I5)' )
+ ' N5 Orbit file record for orbit', NORBIT, '. Day', DAYNO, YEAR
ELSE IF ( LBYTE .EQ. 2862 ) THEN
WRITE ( LUN, '(A,I7,A,2I5)' )
+ ' N6 Orbit file record for orbit', NORBIT, '. Day', DAYNO, YEAR
ELSE
PRINT *,' Unexpected length Orbit file record. Length(bytes)',
+ LBYTE+2
STOP
ENDIF
ENDIF
C
IF ( ID .EQ. 4032 ) THEN
C Start of RAD_GRID day record
DAYNO = IBUFW(9)
YEAR = IBUFW(10)
NORBIT = IBUFW(16)
NMF = IF2FMT ( IBUFW, 18, 19 )
WRITE ( LUN, '(A,2I5)' )
+ ' Start of day record (4032) for N456 file', DAYNO, YEAR
WRITE ( LUN, '(I5,A,I8,A,I6)' ) NORBIT, ' orbits. ', NMF,
+ ' major frames. Length(bytes)', LBYTE+2
ENDIF
IF ( ID .EQ. 3280 ) THEN
C N6 RAT orbit header
DAYNO = IBUFW(5)
YEAR = IBUFW(6)
I = DAYNO*10000 + YEAR
IF ( LASTDY.NE.0 .AND. LASTDY.NE.I ) THEN
WRITE ( LUN, '(I5,A,2I5)' ) KREC-LASTK+1,
+ ' N6 RAT records for', LASTDY/10000 , MOD(LASTDY,10000)
LASTK = KREC
ENDIF
LASTDY = I
ENDIF
IF ( ID .EQ. 192 ) WRITE ( LUN, '(A,I7,A,I7)' )
+ ' Orbit', IF2FMT(IBUFW,5,6), '. Day', IBUFW(8)
C
C Treat all N6 RAT records as 3280 to avoid too much output
IF ( ID .EQ. 3281 ) ID = 3280
C Treat all N5 DT SCR records as 192 to avoid too much output
IF ( ID .EQ. 193 .OR. ID .EQ. 194 ) ID = 192
C Collect summary data
IF ( KREC .EQ. 0 ) IDENT = ID
IF ( ID .EQ. IDENT ) THEN
KREC = KREC + 1
MAXLEN = MAX ( MAXLEN, LBYTE+2 )
GOTO 10
ENDIF
C
999 CONTINUE
IF ( IDENT .EQ. 192 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 DT2 SCR records (192,193,194). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 195 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 DT2 SCR Orbit end records (195). Max length',
+ MAXLEN
ELSEIF ( IDENT .EQ. 384 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N6 RAD_GRID Zonal mean radiance records (384). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 448 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N456 RAD_GRID Orbit grid records (448). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 449 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N456 RAD_GRID Lat/Long Rad grid records (449). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 450 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N456 RAD_GRID ZMR and std dev. records (450). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 451 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 URAD_GRID Zonal Mean Temp. records (451). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 453 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 URAD_GRID Temp. Fourier coeff. records (453). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 454 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 URAD_GRID Temp. Standard dev. records (454). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 461 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N456 RAD_GRID Rad Fourier coeff records (461). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 465 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N6 Day/night difference records (465). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 470 ) THEN
IF ( MAXLEN .EQ. 1060 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' Nimbus 4 Orbit tape (radiance) records (470)'
ELSE IF ( MAXLEN .EQ. 1552 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' Nimbus 5 Orbit tape (radiance) records (470)'
ELSE IF ( MAXLEN .EQ. 2864 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' Nimbus 6 Orbit tape (radiance) records (470)'
ENDIF
ELSE IF ( IDENT .EQ. 577 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N5 DT2 Cal data used records (577). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 3280 ) THEN
WRITE ( LUN, '(I5,A,2I5)' ) KREC-LASTK+1,
+ ' N6 RAT records for', LASTDY/10000 , MOD(LASTDY,10000)
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N6 RAT records (3280 and 3281). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 4033 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' N456 RAD_GRID End of day records (4033). Max length',
+ MAXLEN
ELSE IF ( IDENT .EQ. 4095 ) THEN
WRITE ( LUN, '(I8,A,I6)' ) KREC,
+ ' End of useful data records (4095). Max length',
+ MAXLEN
ENDIF
C
KREC = 1
MAXLEN = LBYTE + 2
IDENT = ID
IF ( IOSTAT .EQ. 0 ) THEN
GOTO 10
ELSEIF ( IOSTAT .GT. 0 ) THEN
PRINT *, 'Error', IOSTAT, ' reading file'
ENDIF
END
SUBROUTINE NIMXSM ( LWORD, IBUFW, IXSUM )
C
C To calculate checksum as written on original magnetic tape
C Note there has been inconsistent use of .GT. and .GE. 4095.
C A checksum of 4095 may have been written to tape as 0.
C
IMPLICIT NONE
C
INTEGER I, IXSUM, LWORD
INTEGER*2 IBUFW(0:*)
C
IXSUM = 0
DO I = 0, LWORD-1
IXSUM = IXSUM + IBUFW(I)
IF ( IXSUM .GT. 4095 ) IXSUM = IXSUM - 4095
ENDDO
END
INTEGER FUNCTION IF2FMT ( IBUFFER, I1, I2 )
C
IMPLICIT NONE
C
INTEGER I1, I2, J1, J2
INTEGER*2 IBUFFER(0:*)
C
J1 = IBUFFER(I1)
J2 = IBUFFER(I2)
IF2FMT = 4096*J1 + J2
IF ( I1 .GE. 2048 ) IF2FMT = IF2FMT - 16777216
END
SUBROUTINE SWAPBY ( IBYTE, I1, I2 )
C
C To reverse the byte ordering to DEC convention
C
INTEGER I1, I2, J
BYTE IBYTE(-1:*), B
C
DO J = I1, I2, 2
B = IBYTE(J)
IBYTE(J) = IBYTE(J+1)
IBYTE(J+1) = B
ENDDO
END