*-- 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 * * *