*-- Author : R. Henderson 24/10/94
SUBROUTINE FPFSSG(NSMLS)
C-----------------------------------------------------------------------
C
C--- Routine finds 'SECONDARY' segments from two Clusters/Planes
C--- + any number of previously unused digits.
C--- Firstly arrays are calculated which
C--- flag clusters which have not already been used in segments
C--- formed from three clusters.
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--- A search is made for all candidate line segments formed from
C--- two unused clusters to find any that have digits (the information
C--- from which can be expressed as a line) in the orientation not
C--- yet contributing with a Distance of Closest
C--- Approach of less than DDTOL. The closest digit is included in the
C--- segment together with any which are within DIGTOL of the closest.
C---
C--- A new cluster is formed using the newly added digit(s).( NB.
C--- If the cluster is formed of only one digit the cluster no longer
C--- represents a plane.) The number of these created is stored in
C--- COMMON/FPSTSG/ as NSTC(9). Otherwise the normal Cluster counter
C--- is incremented to include all clusters new and old.
C---
C--- The new segments are fitted using FPFSTS. A count of the new
C--- secondary segments is kept in COMMON/FPSTSG/ as NFSSEG(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
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,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
PARAMETER (DDCUT= 6.0)
PARAMETER (DIGTOL= 0.3)
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(NFSSEG,3)
CALL VZERO(NFTSEG,3)
C
C--- Loop over supermodule
C
DO 200 ISM = 1,3
C
C--- Loop on candidate line segments
C
NTRAP = 0
DO 210 ICLS = 1,NSMLS(ISM)
*
* SB mod to help with large events
*
IF (NFSEG(ISM) .GE. MAXSEG) THEN
CALL ERRLOG(216,'W:FPFSSG: .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 = DXCLS**2 + DYCLS**2
IF(DZCLS .GT. 0.0)THEN
PHICLS = ATAN(DTCLS/(DZCLS**2))
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
*
* SB mod to help with large events
*
IF(NTC(IPMISS) .GE. MAXCLU)THEN
NTRAP = NTRAP + 1
IF (NTRAP.EQ.1)
& CALL ERRLOG(214,'W:FPFSSG: Cluster limit reached')
GOTO 210
ENDIF
C
IWSTAR = (IPMISS-1)*4 + 1
C
C--- Calculate w of cluster in missing orientation
C
XCLSS = SMLS(1,1,ICLS,ISM)
XCLSE = SMLS(1,2,ICLS,ISM)
YCLSS = SMLS(2,1,ICLS,ISM)
YCLSE = SMLS(2,2,ICLS,ISM)
ZCLSS = SMLS(3,1,ICLS,ISM)
ZCLSE = SMLS(3,2,ICLS,ISM)
C---
XOR = XCLSS + ( (XCLSE-XCLSS) / (ZCLSE-ZCLSS) )
1 * ( ZPLAN( (IPMISS-1)*4 + 1 ) - ZCLSS )
C---
YOR = YCLSS + ( (YCLSE-YCLSS) / (ZCLSE-ZCLSS) )
1 * ( ZPLAN( (IPMISS-1)*4 + 1 ) - ZCLSS )
C---
WOR = YOR * CTP(IPMISS) - XOR * STP(IPMISS)
C
C--- Now find unused digitizations on these wires
C
CALL VZERO(DMINW,4)
CALL VZERO(IDIGM,4)
C---
ICDIG = 0
C---
DO 300 IWW = IWSTAR , IWSTAR + 3
C
C--- Loop over all digits on wires
C
DMIN = 10000.0
C
DO 310 IDIG = 1,NDPW(IWW)
C
C--- Remove any digits already used
C
IF (IUD(IDIG,IWW) .NE. 0) GO TO 310
C
C--- Loop on sign of drifts
C
DO 320 ISD = 1,2
C---
* DRIFT = (DRIW(IDIG,IWW)*(-1.0)**(ISD-1) + DW(IDIG,IWW)) * 10.0
IF (ISD.EQ.1) THEN
DRIFT = (DWG(IDIG,IWW) + DRIWP(IDIG,IWW)) * 10.0
ELSE
DRIFT = (DWG(IDIG,IWW) - DRIWM(IDIG,IWW)) * 10.0
ENDIF
C---
IF( (WOR - DRIFT) .GT. 2.0*DDCUT) GO TO 320
C
C--- Now make vectors TO and PARALLEL to digit information
C
XDIG = -DRIFT * STP(IPMISS)
YDIG = DRIFT * CTP(IPMISS)
C---
TODIG(1) = XDIG
TODIG(2) = YDIG
TODIG(3) = ZPLAN(IWW)
C---
VDIG(1) = PLANE(1,IPMISS)
VDIG(2) = PLANE(2,IPMISS)
VDIG(3) = PLANE(3,IPMISS)
C
C--- Make vector TO and PARALLEL to CLS
C
TOCLS(1) = SMLS(1,1,ICLS,ISM)
TOCLS(2) = SMLS(2,1,ICLS,ISM)
TOCLS(3) = SMLS(3,1,ICLS,ISM)
C---
VCLS(1) = SMLS(1,1,ICLS,ISM) - SMLS(1,2,ICLS,ISM)
VCLS(2) = SMLS(2,1,ICLS,ISM) - SMLS(2,2,ICLS,ISM)
VCLS(3) = SMLS(3,1,ICLS,ISM) - SMLS(3,2,ICLS,ISM)
C
C--- Now calculate distance of closest approach of digit to CLS
C
C CALL FPDCA(TODIG,VDIG,TOCLS,VCLS,DIST)
C New, hopefully faster version
CALL FPNDCA(TODIG,VDIG,TOCLS,VCLS,DIST)
C---
IF(ABS(DIST) .LT. ABS(DMIN))THEN
DMIN = DIST
IDGMIN = IDIG
ISGNMN = ISD
ENDIF
C---
320 CONTINUE
310 CONTINUE
C---
C
C--- Store distance to closest digit on wire plane
C
IF(ABS(DMIN) .LT. DDCUT)THEN
ICDIG = ICDIG + 1
DMINW(IWW-IWSTAR+1) = DMIN
IDIGM(IWW-IWSTAR+1) = IDGMIN*(-1.0)**(ISGNMN-1)
ELSE
DMINW(IWW-IWSTAR+1) = -1000000.0
ENDIF
300 CONTINUE
C
C--- Find closest
C
IDCDIG = 0
IFDIG = 0
CALL VZERO(IWLIS,4)
IF(ICDIG.GT.0)THEN
DCDIG = 1000000.0
DO 500 IWIR = 1,4
IF(DMINW(IWIR) .LT. -1000.0)GO TO 500
IF( ABS(DMINW(IWIR)) .LT. ABS(DCDIG) )THEN
DCDIG = DMINW(IWIR)
IDCDIG = IWIR
ENDIF
500 CONTINUE
C---
C
C--- Find any within a tolerance of closest
C
IF(ICDIG.GT.1)THEN
IWLIS(1) = IDCDIG
IFDIG = 1
DO 501 IWIR = 1,4
IF(IWIR .EQ. IDCDIG)GO TO 501
IF( ABS(DCDIG-DMINW(IWIR)) .GT. DIGTOL)GO TO 501
IFDIG = IFDIG + 1
IWLIS(IFDIG) = IWIR
501 CONTINUE
ENDIF
C
C--- Create secondary clusters and segments
C
IF(IFDIG .GT. 0)THEN
C
C--- Create new clusters
C
NTC(IPMISS) = NTC(IPMISS) + 1
NSTC(IPMISS) = NSTC(IPMISS) + 1
IF(NTC(IPMISS) .GT. MAXCLU)THEN
NTC(IPMISS) = NTC(IPMISS) - 1
NSTC(IPMISS) = NSTC(IPMISS) - 1
CALL ERRLOG(214,'W:FPFSSG: Cluster limit reached')
ELSE
CALL VZERO( TCYUV(1,IPMISS,NTC(IPMISS)),4)
CALL VZERO(TCYUVW(1,IPMISS,NTC(IPMISS)),4)
CALL VZERO(IDGISM(1,IPMISS,NTC(IPMISS)),4)
DO 700 IDG = 1,IFDIG
IWW = IWLIS(IDG)
IWIR = IWW + (IPMISS-1)*4
IDIG = IABS(IDIGM(IWW))
ISGN = IDIGM(IWW)/IDIG
* TCYUV(IWW,IPMISS,NTC(IPMISS)) =
* 1 (DRIW(IDIG,IWIR)*(-1.0)**(ISGN-1) +
* 2 DW(IDIG,IWIR)) * 10.0
IF (MOD(ISGN,2).EQ.1) THEN
TCYUV(IWW,IPMISS,NTC(IPMISS)) =
1 (DWG(IDIG,IWIR) + DRIWP(IDIG,IWIR)) * 10.0
ELSE
TCYUV(IWW,IPMISS,NTC(IPMISS)) =
1 (DWG(IDIG,IWIR) - DRIWM(IDIG,IWIR)) * 10.0
ENDIF
TCYUVW(IWW,IPMISS,NTC(IPMISS)) = 30.0
IDGISM(IWW,IPMISS,NTC(IPMISS)) = IDIGM(IWW)
700 CONTINUE
ENDIF
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 = NTC(IPMISS)*10 + IPMISS
CALL FPFSTS(ID1,ID2,ID3,ISM,PCHI,CHISQ,NDF,PARSGN,ERRSGN)
ENDIF
ENDIF
210 CONTINUE
200 CONTINUE
C
C--- Reform disconnected segment sets
C
CALL FPSSGF(.TRUE.)
END
*