PROGRAM PWSBLOCK
C
C PWS HIGH RESOLUTION RECORD REBLOCKER
C
      PARAMETER (LREC=512)
      CHARACTER DSN*50
      INTEGER*2 INTDATA(24)
      LOGICAL*1 REC(LREC),TREC(48)
      EQUIVALENCE (TREC(1), INTDATA(1))
C
C OPEN BINARY IBM BIT MAPPED EDR .  512 BYTE LENGTH RECORD EXPECTED.
C READ AS SPANNED RECORD CONTAINING 48 BYTE BINARY PWS RECORDS.
C WRITE REBLOCKED RECORDS.
C
      WRITE(6,*) 
      WRITE(6,*) 'ENTER INPUT DSN'
      READ(5,'(A)') DSN
      OPEN(50,FILE=DSN,STATUS='OLD',FORM='UNFORMATTED',READONLY)
C
c      WRITE(6,*) 
C      WRITE(6,*) 'ENTER OUTPUT DSN'
C      READ(5,'(A)') DSN
C      OPEN(51,FILE=DSN,STATUS='NEW',FORM='UNFORMATTED',
C     &     RECORDTYPE='VARIABLE',RECL=8191)
C
      WRITE(6,*) 
      IBYTE = 0
      NREC = 0
   10 CONTINUE
         READ(50,END=100,ERR=10) (REC(I),I=1,LREC)
C
C EXTRACT 48 BYTE RECORDS FROM 512 BYTE SPANNED FILE
C
         DO J = 1,LREC
C
C BUILD HOLDING ARRAY TREC
C
            IBYTE = IBYTE + 1
            TREC(IBYTE) = REC(J)
            IF (IBYTE.EQ.48) THEN
C               WRITE(51) (TREC(L),L=1,48 )
               WRITE(6,800) (INTDATA(K),K=1,4)
               NREC = NREC + 1
               IF ( NREC.GT.5 ) STOP
               IBYTE = 0
            END IF
         END DO
        GOTO 10
  100 CONTINUE
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' TOTAL RECORDS WRITTEN'')') NREC
C
      CLOSE(50)
      CLOSE(51)
      WRITE(6,*)
      STOP
  800 FORMAT(4(1X,I4))
      END