SUBROUTINE FPKANL
*-- Author : Stephen J. Maxfield
      SUBROUTINE FPKANL
*D: FPKANL.......SM. Add options for left/right separation                                                    
**: FPKANL 40000 SM. New routine for calibration checking.                                                    
**----------------------------------------------------------------------                                      
*     Does not work in multi-processor environment.                                                           
*                                                                                                             
*                                                                                                             
      PARAMETER (NBIN=200)                                              
      PARAMETER (NBLOR=40)                                              
      PARAMETER (MXSIDE=1)                                              
*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/                                                      
*KEND.                                                                                                        
      COMMON/FPKSTA/ITOTAN,IRUNLA                                       
                                                                        
      DIMENSION CVEC(6)                                                 
      DIMENSION IOUT(4)                                                 
      DIMENSION FOUT(5)                                                 
      DIMENSION PDAT(5,5)                                               
      DIMENSION PAR(2), PMIN(2), PMAX(2), EPAR(2), COV(3)               
      DIMENSION XST(4), YST(4)                                          
      DIMENSION AVEC(8)                                                 
      DIMENSION NPEAK(3)                                                
      DIMENSION NEMAX(3)                                                
      LOGICAL EX                                                        
                                                                        
      CHARACTER*8  UID                                                  
      CHARACTER*23 DSNINQ  /'/H1TFWD.H01.FPOKER.SUML'/                  
      CHARACTER*22 STOREL  /'H1TFWD.H01.FPOKER.SUML'/                   
      CHARACTER*72 PARMFO                                               
     &                 /'OPEN FILE2 UNIT=2 FILE="H1TFWD.H01.FPOKER.SUML"
     & ACTION=MODIFY RECL=23400'/                                       
      CHARACTER*72 PARMFN                                               
     &                 /'OPEN FILE2 UNIT=2 FILE="H1TFWD.H01.FPOKER.SUML"
     & ACTION=WRITE  RECL=23400'/                                       
                                                                        
      CHARACTER*8  NAMES1(8),NAMES2(8),NAMES3(8)                        
      DATA NEMAX/20, 10, 10/                                            
      DATA LOMAX/20/                                                    
                                                                        
      DATA NAMES1/                                                      
     +    'Run_numb','Events  ',                                        
     +    'Vmean   ','dVmean  ',                                        
     +    'Vf0r8   ','dVf0r8  ',                                        
     +    'intercep','dinterc '/                                        
      DATA NAMES2/                                                      
     +    'Vplus   ','dVplus  ',                                        
     +    'Splus   ','dSplus  ',                                        
     +    'Intplus ','dIplus  ',                                        
     +    'Nopplus ','Chiplus '/                                        
      DATA NAMES3/                                                      
     +    'Vminus  ','dVminus ',                                        
     +    'Sminus  ','dSminus ',                                        
     +    'Intminus','dIminus',                                         
     +    'Nopminus','Chiminus'/                                        
*                                                                                                             
                                                                        
*--------------------------------------------------------------------                                         
                                                                        
      CALL SAREA('FPOKE', 0)                                                                           
*     Book histograms...                                                                                      
      Do KSIDE = 1, MXSIDE                                              
       CALL BVEC(KSIDE*100, 0, 6)                                                                      
       CALL STEXT(KSIDE*100, 4,'D-time (scaled) vs. Dist(predicted)')                                  
      Enddo                                                             
                                                                        
      CALL BVEC( 12000, 0, 6)                                                                          
      CALL STEXT(12000, 4,'DeltaR vs. Drift predicted)')                                               
                                                                        
*     Analyse the data.                                                                                       
*     ------- --- ----                                                                                        
*     Analysis of histogram results.                                                                          
      Write(6,*) ' Fpkanl >> Total Events:', ITOTAN                     
                                                                        
