SUBROUTINE FVFIT
*-- Author :    Stephen Burke   07/05/92
      SUBROUTINE FVFIT
*-----------------------------------------Updates 07/09/93-------                                             
**: FVFIT 40000 SB.  No more garbage collection.                                                              
*-----------------------------------------Updates 26/07/93-------                                             
**: FVFIT  30907 RP. Farm changes.                                                                            
*-----------------------------------------Updates 02/06/93-------                                             
**: FVFIT  30907 SB. Initialise LUN at BEGJOB.                                                                
*-----------------------------------------Updates 03/05/93-------                                             
**: FVFIT  30907 SB. Print summary on ENDJOB.                                                                 
*-----------------------------------------Updates 15/10/92-------                                             
**: FVFIT  30907 SB. A bit of extra printout.                                                                 
*-----------------------------------------Updates 17/08/92-------                                             
**: FVFIT  30907 SB. Fix HBOOK error message.                                                                 
*-----------------------------------------Updates 06/05/92-------                                             
**: FVFIT  30907 SB. New deck to steer forward z-vertex fit.                                                  
*-----------------------------------------Updates----------------                                             
**********************************************************************                                        
*                                                                    *                                        
* Preliminary z-vertex determination from forward tracks.            *                                        
*                                                                    *                                        
**********************************************************************                                        
                                                                        
*KEEP,FVSTEE.                                                                                                 
      LOGICAL LTRUTH,LCUT,LRESID                                        
      COMMON /FVSTEE/ IDIAG,LUN,LUNHB,LTRUTH,LCUT,LRESID                
*KEEP,FVSCAL.                                                                                                 
* Various counters                                                                                            
      PARAMETER (NSCAL=16)                                              
      COMMON /FVSCAL/ NNEVNT,NNVTX,NNFTKR,NNXTR,NNFIT,NNOUT,NNSIN       
     &,               NNFTKP,NNXTRP,NNFITP,NNOUTP,NNSINP                
     &,               NNVTXC,NNSINC,NNFVNC,NNFSNC                       
*KEEP,FVWBI.                                                                                                  
* Work bank indices                                                                                           
      PARAMETER (NFVWBI=2)                                              
      COMMON /FVWBI/ INFTPR,INFVWK                                      
*KEND.                                                                                                        
                                                                        
      LOGICAL LFIRST                                                    
      SAVE LFIRST                                                       
                                                                        
      COMMON /SUMARY/ LSUMA                                             
*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     ------                                                                                                  
*KEND.                                                                                                        
                                                                        
      DATA LFIRST/.TRUE./                                               
                                                                        
**********************************************************************                                        
                                                                        
* Make sure LUN is defined                                                                                    
      IF (BEGJOB) LUN = 6                                               
                                                                        
      IF (BEGRUN .AND. LFIRST) THEN                                     
         LFIRST = .FALSE.                                               
* Zero work bank indices (just in case ...)                                                                   
         CALL VZERO(INFTPR,NFVWBI)                                                                     
* Initialise scalars                                                                                          
         CALL VZERO(NNEVNT,NSCAL)                                                                      
* Read parameters from text banks                                                                             
         CALL FVTEXT
* Format output banks                                                                                         
         CALL BKFMT('FTGR','2I,(3F,I)')
         CALL BKFMT('FTGX','2I,(I)')
* Book monitoring histograms                                                                                  
         CALL FVBKLK
* Book debug histograms                                                                                       
         CALL FVHBK('FVFIT')
      ENDIF                                                             
                                                                        
      IF (REVENT .AND. LFIRST) THEN                                     
* This shouldn't happen!                                                                                      
         WRITE(6,*)                                                     
         WRITE(6,*) '**FVFIT**  Not initialised - code error'           
         WRITE(6,*)                                                     
         CALL H1STOP                                                                                   
      ENDIF                                                             
                                                                        
      IF ((IW(6).GT.0 .AND. ENDRUN .AND. LSUMA.EQ.1) .OR.               
     &    (IW(6).GT.0 .AND. ENDJOB)) THEN                               
         WRITE(LUN,*)                                                   
         WRITE(LUN,*)                                                   
         WRITE(LUN,*) '     *** Forward track z-vertex fit summary ***' 
         WRITE(LUN,*)                                                   
         WRITE(LUN,*) 'Number of events:                 ',NNEVNT       
         WRITE(LUN,*) 'Number of events with a z-vertex: ',NNVTX        
         WRITE(LUN,*)                                                   
         WRITE(LUN,*) 'Forward tracks:                   ',NNFTKR       
         WRITE(LUN,*) 'Tracks extrapolated to vertex:    ',NNXTR        
         WRITE(LUN,*) 'Tracks passing DCAMAX/Z0MAX cuts: ',NNFIT        
         WRITE(LUN,*) 'Tracks contributing to z-vertex:  ',NNOUT        
         WRITE(LUN,*) 'Single tracks giving a vertex:    ',NNSIN        
         WRITE(LUN,*)                                                   
         IF (LTRUTH) THEN                                               
            WRITE(LUN,*) 'Primary forward tracks:           ',NNFTKP    
            WRITE(LUN,*) 'Primary tracks extrapolated:      ',NNXTRP    
            WRITE(LUN,*) 'Primary tracks passing cuts:      ',NNFITP    
            WRITE(LUN,*) 'Primary single tracks:            ',NNSINP    
            WRITE(LUN,*)                                                
         ENDIF                                                          
         WRITE(LUN,*) 'CT z-vertices:                    ',NNVTXC       
         WRITE(LUN,*) 'CT z-vertices from 1 track:       ',NNSINC       
         WRITE(LUN,*)                                                   
         WRITE(LUN,*) 'FT z-vertices, no CT:             ',NNFVNC       
         WRITE(LUN,*) 'FT z-vertices from 1 track, no CT:',NNFSNC       
         WRITE(LUN,*)                                                   
         WRITE(LUN,*)                                                   
      ENDIF                                                             
                                                                        
      IF (REVENT) THEN                                                  
         CALL FVZFIT
* Make sure PAW directory is reset                                                                            
         CALL HCDIR('//PAWC',' ')                                                                      
* Clean up                                                                                                    
C         CALL WGARB(IW)                                                                                      
      ENDIF                                                             
                                                                        
      IF (ENDJOB .AND. IDIAG.GE.10) THEN                                
         IF (IW(6).GT.0) CALL HPDIR('//PAWC/FVFIT',' ')                                                
         IF (LUNHB.GT.0) THEN                                           
            OPEN(UNIT=LUNHB,ACCESS='DIRECT',FORM='UNFORMATTED',         
     &           RECL=1024,STATUS='NEW',IOSTAT=IOS)                     
            IF (IOS.EQ.0) THEN                                          
               CALL HCDIR('//PAWC/FVFIT',' ')                                                          
               CALL HRFILE(LUNHB,'FVFIT','N')                                                          
               CALL HROUT(0,ICYC,' ')                                                                  
               CALL HREND('FVFIT')                                                                     
               CLOSE(LUNHB)                                             
               CALL HCDIR('//PAWC',' ')                                                                
            ELSE                                                        
               CALL ERRLOG(501,'W:FVFIT:  HBOOK file open failed')                                     
            ENDIF                                                       
         ENDIF                                                          
      ENDIF                                                             
                                                                        
      RETURN                                                            
      END                                                               
*