C *************************************************
C     PURPOSE: PRODUCE A FORMATTED DUMP OF DATA
C              TRANSMITTED OR RECEIVED FROM A
C              REMOTE BATCH TERMINAL.
C     DCB ASSIGNMENTS: F:1-INPUT DUMP FILE
C                      F:108-OUTPUT FOR REPORT
C                      F:102-OUTPUT FOR COMMANDS
C                      F:105-INPUT COMMANDS.
C *************************************************
      DIMENSION IBUF(160),IBUF1(160)
      DATA IFLAG/0/,ICON/1800000/,WIDE/4HWIDE/,ISIZE/0/
C      SET TO TRUNCATE...ALLOW LEADING ZEROES IN TIME FIELD
      CALL TRUNCATE(0)
C *************************************************
C     CHECK TO SEE WHAT SIZE REPORT IS DESIRED.
      WRITE(102,940)
      READ(105,920)WN
      IF(WN.EQ.WIDE)ISIZE=1
      WRITE(102,960)
      READ(105,961)Q1
      Q2=0
      Q3=0
      WRITE(108,900)
C     ARRAY INITIALIZATION
10    DO 50 I=1,160
50    IBUF(I)=IBUF1(I)=8Z00000000
C *************************************************
C     INPUT VALIDATION/ERROR CHECKING
      CALL BUFFERIN(1,0,IBUF,160,ISTAT,NW,NB,IERR)
      Q3=Q3+1
      Q2=Q2+1
      WRITE(108,962)Q2
      IF(Q1.GT.Q2)GOTO 10
      IF (Q3.LT.100)GOTO 11
      WRITE(102,962)Q2
      Q3=0
11     CONTINUE
      IF(ISTAT.EQ.3)GO TO 99
      ISQNO=ISA(IBUF(1),-16)
      IF(NW.GE.7)GO TO 15
      WRITE(108,100)ISQNO
      ISQNO1=ISQNO+1
      GO TO 10
15    IF(IFLAG.NE.0)GO TO 20
      IFLAG=1
20    IF(ISQNO.EQ.ISQNO1)GO TO 25
      ISQ=ISQNO-(ISQNO1-1)
      IF(ISQ.NE.0)GO TO 35
      WRITE(108,700)ISQNO
      GO TO 25
35    IF(ISQ.LT.0)GO TO 25
      WRITE(108,200)ISQ
25    ISQNO1=ISQNO+1
      IWD=IAND(IBUF(1),8Z0000FFFF)
      IF(IWD.EQ.NW)GO TO 30
      WRITE(108,300)NW,IWD
C *************************************************
C     TIME CALCULATION AND PRINTING
30    IH=IBUF(7)/ICON
      IM=(IBUF(7)-(IH*ICON))/30000
      ITP=IBUF(7)-((IH*ICON)+(IM*30000))
      ISEC=ITP/500
      ITSEC=2*(ITP-(ISEC*500))
C        ADD FUDGE FACTORS SO LEADING ZEROES WILL PRINT
      IM=IM+1000
      ISEC=ISEC+1000
      ITSEC=ITSEC+10000
C *************************************************
C     DUMP TRANSLATION
      WRITE(108,500)
      IB=IAND(IBUF(5),8Z1F000000)
S     LI,3 0
S     LB,2 IB,3
S     CI,2 X'01'
S     BE 70S
S     CI,2 X'02'
S     BE 71S
S     CI,2 X'05'
S     BE 72S
S     CI,2 X'03'
S     BE 73S
S     CI,2 X'07'
S     BE 74S
S     CI,2 X'0B'
S     BE 75S
S     CI,2 X'09'
S     BE 76S
70    WRITE(108,600)IBUF(I),I=2,6
      GO TO 90
      GO TO 90
72    WRITE(108,602)IBUF(I),I=2,6
      GO TO 90
73    WRITE(108,603)IBUF(I),I=2,6
      GO TO 90
74    WRITE(108,604)IBUF(I),I=2,6
      GO TO 90
75    WRITE(108,605)IBUF(I),I=2,6
      GO TO 90
76    WRITE(108,606)IBUF(I),I=2,6
90    DO 33 I=8,NW
      IB=IBUF(I)
      IB1=IBUF1(I)
