*-- Author : Stephen Burke
SUBROUTINE FFOUT(JTR,NPS,NRS)
*-----------------------------------------Updates 22/11/93-------
**: FFOUT.......SB. New parameters in call.
**: FFOUT.......SB. New monitoring histograms.
**: FFOUT.......SB. Fix FTPR bug.
*-----------------------------------------Updates 27/07/93-------
**: FFOUT 30907 SB. Changes to monitoring histograms.
**: FFOUT 30907 RP. Farm changes.
*-----------------------------------------Updates 03/03/93-------
**: FFOUT 30907 SB. Module mask in LS 6 bits of word 20 of FTKR.
**: FFOUT 30907 SB. New monitoring histograms.
*-----------------------------------------Updates 30/11/92-------
**: FFOUT 30907 SB. Call new track rejection routine FFKILL.
**: FFOUT 30907 SB. New monitoring histograms.
*-----------------------------------------Updates 06/08/92-------
**: FFOUT 30907 SB. New monitoring histograms.
*-----------------------------------------Updates 03/06/92-------
**: FFOUT 30907 SB. Empty banks made here instead of in FFFIT.
**: FFOUT 30907 SB. Protect against large chi-squared.
**: FFOUT 30907 SB. Vertex fit stuff removed.
*-----------------------------------------Updates 02/06/92-------
**: FFOUT 30907 SB. Protect against divide by 0.
*-----------------------------------------Updates 28/04/92-------
**: FFOUT 30907 SB. FTKX now added to E-list in FTREC for debug.
*-----------------------------------------Updates 13/02/92-------
**: FFOUT 30205.SB. Bug fix (NDF now correct if LRISV is .TRUE.)
**: FFOUT 30205.SB. ERRLOG error numbers changed.
*-----------------------------------------Updates 07/02/92-------
**: FFOUT 30205.SB. Remove unused FKMEAS sequence.
*-----------------------------------------Updates 24/01/92-------
**: FFOUT 30205.SB. Count failures.
**: FFOUT 30205.SB. Better handling of errors with missing banks.
**: FFOUT 30205.SB. ERRLOG message format changed.
**: FFOUT 30205.SB. Add some new histograms, with new numbering.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Create output banks for the Kalman filtered tracks *
* *
**********************************************************************
LOGICAL BKOPEN,BKERR,FFKILL,LGOOD
*KEEP,FKNPL.
*
* Per-track values can go in H1WORK; note that LTRUE and LFIRST must
* be set at least per event.
*
* This is about 36k words long; the remaining common blocks are
* about 3.6k in total. Some of this could be in /H1WORK/, but the
* blocks would have to be reorganised.
*
* /FKPROJ/
* /FKFILT/
* /FKSMTH/
* /FKINT/
* /FKRSID/
* /FKTRUE/
* /FKDBG/
*KEEP,FFSTEE.
*KEEP,FFSCAL.
* Counters
*KEEP,FFWBI.
* Work bank indices (note that INDKTR is *NOT* a work bank index!)
*KEEP,FFGEO.
*KEEP,FKFLAG.
*KEEP,FKCONS.
*KEEP,FKMEAS.
*KEEP,FKSMTH.
*KEEP,FKRSID.
*KEEP,FTHIST.
* indices of filter farm histos
*KEEP,FKPIDP.
*KEND.
*KEEP,BCS.
*KEEP,BOSMDL.
C ------BOSMDL
C ------
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
* Statement function for obtaining IOS wire number (1-36)
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
* IPSMD in range 0:8 Planar module number.
*
* IOS wire number (runs from 0 to 36)
* SB plane numbers (1-72) from cell number
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
*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.
**********************************************************************
* If work bank creation failed we junk all the tracks for this event
* Zero work bank indices
* Work banks for pointer lists ...
CALL WBANK(IW,INDKX(1),2*NFRPE+2,*2000)
CALL VZERO(IW(INDKX(1)+1),2*NFRPE+2)
CALL WBANK(IW,INDKX(2),2*NFRRE+2,*2000)
CALL VZERO(IW(INDKX(2)+1),2*NFRRE+2)
* Close banks ...
* Banks are made even if there are no tracks
INDKTR = NBANK('FTKR',0,2)
CALL WBANK(IW,INDKTX,2,*2000)
CALL BKFRW(IW,'FTKX',0,IW,INDKTX,*2000)
CALL WBANK(IW,INDTPR,2,*2000)
CALL BKFRW(IW,'FTPR',0,IW,INDTPR,*2000)
* Pack work banks into named banks...
CALL BKFRW(IW,'FTPX',0,IW,INDKX(1),*2000)
CALL BKFRW(IW,'FTRX',0,IW,INDKX(2),*2000)
* Add banks to the E list ...
CALL BLIST(IW,'E+','FTKR')
CALL BLIST(IW,'E+','FTPR')
CALL BLIST(IW,'E+','FTPX')
CALL BLIST(IW,'E+','FTRX')
* Fill monitoring histograms
CALL SHS(1,0,FLOAT(NTGOOD))
IF (NFRPE.GT.0) CALL SHS(15,0,FLOAT(NPHIT)/FLOAT(NFRPE))
IF (NFRRE.GT.0) CALL SHS(16,0,FLOAT(NRHIT)/FLOAT(NFRRE))
CALL SHD(73,0,IPWCL(ICELL)+0.5,IPIOSW(ICELL)-0.5)
CALL SHD(74,0,IRWPL(ICELL)+0.5,IRIOSW(ICELL)-0.5)
CALL SHD(74,0,IRWMI(ICELL)+0.5,IRIOSW(ICELL)-0.5)
*
* Loop over planes to find chisq and first digi
*
CALL VZERO(IFP,2)
CALL VZERO(NP,2)
CALL VZERO(NHPS,6)
CALL VZERO(NHPO,9)
CALL SBIT1(IMAP,ISMOD+3*(2-IRP(JPL)))
* Get secondary/tertiary segment flag from NHPO
CALL SBIT1(IMAPST,JSM+9)
CALL SBIT1(IMAPST,JSM+6)
CALL ERRLOG(331,'W:FFOUT: Track with no measurements')
* PROB isn't very accurate for small probabilities
* Kill off bad tracks
IF (FFKILL(J1,J2)) RETURN
* Convert start vector to output format ...
CALL FKITOE(ZPL(J1),SSMT(1,J1),CSMT(1,1,J1),VEC)
*
* Fill monitoring histograms
*
CALL SHS(2,0,FLOAT(NP(1)))
CALL SHS(3,0,FLOAT(NP(2)))
IF (IDB.GT.1) CALL SHD(64,0,VEC(3),FLOAT(NP(1)+NP(2)))
CALL FFHTHS(J1,J2,NPS,IMAP)
CALL SHS(7,0,VEC(2))
CALL SHS(8,0,VEC(3))
CALL SHS(9,0,SNGL(SSMT(3,J2)))
CALL SHS(10,0,-LOG10(ABS(SNGL(SSMT(3,J2)))))
CALL SHS(10,0,3.)
CALL SHS(11,0,SQRT(VEC(4)**2+VEC(5)**2))
CALL SHS(12,0,ATAN2(VEC(5),VEC(4)))
IF (NHPS(1,1).GT.0) CALL SHS(17,0,FLOAT(NHPS(1,1)))
IF (NHPS(2,1).GT.0) CALL SHS(17,0,FLOAT(NHPS(2,1))+12)
IF (NHPS(3,1).GT.0) CALL SHS(17,0,FLOAT(NHPS(3,1))+24)
IF (NHPS(1,2).GT.0) CALL SHS(18,0,FLOAT(NHPS(1,2)))
IF (NHPS(2,2).GT.0) CALL SHS(18,0,FLOAT(NHPS(2,2))+12)
IF (NHPS(3,2).GT.0) CALL SHS(18,0,FLOAT(NHPS(3,2))+24)
CALL SHS(19,0,FLOAT(IMAP))
CALL SHS(20,0,FLOAT(IMAPST/64))
CALL SHS(51,0,CHISQ/FLOAT(NDF))
CALL SHS(52,0,CHP)
CALL SHS(53,0,VEC(8)/ABS(VEC(1)))
CALL SHS(53,0,0.)
CALL SHS(54,0,VEC(10))
CALL SHS(55,0,SQRT(ABS(VEC(11)**2+VEC(12)**2)))
CALL SHS(56,0,SNGL(ZPL(J2))-VEC(6))
CALL SHD(59,0,VEC(4),VEC(5))
CALL SHD(63,0,FLOAT(NP(1)),FLOAT(NP(2)))
* ... fill in the other entries ...
* ... and fill another row in the banks
* Convert end vector to output format ...
CALL FKITOE(ZPL(J2),SSMT(1,J2),CSMT(1,1,J2),VEC)
CALL SHD(60,0,VEC(4),VEC(5))
CALL SHS(61,0,SQRT(VEC(4)**2+VEC(5)**2))
CALL SHS(62,0,ATAN2(VEC(5),VEC(4)))
* Fill FTPR row
* Now fill appropriate rows of FTRX and FTPX banks
CALL ERRLOG(332,'W:FFOUT: Digi used twice')
CALL SHD(71,0,IPWCL(ICELL)+0.5,IPIOSW(ICELL)-0.5)
CALL SHD(72,0,IRWPL(ICELL)+0.5,IRIOSW(ICELL)-0.5)
CALL SHD(72,0,IRWMI(ICELL)+0.5,IRIOSW(ICELL)-0.5)
CALL SHD(85,0,IPWCL(ICELL)+0.5,IPIOSW(ICELL)-0.5)
CALL SHD(86,0,IRWPL(ICELL)+0.5,IRIOSW(ICELL)-0.5)
CALL SHD(86,0,IRWMI(ICELL)+0.5,IRIOSW(ICELL)-0.5)
* Fill pointering bank
CALL ERRLOG(333,'S:FFOUT: Error while using work bank')
INFTUR = NLINK('FTUR',0)
* If we run out of space all banks are deleted
IF (NLINK('FTKR',0).GT.0) CALL NDROP('FTKR',0)
IF (NLINK('FTKX',0).GT.0) CALL NDROP('FTKX',0)
IF (NLINK('FTPR',0).GT.0) CALL NDROP('FTPR',0)
IF (NLINK('FTPX',0).GT.0) CALL NDROP('FTPX',0)
IF (NLINK('FTRX',0).GT.0) CALL NDROP('FTRX',0)
* Set flag to ignore all tracks
*
* Drop all work banks
*
CALL WDROP(IW,INDTPR)
CALL WDROP(IW,INDKTX)
CALL WDROP(IW,INDKX(1))
CALL WDROP(IW,INDKX(2))
*