SUBROUTINE FFFIT
*-- 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                                                               
*