*-- 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.
*KEEP,FH1WORK.
* Planar geometry
*
* Radial geometry
*
* Radial data...
*
* Planar Data
*
* Pointers into DIGI bank for IOS labelled hits
*
* Track segment data
*
* Fit data
*
*
*KEEP,FPTVTX.
**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)
*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
C---
*KEEP,FPLSEG.
C---
C---
*KEEP,FPTFLG.
*KEEP,FPTPAR.
*KEEP,FDIFLG.
*KEND.
* Common for track parameter errors...
* Common for segment numbers...
* Local arrays...
* cuts mm for radials
********************************************************************
* write(*,*)' fpcxtd entered '
* 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)
* write(*,*)' k,iplar',k,iplaa
C
C--- Loop over supermodules
C
C
C--- Calculate prediction for segment in this supermodule
C
C
C--- RR and PHI calculated for this Z as predicted by radials
C
C
C--- Convert to cartesian coordinates
C
C
C--- Find differentials of x,y wrt z
C
C
C--- RR and PHI calculated for this Z as predicted by planars
C
C
C--- Convert to cartesian coordinates
C
C
C--- Find differentials of x,y wrt z
C
C
C--- Form segment cartesian vector converting to mm
C
C
C
C--- search only unused segments
C
C
C--- search only the connected set
C
C
C However: this does provide a technique for re-searching
C
C
C--- Extract planar segment and covariance matrix
C
C---
C---
C---
* R and Phi for planar segment
* Believe the radial segment prediction in the 'drift' direction
* only. More-or-less ignore rad radius...
* RMEAN = 0.2*(RRAD + 4.0*RPL)
* RMEAN = RRAD
C
C---
C
*********************************************
*********************************************
C
C--- End of loop over planar segments for supermodule
C
C
C--- Build list of planar hits and mark segment and hits used
C
C
C
C--- End of loop over supermodules
C
*