Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:09

0001  
0002 C*********************************************************************
0003  
0004 C...PYBOOK
0005 C...Books a histogram.
0006  
0007       SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU)
0008  
0009 C...Double precision declaration.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012 C...Commonblock.
0013       COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
0014       SAVE /PYBINS/
0015 C...Local character variables.
0016       CHARACTER TITLE*(*), TITFX*60
0017  
0018 C...Check that input is sensible. Find initial address in memory.
0019       IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28,
0020      &'(PYBOOK:) not allowed histogram number')
0021       IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28,
0022      &'(PYBOOK:) not allowed number of bins')
0023       IF(XL.GE.XU) CALL PYERRM(28,
0024      &'(PYBOOK:) x limits in wrong order')
0025       INDX(ID)=IHIST(4)
0026       IHIST(4)=IHIST(4)+28+NX
0027       IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28,
0028      &'(PYBOOK:) out of histogram space')
0029       IS=INDX(ID)
0030  
0031 C...Store histogram size and reset contents.
0032       BIN(IS+1)=NX
0033       BIN(IS+2)=XL
0034       BIN(IS+3)=XU
0035       BIN(IS+4)=(XU-XL)/NX
0036       CALL PYNULL(ID)
0037  
0038 C...Store title by conversion to integer to double precision.
0039       TITFX=TITLE//' '
0040       DO 100 IT=1,20
0041         BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+
0042      &  256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT))
0043   100 CONTINUE
0044  
0045       RETURN
0046       END