*-- Author : I.O.Skillicorn
SUBROUTINE FPLKPR(ISMP,IDM )
**: FPLKPR 30907 RP. Farm changes.
**----------------------------------------------------------------------
** ROUTINE TO JOIN ADJACENT RADIAL AND PLANAR MODULES
* AS FPLKRP1 BUT FIND BEST RADIAL FOR SELECTED PLANAR
*
* 12/8/96 add d(phi)/dz cut
*
*
*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 for segment numbers...
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)
COMMON /FPSEG3/ ISGR(3,MAXSEG)
* Local arrays...
DIMENSION RSEG(4),PSEG(4)
DIMENSION XX(20),YY(20)
PARAMETER(PI2=6.2831853)
LOGICAL FIRST/.TRUE./
IF(FIRST) THEN
FIRST = .FALSE.
* note millimetres
DRPCUT= 10.0
DRCUT = 100.
phicut= 0.002
atcut = 0.15
write(*,*)' new FPLKPR - d(phi)/dz cut '
ENDIF
C
C--- LOOP OVER SUPERMODULES - FOR RADIALS
C
C ISMP- PLANAR MODULE
C ISM - RADIAL MODULE
C
DO 15 IP = 1,NFSEG(ISMP)
C
C--- search only unused segments
C
IF(IUZP(IP,ISMP).NE.0)GOTO15
C
C--- search only the disconnected set
C
IF( MASKSG(IP,ISMP) .NE. 0 )GO TO 15
C
C--- Extract planar segment and covariance matrix
C
C STR LINES THROUGH PLANARS IN PHI-Z R-Z
C DISTANCES IN MM HERE FOR RCWH
DO 30 I = 1,4
C---
PSEG(I) = XYDXY(I,IP,ISMP)
C---
30 CONTINUE
C---
Z1MM=ZPP(1+12*(ISMP-1))*10.
Z2MM=ZPP(12+12*(ISMP-1))*10.
X1=PSEG(1)+Z1MM*PSEG(3)
Y1=PSEG(2)+Z1MM*PSEG(4)
X2=PSEG(1)+Z2MM*PSEG(3)
Y2=PSEG(2)+Z2MM*PSEG(4)
R1=SQRT(X1**2+Y1**2)
R2=SQRT(X2**2+Y2**2)
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=P1-P2
IF(DP.GT.6.0)DP=DP-PI2
IF(DP.LT.-6.0)DP=DP+PI2
C NOTE MM THRUOUT
RSS =(R1-R2)/(Z1MM-Z2MM)
RIS =(R1-RSS*Z1MM)
PSS =DP/(Z1MM-Z2MM)
PIS =P1-PSS*Z1MM
C
DO 50 ISM=1,3
Z = ZP( 6 + (ISM -1)*12 )
ZMM=Z*10.
* R AND PHI FOR PLANAR SEGMENT AT POSITION OF RADIAL
PHIPLA=PSS*ZMM+PIS
RPL =RSS*ZMM+RIS
PHIPLA = AMOD(PHIPLA,PI2)
IF(PHIPLA.LT.0.0) PHIPLA = PHIPLA + PI2
ISMIN = 0
DRMIN = 1000000.0
DRM = 1000000.0
DO 20 K=1,NTRAKS(ISM)
if(chsq(k,ism).gt.1000.0)goto20
IF(IUZR(K,ISM).NE.0)GOTO20
C
Z = ZP( 6 + (ISM -1)*12 )
C
C--- RR AND PHI CALCULATED FOR THIS Z AS FOUND BY RADIALS
C
RR = PSINL(K,ISM)*Z + RZI(K,ISM)
RRAD= RR*10.
PHI = PCOSL(K,ISM)*Z + PHZL(K,ISM)
PHI = AMOD(PHI,PI2)
IF(PHI.LT.0.0) PHI = PHI + 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)
IF(DRPHI.LT.DRPCUT)THEN
CALL SHS(1631,0,DR )
ENDIF
IF(DRPHI .LT. DRMIN) THEN
IF(DR .LT. DRCUT) THEN
DRMIN = DRPHI
ISMIN = K
DRM = DR
ENDIF
ENDIF
C
C--- END OF LOOP OVER RADIAL SEGMENTS FOR SUPERMODULE
C
20 CONTINUE
C
C GET DISTANCE OF RADIAL POINTS FROM PREDICTION*******
IF(ISMIN.NE.0)THEN
IX=ISMIN
LL=0
DO 22 IPL=1,12
JPL=IPL+(ISM-1)*12
NP=IRPT(IPL,IX,ISM)
IF(NP.NE.0)THEN
LL=LL+1
RR=RSS*ZP(JPL)*10.+RIS
PHI=PSS*ZP(JPL)*10.+PIS
IF(PHI.LT.0.0)PHI=PHI+PI2
DRE=RR*SIN(PHI-WW(NP,JPL))/10.
DRMM=SDRFT(IPL,IX,ISM)*DRI(NP,JPL)+DWS(NP,JPL)
DIFF=DRE-DRMM
XX(LL)=ZP(JPL)
YY(LL)=DIFF
C FOLLOWING HISTOGRAM SHOWS DATA SPREAD TO 1 CMS
c CALL SHS(1632,0,DIFF)
ENDIF
22 CONTINUE
CALL FTLFT(XX,YY,LL,0,AT,BT,EE)
c compare radial d(phi)/dz with planar
dphi=pcosl(ismin,ism)-pss*10.
dphi1=dphi
dphi=amod(dphi,pi2)
if(drmin.lt.drpcut)then
CALL SHS(1633,0,AT)
CALL SHS(1636,0,AT)
* if(dphi1.ne.dphi)write(*,*)' fplkpr ',dphi,dphi1
CALL SHS(1635,0,dphi)
endif
DC=AT*XX(LL/2)+BT
diff=dc
CALL SHS(1632,0,DIFF)
C CHECK SLOPE OF SEGMENT : HISTGRAM SUGGESTS 0.1
IF(ABS(AT).GT.atcut)ISMIN=0
c check d(phi)/dz
if(abs(dphi).gt.phicut)ismin=0
IF(ISMIN.NE.0)CALL SHS(1634,0,DC)
ENDIF
C END ADDITION *****************************************
IF(ISMIN .NE. 0) THEN
CALL SHS(1630,0,DRMIN)
IF(DRMIN .LT. DRPCUT) THEN
C LINK FLAG ISMP =PLANAR MODULE 2,3 . IP POINTS TO PLANAR SEGMENT
C ISGR IS RADIAL SEGMENT IN MODULE ISMP-1
C ISGR ZERO'D IN FTADD
IF(ISMIN.GT.99)ISMIN=99
ISGR(ISMP,IP) = ISMIN*100**(ISM-1)+ISGR(ISMP,IP)
IUZR(ISMIN,ISM)= 1
IUZP(IP,ISMP) = 1
CIOS PRINT 2000,ISM,ISMP,ISMIN,IP
2000 FORMAT(' PR LK1 ',2I3,3X,2I3)
CIOS CALL SHD(212,0,DRMIN,DRM)
ENDIF
ENDIF
C
C--- End of loop over supermodules
C
C PRINT 1000,(IRP(II,K),II=1,36)
1000 FORMAT(' P ',12I2,3X,12I2,3X,12I2)
50 CONTINUE
15 CONTINUE
10 CONTINUE
RETURN
END
*