*-- Author : R. Henderson
SUBROUTINE FPLINT
C
C--- Routine finds all interections between any two planes (defined by
C--- clusters)from different wire orientations within the same
C--- supermodule
C---
C
C---
*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---
*KEND.
C---
*KEEP,FPLGEO.
C---
COMMON /FPLGEO/ ZPLAN(36) , TP(9) , YP(26) , PLANE(3,9),
1 RMAX , RMIN , YSTART , YSPACE ,
2 X0 , Y0 , PZSTRU (8), STAGER ,
3 RESOL , ACUT , CTP(9) , STP(9)
C---
*KEND.
C---
*KEEP,FPCLUS.
COMMON /FPCLUS/ TC(3,9,MAXCLU) , NTC(9) , TOC(3,9,MAXCLU) ,
2 TCYUV(4,9,MAXCLU), TCYUVW(4,9,MAXCLU)
C---
*KEND.
C---
*KEEP,FPH1WRK.
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)
LOGICAL DRMASK
COMMON /H1WORK/
C-- *KEEP,FPCSEG.
C---
3 TPNORM(3,9,MAXCLU), PCONST(9,MAXCLU) ,
4 SMLS(4,2,LIMSTO,3) ,
C---
C-- *KEEP,FPDIGI.
5 DRSTO(MSEGLM,4),NDRSTO(4),
6 IDIGST(4,MSEGLM),
7 SEGTAB(MSEGLM,MSEGLM),DRMASK(MSEGLM,4),
8 IDCELL(MSEGLM,4),
9 NSGTAB(MSEGLM),ASGTAB(MSEGLM),
A RESSTO(MSEGLM,4) ,
C---
C-- *KEEP,FPDGI.
B IDGIST(MSEGLM,4),IDGISM(4,9,MAXCLU)
C ,RCHI(MAXSEG,3) ,
C---
C-- *KEEP,FPSTID.
D IDRSTO(MSEGLM,4),IDYUV(4,9,MSEGLM),
E IDYUVS(12,MAXSEG,3),FREQ(MSEGLM+1) ,
C---
C-- *interface to real data
F NDPW(NUMWPL),DW(MAXHTS,NUMWPL),DWG(MAXHTS,NUMWPL),
G DRIWP(MAXHTS,NUMWPL),DRIWM(MAXHTS,NUMWPL),
G DRIW(MAXHTS,NUMWPL),IPHOLE(MAXHTS,NUMWPL),
H IPFRPE(MAXHTS,36), IPPIOS(MAXDIG,2)
C---.
*KEND.
C--
C
DIMENSION ZSMOD(2,3)
DIMENSION SMLSX(2), SMLSY(2), SMLSZ(2)
C
REAL AMINV(2,2),PCVEC(2),CPINT(2),PONINT(3)
REAL INLINE(3)
C
INTEGER NSMLS(3)
C---
C
C--- define front and back of planar supermodule (f/b,sm).
C
ZSMOD(1,1) = ZPLAN(1)
ZSMOD(2,1) = ZPLAN(12)
ZSMOD(1,2) = ZPLAN(13)
ZSMOD(2,2) = ZPLAN(24)
ZSMOD(1,3) = ZPLAN(25)
ZSMOD(2,3) = ZPLAN(36)
C
C--- define inner and outter radii squared
C
RMINSQ = RMIN**2
RMAXSQ = RMAX**2
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
C
C--- Set counter for supermodule
C
NSMLS(ISM) = 0
C
C--- Loop over plane combinations in sm
C
DO 20 IP1 = 1 + (ISM-1)*3 , 2 + (ISM-1)*3
C
C--- Loop on all tracks in this plane
C
DO 30 IT1 = 1,NTC(IP1)
C
C--- remove all combinations with nothing in
C
IF ( TC(3,IP1,IT1) .EQ. 0.0 ) GO TO 30
C
C--- Combination of planes
C
DO 40 IP2 = IP1 + 1 , 3 + (ISM-1)*3
C
C--- Loop on all tracks in this plane
C
DO 50 IT2 = 1,NTC(IP2)
C
C--- remove all combinations with nothing in
C
IF ( TC(3,IP2,IT2) .EQ. 0.0 ) GO TO 50
C
C--- find cos of angle between track planes
C
CTHETA = TPNORM(1,IP1,IT1) * TPNORM(1,IP2,IT2) +
1 TPNORM(2,IP1,IT1) * TPNORM(2,IP2,IT2) +
2 TPNORM(3,IP1,IT1) * TPNORM(3,IP2,IT2)
C
C--- Set up inverse matrix for finding point on line
C
DET = 1.0 - CTHETA**2
AMINV(1,1) = 1.0 / DET
AMINV(2,2) = 1.0 / DET
AMINV(1,2) = -CTHETA / DET
AMINV(2,1) = -CTHETA / DET
C
C--- set up vector of plane definition constants
C
PCVEC(1) = PCONST(IP1,IT1)
PCVEC(2) = PCONST(IP2,IT2)
C
C--- find coefficient of point on line of intersection
C
DO 100 I = 1,2
CPINT(I) = 0.0
DO 101 J = 1,2
CPINT(I) = CPINT (I) + AMINV(I,J) * PCVEC(J)
101 CONTINUE
100 CONTINUE
C
C--- now we have line of intersection as
C line = cpint + lambda * ( tpnorm1 vec tpnorm2 )
C
C--- calculate vector to line ponint
C
DO 55 KK = 1,3
PONINT(KK) = CPINT(1) * TPNORM(KK,IP1,IT1) +
1 CPINT(2) * TPNORM(KK,IP2,IT2)
55 CONTINUE
C
C--- Calculate direction vector of intersection
C
INLINE(1) =
1 ( TPNORM(3,IP1,IT1) * TPNORM(2,IP2,IT2)
2 - TPNORM(2,IP1,IT1) * TPNORM(3,IP2,IT2) )
INLINE(2) =
1 - ( TPNORM(3,IP1,IT1) * TPNORM(1,IP2,IT2)
2 - TPNORM(1,IP1,IT1) * TPNORM(3,IP2,IT2) )
INLINE(3) =
1 ( TPNORM(2,IP1,IT1) * TPNORM(1,IP2,IT2)
2 - TPNORM(1,IP1,IT1) * TPNORM(2,IP2,IT2) )
C
C--- solve for beginning and end of supermodule
C
IF( INLINE(3) .NE. 0.0 ) THEN
ALAMB = ( ZSMOD (1,ISM) - PONINT (3) ) / INLINE(3)
ALAME = ( ZSMOD (2,ISM) - PONINT (3) ) / INLINE(3)
ENDIF
C
SMLSX(1) = PONINT(1) + ALAMB*INLINE(1)
SMLSY(1) = PONINT(2) + ALAMB*INLINE(2)
SMLSZ(1) = PONINT(3) + ALAMB*INLINE(3)
C
C--- remove those segments not in sensitive volume
C
RSQ = SMLSX(1)**2 + SMLSY(1)**2
IF ( RSQ .LT. RMINSQ .OR. RSQ .GT. RMAXSQ )THEN
C---
C---
ELSE
C---
C---
C
C--- Store line segment for later analysis and plot
C
C
C--- protect overwriting and store good primative segments
C
IF (NSMLS(ISM) .GE. LIMSTO ) THEN
CALL ERRLOG(211,'W:FPLINT: NSMLS(ISM) >= LIMSTO')
GO TO 10
ELSE
C---
NSMLS(ISM) = NSMLS(ISM) + 1
NSEGSM=NSMLS(ISM)
C---
ENDIF
C
C--- calculate and store beginning and end points
C
SMLS(1,1,NSEGSM,ISM) = PONINT(1) + ALAMB*INLINE(1)
SMLS(1,2,NSEGSM,ISM) = PONINT(1) + ALAME*INLINE(1)
SMLS(2,1,NSEGSM,ISM) = PONINT(2) + ALAMB*INLINE(2)
SMLS(2,2,NSEGSM,ISM) = PONINT(2) + ALAME*INLINE(2)
SMLS(3,1,NSEGSM,ISM) = PONINT(3) + ALAMB*INLINE(3)
SMLS(3,2,NSEGSM,ISM) = PONINT(3) + ALAME*INLINE(3)
C
C--- record segment contributing track/planes
C--- smls(4,1 = it1*10 + ip1 smls(4,2 = it2*10 + ip2
C
SMLS(4,1,NSEGSM,ISM) = IT1*10 + IP1
SMLS(4,2,NSEGSM,ISM) = IT2*10 + IP2
ENDIF
C
C--- End of loops
C
50 CONTINUE
40 CONTINUE
30 CONTINUE
20 CONTINUE
10 CONTINUE
C
C--- find if segments are coincident
C
C--- Primary (3 clusters)
C
CALL FPFSEG(NSMLS)
C
C--- Secondary (2 clusters + >=1 digit)
C
CALL FPFSSG(NSMLS)
C
C--- Tertiary (2 clusters ONLY)
C
CALL FPFTSG(NSMLS)
C---
END
*