SUBROUTINE FSUMP
*-- Author :    John V. Morris
      SUBROUTINE FSUMP
                                                                        
      DIMENSION IOUT(6), FOUT(17)                                       
      COMMON/FCOUNT/ NDATE0,NTIME0,ISTATP(20),ISTATR(20),IFRHV,IFPHV,   
     &               NEVENT,NFIEL0,NPRES0,NECUR0,NPCUR0,IRTE0,IRTP0,    
     &               IEVIN,NFPEVT,NHITSP,NFREVT,NHITSR,NMIN92,          
     &               TOTL,H1L,RTIME,REFF,ILRET                          
      PARAMETER( MXC=40 )             ! maximum stored results          
      COMMON/FVOUTP/VEL(MXC),EVEL(MXC),RMIC(MXC),EMIC(MXC),IDVF(MXC),   
     &             SEGS(MXC),ESEG(MXC),ASYM(MXC),EASYM(MXC),            
     &             SEGN(MXC),ESEGN(MXC),SEGF(MXC),ESEGF(MXC)            
      LOGICAL PLANAR,RADIAL                                             
      COMMON /FTQRUN/  NRUN,NRUN0,NRUN1,MAXEV,PLANAR,RADIAL             
      COMMON/FHITLS/ LHITSP(0:8), LHITSR(0:8)                           
      COMMON/FHLUN/ LUNH, LUNS, LMES, IL4L5                             
                                                                        
      PARAMETER( NP = 4 )            ! number of fit parameters         
      Common/PawPar/ PAR(NP)                                            
                                                                        
      EXTERNAL Fwiebl                                                   
                                                                        
      DATA IC/12/                                                       
      DIMENSION P(NP),ST0(NP),PMI0(NP),PMA0(NP),SIG(NP),COV(NP*(NP+1)/2)
      DIMENSION      ST(NP) ,PMI(NP) ,PMA(NP)                           
      DATA    P/0.0,0.0,2.5,0.0/                                        
      DATA  ST0/100.,10.0,1.0,10./                                      
      DATA PMI0/0.0,0.0,0.0,0.0/                                        
      DATA PMA0/9999999.,2500.,5.,2500./                                
                                                                        
      DIMENSION PERCY(10),RELEF(4),ERLEF(4),QWR(4)                      
      DIMENSION ABIEFF(13),ABINEF(13),ABIFEF(13)                        
      DIMENSION AVEC(19),BVEC(8),VVEC(18),HVEC(9),CVEC(9),TVEC(18)      
      DIMENSION EVEC(39),PVEC(26)                                       
      DIMENSION HSIG(3),CONTEN(60)                                      
      DIMENSION BACK(13),EBACK(13),RTZERO(13),ETZERO(13),VELD(13)       
      DIMENSION EVELD(13),LERR(13)                                      
      DATA ICH/ 2/                                                      
      CHARACTER*20 UNITS                                                
      DIMENSION UNITS(6)                                                
      DIMENSION XEFF(9)                                                 
      DATA UNITS/' microns/nsec',' microns','   ',' per-cent',          
     +           ' nsec           ',' from DT width'/                   
                                                                        
      CALL VZERO(PERCY,10)                                                                             
                                                                        
      IF(IEVIN.GT.0)THEN                                                
         DO 1099 J=1,6                                                  
 1099    PERCY(J) = FLOAT(ISTATP(J))*100.0/FLOAT(IEVIN)                 
      ENDIF                                                             
      IF( ISTATP(7).GT.0 )THEN                                          
         DO 1098 J=7,10                                                 
 1098    PERCY(J) = FLOAT(ISTATP(J))/FLOAT(ISTATP(7))                   
      ENDIF                                                             
                                                                        
      DO 10 IVD = 1 , 13                                                
                                                                        
        IF((SEGS(13+IVD) + SEGS(26+IVD)).EQ.0.0) THEN                   
          ABIEFF(IVD) = 0.0                                             
        ELSE                                                            
          ABIEFF(IVD) = SEGS(13+IVD) / (SEGS(13+IVD) + SEGS(26+IVD))    
        ENDIF                                                           
        IF((SEGN(13+IVD) + SEGN(26+IVD)).EQ.0.0) THEN                   
          ABINEF(IVD) = 0.0                                             
        ELSE                                                            
          ABINEF(IVD) = SEGN(13+IVD) / (SEGN(13+IVD) + SEGN(26+IVD))    
        ENDIF                                                           
        IF((SEGF(13+IVD) + SEGF(26+IVD)).EQ.0.0) THEN                   
          ABIFEF(IVD) = 0.0                                             
        ELSE                                                            
          ABIFEF(IVD) = SEGF(13+IVD) / (SEGF(13+IVD) + SEGF(26+IVD))    
        ENDIF                                                           
        EVEC(IVD)   = ABIEFF(IVD)                                       
        EVEC(IVD+13)= ABINEF(IVD)                                       
        EVEC(IVD+26)= ABIFEF(IVD)                                       
                                                                        
        IDB = 137 + IVD                                                 
        IDF = 150 + IVD                                                 
                                                                        
      IF( HMAX(IDB).GT.250. )THEN                                       
      CALL FPEAKF(IDB,area,xmax,thresh)
      P(1) = area                                                       
      P(2) = xmax                                                       
      P(3) = 2.5                                                        
      P(4) = thresh                                                     
      PMA0(1) = area*5.                                                 
      PMA0(2) = xmax*2.                                                 
      PMA0(4) = thresh*2.                                               
                                                                        
      CALL UCOPY( P,PAR,NP )                                                                           
      CALL UCOPY( ST0,ST,NP )                                                                          
      CALL UCOPY( PMI0,PMI,NP )                                                                        
      CALL UCOPY( PMA0,PMA,NP )                                                                        
                                                                        
      CALL HFIT(IDB,Fwiebl,NP,PAR,CHISQ,IC,SIG,COV,ST,PMI,PMA)                                         
         CALL HMINIM(IDB,-500.)                                                                        
         CALL HPRINT(IDB) ! DOS of Drift Time                                                          
         SCER = SQRT(CHISQ/6.0)                                         
         IF(SCER.lt.1.0) SCER = 1.0                                     
         BACK(IVD) = PAR(2)                                             
         EBACK(IVD) = SIG(2)*SCER                                       
         LERR(IVD) = 0                                                  
      ELSE                                                              
         LERR(IVD) = 1                                                  
         BACK(IVD) = 0.0                                                
         EBACK(IVD)= 0.0                                                
      ENDIF                                                             
                                                                        
      IF( HMAX(IDF).GT.250. )THEN                                       
         CALL FPEAKF(IDF,area,xmax,thresh)
         CALL HFITGA(IDF,G1,G2,G3,GXHI,ICH,HSIG)                                                       
         CALL HMINIM(IDF,-500.)                                                                        
         S6702 = GXHI                                                   
         IF( S6702.GT.1. )THEN                                          
            S6702 = SQRT(S6702)                                         
         ELSE                                                           
            S6702 = 1.0                                                 
         ENDIF                                                          
         RTZERO(IVD) = G2                                               
         ETZERO(IVD) = HSIG(2)*S6702                                    
      ELSE                                                              
         LERR(IVD)   = LERR(IVD) + 1                                    
         RTZERO(IVD) = 0.                                               
         ETZERO(IVD) = 0.                                               
      ENDIF                                                             
                                                                        
      IF(LERR(IVD).EQ.0) THEN                                           
         VELD(IVD) = 28100.0/(BACK(IVD)-RTZERO(IVD))                    
         EVELD(IVD) = VELD(IVD)*SQRT(ETZERO(IVD)**2 + EBACK(IVD)*2)     
     &                        /(BACK(IVD)-RTZERO(IVD))                  
         IF(RMIC(1).GT.0.0 .AND. IVD.EQ.1) THEN                         
           EPCNT = SQRT( (EVELD(IVD)/VELD(IVD))**2                      
     &                 + (EMIC(1)/RMIC(1))**2 )                         
           RMIC(1)= RMIC(1)*VELD(IVD)                                   
           EMIC(1)= RMIC(1)*EPCNT                                       
         ENDIF                                                          
      ELSE                                                              
         VELD(IVD)   = 0.                                               
         EVELD(IVD)  = 0.                                               
         IF(IVD.EQ.1) THEN                                              
           RMIC(1)= 0.                                                  
           EMIC(1)= 0.                                                  
         ENDIF                                                          
      ENDIF                                                             
                                                                        
      PVEC(IVD)   = VELD(IVD)                                           
      PVEC(IVD+13)= EVELD(IVD)                                          
                                                                        
   10 CONTINUE                                                          
                                                                        
      NNMAX = 0                                                         
      DO 1080 JW=1,4                                                    
         IDH = 13 + JW                                                  
         NN = NINT( HSUM(IDH) )                                         
         QWR(JW) = HSTATI(IDH,1,'HIST',1)                               
         IF( NN.GT.NNMAX ) NNMAX=NN                                     
         RELEF(JW) = FLOAT(NN)                                          
         ERLEF(JW) = SQRT( RELEF(JW) )                                  
 1080 CONTINUE                                                          
      EFCEN = 0.0                                                       
      ERCEN = 0.0                                                       
      IF( NNMAX.GT.0 ) THEN                                             
         EFCEN = ( RELEF(2)+RELEF(3) )*100.0/( RELEF(1)+RELEF(4) )      
         ERCEN = SQRT( RELEF(2)+RELEF(3) )                              
         ERCEN = 100.0*ERCEN/( RELEF(1)+RELEF(4) )                      
         DO 1081 JW=1,4                                                 
            RELEF(JW) = 100.0*RELEF(JW)/FLOAT(NNMAX)                    
            ERLEF(JW) = 100.0*ERLEF(JW)/FLOAT(NNMAX)                    
 1081    CONTINUE                                                       
      ENDIF                                                             
                                                                        
      TFR = SEGS(1)/FLOAT( ISTATP(1) )                                  
      ETF = ESEG(1)/FLOAT( ISTATP(1) )                                  
      TDG = SEGS(1)*400.0/FLOAT( ISTATP(11) )                           
      EDG = ESEG(1)*400.0/FLOAT( ISTATP(11) )                           
      HPE = FLOAT(ISTATP(11))/FLOAT(ISTATP(1))                          
                                                                        
      IOUT(1) = NRUN0                                                   
      IOUT(2) = NDATE0                                                  
      IOUT(3) = NTIME0                                                  
      IOUT(4) = NPRES0                                                  
      IOUT(5) = ISTATP(1)                                               
                                                                        
      FOUT(1) = HPE                                                     
      FOUT(2) = TFR                                                     
      FOUT(3) = ETF                                                     
      FOUT(4) = TDG                                                     
      FOUT(5) = EDG                                                     
      FOUT(6) = VEL(1)                                                  
      FOUT(7) = EVEL(1)                                                 
      FOUT(8) = VELD(1)                                                 
      FOUT(9) = EVELD(1)                                                
      FOUT(12)= RMIC(1)                                                 
      FOUT(13)= EMIC(1)                                                 
      FOUT(14)= RTZERO(1)                                               
      FOUT(15)= ETZERO(1)                                               
      FOUT(16)= EFCEN                                                   
      FOUT(17)= ERCEN                                                   
                                                                        
      AVQ = HSTATI(18,1,'HIST',1)                                       
      RMS = HSTATI(18,2,'HIST',2)                                       
      XN  = HSUM(18)                                                    
      IF(XN.GT.0.0) RMS = RMS/SQRT(XN)                                  
      FOUT(10)= EXP(AVQ)                                                
      FOUT(11)= RMS                                                     
      DO 3001 NSM=0,2                                                   
         NL0 = NSM*3                                                    
         HLE0 = FLOAT( LHITSP(NL0) )/FLOAT(ISTATP(1))                   
         HLE1 = FLOAT( LHITSP(NL0+1) )/FLOAT(ISTATP(1))                 
         HLE2 = FLOAT( LHITSP(NL0+2) )/FLOAT(ISTATP(1))                 
         HVEC(NL0+1) = HLE0                                             
         HVEC(NL0+2) = HLE1                                             
         HVEC(NL0+3) = HLE2                                             
 3001 CONTINUE                                                          
 3101 FORMAT(1X)                                                        
                                                                        
      DO 3201 NSM=0,2                                                   
         NL0 = NSM*3                                                    
         CLE0 = SEGS(NL0+5)/FLOAT(ISTATP(1))                            
         CLE1 = SEGS(NL0+6)/FLOAT(ISTATP(1))                            
         CLE2 = SEGS(NL0+7)/FLOAT(ISTATP(1))                            
         CVEC(NL0+1) = CLE0                                             
         CVEC(NL0+2) = CLE1                                             
         CVEC(NL0+3) = CLE2                                             
 3201 CONTINUE                                                          
                                                                        
      DO 3002 NSM=0,2                                                   
        VVEC(NSM*2+1) = VEL(NSM+2)                                      
        VVEC(NSM*2+2) = EVEL(NSM+2)                                     
 3002 CONTINUE                                                          
      DO 3022 NSO=0,8                                                   
         TVEC(NSO+1)  = VEL(NSO+5)                                      
         TVEC(NSO+10) = EVEL(NSO+5)                                     
 3022 CONTINUE                                                          
      DO 3003 NSM=0,2                                                   
        VVEC(NSM*2+7) = RMIC(NSM+2)                                     
        VVEC(NSM*2+8) = EMIC(NSM+2)                                     
 3003 CONTINUE                                                          
      DO 3004 NSM=0,2                                                   
         AVQ = HSTATI(19+NSM,1,'HIST',1)                                
         RMS = HSTATI(19+NSM,2,'HIST',2)                                
         XN = HSUM(19+NSM)                                              
         IF(XN.GT.0.0) RMS = RMS/SQRT(XN)                               
         VVEC(NSM*2+13) = AVQ                                           
         VVEC(NSM*2+14) = RMS                                           
 3004 CONTINUE                                                          
      IF(ILRET.EQ.0) THEN                                               
        IF(H1L.GT.0.0) THEN                                             
          IOUT(6) = 0 + IFPHV*10                                        
        ELSE                                                            
          IOUT(6) = 1 + IFPHV*10                                        
        ENDIF                                                           
      ELSE                                                              
        IOUT(6) = 2 + IFPHV*10                                          
      ENDIF                                                             
                                                                        
      AVEC(1) = FLOAT(IOUT(5))                                          
      DO 100 I = 1 , 17                                                 
        AVEC(1+I) = FOUT(I)                                             
        IF(I.LT.5) BVEC(I*2-1) = RELEF(I)                               
        IF(I.LT.5) BVEC(I*2  ) = QWR(I)                                 
  100 CONTINUE                                                          
      AVEC(19) = FLOAT(IFPHV)                                           
                                                                        
      CALL SVEC( 9,0,PVEC)                                                                             
      CALL SVEC(10,0,EVEC)                                                                             
      CALL SVEC(11,0,AVEC)                                                                             
      CALL SVEC(12,0,BVEC)                                                                             
      CALL SVEC(13,0,VVEC)                                                                             
      CALL SVEC(14,0,HVEC)                                                                             
      CALL SVEC(15,0,CVEC)                                                                             
      CALL SVEC(16,0,TVEC)                                                                             
                                                                        
                                                                        
      RETURN                                                            
      END                                                               
*