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