pydump.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pydump.f

 
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
 
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