*-- Author : R. Henderson
SUBROUTINE FPFSEG(NSMLS)
**: FPFSEG.......SM. Add diagnostic histograms
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---
*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---
*KEND.
C---
C---
DOUBLE PRECISION PARSEG(4),ERRSEG(4,4),
1 PARSGN(4),ERRSGN(4,4)
DIMENSION ID(3,2)
DIMENSION XFV(LIMSTO),IOXFV(LIMSTO)
DIMENSION XSOL(2),YSOL(2),ZSOL(2)
C DIMENSION IUCLU(50,9)
C---
INTEGER NSMLS(3)
REAL X(2),Y(2),Z(2)
C
C--- Set segment finding resolution cut
C
ACUTSQ = ACUT**2
C
C--- loop over all combinations of planes formed by clusters
C--- in each orientation per supermodule and
C--- find any three which are coincident to within an
C--- arbitary tolerance acut
C
C
C--- Loop on supermodules
C
DO 5 ISM = 1,3
C
C--- Zero number of segments found
C
NFSEG(ISM) = 0
C
C--- skip if less than three present
C
IF ( NSMLS(ISM) .LT. 3 ) GO TO 5
C
C--- sort the segments according to their front face x values
C
DO 250 IS = 1 , NSMLS(ISM)
XFV(IS) = SMLS(1,1,IS,ISM)
250 CONTINUE
C
C--- call cern library routine to return sorted list
C--- their ascending order is stored in ioxfv
C
IF( NSMLS(ISM) .NE. 0)
1 CALL SORTZV(XFV , IOXFV , NSMLS(ISM) , 1 , 0 , 0)
C
C--- Loop on tracks
C
DO 10 ISEG1 = 1 , NSMLS(ISM)-2
C
C--- Second Plane
C
DO 20 ISEG2 = ISEG1+1 , NSMLS(ISM)-1
C
C--- Test 1/2 front x and then y and rear x then y projections
C
DFX1 = SMLS(1,1,IOXFV(ISEG1),ISM) - SMLS(1,1,IOXFV(ISEG2),ISM)
* Call Hfill(403, DFX1, 0., 1.)
IF (abs( DFX1) .GT. ACUT ) GO TO 10
DFY1 = SMLS(2,1,IOXFV(ISEG1),ISM) - SMLS(2,1,IOXFV(ISEG2),ISM)
* Call Hfill(403, DFY1, 0., 1.)
IF (abs( DFY1) .GT. ACUT ) GO TO 20
DRX1 = SMLS(1,2,IOXFV(ISEG1),ISM) - SMLS(1,2,IOXFV(ISEG2),ISM)
* Call Hfill(403, DRX1, 0., 1.)
IF (abs( DRX1) .GT. ACUT ) GO TO 20
DRY1 = SMLS(2,2,IOXFV(ISEG1),ISM) - SMLS(2,2,IOXFV(ISEG2),ISM)
* Call Hfill(403, DRY1, 0., 1.)
IF (abs( DRY1) .GT. ACUT ) GO TO 20
C
C--- third plane
C
DO 30 ISEG3 = ISEG2+1 , NSMLS(ISM)
C
C--- Now test 1/3 x projection combinations
C
DFX2 = SMLS(1,1,IOXFV(ISEG1),ISM) - SMLS(1,1,IOXFV(ISEG3),ISM)
* Call Hfill(403, DFX2, 0., 1.)
IF (abs( DFX2) .GT. ACUT ) GO TO 20
C
C--- In an ordered sequence this next tests adds nothing
C
DFX3 = SMLS(1,1,IOXFV(ISEG2),ISM) - SMLS(1,1,IOXFV(ISEG3),ISM)
* Call Hfill(403, DFX1, 0., 1.)
C if (ABS( dfx3) .gt. acut ) go to 20
C
C--- Now test front 1/3 and 2/3 y projection combinations
C
DFY2 = SMLS(2,1,IOXFV(ISEG1),ISM) - SMLS(2,1,IOXFV(ISEG3),ISM)
* Call Hfill(403, DFY2, 0., 1.)
IF (abs( DFY2) .GT. ACUT ) GO TO 30
DFY3 = SMLS(2,1,IOXFV(ISEG2),ISM) - SMLS(2,1,IOXFV(ISEG3),ISM)
* Call Hfill(403, DFY3, 0., 1.)
IF (abs( DFY3) .GT. ACUT ) GO TO 30
C
C--- Now test the rear 1/3 combinations
C
DRX2 = SMLS(1,2,IOXFV(ISEG1),ISM) - SMLS(1,2,IOXFV(ISEG3),ISM)
* Call Hfill(403, DRX2, 0., 1.)
IF (abs( DRX2) .GT. ACUT ) GO TO 30
DRY2 = SMLS(2,2,IOXFV(ISEG1),ISM) - SMLS(2,2,IOXFV(ISEG3),ISM)
* Call Hfill(403, DRY2, 0., 1.)
IF (abs( DRY2) .GT. ACUT ) GO TO 30
C
C--- Now test the rear 2/3 combination
C
DRX3 = SMLS(1,2,IOXFV(ISEG2),ISM) - SMLS(1,2,IOXFV(ISEG3),ISM)
* Call Hfill(403, DRX3, 0., 1.)
IF (abs( DRX3) .GT. ACUT ) GO TO 30
DRY3 = SMLS(2,2,IOXFV(ISEG2),ISM) - SMLS(2,2,IOXFV(ISEG3),ISM)
* Call Hfill(403, DRY3, 0., 1.)
IF (abs( DRY3) .GT. ACUT ) GO TO 30
C
C--- ensure that candiate segments have track/plane in common
C
ID(1,1) = SMLS(4,1,IOXFV(ISEG1),ISM)
ID(1,2) = SMLS(4,2,IOXFV(ISEG1),ISM)
ID(2,1) = SMLS(4,1,IOXFV(ISEG2),ISM)
ID(2,2) = SMLS(4,2,IOXFV(ISEG2),ISM)
ID(3,1) = SMLS(4,1,IOXFV(ISEG3),ISM)
ID(3,2) = SMLS(4,2,IOXFV(ISEG3),ISM)
C
C--- ensure that track/plane assignments are self consistent
C
C--- The diagram desribes the functioning of the
C--- following block of code. The brackets represent a candidate
C--- line segment made from two candidate clusters each ( 1 | 2 ).
C--- That is id(1,1) etc.
C--- For the segment to be valid each of the three links must be in pla
C--- The code finds the two outermost links and remembers ipn1,ipn2
C--- imn1,imn2 which constrain the final link.
C---
C---
C--- ( | )
C--- / \
C--- / \
C--- / \
C--- / \
C--- ( |imn2)---(imn1| )
C--- ipn2 ipn1
C
DO 100 IP = 2,3
DO 101 IM = 1,2
IF( ID(1,1) .NE. ID(IP,IM) ) GO TO 101
C---
IF ( IP .EQ. 2 ) THEN
IPN1 = 3
IPN2 = 2
ELSE
IPN1 = 2
IPN2 = 3
ENDIF
C---
IF ( IM .EQ. 1 ) THEN
IMN2 = 2
ELSE
IMN2 = 1
ENDIF
GO TO 102
101 CONTINUE
100 CONTINUE
C
C--- the first track/plane id(1,1) not equal to any of the others rejec
C
GO TO 30
C
C--- the first track/plane link found
C
102 CONTINUE
C
C--- now find second link for a(1,2)
C
IF( ID(1,2) .EQ. ID(IPN1,1) )THEN
IMN1 = 2
ELSEIF( ID(1,2) .EQ. ID(IPN1,2) )THEN
IMN1 = 1
ELSE
GO TO 30
ENDIF
C
C--- now test last remaining link
C
IF ( ID(IPN1,IMN1) .NE. ID(IPN2,IMN2) ) GO TO 30
C
C--- Now test absolute lengths
C
IF ( DFX1**2 + DFY1**2 .GT. ACUTSQ .OR.
1 DFX2**2 + DFY2**2 .GT. ACUTSQ .OR.
2 DFX3**2 + DFY3**2 .GT. ACUTSQ .OR.
3 DRX1**2 + DRY1**2 .GT. ACUTSQ .OR.
4 DRX2**2 + DRY2**2 .GT. ACUTSQ .OR.
5 DRX3**2 + DRY3**2 .GT. ACUTSQ )GO TO 30
C
C--- find the three yuv sets involved in this combination
C
ID1 = ID(1,1)
ID2 = ID(1,2)
ID3 = ID(IPN1,IMN1)
C
C--- do direct lsq fit to yuv to give alternate parseg and errseg
C
CALL FPFYUV(ID1,ID2,ID3,ISM,PCHI,CHISQ,NDF,PARSGN,ERRSGN)
C
C--- end of loops
C
30 CONTINUE
20 CONTINUE
10 CONTINUE
5 CONTINUE
C
C--- Remove connectivity between segments
C
CALL FPSGRF
END
*