*     Do peakparm analysis of the pred drift histograms...                                                    
                                                                        
      DO KSIDE = 1, MXSIDE                                              
      NPEAK(KSIDE) = 0                                                  
      DO KBIN = 1, NBIN                                                 
                                                                        
       DLO       = -5. + (KBIN-1) * 0.05                                
       DHI       = DLO + 0.05                                           
                                                                        
       JHIS1 = 2000 + KBIN + (KSIDE-1)*2000                             
       JHIS2 = 3000 + KBIN + (KSIDE-1)*2000                             
                                                                        
*      Get average predicted drift distance in the slice...                                                   
       CALL GHSTAT('HS', JHIS2, 0, NENT, SUMW, RNEFF, XST, YST)                                        
       DMAV = XST(3)                                                    
       IF(NENT .GT. NEMAX(KSIDE)) THEN                                  
       CALL HPEAK('HS',JHIS1, 0, NPK, PDAT)                                                            
                                                                        
         IF (NPK .GE. 1) THEN                                           
           NPEAK(KSIDE) = NPEAK(KSIDE) + 1                              
*          peak position and error on...                                                                      
           PPOS  = PDAT(1,1)                                            
           PERR  = ABS(PDAT(2,1))                                       
           PINT  = ABS(PDAT(3,1))                                       
*          comment out next line for 'full width errors'                                                      
           PERR  = 2.0*(PERR  / SQRT(PINT))                             
                                                                        
*          Hence Drift time vs. predicted  drift distance:-                                                   
                                                                        
           CVEC(1) = DMAV                                               
           CVEC(2) = PPOS                                               
           CVEC(3) = DMAV - DLO                                         
           CVEC(4) = DHI  - DMAV                                        
           CVEC(5) = PERR                                               
           CVEC(6) = PERR                                               
           CALL SVEC(KSIDE*100, 0, CVEC)                                                               
         ENDIF                                                          
                                                                        
       ENDIF                                                            
                                                                        
*      Now purge figures - no longer needed.                                                                  
       CALL PURGEF(JHIS1)                                                                              
       CALL PURGEF(JHIS2)                                                                              
                                                                        
      ENDDO                                                             
                                                                        
      ENDDO                                                             
                                                                        
                                                                        
                                                                        
*     Do peakparm analysis of the Lorentz Angle Histograms...                                                 
                                                                        
      DO KBIN = 1, NBLOR                                                
                                                                        
       DLO       = -5. + (KBIN-1) * 0.25                                
       DHI       = DLO + 0.25                                           
                                                                        
       JHIS1 = 10000 + KBIN                                             
       JHIS2 = 11000 + KBIN                                             
                                                                        
*      Get average predicted drift distance in the slice...                                                   
       CALL GHSTAT('HS', JHIS2, 0, NENT, SUMW, RNEFF, XST, YST)                                        
       DMAV = XST(3)                                                    
       IF(NENT .GT. LOMAX) THEN                                         
       CALL HPEAK('HS',JHIS1, 0, NPK, PDAT)                                                            
                                                                        
         IF (NPK .GE. 1) THEN                                           
*          peak position and error on...                                                                      
           PPOS  = PDAT(1,1)                                            
           PERR  = ABS(PDAT(2,1))                                       
           PINT  = ABS(PDAT(3,1))                                       
*          comment out next line for 'full width errors'                                                      
           PERR  = 2.0*(PERR  / SQRT(PINT))                             
                                                                        
*          Hence Delta R vs. predicted drift distance:-                                                       
                                                                        
           CVEC(1) = DMAV                                               
           CVEC(2) = PPOS                                               
           CVEC(3) = DMAV - DLO                                         
           CVEC(4) = DHI  - DMAV                                        
           CVEC(5) = PERR                                               
           CVEC(6) = PERR                                               
           CALL SVEC(12000, 0, CVEC)                                                                   
         ENDIF                                                          
                                                                        
       ENDIF                                                            
                                                                        
*      Now purge figures - no longer needed.                                                                  
       CALL PURGEF(JHIS1)                                                                              
       CALL PURGEF(JHIS2)                                                                              
                                                                        
      ENDDO                                                             
                                                                        
*     Extraction of calibration data. Not for online at moment...                                             
                                                                        
999   RETURN                                                            
      END                                                               
*