*-- 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.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEEP,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*KEEP,FRDIMS.
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)
*KEEP,H1EVDT.
COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF
INTEGER KEVENT,IDATA,LCONF
LOGICAL MONTE
*
* 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.
COMMON/FGMIOS/
* Planar geometry
+ ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,
*
* Radial geometry
+ ZP(36),PHW(36),WS(36)
*
COMMON/H1WORK/
* Radial data...
+ WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),
+ NDP(36), NW(MAXHTS,36), DWS(MAXHTS,36),
*
* Planar Data
+ NDPW(NUMWPL),DW(MAXHTS,NUMWPL),
+ DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),
+ WWP(MAXHTS,NUMWPL),
+ IPHOLE(MAXHTS,NUMWPL),
*
* Pointers into DIGI bank for IOS labelled hits
+ IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,
+ IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),
*
* Track segment data
+ NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),
*
* Fit data
+ PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),
+ DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),
+ DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),
+ RPCOSG(MAXTRK),RPSING(MAXTRK),
+ PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),
+ IRADG(36,MAXTRK),PHIG(36,MAXTRK),
+ IG,SDRADG(36,MAXTRK),
+ R1,Z1,RFIT(MAXTRK,3),
+ CHG(MAXTRK),
+ PPA(MAXTRK,3), ZZA(MAXTRK,3),
+ GPA(MAXTRK,3),GZA(MAXTRK,3)
*
*
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),
+ IRP(36,MAXTRK),SDP(36,MAXTRK),
+ IG2,IGTTRK(MAXTRK),
+ CHISQ(MAXTRK),NUMDF(MAXTRK),
+ FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),
+ FITTH(MAXTRK),FITPH(MAXTRK),
+ FITCU(MAXTRK),FTCOV(15,MAXTRK)
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*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---
*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.
* Common for work bank indices (just in case)
COMMON/FWBIND/IWFRUX,IWFPUX,IWFPUR
* Commons for planar found tracks
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FTPPBS/SPP(36,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
COMMON/FPLNK/KTIP(3,50),LPP(3,100)
* Common for radials associated with planar tracks
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
* Common for segment numbers...
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)
COMMON /FPSEG3/ ISGR(3,MAXSEG)
COMMON /FLINK3/ LNK3(MAXTRK,3)
* Radial reject , unused , radial verified by planar
COMMON/FTRFLG/ IBRR(MAXTRK),IBPP(100),IVRR(MAXTRK)
* Bank formatting data...
PARAMETER(NCFTUR=21)
PARAMETER(NCFPUR=4)
PARAMETER(NCFRUX=2)
PARAMETER(NCFPUX=2)
PARAMETER(NCFPSX=1)
PARAMETER(NCFRSX=1)
PARAMETER(NBNN=0)
PARAMETER(NPATYP=2)
* Local arrays...
DIMENSION IRPNT(36), IPPNT(36)
DIMENSION IRSGN(36), IPSGN(36)
DIMENSION UCOV(15), VCOVCP(9)
DIMENSION ISGPL(3) , ISGRA(3), NSR(3)
DIMENSION BAR(NCFTUR), IAR(NCFTUR)
EQUIVALENCE(BAR(1), IAR(1))
LOGICAL FIRST
DATA FIRST/.TRUE./
*--------statement functions for table access -------------*
*KEEP,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEND.
*------------------------BEGIN ROUTINE-------------------------------
IF(FIRST) THEN
FIRST = .FALSE.
* 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')
ENDIF
* Open BANKS
NFRRE = IW(IW(IQFRLC)+2)
NFRPE = IW(IW(IQFPLC)+2)
IWFRUX = 0
IWFPUX = 0
* Get access to segment banks...
IWFPSG = IW(IQFPSG)
IWFRSG = IW(IQFRSG)
* Work banks for pointer lists...
NWRD = 2+NFRRE*2
CALL WBANK(IW,IWFRUX,NWRD,*999)
CALL VZERO(IW(IWFRUX+1),NWRD)
IW(IWFRUX+1) = 2
IW(IWFRUX+2) = NFRRE
NWRD = 2+NFRPE*2
CALL WBANK(IW,IWFPUX,NWRD,*999)
CALL VZERO(IW(IWFPUX+1),NWRD)
IW(IWFPUX+1) = 2
IW(IWFPUX+2) = NFRPE
*
* 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)
*
IROWF = 0
* precalculate number of good radial segments in each module
Do jmod = 1, 3
NSR(jmod) = 0
Do k = 1, NTRAKS(jmod)
If( chsq(k, jmod) .le. 1000.) NSR(jmod) = NSR(jmod) + 1
Enddo
Enddo
DO 900 ILIST = 1, 2
IF(ILIST .EQ. 1) THEN
ITMAX = IG
ELSE
ITMAX = NPP
ENDIF
DO 100 ITRK = 1, ITMAX
* ILIST 2 (planar-based tracks) are O.K. Otherwise track
* may have been rejected:-
IF(ILIST.EQ.2 .OR.
+ (IGTTRK(ITRK).EQ.0 .AND. IVRR(ITRK).EQ.1) ) THEN
IROWF = IROWF + 1
CALL SHS(711,0,7.01)
*
* Pointer lists for FRRE and FRPE banks. First points on track.
*
CALL FILHTS(ITRK, ILIST,
+ NMRAD, IRPNT, IRSGN, IFRP,
+ NMPLA, IPPNT, IPSGN, IFPP,
+ ZF)
*
* Get HELIX parameters for this track...
*
CALL FHEPAR(ITRK, ILIST, ZF, CU, PHI0, TH, X0, Y0)
*
* Build Supermodule Mask
MASK = 0
IF(ILIST.EQ.1) THEN
* Planar segments from Rad-based tracks...
DO 75 I=1,3
IF(ISGG(I,ITRK) .NE. 0) THEN
MASK = MASK + 2**(I+2)
ENDIF
75 CONTINUE
* Radial segments from Rad-based tracks...
DO 76 I=1,3
IF(LNK3(ITRK,I) .NE. 0) THEN
MASK = MASK + 2**(I-1)
ENDIF
76 CONTINUE
ELSE
* Planar segments from Pla-based tracks...
DO 77 I=1,3
IF(LPP(I,ITRK) .NE. 0) THEN
MASK = MASK + 2**(I+2)
ENDIF
77 CONTINUE
* Radial segments from Pla-based tracks...
DO 78 I=1,3
IF(LRR(I,ITRK) .NE. 0) THEN
MASK = MASK + 2**(I-1)
ENDIF
78 CONTINUE
ENDIF
*
* Fill the FTUR and pointering bank, FPUR
*
BAR(1) = CU
BAR(2) = PHI0
BAR(3) = TH
BAR(4) = X0
BAR(5) = Y0
BAR(6) = ZF
*
IAR(7) = NPATYP
*
* Words 8 - 16 will contain packed covariance matrix...
* Zero for now...
DO 650 KCOV = 1, 9
BAR(7+KCOV) = 0.0
650 CONTINUE
*
IAR(17) = 0
BAR(18) = 0
*
IAR(19) = 0
*
* Pack number of planar and radial hits.
*
NHTFTD = NMRAD*16777216 + NMPLA*65536 + MASK
*
IAR(20) = NHTFTD
IAR(21) = IROWF
*
IFTUR = IADROW('FTUR',NBNN,NCFTUR,BAR)
*
* Fill pointering bank:
*
IAR(1) = NMRAD
IAR(2) = IFRP
IAR(3) = NMPLA
IAR(4) = IFPP
*
IFPUR = IADROW('FPUR',NBNN,NCFPUR,BAR)
*
* Now do the pointers to the segments. Where to look depends on
* the type of track.
*
IF(ILIST.EQ.1) THEN
* Planar segments from Rad-based tracks...
NPSG=0
DO 680 I=1,3
IF(ISGG(I,ITRK) .NE. 0) THEN
NPSG = NPSG + 1
* Calculate row number in segment bank FPSG...
ISGMOD = ISGG(I, ITRK)
IF(I.GT.1) ISGMOD = ISGMOD + NFSEG(1)
IF(I.GT.2) ISGMOD = ISGMOD + NFSEG(2)
ISGPL(NPSG) = ISGMOD
ENDIF
680 CONTINUE
* Radial segments from Rad-based tracks...
* more complicated because IOS segment may have
* failed Chisq test...
NRSG=0
ISGOFF = 0
DO 780 I=1,3
IF(LNK3(ITRK,I) .NE. 0) THEN
NRSG = NRSG + 1
* ...assumes that only good segments have been linked!
* Calculate row number in segment bank FRSG...
* ...offset by number of good segments in prior modules...
ISGMOD = ISGOFF
* ...and increment offset ready for next module...
ISGOFF = ISGOFF + NSR(I)
* IOS segment number in this module...
KLN = LNK3(ITRK,I)
* add to ISGMOD passing over bad segments...
do kk = 1, KLN
If( chsq(kk, I) .le. 1000.)ISGMOD = ISGMOD + 1
enddo
ISGRA(NRSG) = ISGMOD
ENDIF
780 CONTINUE
ELSE
* Planar segments from Pla-based tracks...
NPSG=0
DO 685 I=1,3
IF(LPP(I,ITRK) .NE. 0) THEN
NPSG = NPSG + 1
* Calculate row number in segment bank FPSG...
ISGMOD = LPP(I, ITRK)
IF(I.GT.1) ISGMOD = ISGMOD + NFSEG(1)
IF(I.GT.2) ISGMOD = ISGMOD + NFSEG(2)
ISGPL(NPSG) = ISGMOD
ENDIF
685 CONTINUE
* Radial segments from Pla-based tracks...
NRSG=0
ISGOFF = 0
DO 785 I=1,3
IF(LRR(I,ITRK) .NE. 0) THEN
NRSG = NRSG + 1
* ...assumes that only good segments have been linked!
* Calculate row number in segment bank FRSG...
* ...offset by number of good segments in prior modules...
ISGMOD = ISGOFF
* ...and increment offset ready for next module...
ISGOFF = ISGOFF + NSR(I)
* IOS segment number in this module...
KLN = LRR(I,ITRK)
* add to ISGMOD passing over bad segments...
do kk = 1, KLN
If( chsq(kk, I) .le. 1000.)ISGMOD = ISGMOD + 1
enddo
ISGRA(NRSG) = ISGMOD
ENDIF
785 CONTINUE
ENDIF
*
* Now fill the cross-reference FPSX FRSX and update the
* the FRSG FPSG banks with pointers to next segments...
*
IF(NPSG .NE. 0) THEN
* ...pointer to first segment on track...
IAR(1) = ISGPL(1)
IFPSX = IADROW('FPSX',NBNN,NCFPSX,BAR)
* ...and fill chain in FPSG bank...
DO 690 KSG = 1, NPSG - 1
IW(INDCR(IWFPSG,10,ISGPL(KSG))) = ISGPL(KSG+1)
690 CONTINUE
IW(INDCR(IWFPSG,10,ISGPL(NPSG))) = ISGPL(1)
ELSE
* ...pointer to first segment on track... is zero
IAR(1) = 0
IFPSX = IADROW('FPSX',NBNN,NCFPSX,BAR)
ENDIF
IF(NRSG .NE. 0) THEN
* ...pointer to first segment on track...
IAR(1) = ISGRA(1)
IFRSX = IADROW('FRSX',NBNN,NCFRSX,BAR)
* ...and fill chain in FRSG bank...
DO 790 KSG = 1, NRSG - 1
IW(INDCR(IWFRSG,10,ISGRA(KSG))) = ISGRA(KSG+1)
790 CONTINUE
IW(INDCR(IWFRSG,10,ISGRA(NRSG))) = ISGRA(1)
ELSE
* ...pointer to first segment on track... is zero
IAR(1) = 0
IFRSX = IADROW('FRSX',NBNN,NCFRSX,BAR)
ENDIF
*
* Now fill appropriate rows of FRUX and FPUX banks
* Radial point list...
IF(NMRAD.GT.0) THEN
DO 700 KRP=1,NMRAD-1
IW(INDCR(IWFRUX,1,IRPNT(KRP))) = IRPNT(KRP+1)
IW(INDCR(IWFRUX,2,IRPNT(KRP))) = IRSGN(KRP)
700 CONTINUE
IW(INDCR(IWFRUX,1,IRPNT(NMRAD))) = IRPNT(1)
IW(INDCR(IWFRUX,2,IRPNT(NMRAD))) = IRSGN(NMRAD)
ENDIF
* Planar point list...
IF(NMPLA.GT.0) THEN
DO 800 KPP=1,NMPLA-1
IW(INDCR(IWFPUX,1,IPPNT(KPP))) = IPPNT(KPP+1)
IW(INDCR(IWFPUX,2,IPPNT(KPP))) = IPSGN(KPP)
800 CONTINUE
IW(INDCR(IWFPUX,1,IPPNT(NMPLA))) = IPPNT(1)
IW(INDCR(IWFPUX,2,IPPNT(NMPLA))) = IPSGN(NMPLA)
ENDIF
ENDIF
100 CONTINUE
900 CONTINUE
* End loop over tracks.
* Close banks...
IF(IROWF .GT. 0) THEN
IFTUR = IADFIN('FTUR',NBNN)
IFPUR = IADFIN('FPUR',NBNN)
IFPSX = IADFIN('FPSX',NBNN)
IFRSX = IADFIN('FRSX',NBNN)
ELSE
* make empty banks
IFTUR = NBANK('FTUR',NBNN,2)
IW(IFTUR+1) = NCFTUR
IW(IFTUR+2) = 0
IFPSX = NBANK('FPSX',NBNN,2)
IW(IFPSX+1) = NCFPSX
IW(IFPSX+2) = 0
IFRSX = NBANK('FRSX',NBNN,2)
IW(IFRSX+1) = NCFRSX
IW(IFRSX+2) = 0
NWRD = 2
CALL WBANK(IW,IWFPUR,NWRD,*999)
IW(IWFPUR+1) = NCFPUR
IW(IWFPUR+2) = 0
CALL BKFRW(IW,'FPUR',NBNN,IW,IWFPUR,*999)
CALL WDROP(IW,IWFPUR)
ENDIF
* 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)
RETURN
* Error ...
999 CONTINUE
WRITE(6,*) ' FPTOUT>> Error in work bank creation.'
CALL WDROP(IW,IWFRUX)
CALL WDROP(IW,IWFPUX)
RETURN
END
*