PROGRAM VERN7R
C
C     To verify and summarise the contents of Nimbus 7 SAMS R (RAW) files
C
      IMPLICIT NONE
C
      INTEGER CXSUM, DXSUM
      INTEGER IOSTAT, LUN, NEWD, NOLD, NREC
C
      CHARACTER*1  YN
      LOGICAL      BUFOUT, BYSWAP
C
      INTEGER*2    IBUFW(332)
      BYTE         IBUFB(664)
      EQUIVALENCE (IBUFW,IBUFB)
C
C-------------------------------------------------------------------------------
C
      BYSWAP = .FALSE.
      NOLD = 0
      NREC = 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, '(40Z2)', IOSTAT=IOSTAT ) IBUFB
      IF ( IOSTAT .NE. 0 ) GOTO 999
      IF ( IBUFW(1).EQ.17934 .AND. IBUFW(2).EQ.17934 ) THEN
C       Assume byte ordering does not follow original DEC convention
        IF ( .NOT. BYSWAP ) PRINT *, 'Swapping bytes'
        BYSWAP = .TRUE.
        CALL SWAPBY ( IBUFB )
      ENDIF
C****
C
C     Dump record if required
      IF ( BUFOUT ) THEN
        WRITE ( LUN, * ) ' '
        WRITE ( LUN, * ) IBUFW
        WRITE ( LUN, * ) ' '
      ENDIF
C
C     Check original checksum from data tape
      IF ( IBUFW(3) .NE. 332 ) THEN
        PRINT *, 'Unexpected buffer length', IBUFW(3)
        STOP
      ENDIF
      DXSUM = IBUFW(332)
      CALL NIMXSM ( 332, IBUFW, 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
          STOP
        ENDIF
      ENDIF
C
      NEWD = IAND ( IBUFW(6), 511 )
      IF ( NEWD.NE.NOLD .AND. NREC.NE.0 ) THEN
        PRINT *, NREC, ' N7 SAMS Raw records for day', NOLD
        NOLD = NEWD
        NREC = 0
       ENDIF
       NREC = NREC + 1
C
  999 CONTINUE
      IF ( IOSTAT .EQ. 0 ) THEN
        GOTO 10
      ELSEIF ( IOSTAT .GT. 0 ) THEN
        PRINT *, 'Error', IOSTAT, ' reading file'
      ENDIF
      IF ( NREC .GT. 0 )
     +  PRINT *, NREC, ' N7 SAMS Raw records for day', NOLD
      END

      SUBROUTINE NIMXSM ( LWORD, IBUFW, IXSUM )
C
C     To calculate checksum on R series tapes
C
      IMPLICIT NONE
C
      INTEGER   I, IXSUM, LWORD
      INTEGER*2 IBUFW(*)

      IXSUM = 0
      DO I = 1, LWORD-1
        IXSUM = IXSUM + IBUFW(I)
        IF ( IXSUM .GT. 4095 ) IXSUM = IXSUM - 4095
      ENDDO
      END

      SUBROUTINE SWAPBY ( IBYTE )
C
C     To reverse the byte ordering to DEC convention
C
      IMPLICIT NONE
C
      BYTE    IBYTE(664)
      BYTE    B
      INTEGER J
C
      DO J = 1, 663, 2
        B = IBYTE(J)
        IBYTE(J)   = IBYTE(J+1)
        IBYTE(J+1) = B
      ENDDO
      END