*-- Author : R. Henderson
SUBROUTINE FPSEG
C-----------------------------------------------------------------------
C
C--- Routine reconstructs planar line segments from digitisings
C
C-----------------------------------------------------------------------
C
C--- INPUT/drifts/ dstore(plane,wire,drift) = drifts (not reflection
C--- INPUT/drifts/ dstore(plane,wire,50) = number of drifts
C--- (please see routine drpak for interface to current patrec code)
C
C--- OUTPUT/plseg/ pw(digit,segment,sm) = w of digitisings in segmen
C--- OUTPUT/plseg/ pwc(digit,segment,sm) = fitted w of digitisings in
C--- OUTPUT/plseg/ prchi(segment,sm) = probability from chisquare of
C--- OUTPUT/plseg/ nfseg(sm) = number of found segments
C--- OUTPUT/plseg/ xydxy = (x,y (at first z value) ,dx/dz,dy/
C--- OUTPUT/plseg/ exydxy = covariance matrix of xydxy(sm)
C
C--- also in common /PLSEG/ and used by code to analyse segments and
C--- return an disconnected set (see MASKSG)
C
C ASEGIN(SEG,SUPERMODULE) = chisquare of segment
C
C ISEGIN(1,SEG,SUPERMODULE) = 1st cluster-plane for segment
C ISEGIN(2,SEG,SUPERMODULE) = 2nd cluster-plane for segment
C ISEGIN(3,SEG,SUPERMODULE) = 3rd cluster-plane for segment
C ISEGIN(4,SEG,SUPERMODULE) = number of degree of freedom for segmen
C
C NFSEG(SUPERMODULE) = number of found segments per supermodu
C
C--- output
C
C MASKSG(SEG,SUPERMODULE) = 0 if SEGMENT allowed in disconnected
C = -1 if SEGMENT disallowed in disconnec
C
C
C-----------------------------------------------------------------------
C
C--- In order to make this code compatible with compilers that
C--- unable to cope with more than 6 character names the following
C--- name translations have been necessary. Information is lost.
C
C--- stagger => stager
C--- idstore => idtore
C--- drift_store => drsto
C--- digi_store => idigst
C--- seg_table => segtab
C--- n_seg_table => nsgtab
C--- a_seg_table => asgtab
C--- drift_mask => drmask
C--- plane_wire => plwire
C--- tolerance => toler
C--- slope_max => slmax
C--- dstore_mask => dsmask
C--- iorient => iorien
C--- gradient => grad
C--- error_sc => covslz
C--- val_maxseg => vmxseg
C--- last_seg => lstseg
C--- next_seg => nxtseg
C--- fit_drift_end => fdrend
C--- fit_drift_start=> fdrsta
C--- kseg_save => kssave
C--- new_seg => newseg
C--- loop_save => lpsave
C--- matrix_a => mtrixa
C--- err_xysxy => exysxy
C--- num_seg_sm => nsegsm
C--- val_seg => valseg
C--- new_parseg => parsgn
C--- new_errseg => errsgn
C--- intline => inline
C--- iplane1 => iplan1
C--- iplane2 => iplan2
C--- iplane3 => iplan3
C--- itrack1 => itrck1
C--- itrack2 => itrck2
C--- itrack3 => itrck3
C--- cponint => cpint
C--- limstor => limsto
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,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---
DATA IFIRST/1/
C---
C---
C---
C---
C---
C---
C
C--- call routine to extract planar digitizings from standard program
C
C CALL DRPAK
C
C--- calculate vectors along the 9 orientations of planar detector
C
CALL FPPDEF
C
C--- Routine FPDG4 (sdig31 sdig32 sdig33 fpcfit) are called to
C--- find candidate clusters in each 4 wire orientation.
C--- (Clusters are a series of 3/4 digitizings in a given plnars
C--- orientation which are aligned within tolerance and represent
C--- to within a plane the tracjectory of a track. These clucters are
C--- a chosen disconnected set. )
C
CALL FPDG4
C
C--- Calculate the normals of the planes formed by the tracks
C--- and four wires in the same orientation using FPCPLN
C--- (cluster --->plane calculation)
C
CALL FPCPLN
C
C
C
C--- Now find all the lines of intersection between pairs of planes
C--- from clusters in different orientation within a supermodule
C--- and find the line segments from 3 coincidences of these intections
C--- within a tolerance acut. The line segments returned a disconnected
C--- set.
C
CALL FPLINT
C
C--- FPLINT routine calls FPFSEG (finds correlations of 3
C--- intersections to form segments)
C
C--- FPFSEG calls FPFYUV to fit line segments and return fitted
C--- values and probabilites. (This rotine fills PLSEG)
C
C--- FPSEG then calls FPSGRF to determine a disconnected set of
C--- line segments. (see MASKSG description at top of this routine)
C
C
C---
C---
C---
C---
*
*
END
*