pythiaeRHIC/pythia/pydump.f

0001
0002 C*********************************************************************
0003
0004 C...PYDUMP
0005 C...Dumps histogram contents on file for reading by other program.
0006 C...Can also read back own dump.
0007
0008       SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI)
0009
0010 C...Double precision declaration.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013 C...Commonblock.
0014       COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
0015       SAVE /PYBINS/
0016 C...Local arrays and character variables.
0017       DIMENSION IHI(*),ISS(100),VAL(5)
0018       CHARACTER TITLE*60,FORMAT*13
0019
0020 C...Dump all histograms that have been booked,
0021 C...including titles and ranges, one after the other.
0022       IF(MDUMP.EQ.1) THEN
0023
0024 C...Loop over histograms and find which are wanted and booked.
0025         IF(NHI.LE.0) THEN
0026           NW=IHIST(1)
0027         ELSE
0028           NW=NHI
0029         ENDIF
0030         DO 130 IW=1,NW
0031           IF(NHI.EQ.0) THEN
0032             ID=IW
0033           ELSE
0034             ID=IHI(IW)
0035           ENDIF
0036           IS=INDX(ID)
0037           IF(IS.NE.0) THEN
0038
0039 C...Write title, histogram size, filling statistics.
0040             NX=NINT(BIN(IS+1))
0041             DO 100 IT=1,20
0042               IEQ=NINT(BIN(IS+8+NX+IT))
0043               TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//
0044      &        CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256))
0045   100       CONTINUE
0046             WRITE(LFN,5100) ID,TITLE
0047             WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3)
0048             WRITE(LFN,5300) NINT(BIN(IS+5)),BIN(IS+6),BIN(IS+7),
0049      &      BIN(IS+8)
0050
0051
0052 C...Write histogram contents, in groups of five.
0053             DO 120 IXG=1,(NX+4)/5
0054               DO 110 IXV=1,5
0055                 IX=5*IXG+IXV-5
0056                 IF(IX.LE.NX) THEN
0057                   VAL(IXV)=BIN(IS+8+IX)
0058                 ELSE
0059                   VAL(IXV)=0D0
0060                 ENDIF
0061   110         CONTINUE
0062               WRITE(LFN,5400) (VAL(IXV),IXV=1,5)
0063   120       CONTINUE
0064
0065 C...Go to next histogram; finish.
0066           ELSEIF(NHI.GT.0) THEN
0067             CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
0068           ENDIF
0069   130   CONTINUE
0070
0071 C...Read back in histograms dumped MDUMP=1.
0072       ELSEIF(MDUMP.EQ.2) THEN
0073
0074 C...Read histogram number, title and range, and book.
0075   140   READ(LFN,5100,END=170) ID,TITLE
0076         READ(LFN,5200) NX,XL,XU
0077         CALL PYBOOK(ID,TITLE,NX,XL,XU)
0078         IS=INDX(ID)
0079
0080 C...Read filling statistics.
0081         READ(LFN,5300) NENTRY,BIN(IS+6),BIN(IS+7),BIN(IS+8)
0082         BIN(IS+5)=DBLE(NENTRY)
0083
0084 C...Read histogram contents, in groups of five.
0085         DO 160 IXG=1,(NX+4)/5
0086           READ(LFN,5400) (VAL(IXV),IXV=1,5)
0087           DO 150 IXV=1,5
0088             IX=5*IXG+IXV-5
0089             IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV)
0090   150     CONTINUE
0091   160   CONTINUE
0092
0093 C...Go to next histogram; finish.
0094         GOTO 140
0095   170   CONTINUE
0096
0097 C...Write histogram contents in column format,
0098 C...convenient e.g. for GNUPLOT input.
0099       ELSEIF(MDUMP.EQ.3) THEN
0100
0101 C...Find addresses to wanted histograms.
0102         NSS=0
0103         IF(NHI.LE.0) THEN
0104           NW=IHIST(1)
0105         ELSE
0106           NW=NHI
0107         ENDIF
0108         DO 180 IW=1,NW
0109           IF(NHI.EQ.0) THEN
0110             ID=IW
0111           ELSE
0112             ID=IHI(IW)
0113           ENDIF
0114           IS=INDX(ID)
0115           IF(IS.NE.0.AND.NSS.LT.100) THEN
0116             NSS=NSS+1
0117             ISS(NSS)=IS
0118           ELSEIF(NSS.GE.100) THEN
0119             CALL PYERRM(8,'(PYDUMP:) too many histograms requested')
0120           ELSEIF(NHI.GT.0) THEN
0121             CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
0122           ENDIF
0123   180   CONTINUE
0124
0125 C...Check that they have common number of x bins. Fix format.
0126         NX=NINT(BIN(ISS(1)+1))
0127         DO 190 IW=2,NSS
0128           IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN
0129             CALL PYERRM(8,'(PYDUMP:) different number of bins')
0130             RETURN
0131           ENDIF
0132   190   CONTINUE
0133         FORMAT='(1P,000E12.4)'
0134         WRITE(FORMAT(5:7),'(I3)') NSS+1
0135
0136 C...Write histogram contents; first column x values.
0137         DO 200 IX=1,NX
0138           X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4)
0139           WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS)
0140   200   CONTINUE
0141
0142       ENDIF
0143
0144 C...Formats for output.
0145  5100 FORMAT(I5,5X,A60)
0146  5200 FORMAT(I5,1P,2D12.4)
0147  5300 FORMAT(I12,1P,3D12.4)
0148  5400 FORMAT(1P,5D12.4)
0149
0150       RETURN
0151       END