*-- Author : Stephen Burke SUBROUTINE FFFIT *-----------------------------------------Updates 22/11/93------- **: FFFIT.......SB. New parameters in FFOUT call. *-----------------------------------------Updates 27/07/93------- **: FFFIT 30907 SB. Changes to monitoring histograms. **: FFFIT 30907 RP. Farm changes. *-----------------------------------------Updates 03/03/93------- **: FFFIT 30907 SB. New monitoring histograms. *-----------------------------------------Updates 06/08/92------- **: FFFIT 30907 SB. Cosmetic changes. *-----------------------------------------Updates 03/06/92------- **: FFFIT 30907 SB. 1-column FTKR banks no longer made. **: FFFIT 30907 SB. Creation of empty files moved to FFOUT. **: FFFIT 30907 SB. Small fix to error counting. *-----------------------------------------Updates 28/04/92------- **: FFFIT 30907 SB. Make empty FTKX bank if necessary. *-----------------------------------------Updates 13/02/92------- **: FFFIT 30205.SB. ERRLOG error numbers changed. *-----------------------------------------Updates 24/01/92------- **: FFFIT 30205.SB. BKFMT calls moved to FFKAL. **: FFFIT 30205.SB. Count failures due to banks missing. **: FFFIT 30205.SB. ERRLOG message format changed. **: FFFIT 30205.SB. Add #tracks histogram call for empty events *-----------------------------------------Updates---------------- ********************************************************************** * * * Find various banks, and Kalman filter the FPATREC tracks * * * ********************************************************************** CHARACTER*4 BANK *KEEP,FKNPL. CHARACTER*5 CKDBG PARAMETER (CKDBG='FKDBG') PARAMETER (NPL=72) LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL &, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN &, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT * * 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. * COMMON /H1WORK/ * /FKPROJ/ & SPRO(5,NPL),CPRO(5,5,NPL) * /FKFILT/ &, SFIL(5,NPL),CFIL(5,5,NPL) * /FKSMTH/ &, SSMT(5,NPL),CSMT(5,5,NPL) &, SSMTR(5,NPL),CSMTR(5,5,NPL) * /FKINT/ &, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL) &, QGAIN(5,5,NPL),IAPROX,LFIRST * /FKRSID/ &, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL) &, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL) &, CHIFIL(NPL),CHISMT(NPL) * /FKTRUE/ &, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE * /FKDBG/ &, LTRPL(NPL),LTRPLD(NPL) *KEEP,FFSTEE. PARAMETER (NFT=72) LOGICAL LRISV,LWMAP,LGRAPH,LTRUTH REAL DSX,DSY,DSQOP,DSTTH,DSPHI,PMCUT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX COMMON /FFSTEE/ DSX,DSY,DSQOP,DSTTH,DSPHI &, PMCUT,IDIAG,JPLRSV,LRISV,LWMAP(NFT),JPLMAX &, IRP(NPL),JPLFT(NPL),JFTPL(NFT) &, LUNGKS,IWKGKS,IDGKS,LUNHB,LUNGKM,IWKGKM,IDGKM &, LGRAPH,LTRUTH,IHFF,IHFK,ISRJCT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX *KEEP,FFGEO. COMMON /FFGEO/ INDG1(2),INDLC(2),IDIGI(NPL) *KEEP,FKCNTL. COMMON /FKCNTL/ LUN,IPR,ITR,IPL,JSTART,JSTOP,JLAST,JSTEP *KEEP,FFSCAL. * Counters PARAMETER (NSCAL=145) COMMON /FFSCAL/ NPFAIL,NRFAIL,NXFAIL,NFFAIL,NMFAIL,NBFAIL,NTFAIL &, NWFAIL,NNSPLT,NNMISS,NNMISP &, NQFAIL,NAFAIL,NOFAIL,NIFAIL &, NTRIN,NTROUT,NPRSEG(0:7,0:7),N23SEG(0:7,0:7) *KEEP,FFWBI. * Work bank indices (note that INDKTR is *NOT* a work bank index!) PARAMETER (NWBI=10) COMMON /FFWBI/ INDRSX(2),INDX(2),INDKX(2),INDPUR &, INDKTR,INDKTX,INDTPR *KEEP,FFDBG. CHARACTER*5 CFDBG CHARACTER*6 CFKDBG PARAMETER (CFDBG='FFDBG',CFKDBG='FFKDBG') PARAMETER (NTRACK=1000) COMMON /FFDBG/ ITRTR(2,NTRACK),ITRNF(5,NTRACK),JTRTR *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,CNSTBF. INTEGER LW(NBOSIW) REAL SW(NBOSIW) EQUIVALENCE (RW(1),IW(1),LW(1),SW(1)) *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,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,FTHIST. * indices of filter farm histos COMMON/FTHIST/IHP(100) *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. ********************************************************************** * Look for the track bank INFTUR = NLINK('FTUR',0) IF (INFTUR.LE.0) THEN CALL ERRLOG(301,'S:FFFIT: Bank FTUR not found; Kalman ' + //'filter aborted') RETURN ENDIF NTR = IW(INFTUR+2) IF (NTR.GT.500) THEN CALL ERRLOG(302,'S:FFFIT: Too many tracks; Kalman ' + //'filter aborted') RETURN ENDIF * Unpacked geometry banks INDG1(1) = MLINK(LW,'FPG1',0) INDG1(2) = MLINK(LW,'FRG1',0) IF (INDG1(1).LE.0 .OR. INDG1(2).LE.0) THEN CALL FTCORG INDG1(1) = MLINK(LW,'FPG1',0) INDG1(2) = MLINK(LW,'FRG1',0) IF (INDG1(1).LE.0 .OR. INDG1(2).LE.0) THEN CALL ERRLOG(303,'S:FFFIT: Banks FPG1/FRG1 not found;'// + ' Kalman filter aborted') NBFAIL = NBFAIL + NTR RETURN ENDIF ENDIF * Unpacked digi banks (MUST always exist) INDLC(1) = NLINK('FPLC',0) IF (INDLC(1).LE.0) THEN CALL FPLOCO INDLC(1) = NLINK('FPLC',0) ENDIF INDLC(2) = NLINK('FRLC',0) IF (INDLC(2).LE.0) THEN CALL FRLOCO INDLC(2) = NLINK('FRLC',0) ENDIF IF (INDLC(1).LE.0 .OR. INDLC(2).LE.0) THEN CALL ERRLOG(304,'S:FFFIT: Banks FPLC/FRLC not found;'// + ' Kalman filter aborted') NBFAIL = NBFAIL + NTR RETURN ENDIF INFPSG = NLINK('FPSG',0) INFRSG = NLINK('FRSG',0) CALL SHS(13,0,FLOAT(IW(INDLC(1)+2))) CALL SHS(14,0,FLOAT(IW(INDLC(2)+2))) IF (IDB.GT.1) THEN IF (INFPSG.GT.0) CALL SHS(57,0,FLOAT(IW(INFPSG+2))) IF (INFRSG.GT.0) CALL SHS(58,0,FLOAT(IW(INFRSG+2))) ENDIF * Zero the work bank indices INDPUR = 0 CALL VZERO(INDX,2) CALL VZERO(INDRSX,2) * Get the pointering bank ... IF (NLINK('FPUR',0).LE.0) THEN CALL ERRLOG(305,'S:FFFIT: Bank FPUR not found; Kalman ' + //'filter aborted') NBFAIL = NBFAIL + NTR GOTO 9000 ENDIF BANK = 'FPUR' CALL BKTOW(IW,BANK,0,IW,INDPUR,*1000) IF (IW(INDPUR+2).NE.NTR) THEN CALL ERRLOG(306,'S:FFFIT: Bank FPUR has wrong length; Kalman ' + //'filter aborted') NBFAIL = NBFAIL + NTR GOTO 9000 ENDIF * Now get the link banks ... IF (NLINK('FPUX',0).LE.0 .OR. NLINK('FRUX',0).LE.0) THEN CALL ERRLOG(307,'S:FFFIT: Banks FPUX or FRUX not found;'// + ' Kalman filter aborted') NBFAIL = NBFAIL + NTR GOTO 9000 ENDIF BANK = 'FPUX' CALL BKTOW(IW,BANK,0,IW,INDX(1),*1000) BANK = 'FRUX' CALL BKTOW(IW,BANK,0,IW,INDX(2),*1000) IF (MONTE .AND. LTRUTH) THEN * This is for MC data only - true track/digi link banks IF (NLINK('FRPX',0).GT.0) THEN BANK = 'FRPX' CALL BKTOW(IW,BANK,0,IW,INDRSX(1),*1000) ENDIF IF (NLINK('FRRX',0).GT.0) THEN BANK = 'FRRX' CALL BKTOW(IW,BANK,0,IW,INDRSX(2),*1000) ENDIF ENDIF CALL HCDIR('//PAWC/'//CFDBG,' ') IF (MOD(IHFF,1000).GT.0) CALL HFILL(300,FLOAT(NTR),0.,1.) CALL VZERO(ITRTR,2*NTRACK) * Set the track number to (event no)*1000 + JTR ITR = MOD(NEVENT,1000000)*1000 * Fit each track in turn DO 100 JTR=1,NTR * Quick track rejection NRHIT = IBTAB(INDPUR,1,JTR) NPHIT = IBTAB(INDPUR,3,JTR) IF (NRHIT.GE.9 .OR. NPHIT.GE.1) THEN CALL FFKLMN(INFTUR,JTR) ELSE NRFAIL = NRFAIL + 1 ENDIF 100 CONTINUE * Close the output banks CALL FFOUT(0,NPS,NRS) IF (MOD(IHFF,1000).GT.0) CALL FFTRCH GOTO 9000 1000 CALL ERRLOG(308,'S:FFFIT: Bank '//BANK//' not found by BKTOW') NWFAIL = NWFAIL + NTR 9000 CONTINUE * * Must make sure all work banks are dropped!!! * CALL WDROP(IW,INDPUR) CALL WDROP(IW,INDX(1)) CALL WDROP(IW,INDX(2)) CALL WDROP(IW,INDRSX(1)) CALL WDROP(IW,INDRSX(2)) RETURN END *