PROGRAM VERN7C
C
C     To verify and summarise the contents of Nimbus 7 SAMS C (RAT) files
C
      IMPLICIT NONE
C
      INTEGER CXSUM, DXSUM
      INTEGER I, IOSTAT, LUN, LBYTE, LWORD, NORBIT, NMF, NTB, K
C
      CHARACTER*1  YN
      LOGICAL      BUFOUT, BYSWAP
      CHARACTER*80 STRING
C
C     Documentated word count starts from zero
      INTEGER*2    IBUFW(-3:400)
      BYTE         IBUFB(-7:800)
      EQUIVALENCE (IBUFW,IBUFB)
C
C-------------------------------------------------------------------------------
C
      BYSWAP = .FALSE.
      NMF = 0
      NTB = 0
      NORBIT = 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=-7,-2)
      IF ( IBUFW(-1).EQ.8220 .OR. IBUFW(-1).EQ.8476 .OR.
     &     IBUFW(-1).EQ.8732 .OR. IBUFW(-1).EQ.8988      ) THEN
C       Assume byte ordering does not follow original DEC convention
        IF ( .NOT. BYSWAP ) PRINT *, 'Swapping bytes'
        BYSWAP = .TRUE.
        CALL SWAPBY ( IBUFB, -7, -2 )
      ENDIF
C     Set pointers to last word and byte in record
      LBYTE = IBUFW(-3) - 8
      LWORD = (LBYTE+1)/2
      READ ( STRING(13:), '(34Z2)' ) (IBUFB(I),I=-1,MIN(32,LBYTE))
      DO K = 33, LBYTE, 40
        READ ( 3, '(40Z2)' ) (IBUFB(I),I=K,MIN(K+39,LBYTE))
      ENDDO
      IF ( BYSWAP ) CALL SWAPBY ( IBUFB, -1, LBYTE )
C****
C
C     Dump record if required
      IF ( BUFOUT ) THEN
        WRITE ( LUN, * ) ' '
        WRITE ( LUN, * ) (IBUFW(I), I=-3,LWORD)
        WRITE ( LUN, * ) ' '
      ENDIF
C
C     Check original checksum from data tape
      DXSUM = IBUFW(LWORD)
      DXSUM = IAND ( DXSUM, 32767 )
      CALL NIMXSM ( -3, LBYTE, IBUFB, CXSUM )
      IF ( CXSUM .NE. DXSUM ) 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=-3,LWORD)
          STOP
        ENDIF
      ENDIF
C
      IF     ( IBUFW(-1) .EQ. 7200 ) THEN
C       File Header record
        IF ( NTB.GT.0 .OR. NMF.GT.0 ) THEN
          PRINT *,
     +    NMF,' major frames', NTB,' temp. blocks.  First orbit', NORBIT
          NTB = 0
          NMF = 0
          NORBIT = 0
        ENDIF
        PRINT *, ' N7 RAT File Header for day', IBUFW(2), IBUFW(1)
      ELSEIF ( IBUFW(-1) .EQ. 7201 ) THEN 
C       Data Header record
        IF ( NORBIT .EQ. 0 ) THEN
          NORBIT = IBUFW(12)
        ELSE
          PRINT *, ' Unexpected Data Header for true orbit', IBUFW(12)
         ENDIF
      ELSEIF ( IBUFW(-1) .EQ. 7202 ) THEN
C       Major frame data
        NMF = NMF + 1
      ELSEIF ( IBUFW(-1) .EQ. 7203 ) THEN
C       Temperature Data
        NTB = NTB + 1
      ELSE
        PRINT *, 'Unexpected buffer', (IBUFW(I), I=-3,0)
      ENDIF
C
  999 CONTINUE
      IF ( IOSTAT .EQ. 0 ) THEN
        GOTO 10
      ELSEIF ( IOSTAT .GT. 0 ) THEN
        PRINT *, 'Error', IOSTAT, ' reading file'
      ENDIF
      IF ( NTB.GT.0 .OR. NMF.GT.0 ) PRINT *,
     +    NMF,' major frames', NTB,' temp. blocks.  First orbit', NORBIT
      END

      SUBROUTINE NIMXSM ( I0, LBYTE, IBUFB, IXSUM )
C
C     To calculate N7 checksum as written on original magnetic tape
C
      IMPLICIT NONE
C
      INTEGER   I, J, IXSUM, I0, LBYTE
      BYTE      IBUFB(-7:800)
C
      IXSUM = 0
      DO I = I0, LBYTE-2
        J = IBUFB(I)
        IF ( J .LT. 0 ) J = 256 + J
        IXSUM = IXSUM + J
      ENDDO
      IXSUM = IAND ( IXSUM, 32767 )
      END

      SUBROUTINE SWAPBY ( IBYTE, I1, I2 )
C
C     To reverse the byte ordering to DEC convention
C
      IMPLICIT NONE
C
      BYTE    IBYTE(-7:*)
      BYTE    B
      INTEGER I1, I2, J
C
      DO J = I1, I2, 2
        B = IBYTE(J)
        IBYTE(J)   = IBYTE(J+1)
        IBYTE(J+1) = B
      ENDDO
      END