*-- Author : Stephen J. Maxfield 22/07/92
SUBROUTINE FPREZI
**: FPREZI.......SM. New deck for planar seg residuals.
**----------------------------------------------------------------------
*
* Make diagnostic histograms of planar 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/
*KEND.
*
*
*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
* Planar geometry...
IFPG1 = NLINK('FPG1',0)
IF(IFPG1 .EQ. 0)RETURN
NSEG = IW(IFPSG+2)
NPLC = IW(IFPLC+2)
IF(NPLC .EQ. 0) RETURN
IMTST = 0
DO 1 JSEG = 1, NSEG
IMSK = IBTAB(IFPSG,9,JSEG)
IF(IMSK.NE.IMTST) GO TO 1
* Get segment parameters...
PRCH = RBTAB(IFPSG,7,JSEG)
IMOD = IBTAB(IFPSG,8,JSEG)+ 1
XPSGI = RBTAB(IFPSG, 1,JSEG)
YPSGI = RBTAB(IFPSG, 2,JSEG)
ZPSGI = RBTAB(IFPSG, 3,JSEG)
XPSGO = RBTAB(IFPSG, 4,JSEG)
YPSGO = RBTAB(IFPSG, 5,JSEG)
ZPSGO = RBTAB(IFPSG, 6,JSEG)
DZG = (ZPSGO - ZPSGI)
XSLPG = (XPSGO - XPSGI) / DZG
YSLPG = (YPSGO - YPSGI) / DZG
* Loop through the (up to) 12 hits on this segment...
NUMD = 0
DO 2 KDP = 1, 12
KDIG = IBTAB(IFPSG,10+KDP,JSEG)
KDG = IABS(KDIG)
K36 = 12*(IMOD-1)+KDP
IF(KDG .NE. 0) THEN
NUMD = NUMD + 1
* Get the cellnumber, hence the orientation...
ICLNUM = IBTAB(IFPLC,1,KDG)
IORI = IPORI(ICLNUM)
* Locate the hit in space...
CALL FPWHIT(KDG,WPL, WMI, PHIDUM, WWIR, ZZ, IBB)
WMEAS = WPL
IF(KDIG .LT. 0)WMEAS = WMI
* distance from wire...
WDRIF = ABS(WMEAS-WWIR)
* Predict x, y, U and V from segment, at z of this hit.
XG = XPSGI + (ZZ-ZPSGI) * XSLPG
YG = YPSGI + (ZZ-ZPSGI) * YSLPG
UG = 0.5*XG + YG*SQRT(3.0)/2.0
VG = 0.5*XG - YG*SQRT(3.0)/2.0
* depending on wire orientation, one of these is drift!
IF (IORI .EQ. 0) THEN
DELMG = WMEAS - XG
ELSEIF(IORI .EQ. 1) THEN
DELMG = WMEAS - UG
ELSEIF(IORI .EQ. 2) THEN
DELMG = WMEAS - VG
ENDIF
* histogram the 'residuals'...
* by orientation...
CALL SHS(243+IORI,0,DELMG)
CALL SHS( 246,0,DELMG)
CALL SHD( 247,0,WDRIF,DELMG)
ELSE
* Histogram missing wire...
* Cell number of 1st cell on this wire plane...
ICL1 = 32*(K36-1)
IORI = IPORI(ICL1)
ZZ = RBTAB(IFPG1,4,ICL1+1)
* Predict x, y, U and V from segment, at this z...
XG = XPSGI + (ZZ-ZPSGI) * XSLPG
YG = YPSGI + (ZZ-ZPSGI) * YSLPG
UG = 0.5*XG + YG*SQRT(3.0)/2.0
VG = 0.5*XG - YG*SQRT(3.0)/2.0
* depending on wire orientation, one of these is drift!
IF (IORI .EQ. 0) THEN
WPRED = XG
ELSEIF(IORI .EQ. 1) THEN
WPRED = UG
ELSEIF(IORI .EQ. 2) THEN
WPRED = VG
ENDIF
CALL SHS(263,0,FLOAT(K36))
CALL SHD(264,0,FLOAT(K36),WPRED)
ENDIF
2 CONTINUE
CALL SHS(248,0,FLOAT(NUMD))
CALL SHS(249,0,PRCH)
1 CONTINUE
RETURN
END
*