*-- Author : I.O.Skillicorn
SUBROUTINE FPLPKS( IUSEDP, IUSEG)
*
* Routine to pick up planar segments.
* INPUT: IT ... Iteration number.
* K..... Track number.
* IUSEDP(Hit number, wire-plane) = 1 if hit already used
* = 0 if free.
* OUTPUT:IUSEDP(Hit number, wire-plane) (up-dated)
*
* ...and in common block FRH3FT:
* IRP(wire-plane, K) = number of hit on this plane
* associated with the track K
* SDP(wire-plane, K) = +1.0, -1.0 for its drift sign
*
* 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
* mean of planar segment and radial predicted R's and delta-phi
* is separation in Phi.
*
*
* 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/fpstsg/nstc(9),nfsseg(3),nftseg(3)
* Local arrays...
DIMENSION IUSEDP(MAXTRK,36), IUSEG( MAXSEG, 3)
DIMENSION RSEG(4),PSEG(4)
PARAMETER(PI2=6.2831853)
data istart/0/
* Establish cut values for this iteration...
* single iteration in this code
it=3
IF (IT .EQ. 1) THEN
DRPCUT = DRPCT1
DRCUT = DRCUT1
ELSEIF(IT .EQ. 2) THEN
DRPCUT = DRPCT2
DRCUT = DRCUT2
ELSEIF(IT .EQ. 3) THEN
DRPCUT = DRPCT3
DRCUT = DRCUT3
ELSE
DRPCUT = DRPCT3
DRCUT = DRCUT3
ENDIF
c note mm
drpcut= 5.
drcut=100.
c rad/cm
phicut=0.002
if(istart.eq.0)then
istart=1
write(*,*)' fplpks cuts: hardwired '
write(*,*)' drpcut = 5. mm '
write(*,*)' drcut = 100. mm '
write(*,*)' phicut = 0.002 rad/cm '
write(*,*)' single iteration '
write(*,*)' primary only '
endif
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
c number primary segments
npris=nfseg(ism)-nfsseg(ism)-nftseg(ism)
C
C--- Calculate radial prediction for segment in this supermodule
C
Z = ZPP( 6 + (ISM -1)*12 )
C
C--- RR and PHI calculated for this Z as predicted by radials
C
c loop over all tracks
c and all planar segments
200 nadd=0
ISMIN = 0
kmin=0
DRMIN = 1000000.0
DRM = 1000000.0
do 100 k=1,ig
c check if planar already linked
if(isgg(ism,k).ne.0)goto100
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
ZMM = Z*10.0
zb=zpp(1+(ism-1)*12)
ze=zpp(12*ism)
zbmm=zb*10.
zemm=ze*10.
C
DO 20 IP = 1,NFSEG(ISM)
C
C--- search only unused segments
C
IF( IUSEG(IP,ISM) .NE. 0 )GO TO 20
C
C--- search only the disconnected set
C
IF( MASKSG(IP,ISM) .NE. 0 )GO TO 20
c
c--- primary only
c
if(ip.gt.npris)goto20
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
* note mm
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 = RPL
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)
c compare slope of planar in phi-z
c with radial based track model
x1=xydxy(1,ip,ism)+zbmm*xydxy(3,ip,ism)
y1=xydxy(2,ip,ism)+zbmm*xydxy(4,ip,ism)
x2=xydxy(1,ip,ism)+zemm*xydxy(3,ip,ism)
y2=xydxy(2,ip,ism)+zemm*xydxy(4,ip,ism)
p1=atan2(y1,x1)
p1=amod(p1,pi2)
if(p1.lt.0.)p1=p1+pi2
p2=atan2(y2,x2)
p2=amod(p2,pi2)
if(p2.lt.0.)p2=p2+pi2
dp=p2-p1
if(dp.gt.6.0)dp=dp-pi2
if(dp.lt.-6.0)dp=dp+pi2
ps=dp/(ze-zb)
dps=ps-rpcosg(k)
dps=amod(dps,pi2)
if(drphi.lt.drpcut)then
if(dr.lt.drcut)then
call shs(224+it,0,dps)
endif
endif
c
c hardwired cut
c slope of planar line segment differs
c from track model
c
if(abs(dps).gt.phicut)goto20
IF(DRPHI .LT. DRMIN) THEN
IF(DR .LT. DRCUT) THEN
DRMIN = DRPHI
ISMIN = IP
kmin = k
DRM = DR
ENDIF
ENDIF
C
C--- End of loop over planars segments for supermodule
C
20 CONTINUE
c end of loop over tracks
100 continue
c loop over tracks and segments finished
c best selected
IF(IDOHIS .GE. 2) THEN
if(ismin.ne.0)then
CALL SHS(214+IT, 0, DRMIN)
CALL SHS(217+IT, 0, DRM)
endif
ENDIF
C
C--- Build list of planar hits and mark segment and hits used
C
IFR = 1+(ISM-1)*12
ILS = 11+IFR
IF(ISMIN .NE. 0) THEN
IF(DRMIN .LT. DRPCUT) THEN
IF(IT.EQ.NIT) THEN
IUSEG(ISMIN, ISM) = 1
ISGG(ISM,Kmin) = ISMIN
nadd=1
IF(IDOHIS .GE. 2) THEN
CALL SHS(210,0,DRMIN)
CALL SHS(211,0,DRM )
CALL SHD(212,0,DRMIN,DRM)
ENDIF
ENDIF
II=0
DO 50 IWIR= IFR, ILS
II = II+1
IOSP = IDGISG(II,ISMIN,ISM)
IF (IOSP.EQ.0) GOTO 50
IRP(IWIR, Kmin) = IABS(IOSP)
SDP(IWIR, Kmin) = SIGN(1.0, FLOAT(IOSP))
IF(IT.EQ.NIT) THEN
IF(IUSEDP(IABS(IOSP), IWIR).NE.0) THEN
c check if point previously used,if yes,remove
DO 51 ITRK = 1, IG
IF(ITRK .EQ. Kmin) GOTO 51
IF(IRP(IWIR, ITRK) .EQ. IABS(IOSP)) THEN
IRP(IWIR, ITRK) = 0
ENDIF
51 CONTINUE
ENDIF
c mark point used
IUSEDP(IABS(IOSP), IWIR)=1
ENDIF
50 CONTINUE
ENDIF
ENDIF
c continue search for links if link found
c otherwise go to next supermodule
if(nadd.eq.1)goto 200
C
C--- End of loop over supermodules
C
10 CONTINUE
RETURN
END
*
*
*