*-- Author : I.O.Skillicorn
SUBROUTINE FPKPKR
*D: FPLPKR.......SM. Fix small bug.
**: FPKPKR 30907 RP. Farm changes.
**----------------------------------------------------------------------
*
*
* 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.
*
*
*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 FOR PLANAR PATREC ...
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
C POINTER TO RADIAL ASSOCIATED WITH NPP'TH PLANAR
COMMON/FPPTR/LR(3,100)
COMMON/FPLNK/KTIP(3,50),LPP(3,100)
C COMMON FOR RADIALS ASSOCIATED WITH PLANAR TRACKS
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
COMMON/FTRSUS/IRUSED(3,100)
* Local arrays...
DIMENSION RSEG(4),PSEG(4),XX(40),YY(40),YYY(40)
PARAMETER(PI2=6.2831853)
data istart /0/
* ESTABLISH CUT VALUES
C ALLOW A 1/2 CM ROAD IN DRIFT
DRPCUT=0.5
C VERY GENEROUS RADIUS CUT 10.0 cm
DRCUT=10.0
c rad/cm
phicut=0.002
c slope cut in drift
atcut=0.05
c
if(istart.eq.0)then
istart=1
write(*,*)' fpkpkr cuts: hardwired '
write(*,*)' drpcut = 0.5 cm '
write(*,*)' drcut = 10.0 cm '
write(*,*)' phicut = 0.002 rad/cm '
write(*,*)' atcut = 0.050 '
endif
C
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
C
C--- CALCULATE PLANAR PREDICTION FOR SEGMENT IN THIS SUPERMODULE
C
Z = ZP( 4 + (ISM -1)*12 )
ZMM=Z
200 nadd=0
kmin=0
ISMIN = 0
DRMIN = 1000000.0
DRM = 1000000.0
do 100 k=1,npp
if(lrr(ism,k).ne.0)goto100
C
C--- RR AND PHI CALCULATED FOR THIS Z AS PREDICTED BY PLANARS
C
RR = RSSS(K)*Z + RISS(K)
RRAD= RR
PHI = PSSS(K)*Z + PISS(K)
IF(PHI.LT.0.0) PHI = PHI + PI2
C WRITE(*,*)' PRED PHI,R ',PHI,RR
*
*---- Loop over the Radial Segments..
*
DO 20 IP = 1,NTRAKS(ISM)
* check FTFIT has not killed segment
if(chsq(ip,ism).gt.1000.)goto20
*
* Check that this segment hasn't been used already...
*
IF(IRUSED(ISM, IP) .NE. 0)GO TO 20
* R AND PHI FOR RADIAL SEGMENT
* PRINT 3000,ISM,IP,PHI,PHIPLA
PHIPLA = PHZL(IP,ISM)+ZMM * PCOSL(IP,ISM)
RPL = RZI(IP,ISM) + ZMM * PSINL(IP,ISM)
CIOS 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. 6.0 ) THEN
DELP = DELP -PI2
ELSEIF(DELP .LT. -6.0 ) THEN
DELP = DELP +PI2
ENDIF
DRPHI = RMEAN*(DELP)
DR = RPL - RRAD
DRPHI = ABS(DRPHI)
DR = ABS(DR)
C CHECK IN CORRECT PHI-REGION *** 9/12/93 ****
IF(DRPHI.GT.2.*DRPCUT)GOTO20
* DIAGNOSTIC Plots...
C PLOT DISTANCE OF RADIAL POINTS FROM PREDICTION
DDIST=0.
FNN=0.
ll=0
DO 21 IPL=1,12
JPL=IPL+(ISM-1)*12
NP=IRPT(IPL,IP,ISM)
IF(NP.NE.0)THEN
RRt=RSSS(K)*ZP(JPL)+RISS(K)
PHIt=PSSS(K)*ZP(JPL)+PISS(K)
IF(PHIt.LT.0.0)PHIt=PHIt+PI2
DRE=RRt*SIN(PHIt-WW(NP,JPL))
DRMM=SDRFT(IPL,IP,ISM)*DRI(NP,JPL)+DWS(NP,JPL)
CALL SHS(701+ISM,0.,DRE-DRMM)
DDIST=DDIST+(DRE-DRMM)
FNN=FNN+1.
ll=ll+1
xx(ll)=zp(jpl)
yy(ll)=dre-drmm
ENDIF
21 CONTINUE
C REPLACE DRPHI
IF(FNN.NE.0.)DRPHI=ABS(DDIST/FNN)
CALL FTLFT(XX,YY,LL,0,AT,BT,EE)
c relative slope cut
if(abs(at).gt.atcut)goto20
if(drphi.lt.drpcut)then
c d(phi)/dz diff plot
call shs(740,0,pcosl(ip,ism)-psss(k))
endif
c cut on d(phi)/dz - hard wired
if(abs(pcosl(ip,ism)-psss(k)).gt.phicut)goto20
IF(DRPHI .LT. DRMIN) THEN
CALL SHS(701 , 0, DR )
IF(DR .LT. DRCUT) THEN
C END ADDITION
DRMIN = DRPHI
ISMIN = IP
kmin = k
DRM = DR
C WRITE(*,*)' DRMIN,ISMIN,DRM ',DRMIN,ISMIN,DRM
ENDIF
ENDIF
C PRINT 3000,ISM,IP,PHI,PHIPLA,RPL,DELP,DRPHI
3000 FORMAT(' MOD,SEG,PHIP,PHIR,R ',2I3,2F10.4,F6.1,F10.4,F6.1)
C
C--- End of loop over radial segments for supermodule
C
20 CONTINUE
c loop over tracks
100 continue
k=kmin
* Diagnostics
IF(NTRAKS(ISM).NE.0)CALL SHS(730+ISM,0,FLOAT(NTRAKS(ISM))+0.01)
C PLOT DISTANCE OF RADIAL POINTS FROM PREDICTION
IF(ISMIN.NE.0)THEN
CALL SHS(700, 0, DRMIN)
ENDIF
* Diagnostics End.
C
C--- Build list of radial hits and mark segment and hits used
C
IF(ISMIN .NE. 0) THEN
IF(DRMIN .LT. DRPCUT) THEN
IP=ISMIN
IP1=0
IP2=0
IP3=0
DO Ii=1,36
IF(Ii.Ge.01.AND.Ii.LE.12.AND.IPP(Ii,K).NE.0)IP1=1
IF(Ii.Gt.12.AND.Ii.LE.24.AND.IPP(Ii,K).NE.0)IP2=1
IF(Ii.GT.24.AND.Ii.LE.36.AND.IPP(Ii,K).NE.0)IP3=1
end do
SME=0.
SEE=0.
SSS=0.
LL=0
DO 22 IPL=1,12
JPL=IPL+(ISM-1)*12
NP=IRPT(IPL,IP,ISM)
IF(NP.NE.0)THEN
LL=LL+1
RR=RSSS(K)*ZP(JPL)+RISS(K)
PHI=PSSS(K)*ZP(JPL)+PISS(K)
IF(LL.EQ.3)THEN
C EXPECTED D(DRIFT)/DZ
DDDZ=RSSS(K)*SIN(PHI-WW(NP,JPL))
1 +RR*COS(PHI-WW(NP,JPL))*PSSS(K)
ENDIF
IF(PHI.LT.0.0)PHI=PHI+PI2
DRE=RR*SIN(PHI-WW(NP,JPL))
DRMM=SDRFT(IPL,IP,ISM)*DRI(NP,JPL)+DWS(NP,JPL)
DIFF=DRE-DRMM
XX(LL)=ZP(JPL)
YY(LL)=DIFF
YYY(LL)=DRMM
IF(ABS(DRE-DRMM).LT.1.0)THEN
IF(IP1.EQ.1.AND.IP2.EQ.1.AND.ISM.EQ.1)THEN
CALL SHS(704+ISM,0.,DRE-DRMM)
SEE=SEE+DRE*DRE
SME=SME+DRMM*DRE
SSS=SSS+1.0
ENDIF
IF(IP2.EQ.1.AND.IP3.EQ.1.AND.ISM.EQ.2)THEN
CALL SHS(704+ISM,0.,DRE-DRMM)
SEE=SEE+DRE*DRE
SME=SME+DRMM*DRE
SSS=SSS+1.0
ENDIF
IF(IP2.EQ.1.AND.IP3.EQ.1.AND.ISM.EQ.3)THEN
CALL SHS(704+ISM,0.,DRE-DRMM)
SEE=SEE+DRE*DRE
SME=SME+DRMM*DRE
SSS=SSS+1.0
ENDIF
ENDIF
ENDIF
22 CONTINUE
CALL FTLFT(XX,YY,LL,0,AT,BT,EE)
CALL FTLFT(XX,YYY,LL,0,AD,BD,EE)
CALL SHS(708,0,AT)
CALL SHS(699,0,AD-DDDZ)
**********************************************************
* Diagnostics...
IF(ISMIN .NE. 0) THEN
IF(DRMIN .LT. DRPCUT) THEN
IF(SSS.GT.4.AND.ISMIN.NE.0)THEN
C CALCULATE VELOCITY CORRECTION
VFAC=SME/SEE
CALL SHS(750+ISM,0,VFAC)
ENDIF
endif
endif
* Diagnostics end.
IF(ISMIN.NE.0)THEN
IF(DRMIN .LT. DRPCUT) THEN
* Mark radial segment used...
IRUSED(ISM,ISMIN) = 1
II=0
C PRINT2000,(IRPT(LK,ISMIN,ISM),LK=1,12)
2000 FORMAT(' RSEG ',12I2)
ifr=1+(ism-1)*12
ils=11+ifr
DO 50 IWIR= IFR, ILS
II = II+1
IOSP = IRPT(II,ISMIN,ISM)
IF (IOSP.EQ.0) GOTO 50
IRR(IWIR, K) = IABS(IOSP)
SRR(IWIR, K) = SDRFT(II,ISMIN,ISM)
50 CONTINUE
C POINTER TO RADIAL SEGMENT # ASSOCIATED WITH
C NPP'TH PLANAR TRACK
LRR(ISM,K)=ISMIN
nadd=1
ENDIF
ENDIF
ENDIF
ENDIF
c link made: make another search
c otherwise next module
if(nadd.eq.1)goto200
C
C--- End of loop over supermodules
C NEXT LINE SHOWS FINAL SELECTION
CDEB WRITE(*,*)' DRMIN DRM ',ISM,DRMIN,DRM,ISMIN
10 CONTINUE
C PRINT 1000,K,(IRR(II,K),II=1,36),LRR(1,K),LRR(2,K),LRR(3,K)
1000 FORMAT(' R',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
RETURN
END
*