*-- Author : Stephen J. Maxfield 21/09/92
SUBROUTINE FOXY
*
*
* Make scatter plots of digitisation locations in FTD.
*
* For Radials, space points from FRLC are used.
* For Planars, where space points are not defined at the hit level,
* the x-y coordinates of segment start positions are used (ex FPSG)
*
*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.
PARAMETER(NBN=0)
* Locators for FRG1 bank
PARAMETER(IPDEAD=1)
PARAMETER(IPRPHP=2)
PARAMETER(IPRSTP=3)
PARAMETER(IPRPHM=5)
PARAMETER(IPRSTM=6)
* Locators for FRLC bank
PARAMETER(IPRCLN=1)
PARAMETER(IPRDRF=2)
PARAMETER(IPRRAD=4)
PARAMETER(IPRSGW=6)
LOGICAL FIRST
DATA FIRST/.TRUE./
*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.
*----------------------------------------------------------------------
* Initialisations on first call...
IF(FIRST) THEN
FIRST = .FALSE.
IQFRLC = NAMIND('FRLC')
IQFRG1 = NAMIND('FRG1')
ENDIF
*-----------------------------------------------------------
* Space points in Radials ex FRLC bank...
IFRG1 = IW(IQFRG1)
IF(IFRG1.EQ.0) THEN
* Create FRLC bank...
CALL FTCORG
IFRG1 = IW(IQFRG1)
IF(IFRG1.EQ.0) THEN
WRITE(6,'('' FRCART : failure to create FRG1 bank'')')
CALL H1STOP
ENDIF
ENDIF
IFRLC = IW(IQFRLC)
IF(IFRLC.EQ.0) THEN
* Create FRLC bank...
CALL FRLOCO
IFRLC = IW(IQFRLC)
IF(IFRLC.EQ.0) THEN
WRITE(6,'('' FRCART : failure to create FRLC bank'')')
CALL H1STOP
ENDIF
ENDIF
NFRLC = IW(IFRLC+2)
DO 1 IROW = 1, NFRLC
ICLNUM= IBTAB(IFRLC,IPRCLN,IROW)
DRIFT = RBTAB(IFRLC,IPRDRF,IROW)
RADIUS= RBTAB(IFRLC,IPRRAD,IROW)
ISGNW = MOD(IBTAB(IFRLC,IPRSGW,IROW),2)
* Phi, Stagger and Z of wire
PHI = RBTAB(IFRG1,2+3*ISGNW,ICLNUM+1)
STAGGR = RBTAB(IFRG1,3+3*ISGNW,ICLNUM+1)
ZZ = RBTAB(IFRG1,4+3*ISGNW,ICLNUM+1)
DSIGN = 1.
DDD = DRIFT*DSIGN + STAGGR
RR = RADIUS + FLOREN(RADIUS,ABS(DDD),DSIGN)
XXP = RR*COS(PHI) - DDD*SIN(PHI)
YYP = RR*SIN(PHI) + DDD*COS(PHI)
DSIGN = -1.
DDD = DRIFT*DSIGN + STAGGR
RR = RADIUS + FLOREN(RADIUS,ABS(DDD),DSIGN)
XXM = RR*COS(PHI) - DDD*SIN(PHI)
YYM = RR*SIN(PHI) + DDD*COS(PHI)
ISM = IRMOD(ICLNUM)
CALL SHD(703, 0,XXP,YYP)
CALL SHD(703, 0,XXM,YYM)
CALL SHD(700+ISM,0,XXP,YYP)
CALL SHD(700+ISM,0,XXM,YYM)
1 CONTINUE
* Planar and radial segment data...
IFRSG = NLINK('FRSG',0)
IFPSG = NLINK('FPSG',0)
IF(IFRSG .NE. 0) THEN
NFRSG = IW(IFRSG+2)
ELSE
NFRSG = 0
ENDIF
IF(IFPSG .NE. 0) THEN
NFPSG = IW(IFPSG+2)
ELSE
NFPSG = 0
ENDIF
DO 2 JROW = 1, NFRSG
XIN = RBTAB(IFRSG, 1, JROW)
YIN = RBTAB(IFRSG, 2, JROW)
ISM = IBTAB(IFRSG, 8, JROW)
CALL SHD(713, 0, XIN, YIN)
CALL SHD(710+ISM, 0, XIN, YIN)
2 CONTINUE
DO 3 JROW = 1, NFPSG
XIN = RBTAB(IFPSG, 1, JROW)
YIN = RBTAB(IFPSG, 2, JROW)
ISM = IBTAB(IFPSG, 8, JROW)
CALL SHD(723, 0, XIN, YIN)
CALL SHD(720+ISM, 0, XIN, YIN)
3 CONTINUE
* Done
RETURN
END
*