*-- Author : Stephen J. Maxfield 20/11/92
SUBROUTINE FPATUT
**: FPATUT 30907 RP. Farm changes.
*------------------------------------------------------------------*
* OUTPUT RESULTS OF PATTERN RECOGNITION IN FORWARD DRIFT CHAMBERS *
* MAKE LEVEL ZERO BANKS *
* *
*------------------------------------------------------------------*
* New version********* *
* *
* *
* OUTPUT: FTUR,0 Reconstructed track parameters *
* ===== FPUR,0 Pointering bank to FRUX FPUX *
* FRUX,0 Pointers to hits (parallel to FRRE) *
* FPUX,0 Pointers to hits (parallel to FRPE) *
*------------------------------------------------------------------*
* FORMAT OF BANKS FROM FORWARD TRACK RECONSTRUCTION *
* *
* FTUR TABLE FMT = (6F,I,9F,I,F,3I) *
* ==== *
* *
* 1 KAPPA F 1/radius (signed) *
* 2 PHI F Phi track angle in xy plane. *
* 3 THETA F Theta polar angle. *
* 4 X F x ) coords of point on track, *
* 5 Y F y ) either first measured point (FTUR) *
* 6 Z F z ) or vertex (FTVR).(z is reference *
* value NOT parameter.) *
* 7 IPTYPE I Patyp = 2 type of parametrisation *
* *
* 8 SIGMA1 ) *
* 9 SIGMA2 ) *
* 10 SIGMA3 ) *
* 11 SIGMA4 ) *
* 12 SIGMA5 ) *
* ) Packed covariance matrix *
* 13 CORR1 ) *
* 14 CORR2 ) *
* 15 CORR3 ) *
* 16 CORR4 ) *
* *
* 17 NDF Num degrees of freedom *
* 18 CHSQ Chisq per degree of freedom *
* *
* 19 FTUR Pointer to next set on track (=0) *
* 20 NHIT ** Packed number of radial and planar hits *
* *
* 21 FPUR Pointer to pointering bank *
* *
* ** NHIT: Bits 24-31 Number of Radial Points *
* Bits 16-23 Number of Planar Points *
* *
* *
* *
********************************************************************
* FPUR Pointering bank *
* ==== *
* FORMAT B16 *
* 1 NHITFR Number of radial hits *
* 2 FRUX pointer to FRUX bank *
* 3 NHITFP Number of planar hits *
* 4 FPUX pointer to FPUX bank *
* *
* Note: as there are only ever one set of track parameters on a *
* track at level 0, this bank is effectively parallel to *
* FTUR. *
* *
********************************************************************
* FRUX bank PARALLEL to FRRE bank. Lists of radial digis *
* ==== on track using INTERNAL NEXT relation *
* FORMAT B16 *
* 1 PNHIT I Pointer to next hit on track *
* 2 DTFLAG I 0=positive drift ; 1=negative drift *
* FPUX bank PARALLEL to FRPE bank. Lists of radial digis *
* ==== on track using INTERNAL NEXT relation *
* FORMAT B16 *
* 1 PNHIT I Pointer to next hit on track *
* 2 DTFLAG I 0=positive drift ; 1=negative drift *
********************************************************************
* *
* INPUT is from two lists of tracks:- *
* a) Radial-based tracks: *
* a IG tracks *
* Hits:- IRN/SDN IRP/SDP *
* Segments:- ISGG LNK3 *
* Parameters:- RPCOS, RPSIN etc. *
* b) Planar-based and R-P link tracks: *
* NPP tracks *
* Hits:- IRR/SRR IPP/SPP *
* Segments:- LRR LPP *
* Parameters:- RSSS, PSSS, RISS, PISS *
********************************************************************
* BOS Commons...
*KEEP,BCS.
*KEEP,BOSMDL.
C ------BOSMDL
C ------
*KEEP,FRDIMS.
*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
*
*KEEP,FH1WORK.
* Planar geometry
*
* Radial geometry
*
* Radial data...
*
* Planar Data
*
* Pointers into DIGI bank for IOS labelled hits
*
* Track segment data
*
* Fit data
*
*
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
*KEEP,FDIFLG.
*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---
*KEEP,FPLSEG.
C---
C---
*KEND.
* Common for work bank indices (just in case)
* Commons for planar found tracks
* Common for radials associated with planar tracks
* Common for segment numbers...
* Radial reject , unused , radial verified by planar
* Bank formatting data...
* Local arrays...
*--------statement functions for table access -------------*
*KEEP,STFUNCT.
* index of element before row number IROW
* index of L'th element of row number IROW
* L'th integer element of the IROW'th row of bank with index IND
* L'th real element of the IROW'th row of bank with index IND
*KEND.
*------------------------BEGIN ROUTINE-------------------------------
* Format output banks...
CALL BKFMT('FTUR','2I,(6F,I,9F,I,F,3I)')
CALL BKFMT('FPUR','B16')
CALL BKFMT('FRUX','B16')
CALL BKFMT('FPUX','B16')
CALL BKFMT('FPSX','2I,(I)')
CALL BKFMT('FRSX','2I,(I)')
IQFPSG = NAMIND('FPSG')
IQFRSG = NAMIND('FRSG')
IQFPLC = NAMIND('FPLC')
IQFRLC = NAMIND('FRLC')
* Open BANKS
* Get access to segment banks...
* Work banks for pointer lists...
CALL WBANK(IW,IWFRUX,NWRD,*999)
CALL VZERO(IW(IWFRUX+1),NWRD)
CALL WBANK(IW,IWFPUX,NWRD,*999)
CALL VZERO(IW(IWFPUX+1),NWRD)
*
* Loop over patrec tracks.
*
* There are two lists of tracks to loop over containing
* Radial-based and Planar-based tracks respectively.
*
* Tracks in the radial-based list may have been rejected in
* Favour of planars or not verified by a planar segment or
* otherwise marked as bad (IGTTRK)
*
* precalculate number of good radial segments in each module
* ILIST 2 (planar-based tracks) are O.K. Otherwise track
* may have been rejected:-
CALL SHS(711,0,7.01)
*
* Pointer lists for FRRE and FRPE banks. First points on track.
*
CALL FILHTS(ITRK, ILIST,
*
* Get HELIX parameters for this track...
*
CALL FHEPAR(ITRK, ILIST, ZF, CU, PHI0, TH, X0, Y0)
*
* Build Supermodule Mask
* Planar segments from Rad-based tracks...
* Radial segments from Rad-based tracks...
* Planar segments from Pla-based tracks...
* Radial segments from Pla-based tracks...
*
* Fill the FTUR and pointering bank, FPUR
*
*
*
* Words 8 - 16 will contain packed covariance matrix...
* Zero for now...
*
*
*
* Pack number of planar and radial hits.
*
*
*
*
* Fill pointering bank:
*
*
*
* Now do the pointers to the segments. Where to look depends on
* the type of track.
*
* Planar segments from Rad-based tracks...
* Calculate row number in segment bank FPSG...
* Radial segments from Rad-based tracks...
* more complicated because IOS segment may have
* failed Chisq test...
* ...assumes that only good segments have been linked!
* Calculate row number in segment bank FRSG...
* ...offset by number of good segments in prior modules...
* ...and increment offset ready for next module...
* IOS segment number in this module...
* add to ISGMOD passing over bad segments...
* Planar segments from Pla-based tracks...
* Calculate row number in segment bank FPSG...
* Radial segments from Pla-based tracks...
* ...assumes that only good segments have been linked!
* Calculate row number in segment bank FRSG...
* ...offset by number of good segments in prior modules...
* ...and increment offset ready for next module...
* IOS segment number in this module...
* add to ISGMOD passing over bad segments...
*
* Now fill the cross-reference FPSX FRSX and update the
* the FRSG FPSG banks with pointers to next segments...
*
* ...pointer to first segment on track...
* ...and fill chain in FPSG bank...
* ...pointer to first segment on track... is zero
* ...pointer to first segment on track...
* ...and fill chain in FRSG bank...
* ...pointer to first segment on track... is zero
*
* Now fill appropriate rows of FRUX and FPUX banks
* Radial point list...
* Planar point list...
* End loop over tracks.
* Close banks...
* make empty banks
IFTUR = NBANK('FTUR',NBNN,2)
IFPSX = NBANK('FPSX',NBNN,2)
IFRSX = NBANK('FRSX',NBNN,2)
CALL WBANK(IW,IWFPUR,NWRD,*999)
CALL BKFRW(IW,'FPUR',NBNN,IW,IWFPUR,*999)
CALL WDROP(IW,IWFPUR)
* Pack work banks into named banks...
CALL BKFRW(IW,'FRUX',NBNN,IW,IWFRUX,*999)
CALL BKFRW(IW,'FPUX',NBNN,IW,IWFPUX,*999)
* Add Banks to list...
CALL BLIST(IW,'R+','FTUR')
CALL BLIST(IW,'R+','FPUR')
CALL BLIST(IW,'R+','FRUX')
CALL BLIST(IW,'R+','FPUX')
CALL BLIST(IW,'R+','FRLC')
CALL BLIST(IW,'R+','FPLC')
CALL BLIST(IW,'R+','FRHC')
CALL BLIST(IW,'R+','FPHC')
CALL BLIST(IW,'R+','FAUX')
CALL BLIST(IW,'R+','FPSX')
CALL BLIST(IW,'R+','FRSX')
* ...and drop work banks...
CALL WDROP(IW,IWFRUX)
CALL WDROP(IW,IWFPUX)
* Error ...
CALL WDROP(IW,IWFRUX)
CALL WDROP(IW,IWFPUX)
*