*-- Author : R. Henderson 24/10/94
SUBROUTINE FPFTSG(NSMLS)
C-----------------------------------------------------------------------
C
C--- Routine finds 'TERTIARY' segments from two Clusters/Planes
C--- + nothing.
C--- Firstly arrays are calculated which
C--- flag clusters which have not already been used in segments.
C--- (IUCLU(IPLANE,MAXCLU) = 0 if unused)
C--- Then for unused digits that have not yet been placed in a cluster.
C--- (IUD(MAXHTS,NUMWPL) = 0 if not used)
C---
C--- The new segments are fitted using FPFSTS. A count of the new
C--- tertiary segments is kept in COMMON/FPSTSG/ as NFTSEG(9) but
C--- otherwise the normal counter NFSEG(9) is incremented to include
C--- these new segments.
C---
C--- A new disconnected set is found for all segments by FPSSGF.
C---
C--- COMMON/FPSTSG/NSTC(9) --- Number of secondary clusters formed.
C--- NFSSEG(3) --- Number of secondary Segments formed.
C--- NFTSEG(3) --- Number of Tertiary segments formed.
C---
C--- The segments are ordered so all primary segments preceed
C--- secondary and finary secondary preceed Tertiary)
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---
*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---.
*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,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---
*KEEP,FPSTSG.
COMMON/FPSTSG/ NSTC(9),NFSSEG(3),NFTSEG(3)
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
DIMENSION IUD(MAXHTS,NUMWPL)
DIMENSION IUCLU(9,MAXCLU)
DIMENSION IPL(2),ICL(2)
DIMENSION TODIG(3),VDIG(3),TOCLS(3),VCLS(3)
DIMENSION DMINW(4),IDIGM(4),IWLIS(4)
C
INTEGER NSMLS(3)
C
DOUBLE PRECISION PARSGN(4),ERRSGN(4,4)
C
C--- Initialize arrays
C
CALL VZERO(IUD,MAXHTS*NUMWPL)
C
C--- Establish a list of clusters and digits available
C--- to form secondary segments
C
C
C--- Firstly Digits
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
C
C--- Loop over candidate line segments
C
DO 20 LSC = 1,NSMLS(ISM)
C
C--- Loop on clusters that form CANDIDATE line segments
C
DO 30 IC = 1,2
C
C--- Find the planes.clusters numbers that make them up
C
IDCLS = SMLS(4,IC,LSC,ISM)
IP = MOD(IDCLS,10)
ICLU = IDCLS/10
C
C--- Loop on four wires in cluster
C
DO 40 IW = 1, 4
IWW = (IP-1)*4 + IW
C
C--- Set flag in IUD (Used Digits) to +/-1 from 0
C (SIGN = DRIFT DIRECTION)
C
IND = ABS(IDGISM(IW,IP,ICLU))
IF(IND .EQ. 0)GO TO 40
ISIGN = IDGISM(IW,IP,ICLU)/IABS(IDGISM(IW,IP,ICLU))
C---
IUD(IND,IWW) = ISIGN
C
40 CONTINUE
C
30 CONTINUE
C
20 CONTINUE
C
10 CONTINUE
C
C--- Create list of used/unused clusters
C
CALL VZERO(IUCLU,9*MAXCLU)
C
C--- Loop over supermodules
C
DO 100 ISM=1,3
C
C--- Loop over segments
DO 110 ISEG = 1,NFSEG(ISM)
C
C--- Remove those outside disconnected set
C
IF(MASKSG(ISEG,ISM) .EQ. -1) GO TO 110
C
C---
C
IPLAN1 = MOD(ISEGIN(1,ISEG,ISM),10)
IPLAN2 = MOD(ISEGIN(2,ISEG,ISM),10)
IPLAN3 = MOD(ISEGIN(3,ISEG,ISM),10)
ITRK1 = ISEGIN(1,ISEG,ISM)/10
ITRK2 = ISEGIN(2,ISEG,ISM)/10
ITRK3 = ISEGIN(3,ISEG,ISM)/10
C
C--- Set IUCLU to 1 if used
C
IUCLU(IPLAN1,ITRK1) = 1
IUCLU(IPLAN2,ITRK2) = 1
IUCLU(IPLAN3,ITRK3) = 1
C---
110 CONTINUE
100 CONTINUE
C
C--- Having established the unused CLS and Digits find all
C--- distances of closest approach
C
CALL VZERO(NFTSEG,3)
C
C--- Loop over supermodule
C
DO 200 ISM = 1,3
C
C--- Loop on candidate line segments
C
DO 210 ICLS = 1,NSMLS(ISM)
*
* SB mod to help with large events
*
IF (NFSEG(ISM) .GE. MAXSEG) THEN
CALL ERRLOG(216,'W:FPFTSG: .GT. MAXSEG segments found')
GOTO 200
ENDIF
C
C--- Calculate the angle wrt to axis of candidate line segment
C
DXCLS = SMLS(1,2,ICLS,ISM) - SMLS(1,1,ICLS,ISM)
DYCLS = SMLS(2,2,ICLS,ISM) - SMLS(2,1,ICLS,ISM)
DZCLS = SMLS(3,2,ICLS,ISM) - SMLS(3,1,ICLS,ISM)
DTCLS = SQRT( DXCLS**2 + DYCLS**2 )
IF(DZCLS .GT. 0.0)THEN
PHICLS = ATAN(DTCLS/DZCLS)
ENDIF
C
C---
C
IF(PHICLS .GT. 0.5)GO TO 210
C
C--- Check that neither plane in candidate line segment used
C
DO 220 ICLU = 1,2
ICCLU = SMLS(4,ICLU,ICLS,ISM)
IPL(ICLU) = MOD(ICCLU,10)
ICL(ICLU) = ICCLU/10
IF(IUCLU(IPL(ICLU),ICL(ICLU)) .EQ. 1)GO TO 210
220 CONTINUE
C
C--- Calculate which wires are to be searched for digits
C--- They must be the wires which have not contributed to CLS
C
IF( IPL(1) .EQ. 1 .AND. IPL(2) .EQ. 2)THEN
IPMISS = 3
ELSEIF(IPL(1) .EQ. 1 .AND. IPL(2) .EQ. 3)THEN
IPMISS = 2
ELSEIF(IPL(1) .EQ. 2 .AND. IPL(2) .EQ. 3)THEN
IPMISS = 1
ELSEIF(IPL(1) .EQ. 4 .AND. IPL(2) .EQ. 5)THEN
IPMISS = 6
ELSEIF(IPL(1) .EQ. 4 .AND. IPL(2) .EQ. 6)THEN
IPMISS = 5
ELSEIF(IPL(1) .EQ. 5 .AND. IPL(2) .EQ. 6)THEN
IPMISS = 4
ELSEIF(IPL(1) .EQ. 7 .AND. IPL(2) .EQ. 8)THEN
IPMISS = 9
ELSEIF(IPL(1) .EQ. 7 .AND. IPL(2) .EQ. 9)THEN
IPMISS = 8
ELSEIF(IPL(1) .EQ. 8 .AND. IPL(2) .EQ. 9)THEN
IPMISS = 7
ENDIF
C
C
C--- Fit newly created cluster with candidate line segment
C--- to form new (secondary segment)
C
ID1 = SMLS(4,1,ICLS,ISM)
ID2 = SMLS(4,2,ICLS,ISM)
ID3 = 0 + IPMISS
CALL FPFSTS(ID1,ID2,ID3,ISM,PCHI,CHISQ,NDF,PARSGN,ERRSGN)
210 CONTINUE
200 CONTINUE
C
C--- Reform disconnected segment sets
C
CALL FPSSGF(.FALSE.)
END
*