*-- Author : Stephen J. Maxfield 17/02/92
SUBROUTINE FPSGST
**: FPSGST.......SM. More diagnostic histograms.
**----------------------------------------------------------------------
**: FPSGST 30207 GB. comment lines moved inside the routine
**: FPSGST 30205 SM. Add extra diagnostics for segments.
**----------------------------------------------------------------------
*
* Make diagnostic histograms of planar segments.
* (Monte Carlo only!!)
*
*KEEP,BCS.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEEP,H1EVDT.
COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF
INTEGER KEVENT,IDATA,LCONF
LOGICAL MONTE
*
* IDATA type of information (HEAD bank word 6) :
*
* 0 - real data H1
* 1 - MC data H1SIM
* 2 - real data CERN tests
* 3 - MC data ARCET
*
* MONTE = .TRUE. if IDATA=1
* KEVENT = event processed counter for H1REC
*
*KEND.
*
DIMENSION KDIG(12), KSTR(12), KSGN(12), KBAD(12), IDX(12)
*
PARAMETER (MAXSTR=2000)
DIMENSION IPLHIT(MAXSTR,3)
DIMENSION IPPHIT(MAXSTR,3)
DIMENSION KSEG(3)
DIMENSION NSGSTR(3)
DIMENSION NSGFND(3,2)
DIMENSION NSTRPR(3)
DIMENSION NFNDPR(3,2)
*KEEP,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
IRMOD(J) = J/288
IRWDP(J) = (J-IRMOD(J)*288)/12
IRZPL(J) = J-IRMOD(J)*288-IRWDP(J)*12
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2))
IRWMI(J) = MOD(IRWPL(J) + 34,48)
* Statement function for obtaining IOS wire number (1-36)
IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
IPMOD(J) = J/384
IPORI(J) = (J-IPMOD(J)*384)/128
IPWCL(J) = (J-IPMOD(J)*384-IPORI(J)*128)/4
IPZPL(J) = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4)
* IPSMD in range 0:8 Planar module number.
IPSMD(J) = IPMOD(J)*3 + IPORI(J)
*
* IOS wire number (runs from 0 to 36)
IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1
* SB plane numbers (1-72) from cell number
IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1
IRSBW(J) = 24*IRMOD(J) + IRZPL(J) + 13
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
IPMSB(J) = (J - 1)/24
IPOSB(J) = (J - 24*IPMSB(J) - 1)/4
IPZSB(J) = J - 24*IPMSB(J) - 4*IPOSB(J) - 1
IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J)
IRMSB(J) = (J - 1)/24
IRZSB(J) = J - 24*IRMSB(J) - 13
IRCLSB(J) = 288*IRMSB(J) + IRZSB(J)
IRADSB(J) = (J - 24*((J-1)/24) - 1)/12
ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J)
*KEND.
* Planar segment bank...
IFPSG = NLINK('FPSG',0)
IF(IFPSG .EQ. 0)RETURN
* Planar hit bank...
IFPLC = NLINK('FPLC',0)
IF(IFPLC .EQ. 0)RETURN
NSEG = IW(IFPSG+2)
NPHT = IW(IFPLC+2)
* Count number of (disconnected) segments found in each SM
* and total number of hits attached to segments...
CALL VZERO(KSEG, 3)
KUSED = 0
KSUM = 0
DO 300 JSEG = 1, NSEG
IMSK = IBTAB(IFPSG,9,JSEG)
IF(IMSK.NE.0) GO TO 300
IMOD = IBTAB(IFPSG,8,JSEG)+ 1
KSEG(IMOD) = KSEG(IMOD) + 1
DO 301 KDP = 1, 12
KDG = IABS(IBTAB(IFPSG,10+KDP,JSEG))
IF(KDG.NE.0) THEN
KUSED = KUSED + 1
CHARGE= RBTAB(IFPLC,5,KDG)
* separate inner and outer wires...
KTEST = MOD(KDP,4)
IF(KTEST.LT.2) THEN
* outer...
CALL SHS(253,0,CHARGE)
CALL SHD(254,0,CHARGE,FLOAT(KDP))
ELSE
CALL SHS(255,0,CHARGE)
CALL SHD(256,0,CHARGE,FLOAT(KDP))
ENDIF
ENDIF
301 CONTINUE
300 CONTINUE
CALL SHS(221,0,FLOAT(KSEG(1)))
CALL SHS(222,0,FLOAT(KSEG(2)))
CALL SHS(223,0,FLOAT(KSEG(3)))
KSUM = KSEG(1) + KSEG(2) + KSEG(3)
CALL SHS(261,0,FLOAT(KSUM))
IF(NPHT .GT. 30) THEN
FRUSED = FLOAT(KUSED) / FLOAT(NPHT)
CALL SHS(262,0,FRUSED)
ENDIF
RETURN
END
*