C*********************************************************************
 
C...PYDUMP
C...Dumps histogram contents on file for reading by other program.
C...Can also read back own dump.
 
      SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI)
 
C...Double precision declaration.
      IMPLICIT DOUBLE PRECISION(A-H, O-Z)
      IMPLICIT INTEGER(I-N)
C...Commonblock.
      COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
      SAVE /PYBINS/
C...Local arrays and character variables.
      DIMENSION IHI(*),ISS(100),VAL(5)
      CHARACTER TITLE*60,FORMAT*13
      SAVE
 
C...Dump all histograms that have been booked,
C...including titles and ranges, one after the other.
      IF(MDUMP.EQ.1) THEN
 
C...Loop over histograms and find which are wanted and booked.
        IF(NHI.LE.0) THEN
          NW=IHIST(1)
        ELSE
          NW=NHI
        ENDIF
        DO 130 IW=1,NW
          IF(NHI.EQ.0) THEN
            ID=IW
          ELSE
            ID=IHI(IW)
          ENDIF
          IS=INDX(ID)
          IF(IS.NE.0) THEN
 
C...Write title, histogram size, filling statistics.
            NX=NINT(BIN(IS+1))
            DO 100 IT=1,20
              IEQ=NINT(BIN(IS+8+NX+IT))
              TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//
     &        CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256))
  100       CONTINUE
            WRITE(LFN,5100) ID,TITLE
            WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3)
            WRITE(LFN,5300) NINT(BIN(IS+5)),BIN(IS+6),BIN(IS+7),
     &      BIN(IS+8)
 
 
C...Write histogram contents, in groups of five.
            DO 120 IXG=1,(NX+4)/5
              DO 110 IXV=1,5
                IX=5*IXG+IXV-5
                IF(IX.LE.NX) THEN
                  VAL(IXV)=BIN(IS+8+IX)
                ELSE
                  VAL(IXV)=0D0
                ENDIF
  110         CONTINUE
              WRITE(LFN,5400) (VAL(IXV),IXV=1,5)
  120       CONTINUE
 
C...Go to next histogram; finish.
          ELSEIF(NHI.GT.0) THEN
            CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
          ENDIF
  130   CONTINUE
 
C...Read back in histograms dumped MDUMP=1.
      ELSEIF(MDUMP.EQ.2) THEN
 
C...Read histogram number, title and range, and book.
  140   READ(LFN,5100,END=170) ID,TITLE
        READ(LFN,5200) NX,XL,XU
        CALL PYBOOK(ID,TITLE,NX,XL,XU)
        IS=INDX(ID)
 
C...Read filling statistics.
        READ(LFN,5300) NENTRY,BIN(IS+6),BIN(IS+7),BIN(IS+8)
        BIN(IS+5)=DBLE(NENTRY)
 
C...Read histogram contents, in groups of five.
        DO 160 IXG=1,(NX+4)/5
          READ(LFN,5400) (VAL(IXV),IXV=1,5)
          DO 150 IXV=1,5
            IX=5*IXG+IXV-5
            IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV)
  150     CONTINUE
  160   CONTINUE
 
C...Go to next histogram; finish.
        GOTO 140
  170   CONTINUE
 
C...Write histogram contents in column format,
C...convenient e.g. for GNUPLOT input.
      ELSEIF(MDUMP.EQ.3) THEN
 
C...Find addresses to wanted histograms.
        NSS=0
        IF(NHI.LE.0) THEN
          NW=IHIST(1)
        ELSE
          NW=NHI
        ENDIF
        DO 180 IW=1,NW
          IF(NHI.EQ.0) THEN
            ID=IW
          ELSE
            ID=IHI(IW)
          ENDIF
          IS=INDX(ID)
          IF(IS.NE.0.AND.NSS.LT.100) THEN
            NSS=NSS+1
            ISS(NSS)=IS
          ELSEIF(NSS.GE.100) THEN
            CALL PYERRM(8,'(PYDUMP:) too many histograms requested')
          ELSEIF(NHI.GT.0) THEN
            CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
          ENDIF
  180   CONTINUE
 
C...Check that they have common number of x bins. Fix format.
        NX=NINT(BIN(ISS(1)+1))
        DO 190 IW=2,NSS
          IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN
            CALL PYERRM(8,'(PYDUMP:) different number of bins')
            RETURN
          ENDIF
  190   CONTINUE
        FORMAT='(1P,000E12.4)'
        WRITE(FORMAT(5:7),'(I3)') NSS+1
 
C...Write histogram contents; first column x values.
        DO 200 IX=1,NX
          X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4)
          WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS)
  200   CONTINUE
 
      ENDIF
 
C...Formats for output.
 5100 FORMAT(I5,5X,A60)
 5200 FORMAT(I5,1P,2D12.4)
 5300 FORMAT(I12,1P,3D12.4)
 5400 FORMAT(1P,5D12.4)
 
      RETURN
      END