*-- Author : "I. O. Skillicorn" 24/04/95
SUBROUTINE FPCXTD
*
*
* test8.f reject segment if it does not link
* mid plane with all planar segments for
* planar based track : cut 5cms**2
*
*
* fpcxtd.new.f remove radial based (2):-
* planar pickup from planars appears unsafe
*
* searches connected + disconnected set
*
*
*
*
*
*
*
*
* Routine to pick up planar segments from connected set.
*
* radial based tracks:-
* 1)Searches for closest segment to track K in the R-Phi
* direction which is sufficiently close in the radial direction.
* Separation is Rmean*delta-phi, where Rmean is R
* of planar segment and delta-phi
* is separation in Phi.
* 2) Uses each first-pass associated planar to search for
* a link to a planar in the connected set(dd defined) that
* is close to the radial-defined track.
*
* Radial only: associates planars using (1).
* Radial+planar: uses (1)+(2).
*
* cuts changed relative to fpcxtd.test4.f
* open dd cut for radial based tracks to 5 cm**2
* use sum of sep+dd < 3 cm**2 for planars
*
*
*
*
*
*
* planar based tracks:-
* uses each found planar to search for a link (DD defined)
* to a planar segment in connected set. checks planar coord.
* is within 1 cm of expectation from str. line phi-z,r-z.
*
*
*
* Fit parameters are in H1WORK:
* RPCOSG(K) = Slope of Phi-z fit
* RPSING(K) = Slope of R-z fit
* PHZG(K) = Intercept of Phi-z fit (at z=0)
* ZIG(K) = Intercept of R-z fit (at z=0)
* Errors are in FTRERR:
* COMMON /FTRERR/ DSLPHI, DPHZER, COVP, DSLPR, DRZER, COVR
* Dxxxx = sigma (not squared) of parameter xxxx
* COVP = covariance of Phi-z fit parameters
* COVR = covariance of R -z fit parameters
*KEEP,FRDIMS.
PARAMETER (MAXHTS=200)
PARAMETER (NUMWPL=36)
PARAMETER (MAXTRK=200)
PARAMETER (MXTTRK=900)
PARAMETER (MAXTR3=200)
PARAMETER (MAXHPW=2)
PARAMETER (MAXDIG=2000)
PARAMETER (NUMRWR=1727)
PARAMETER (NUMPWR=1151)
*KEEP,FH1WORK.
COMMON/FGMIOS/
* Planar geometry
+ ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,
*
* Radial geometry
+ ZP(36),PHW(36),WS(36)
*
COMMON/H1WORK/
* Radial data...
+ WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),
+ NDP(36), NW(MAXHTS,36), DWS(MAXHTS,36),
*
* Planar Data
+ NDPW(NUMWPL),DW(MAXHTS,NUMWPL),
+ DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),
+ WWP(MAXHTS,NUMWPL),
+ IPHOLE(MAXHTS,NUMWPL),
*
* Pointers into DIGI bank for IOS labelled hits
+ IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,
+ IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),
*
* Track segment data
+ NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),
*
* Fit data
+ PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),
+ DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),
+ DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),
+ RPCOSG(MAXTRK),RPSING(MAXTRK),
+ PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),
+ IRADG(36,MAXTRK),PHIG(36,MAXTRK),
+ IG,SDRADG(36,MAXTRK),
+ R1,Z1,RFIT(MAXTRK,3),
+ CHG(MAXTRK),
+ PPA(MAXTRK,3), ZZA(MAXTRK,3),
+ GPA(MAXTRK,3),GZA(MAXTRK,3)
*
*
*KEEP,FPTVTX.
COMMON/VERTVV/ZV ,XVV,YVV
**the common/VERTEX/ becomes /VERTVV/ (in analogy to /VERTFF/) on the
** 17/6/91, since it is in conflict with the VERTEX module (g.bernardi)
** (note that all these common names should start by F in this deck...)
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),
+ IRP(36,MAXTRK),SDP(36,MAXTRK),
+ IG2,IGTTRK(MAXTRK),
+ CHISQ(MAXTRK),NUMDF(MAXTRK),
+ FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),
+ FITTH(MAXTRK),FITPH(MAXTRK),
+ FITCU(MAXTRK),FTCOV(15,MAXTRK)
*KEEP,FPPRAM.
C
C--- MAXSEG is maximum number of segments per supermodule
C--- MAXCON is maximum number of amibiguous segments associatable with
C--- one segment
C--- LIMSTO is maximum number of 2 cluster planes intersections to be
C--- stored per supermodule
C--- MSEGLM is maximum number of clusters that can be found before
C--- connectivity considered
C--- MAXCLU is maximum number of clusters that can be found after
C--- forming non-connected set MUST BE 50 IF RUN WITH OLD RCW
C--- (cluster = 3/4 digits found in a straight line in one
C--- 4-wire orientation)
C
PARAMETER (MAXSEG = 200)
PARAMETER (MAXCON = 100)
PARAMETER (LIMSTO = 5000)
PARAMETER (MSEGLM = 150)
PARAMETER (MAXCLU = 50)
C---
*KEEP,FPLSEG.
C---
COMMON /FPLSEG / PW(12,MAXSEG,3) , PWC(12,MAXSEG,3) ,
1 PRCHI(MAXSEG,3) , NFSEG(3) ,
2 XYDXY(4,MAXSEG,3) , EXYDXY(4,4,MAXSEG,3) ,
3 ZSEG(2,MAXSEG,3) ,
4 ASEGIN(MAXSEG,3) , ISEGIN(5,MAXSEG,3) ,
5 MASKSG(MAXSEG,3) , IDGISG(12,MAXSEG,3)
C---
*KEEP,FPTFLG.
COMMON/FPTFLG/IPLAR, NIT, IREZ, LUNFP, NPLMAX
*KEEP,FPTPAR.
COMMON/FPTPAR/PCUT1, PCUT2, PCUT3, CXP, CYP,
+ DRPCT1, DRPCT2, DRPCT3,
+ DRCUT1, DRCUT2, DRCUT3
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEND.
* Common for track parameter errors...
COMMON /FTRERR/ DSLPHI, DPHZER, COVP, DSLPR, DRZER, COVR
* Common for segment numbers...
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FTPPBS/SPP(36,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
COMMON/FTRFLG/ IBRR(MAXTRK),IBPP(100),IVRR(MAXTRK)
COMMON/FPLNK/KTIP(3,50),LPP(3,100)
common/fcnset/ipuze(maxhts,numwpl)
* Local arrays...
DIMENSION IUSEG( MAXSEG, 3)
DIMENSION RSEG(4),PSEG(4)
PARAMETER(PI2=6.2831853)
data istart/0/
c debug **************************************************
if(istart.eq.0)then
istart=1
endif
c*************************************************************
* cuts mm for radials
DRPCUT = 2.
DRCUT = 100.
c hard wired 5 cm**2 cut in DDmin
********************************************************************
c and note hard wired cuts below
c for planar linkage!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
c planar linkage cuts in cm or cm**2
c sep + ddmin < 3 cm**2
c******************************************************************
c
c Examine multimodule radial and planar based tracks that
c have been linked using planar segments in the disconnected
c set. Set these points used and search for additional planar
c segments ( made of unused points) in the connected set.
c
c
call vzero(ipuze,maxhts*numwpl)
c for radial/planar tracks mark points(discon. set) used.
do 110 i=1,ig
if(ivrr(i).ne.1)goto110
do120 j=1,36
jp=irp(j,i)
if(jp.ne.0)ipuze(jp,j)=1
120 continue
110 continue
do 115 i=1,npp
do125 j=1,36
jp=ipp(j,i)
if(jp.ne.0)ipuze(jp,j)=1
125 continue
115 continue
* write(*,*)' fpcxtd entered '
do 200 ity=1,2
c ity=1 planar based tracks
c ity=2 radial based tracks
if(ity.eq.1)igg=npp
if(ity.eq.2)igg=ig
do 100 k=1,igg
c good radials only
if(ity.eq.2.and.ivrr(k).ne.1)goto100
c debug ********************************************************
if(ity.eq.2)then
* PRINT 1001,k,(IRN(n,k),n=1,36),LNK3(k,1),LNK3(k,2),LNK3(k,3)
* PRINT 1002,k,(IRP(n,k),n=1,36),ISGG(1,k),ISGG(2,k),ISGG(3,k)
iplaa=0
if(isgg(1,k)+isgg(2,k)+isgg(3,k).ne.0)iplaa=1
* write(*,*)' k,iplar',k,iplaa
c if(isgg(1,k)+isgg(2,k)+isgg(3,k).ne.0)then
c write(*,*)' fpcxtd p ',k,ivrr(k),ibrr(k),iplaa
c endif
endif
c end debug *************************************************
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
C
C--- Calculate prediction for segment in this supermodule
C
Z = ZPP( 6 + (ISM -1)*12 )
if(ity.eq.2)then
c radial based track
c skip module if segment found
if(isgg(ism,k).ne.0)goto10
C
C--- RR and PHI calculated for this Z as predicted by radials
C
RR = RPSING(K)*Z + ZIG(K)
RRAD= RR*10.
PHI = RPCOSG(K)*Z + PHZG(K)
PHI = AMOD(PHI,PI2)
IF(PHI.LT.0.0) PHI = PHI + PI2
C
C--- Convert to cartesian coordinates
C
X = RR * COS(PHI) + XVV
Y = RR * SIN(PHI) + YVV
C
C--- Find differentials of x,y wrt z
C
XDZ = RPSING(K)*COS(PHI) - RR*RPCOSG(K)*SIN(PHI)
YDZ = RPSING(K)*SIN(PHI) + RR*RPCOSG(K)*COS(PHI)
endif
if(ity.eq.1)then
c
c planar based track
c
c skip module if segment found
if(lpp(ism,k).ne.0)goto 10
C
C--- RR and PHI calculated for this Z as predicted by planars
C
RR = rsss(K)*Z + riss(K)
RRAD= RR*10.
PHI = psss(K)*Z + piss(K)
PHI = AMOD(PHI,PI2)
IF(PHI.LT.0.0) PHI = PHI + PI2
C
C--- Convert to cartesian coordinates
C
X = RR * COS(PHI) + XVV
Y = RR * SIN(PHI) + YVV
C
C--- Find differentials of x,y wrt z
C
XDZ = rsss(K)*COS(PHI) - RR*psss(K)*SIN(PHI)
YDZ = rsss(K)*SIN(PHI) + RR*psss(K)*COS(PHI)
endif
C
C--- Form segment cartesian vector converting to mm
C
RSEG(1) = X*10.0
RSEG(2) = Y*10.0
RSEG(3) = XDZ
RSEG(4) = YDZ
ZMM = Z*10.0
C
ISMIN = 0
DRMIN = 1000000.0
DRM = 1000000.0
ddmin= 1000000000.
ismind=0
isminr=0
DO 20 IP = 1,NFSEG(ISM)
C
C--- search only unused segments
C
C
C--- search only the connected set
c ( a check has been made of searching all -
c a negligible number of additional planars
c are found)
C
C
C However: this does provide a technique for re-searching
c for segments unlinked in the first pass;
c so reexamine the disconnected set.
c
C
c IF( MASKSG(IP,ISM) .eq. 0 )GO TO 20
c check if points have been used
do 25 i=1,12
iosp=idgisg(i,ip,ism)
if(iosp.eq.0)goto25
ipu=iabs(iosp)
ipl=I+(ism-1)*12
if(ipuze(ipu,ipl).eq.1)goto20
25 continue
C
C--- Extract planar segment and covariance matrix
C
DO 30 I = 1,4
C---
PSEG(I) = XYDXY(I,IP,ISM)
C---
30 CONTINUE
C---
* R and Phi for planar segment
PSEG(1) = PSEG(1) + ZMM * PSEG(3)
PSEG(2) = PSEG(2) + ZMM * PSEG(4)
RPL = SQRT(PSEG(1)**2 + PSEG(2)**2)
PHIPLA = ATAN2(PSEG(2), PSEG(1))
PHIPLA = AMOD(PHIPLA,PI2)
IF(PHIPLA.LT.0.0) PHIPLA = PHIPLA + PI2
* Believe the radial segment prediction in the 'drift' direction
* only. More-or-less ignore rad radius...
* RMEAN = 0.2*(RRAD + 4.0*RPL)
RMEAN = RPL
* RMEAN = RRAD
DELP = PHIPLA - PHI
IF(DELP .GT. (PI2/2.)) THEN
DELP = DELP -PI2
ELSEIF(DELP .LT. -(PI2/2.)) THEN
DELP = DELP +PI2
ENDIF
DRPHI = RMEAN*(DELP)
DR = RPL - RRAD
DRPHI = ABS(DRPHI)
DR = ABS(DR)
if(ity.eq.2)then
c write(*,*)' rb tr ',k,ip,delp,rmean,drphi
c radial based track:
c check if planar segment links to
c an associated planar.
ddm=100000.
fnd=0.
do 92 ismm=1,3
c link adjacent only
if(iabs(ismm-ism).gt.1)goto92
if(ismm.eq.ism)goto92
if(isgg(ismm,k).ne.0)then
ipl=isgg(ismm,k)
z1=zpp(6+(ismm-1)*12)*10.
zm=(z1+zmm)*0.5
x1m=(xydxy(1,ipl,ismm)+zm*xydxy(3,ipl,ismm))*.1
y1m=(xydxy(2,ipl,ismm)+zm*xydxy(4,ipl,ismm))*.1
x2m=(xydxy(1,ip,ism)+zm*xydxy(3,ip,ism))*.1
y2m=(xydxy(2,ip,ism)+zm*xydxy(4,ip,ism))*.1
c note units cm**2
dd=(x1m-x2m)**2+(y1m-y2m)**2
c may link to more than one planar seg
c forming track
if(dd.lt.ddm)then
ddm=dd
fnd=1.
endif
endif
92 continue
c if(fnd.ne.0.0)call shs(3018,0,ddm)
c
if(ddm.lt.ddmin.and.fnd.ne.0.0)then
ddmin=ddm
isminr=ip
endif
endif
if(ity.eq.2)then
IF(DRPHI .LT. DRMIN) THEN
IF(DR .LT. DRCUT) THEN
DRMIN = DRPHI
ISMIN = IP
DRM = DR
ENDIF
ENDIF
endif
C
C---
C
if(ity.eq.1)then
c dd parameter calculated as in planar linking.
c select best if several planars already found to
c which a link may be made
ddm=100000.
fnd=0.
do 91 ismm=1,3
c link adjacent only
if(iabs(ismm-ism).gt.1)goto91
if(ismm.eq.ism)goto91
if(lpp(ismm,k).ne.0)then
ipl=lpp(ismm,k)
z1=zpp(6+(ismm-1)*12)*10.
zm=(z1+zmm)*0.5
x1m=(xydxy(1,ipl,ismm)+zm*xydxy(3,ipl,ismm))*.1
y1m=(xydxy(2,ipl,ismm)+zm*xydxy(4,ipl,ismm))*.1
x2m=(xydxy(1,ip,ism)+zm*xydxy(3,ip,ism))*.1
y2m=(xydxy(2,ip,ism)+zm*xydxy(4,ip,ism))*.1
c note units cm**2
dd=(x1m-x2m)**2+(y1m-y2m)**2
*********************************************
c segment has to mid-plane point to all adjacent
c planar linesegs
c new 26/10/95
if(dd.gt.5.0)go to 20
*********************************************
c may link to more than one planar seg
c forming track
if(dd.lt.ddm)then
ddm=dd
xs=pseg(1)/10.
ys=pseg(2)/10.
fnd=1.
endif
endif
91 continue
c if(fnd.ne.0.0)call shs(3013,0,ddm)
c
if(ddm.lt.ddmin.and.fnd.ne.0.0)then
ddmin=ddm
ismind=ip
xsm=xs
ysm=ys
endif
endif
C
C--- End of loop over planar segments for supermodule
C
20 CONTINUE
C
C--- Build list of planar hits and mark segment and hits used
C
IFR = 1+(ISM-1)*12
ILS = 11+IFR
if(ity.eq.2)then
c radial based tracks
IF(ISMIN .NE. 0) THEN
IF(DRMIN .LT. DRPCUT) THEN
c no planar linked by planar
c use planar associated by track model
IUSEG(ISMIN, ISM) = 1
ISGG(ISM,K) = ISMIN
II=0
DO 50 IWIR= IFR, ILS
II = II+1
IOSP = IDGISG(II,ISMIN,ISM)
IF (IOSP.EQ.0) GOTO 50
IRP(IWIR, K) = IABS(IOSP)
SDP(IWIR, K) = SIGN(1.0, FLOAT(IOSP))
Ipuze(IABS(IOSP), IWIR)=1
50 CONTINUE
c write(*,*)' fpcxtd: plseg added r-b tr,mod ',k,ism,drmin
ENDIF
ENDIF
endif
if(ity.eq.1)then
c planar based tracks
ibad=0
IF(ISMINd.NE. 0) THEN
c centre of planar segment with respect to track model
sep=(xsm-x)**2+(ysm-y)**2
c hard wired 3 cm**2 cut ******************************************
if(sep.gt.3.0)ibad=1
c
c planar based tracks
c select on sep+dd: 3 cm**2 hard wired cut********************
IF((sep+ddmin).lt.3.0.and.ibad.eq.0) THEN
c good link - store , set points used
IUSEG(ISMINd, ISM) = 1
lpp(ISM,K) = ISMINd
II=0
DO 70 IWIR= IFR, ILS
II = II+1
IOSP = IDGISG(II,ISMINd,ISM)
IF (IOSP.EQ.0) GOTO 70
IpP(IWIR, K) = IABS(IOSP)
SpP(IWIR, K) = SIGN(1.0, FLOAT(IOSP))
ipuze(IABS(IOSP), IWIR)=1
70 CONTINUE
c write(*,*)' fpcxtd: pl seg added to p-b tr,mod ',k,ism
ENDIF
ENDIF
endif
C
C
C--- End of loop over supermodules
C
10 CONTINUE
100 continue
200 continue
1001 FORMAT(' RR',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1002 FORMAT(' RP',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1003 FORMAT(' PP',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1004 FORMAT(' PR',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
RETURN
END
*