S     LW,5 NB
S     LI,4 3
S     LI,3 0
S34   LB,2 IB,3
S     CI,2 X'40'
S     BE 32S
S     CI,2 X'4A'
S     BL 31S
S     CI,2 X'51'
S     CI,2 X'5A'
S     BL 31S
S     CI,2 X'62'
S     BL 32S
S     CI,2 X'6A'
S     BL 31S
S     CI,2 X'70'
S     BL 32S
S     CI,2 X'7A'
S     BL 31S
S     CI,2 X'80'
S     BE 31S
S     BL 32S
S     CI,2 X'8A'
S     BL 32S
S     CI,2 X'91'
S     BL 31S
S     CI,2 X'9A'
S     BL 32S
S     CI,2 X'A2'
S     BL 31S
S     CI,2 X'AA'
S     CI,2 X'B1'
S     BL 31S
S     CI,2 X'B6'
S     BL 32S
S     CI,2 X'C1'
S     BL 31S
S     CI,2 X'CA'
S     BL 32S
S     CI,2 X'D1'
S     BL 31S
S     CI,2 X'DA'
S     BL 32S
S     CI,2 X'E2'
S     BL 31S
S     CI,2 X'EA'
S     BL 32S
S     CI,2 X'F0'
S     BL 31S
S     CI,2 X'FA'
S     BL 32S
S31   LI,2 X'4B'
S32   STB,2 IB1,3
S     CI,3 4
S     BE 33S
S     AI,3 1
S     B 34S
C *+***********************************************
C     REPORT PRINTING
33    IBUF1(I)=IB1
C******  CALCULATE ACTUAL BYTE COUNT
      NB=IAND(8Z0000FFFF,IBUF(6))-IAND(8Z0000FFFF,IBUF(4))
      WRITE(108,910)NB
      NB1=NB+28
      IF(ISIZE.EQ.1)GO TO 55
      DO 40 I=8,NW,4
      II=I-8
      IF(NB1.GE.((I+3)*4))GO  TO 110
      I1=(NB-(II*4))/4
      N1=N4=I1
      N5=NB1-((I-1)*4)-(N1*4)
      N2=2*N5
      N6=32-(4*N2)
      N3=40-(10*N1)-N2
      IBUFX=ISA(IBUF(I+I1),-N6)
      IF(I1.GT.0)GO TO 42
      WRITE(108,810)II,N2,IBUFX,N3,N5,IBUF1(I)
42    I1=I1-1
      GO TO 40
110   I1=2
      N1=N4=3
      N3=2
      N2=8
      N5=4
      IBUFX=IBUF(I+3)
40    WRITE(108,800)II,N1,(IBUF(J),J=I,I+I1),N2,IBUFX,N3,N4,
     1(IBUF1(J),J=I,I+I1),N5,IBUF1(J)
      GO TO 10
55    DO 60 I=8,NW,8
      II=I-8
      IF(NB1.GE.((I+7)*4))GO TO 56
      I1=(NB-(II*4))/4
      N1=N4=I1
      N5=NB1-((I-1)*4)-(N1*4)
      N2=2*N5
      N6=32-(4*N2)
      N3=73-(9*N1)-N2
      IBUFX=ISA(IBUF(I+I1),-N6)
      IF(I1.GT.0)GO TO 57
      GO TO 10
57    I1=I1-1
      GO TO 60
56    I1=6
      N1=N4=7
      N2=8
      N3=2
      N5=4
      IBUFX=IBUF(I+7)
60    WRITE(108,930)II,N1,(IBUF(J),J=I,I+I1),N2,IBUFX,N3,N4,
     1(IBUF1(J),J=I,I+I1),N5,IBUF1(J)
      GO TO 10
100   FORMAT(//,2X,30HNO. WORDS READ LT 7  SEQ. NO.=,I5)
200   FORMAT(//,2X,I3,2X,22HRECORDS LOST**********)
300   FORMAT(//,2X,49HNO. WORDS READ DOES NOT MATCH NO. WORDS IN HEADER
     1,/,2X,I3,14HNO. WORDS READ,10X,I3,19HNO. WORDS IN HEADER)
400   FORMAT(///,2X,5HTIME-,I2,1H:,I2,1H:,I2,1H.,I3)
500   FORMAT(/,4X,8HAIO STAT,3X,17H----TDV STATUS---,4X,
     117H-COMMAND DBLE WD-)
600   FORMAT(4X,Z8,3X,Z8,1X,Z8,4X,Z8,1X,Z8,2X,5HWRITE)
601   FORMAT(4X,Z8,3X,Z8,1X,Z8,4X,Z8,1X,Z8,2X,4HREAD)
602   FORMAT(4X,Z8,3X,Z8,2X,Z8,4X,Z8,1X,Z8,2X,4HDIAL)
604   FORMAT(4X,Z8,3X,Z8,1X,Z8,4X,Z8,1X,Z8,2X,18HENABLE RING DETECT)
605   FORMAT(4X,Z8,3X,Z8,1X,Z8,4X,Z8,1X,Z8,2X,10HDISCONNECT)
606   FORMAT(4X,Z8,3X,Z8,1X,Z8,4X,Z8,1X,Z8,2X,19HGENERATE LONG SPACE)
700   FORMAT(//,2X,27HDUPLICATE RECORDS-SEQ. NO.=,I5)
800   FORMAT(/,1X,I5,2X,N(Z8,2X),ZN,NX,N(A4,2X),AN)
810   FORMAT(/,1X,I5,2X,ZN,NX,AN)
900   FORMAT(1H1,/,20X,25HRBT DUMP ANALYSIS PROGRAM)
910   FORMAT(/,2X,33HDUMP OF TRANSMITTED/RECEIVED DATA,5X,
     128HNUMBER OF BYTES TRANSMITTED=,I3)
920   FORMAT(A4)
930   FORMAT(/,1X,I3,2X,N(Z8,1X),ZN,NX,N(A4,1X),AN)
940   FORMAT(25HSIZE OF PAPER?(WIDE/NARR))
950   FORMAT(/,1X,I3,2X,ZN,NX,AN)
960    FORMAT(8H SKIP #?)
961    FORMAT(I5)
962     FORMAT(2X,I5)
99    STOP
      END
