*-- Author : Stephen J. Maxfield 30/03/92
SUBROUTINE FRSGST
**: FRSGST 30907 SM. Allow for 12-wire readout.
**----------------------------------------------------------------------
**: FRSGST 30907 SM. New routine for monitoring.
**----------------------------------------------------------------------
*
* Make diagnostic histograms of radial segments.
*
*
*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,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*KEEP,FSGPAR.
COMMON/FSGPAR/DMINX, PHIT, TSCUT, SLCUT, RCUT, TSLPC,
+ MINHTS, MINPTS, MAXCLU, LSCUT, NWIRES, IPLOT
*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 NSGFND(3)
*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.
* Radial segment bank...
IFRSG = NLINK('FRSG',0)
IF(IFRSG .EQ. 0)RETURN
* Radial hit bank...
IFRLC = NLINK('FRLC',0)
IF(IFRLC .EQ. 0)RETURN
NRLC = IW(IFRLC+2)
IF(NRLC .EQ. 0) RETURN
* Radial geometry bank...
IFRG1 = NLINK('FRG1',0)
IF(IFRG1 .EQ. 0)RETURN
CALL VZERO(NSGFND, 3)
NSEG = IW(IFRSG+2)
NTOTHT = 0
DO 50 JSEG = 1, NSEG
CHIS = RBTAB(IFRSG,7,JSEG)
IMOD = IBTAB(IFRSG,8,JSEG)+ 1
NSGFND(IMOD) = NSGFND(IMOD) + 1
XIN = RBTAB(IFRSG,1,JSEG)
YIN = RBTAB(IFRSG,2,JSEG)
ZIN = RBTAB(IFRSG,3,JSEG)
XOUT = RBTAB(IFRSG,4,JSEG)
YOUT = RBTAB(IFRSG,5,JSEG)
ZOUT = RBTAB(IFRSG,6,JSEG)
RIN = SQRT(XIN**2 + YIN**2)
ROUT = SQRT(XOUT**2 + YOUT**2)
PHIIN = ATAN2(YIN,ZIN)
PHIOUT = ATAN2(YOUT,XOUT)
SLPPHI = (PHIOUT - PHIIN) / (ZOUT - ZIN)
SLPR = (ROUT - RIN) / (ZOUT - ZIN)
NUMRHT = 0
DO 60 KDP = 1, NWIRES
KDS = IBTAB(IFRSG,10+KDP,JSEG)
KD = IABS(KDS)
KSG = ISIGN(1,KDS)
IF(KD .NE. 0) THEN
NUMRHT = NUMRHT + 1
NTOTHT = NTOTHT + 1
* Cell number and flag...
ICLNUM = IBTAB(IFRLC,1,KD)
ISGNW = IBTAB(IFRLC,6,KD)
* Pointer to geometry for this hit (+ or - wedge)
KPOINT = 1 + 3*MOD(ISGNW,2)
* geometry...
PHIWIR = RBTAB(IFRG1,KPOINT+1,ICLNUM+1)
STGWIR = RBTAB(IFRG1,KPOINT+2,ICLNUM+1)
ZEDWIR = RBTAB(IFRG1,KPOINT+3,ICLNUM+1)
* Predict the drift from the segment parameters...
PHIHIT = PHIIN + SLPPHI*(ZEDWIR-ZIN)
RHIT = RIN + SLPR *(ZEDWIR-ZIN)
* expected drift not including wire stagger...
DRFE = RHIT*SIN(PHIHIT-PHIWIR)
* measured drift, signed and corrected for stagger...
DRIFT = KSG*RBTAB(IFRLC,2,KD)+ STGWIR
QPLUS = RBTAB(IFRLC,7,KD)
QMINUS = RBTAB(IFRLC,8,KD)
QSUM = QPLUS+QMINUS
CALL SHS(251, 0,QSUM)
CALL SHS(251,KDP,QSUM)
CALL SHD(252,0,QSUM,FLOAT(KDP))
ENDIF
60 CONTINUE
FNMRHT = FLOAT(NUMRHT)
50 CONTINUE
F1=FLOAT(NSGFND(1))
F2=FLOAT(NSGFND(2))
F3=FLOAT(NSGFND(3))
FALL = F1 + F2 + F3
CALL SHS(204, 0, F1 )
CALL SHS(205, 0, F2 )
CALL SHS(206, 0, F3 )
CALL SHS(207, 0, FALL)
IF(NRLC .GT. 12) THEN
USED = FLOAT(NTOTHT) / FLOAT(NRLC)
CALL SHS(260, 0, USED)
ENDIF
END
*