*-- Author : I. O. Skillicorn 31/07/96
SUBROUTINE FPPHIT(m1,m2,i,j,iflag)
c check planar linking in phi:
c d(phi)/dz for the line segments should agree
c with that from the track model.
*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,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,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,FPFVTX.
COMMON/VERTFF/ZFF,XFF,YFF
*
*KEEP,FPJPAR.
COMMON/FPJPAR/
+ RRCUT1, RRCUT2, RRCUT3,
+ PLCC3, PLCC12, PLCC23, PLCC13
*KEND.
COMMON/FTPS3/NS(3),SPAR(4,50,3),IPT(12,50,3),IPLA(12,50,3),
1 SGN(12,50,3),YYS(12,50,3),YYF(12,50,3)
COMMON/FTPLNK/LINK,CHIL(100),LNK(3,100),IUS(100,3)
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
COMMON/FKLOC/KLOC(100)
COMMON/FEVSAT/IEVSAT
COMMON/fsegtp/iseg(100,3)
data istart/0/
if(istart.eq.0)then
istart=1
call stext(970,4,' fpphit phips1-phipl 12 ')
call bhs(970,0,50,-0.005,0.005)
call stext(971,4,' fpphit phips2-phipl 12 ')
call bhs(971,0,50,-0.005,0.005)
call stext(972,4,' fpphit phips2-phips1 12')
call bhs(972,0,50,-0.01,0.01)
call stext(973,4,' fpphit phi2-phi1 midplane 12')
call bhs(973,0,50,-0.50,0.50)
call stext(974,4,' fpphit phips1-phipl 23 ')
call bhs(974,0,50,-0.005,0.005)
call stext(975,4,' fpphit phips2-phipl 23 ')
call bhs(975,0,50,-0.005,0.005)
call stext(976,4,' fpphit phips2-phips1 23')
call bhs(976,0,50,-0.01,0.01)
call stext(977,4,' fpphit phi2-phi1 midplane 23')
call bhs(977,0,50,-0.50,0.50)
call stext(978,4,' fpphit phips1-phipl 13 ')
call bhs(978,0,50,-0.005,0.005)
call stext(979,4,' fpphit phips2-phipl 13 ')
call bhs(979,0,50,-0.005,0.005)
call stext(980,4,' fpphit phips2-phips1 13')
call bhs(980,0,50,-0.01,0.01)
call stext(981,4,' fpphit phi2-phi1 midplane 13')
call bhs(981,0,50,-0.50,0.50)
endif
PI2=6.283185307
if(m1.eq.1)ip1=6
if(m1.eq.2)ip1=18
if(m2.eq.2)ip2=18
if(m2.eq.3)ip2=30
Z1=ZPP(ip1)
X1=SPAR(3,I,m1)*Z1+SPAR(4,I,m1)
Y1=SPAR(1,I,m1)*Z1+SPAR(2,I,m1)
Z2=ZPP(ip2)
X2=SPAR(3,J,m2)*Z2+SPAR(4,J,m2)
Y2=SPAR(1,J,m2)*Z2+SPAR(2,J,m2)
zm=0.5*(z1+z2)
c get parameters of line connecting centres of
c segments
p1=atan2(y1,x1)
p1=amod(p1,pi2)
if(p1.lt.0.0)p1=p1+pi2
p2=atan2(y2,x2)
p2=amod(p2,pi2)
if(p2.lt.0.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/(z2-z1)
pi=(p1-ps*z1)
c
c get parameters of each segment
c segment start 1
Z11=ZPP(ip1-5)
X1=SPAR(3,I,m1)*Z11+SPAR(4,I,m1)
Y1=SPAR(1,I,m1)*Z11+SPAR(2,I,m1)
c segment end 1
Z12=ZPP(ip1+6)
X2=SPAR(3,I,m1)*Z12+SPAR(4,I,m1)
Y2=SPAR(1,I,m1)*Z12+SPAR(2,I,m1)
p1=atan2(y1,x1)
p1=amod(p1,pi2)
if(p1.lt.0.0)p1=p1+pi2
p2=atan2(y2,x2)
p2=amod(p2,pi2)
if(p2.lt.0.0)p2=p2+pi2
dp=p2-p1
if(dp.gt.6.0)dp=dp-pi2
if(dp.lt.-6.0)dp=dp+pi2
c parameters of first segment
ps1=dp/(z12-z11)
pii1=(p1-ps1*z11)
c
c segment start 2
Z11=ZPP(ip2-5)
X1=SPAR(3,j,m2)*Z11+SPAR(4,j,m2)
Y1=SPAR(1,j,m2)*Z11+SPAR(2,j,m2)
c segment end 2
Z12=ZPP(ip2+6)
X2=SPAR(3,j,m2)*Z12+SPAR(4,j,m2)
Y2=SPAR(1,j,m2)*Z12+SPAR(2,j,m2)
p1=atan2(y1,x1)
p1=amod(p1,pi2)
if(p1.lt.0.0)p1=p1+pi2
p2=atan2(y2,x2)
p2=amod(p2,pi2)
if(p2.lt.0.0)p2=p2+pi2
dp=p2-p1
if(dp.gt.6.0)dp=dp-pi2
if(dp.lt.-6.0)dp=dp+pi2
c parameters of second segment
ps2=dp/(z12-z11)
pii2=(p1-ps2*z11)
ps1ps=amod(ps1-ps,pi2)
ps2ps=amod(ps2-ps,pi2)
ps2ps1=amod(ps2-ps1,pi2)
c phi midplane
ph1=ps1*zm+pii1
ph2=ps2*zm+pii2
ph1ph2=amod(ph1-ph2,pi2)
iflag=0
if(abs(ps1ps).gt.0.002)iflag=1
if(abs(ps2ps).gt.0.002)iflag=1
if(m1.eq.1.and.m2.eq.2)then
call shs(970,0,ps1ps)
call shs(971,0,ps2ps)
if(iflag.eq.0)then
call shs(972,0,ps2ps1)
endif
call shs(973,0,ph1ph2)
endif
if(m1.eq.2.and.m2.eq.3)then
call shs(974,0,ps1ps)
call shs(975,0,ps2ps)
if(iflag.eq.0)then
call shs(976,0,ps2ps1)
endif
call shs(977,0,ph1ph2)
endif
if(m1.eq.1.and.m2.eq.3)then
call shs(978,0,ps1ps)
call shs(979,0,ps2ps)
if(iflag.eq.0)then
call shs(980,0,ps2ps1)
endif
call shs(981,0,ph1ph2)
endif
RETURN
END