*-- Author : R. Henderson
SUBROUTINE FPDG4
**: FPDG4 40000 RH. New steering parameters; use true resolution.
*------------------------------------------------------------------
**: FPDG4 30907 RH. Bug fix in cluster finding.
C------------------------------------------------------------------
**: FPDG4 30907 SM. Tune slope cuts. Add diagnostic histograms.
C-------------------------------------------------------------------
C
C--- This routine finds clusters from 4 digitizings at a single
C--- angular orientation that are aligned to within a tolerance
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
C---
*KEND.
C---
*KEEP,FPLGEO.
C---
C---
*KEND.
C---
*KEEP,FPCLUS.
C---
*KEND.
C---
*KEEP,FPH1WRK.
C-- *KEEP,FPCSEG.
C---
C---
C-- *KEEP,FPDIGI.
C---
C-- *KEEP,FPDGI.
C---
C-- *KEEP,FPSTID.
C---
C-- *interface to real data
C---.
*KEND.
C---
C---
*KEEP,H1EVDT.
*
* IDATA type of information (HEAD bank word 6) :
*
* 0 - real data H1
* 1 - MC data H1SIM
* 2 - real data CERN tests
* 3 - MC data ARCET
*
* MONTE = .TRUE. if IDATA=1
* KEVENT = event processed counter for H1REC
*
*KEND.
C---
C---
C---
C---
C---
C-------------------------------------------------------------------
C DIGITS ANALYSIS
C
C The following arrays are used in the remainder of this routine
C
C DRSTO(drift,wire_in_orientation):
C This has both drift and reflection per orientation
C
C IDRSTO(drift,wire_in_orientation):
C This is track id for both drift and reflection per orientation
C
C NDRSTO(wire_in_orientation):
C Number of drifts + reflections on wire (Naughty)
C
C DRMASK(drift,wire_in_orientation):
C 1.0 If digit or reflection used
C 0.0 If digit or reflection unused
C
C idigst(wire_in_orientation,found_segment_candidate):
C index of digitising associated with a particular
C candidate segment for a particular wire
C
C NSGTAB(candidate_segment):
C Number of candidate segments with which current segment
C shares digitizings
C
C SEGTAB(candidate_segment,associated_ambiguous_segments):
C segment index ambiguous with current segment
C
C dres2 two track resolution: for digits closer together than
C dres2 the further away is placed
C at first + dres/2 , error dres2/2
C
C OUTPUT BANKS
C
C NTC(tracks per plane ( 9 sets of 4 wire orientations) )
C TC (xyz of a vector in the plane ,plane, track intersection)
C TOC(xyz of vector to the plane ,plane, track intersection)
C TCYUV (4 digitizings forming plane , plane, track)
C tcyuvw (weight 4 digitizings forming plane, plane, track)
C
C
C-------------------------------------------------------------------
C
C--- This routine searches for clusters in 4 points
C--- for looking at drifts
C
C
C--- zero number of track clusters found per orientation (plane of 4 wi
C
C
C--- Loop over 36 planar planes
C
C
C--- tolerance for finding digitizings
C
C
C--- define maximum slope to be found for segment
C
*SJM TEMPORARY MOD FOR COSMIC DATA
* IF(IDATA.EQ.0) THEN
* SLMAX = 40.0
* ELSE
* SLMAX = 4.0
* ENDIF
*SJM
C---
C---
C---
C---
C---
C
C--- Zero drsto per 4 wire set
C
CALL VZERO(DRSTO,4*MSEGLM)
C
C--- Loop over four wires of orientation
C
C
C--- Loop over digits on each wire
C
C--- drift
C--- Loop over reflections
C--- Two track resolution code
CALL ERRLOG(201,'W:FPDG4 : NDRSTO > MSEGLM ')
* DRSTO(NDRSTO(IWR),IWR) = (DRIFP*(-1.)**(I-1) + DW(IND,IPO))*10.0
* RESSTO(NDRSTO(IWR),IWR) = RESOL
C---
C
C--- Section to find 2d line segments
C
C--- loop over first and last wire in orientation
C
C
C--- ifirst = 1 on first pass through
C
C
C--- sort drifts per plane
C
1 CALL SORTZV(DRSTO(1,1) , IN1 , NDRSTO(1) , 1 , 0 , 0)
1 CALL SORTZV(DRSTO(1,4) , IN4 , NDRSTO(4) , 1 , 0 , 0)
C
C--- determine if dealing with a split cell
C
C
C--- check if same split cells
C
C
C--- On first pass filter out large slopes
C
C
*SJM TEMPORARY MOD FOR COSMIC DATA
C Following not applied for cosmic data
* IF(IDATA.NE.0) THEN
C
C--- filter out slopes not from vertex
C
C CALL HFILL(400+IFIRST, LINEY(1), GRAD, 1.)
* ENDIF
*SJM
C
C--- use tolerance to find digitizings to form segments
C
C
C--- store the digitizing per segment found
C
CALL ERRLOG(202,'W:FPDG4 : NSEG > MSEGLM ')
C CALL HFILL(14450,GRAD,LINEY(1),1.0)
C
C--- Now sort out which initial segments to keep
C
CALL VZERO(NSGTAB,MSEGLM)
C
C--- loop over all segments
C
C
C--- loop over remaining segments
C
C
C--- comparison loop over each wire in turn
C
C
C--- has the same wire the same digit
C
C
C--- remove nodes greater than or equal to 3
C
CALL VFLOAT(NSGTAB,ASGTAB,NSEG)
C
C---
C
C
C--- Find all nodes with this multipicity
C
C
C--- Skip next section if only one at this multipicity
C
C
C--- Fit all candidates and choose the worst
C
C
C--- Check they have not already been fitted
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ,PBCHI)
C
C--- Fit all CONNECTED to candidates
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ,PBCHI)
C
C--- Probability of node LESS those connected
C
C---
C
C--- Now choose the cluster with worse chisqaure to remove
C
C
C--- greater than 2.0 so remove by setting nsgtab = -1.0
C
C
C--- Now remove any reference to this node in the remaining nodes
C
C
C--- More nodes to remove
C
C
C--- Finished
C
C
C--- a point of restart having remove a 2 node
C
C
C--- Now try to find loops and angles and eliminate
C
C
C--- Find first candidate with 2 links
C
C
C--- Now trace its path
C
C
C--- Entry point for step along chain
C
C
C--- Test if path at end
C
C
C--- Skip link if pointing back
C
C
C--- Store next element of chain
C
C
C--- Test if loop complete
C
C
C--- Points to next element in chain
C
C
C--- End of branch one
C
C
C--- This cannot be a loop so kill off node
C
C--&&MOD&&
C
C--- Now remove any reference to this node in the remaining nodes
C
C--&&MOD&&
C---&&MODS&&
C
C--- Now start again
C
C---&&END&&
C
C--- Loop complete
C
C
C--- Perform fits and eliminate adjacent nodes in loop
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ,PBCHI)
C
C--- Keep highest probability node and delete those two either side
C
C
C--- If loop is 4 then keep the most probable pair
C
C
C--- Remove links to maximum
C
C
C--- Now remove any reference to this node in the remaining nodes
C
C---
C
C--- now remove any pairs by fitting
C
C
C--- Found a pair so find partner
C
C
C--- fit the first possiblity
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ1,PBCHI1)
C
C--- Fit the second possiblity
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ2,PBCHI2)
C
C--- Now remove the smaller probability segment
C
C
C--- Now remove any reference to this node in the remaining nodes
C
C
C
C--- Now ANALYSE remaining segments
C
C
C--- fit remaining segments
C
CALL FPCFIT(IP,Y,W,SLOPE,ZERO,COVSLZ,CHISQ,PBCHI)
C
C--- Create routine output banks of track plane normals
C--- and points to planes at ZPLAN(lane) intersection
C
C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
C--- find the absolute coordinate normal current wire orientation
C
C
C--- find which orientation plane (1-9) is current
C
C
C--- find fitted 'y' position at begining and end of 4 wire set
C--- fdrsta and fdrend respectively
C
C
C--- Transform from orientation drift coordinates to global coordinates
C--- assuming that drift x coordinate is zero
C
C
C--- Fill track cluster banks and banks counter
C
C
C--- Increment cluster counter per plane
C
CALL ERRLOG(203,'W:FPDG4 : NTC(IPLANE) > MAXCLU')
C---
C
C--- store toC
C
C
C--- store the digitisings associated with plane/track for final
C fit
C
C---
C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
C--- Set drmask to 1.0 for used digits
C
C
C--- Now plot and count them
C
C
C--- If first pass now loop back with increased tolerance and maxang
C
*SJM TEMPORARY MOD FOR COSMIC DATA
* IF(IDATA.EQ.0) THEN
* ELSE
* SLMAX = 6.0
* ENDIF
*SJM
C
C--- END FPDG4
C
C
C--- Now deal with segments with only 3 digitizings
C
CALL FPDG31(IP)
CALL FPDG32(IP)
CALL FPDG33(IP)
C if(lgks)CALL grqst(2,1,istat,len_plwire,plwire)
C
C--- examine idyuv cluster ids and see how many correct
C
*