c     ============
      program main
c     ============
c
c --- Combine W mass results : allow for common error.
c --- All hard-wired to avoid typing cock-ups...
c
      implicit  none
      integer  np,id0,ic
      real     ec,chisq,mw(100),ew(100),mw_ua2(100),mw_cdf(100),
     +         mw_d0a(100),mw_ccfr(100),mw_lep(100),
     +         cdf_ec,d0_ec,tev_ec,had_ec,lep_161_ec,lep_172_ec,mwo(2),
     +         lep_ec,mwhad(2),mwlep(2),mwd0(2),
     +         mwcdf(2),mwtev(2),mwleph(2),mwworld(2),
     +         mw_d0(100),
     +         mw_cdf1b_1(100),mw_cdf1b_1_ec,
     +         mw_cdf1b_2(100),mw_cdf1b_2_ec

c
c ----------------------- UA2 --------------------------------------------
c
      data  mw_ua2  / 80.360, 0.370, 98*0.0 /   ! CORRECTED FROM PUBLISHED FOR
                                                ! UPTO DATE LEP Z-MASS
c 
c ---------------------- CDF ---------------------------------------------
c
c --- Using Z->>> ee and Z->> mumu
      data  mw_cdf1b_1 /    80.465, 0.145,       ! RUN 1B = PRELIMINARY
     +                      80.475, 0.115,
     +                      96*0.0 /
      data mw_cdf1b_1_ec /  0.015 /       ! internal CDF common  

c --- Using Z->>> ee and Upsilon->mumu
      data  mw_cdf1b_2 /   80.440, 0.120,       ! RUN 1B = PRELIMINARY
     +                     80.475, 0.115,
     +                     96*0.0 /
      data mw_cdf1b_2_ec /  0.015 /       ! internal CDF common  

      data  mw_cdf / 79.935, 0.390,       ! RUN 0  = 79.91 (+40-25 PDF)
     +               80.385, 0.180,       ! RUN 1A = 80.41 (-25 PDF)
     +               96*0.0 /
c -- error between 1B + rest
      data cdf_ec /  0.015 /       ! internal CDF common  (tracking,pdf,ptw)


      data  mw_d0 / 80.350, 0.270,       ! RUN-1A = PUBLISHED.
     +              80.498, 0.095,       ! RUN-1B (UPDATED)
     +              96*0.0 /

      data d0_ec /  0.050  / ! common error : calibration, pdf, ptw
c                
c -------------------- TEVATRON/HADRON COLLIDER COMMON UNCERTAINTIES -----
c
      data tev_ec / 0.025 / ! tevatron common error
      data had_ec / 0.025 / ! hadron collider common error.

c
c ------------------- CCFR  -----------------------------------------------
c         
      data  mw_ccfr / 80.250 , 0.110, 98*0.0   /  ! JULY-98
c
c ------------------ LEP-2 ------------------------------------------------
c
      data  mw_lep  / 80.427, 0.046,
     +                98*0.0    /    ! LEP COMBINED : JULY-98
      data  lep_ec  / 0.000/
c
c ------------------------------------------------------------------------
c
      ic = 1
      if (ic.eq.1) then
         call copyp(2,mw_cdf1b_1,1,mw,ew)
         call makeav(2,mw,ew,mw_cdf1b_1_ec,
     +               ' *** CDF-1B : Zs COMBINED ***',
     +                chisq,mwcdf)
      elseif (ic.eq.2) then
         call copyp(2,mw_cdf1b_2,1,mw,ew)
         call makeav(2,mw,ew,mw_cdf1b_2_ec,
     +              ' *** CDF-1B : Ups COMBINED ***',
     +               chisq,mwcdf)
      endif


      call copyp(2,mw_cdf,1,mw,ew)
      call copyp(1,mwcdf,3,mw,ew)
      call makeav(3,mw,ew,cdf_ec,' *** CDF COMBINED ***',
     +            chisq,mwcdf)

      call copyp(2,mw_d0,1,mw,ew)
      call makeav(2,mw,ew,d0_ec,' *** D0 COMBINED ***',
     +            chisq,mwd0)

      mwd0(1) = 80.482
      mwd0(2) = 0.091
c      mwd0(1) = 80.474
c      mwd0(2) = 0.093
      call copyp(1,mwcdf,1,mw,ew)
      call copyp(1,mwd0,2,mw,ew)
      call makeav(2,mw,ew,tev_ec,' *** CDF+D0 COMBINED ***',
     +            chisq,mwtev)

      call copyp(1,mwtev,1,mw,ew)
      call copyp(1,mw_ua2,2,mw,ew)
      call makeav(2,mw,ew,had_ec,' *** CDF+D0+UA2 COMBINED ***',
     +            chisq,mwhad)


      call copyp(1,mw_lep,1,mw,ew)
      call makeav(1,mw,ew,lep_ec,' *** LEP-ALL ***',
     +            chisq,mwlep)


      call copyp(1,mwlep,1,mw,ew)
      call copyp(1,mwhad,2,mw,ew)
      call makeav(2,mw,ew,lep_ec,' *** LEP+HADRONS ***',
     +            chisq,mwleph)

      call copyp(1,mwleph,1,mw,ew)
      call copyp(1,mw_ccfr,2,mw,ew)
      call makeav(2,mw,ew,lep_ec,' *** LEP+HADRONS+CCFR ***',
     +            chisq,mwworld)

      stop
      end

c     ===============================================
      subroutine copyp(ncopy,mw_in,is,mw_out,mwe_out)
c     ===============================================


      implicit none

      real    mw_in(100),mwe_in(100),mw_out(100),mwe_out(100)
      integer ncopy,is,i,j



      j = 0
      do i = 1,ncopy
         j = j + 1
         mw_out((is-1)+i)  = mw_in(j)
         j = j + 1
         mwe_out((is-1)+i) = mw_in(j)
      enddo

      return
      end

c     =============================================
      subroutine makeav(np,mw,ew,ec,text,chisq,mwo)
c     =============================================

      implicit      none
      integer       np,i,lenocc
      real          ec,chisq,wt,smw,xmw,xme,prob,xx
      real          mw(100),ew(100),ewu(100),mwo(2)
      character*(*) text
      external      lenocc,prob


      do i = 1,np
         ewu(i) = sqrt(ew(i)**2 - ec**2)  ! uncorrelated part of error.
      enddo

      wt  = 0.0
      smw = 0.0
      do i = 1,np
         wt  = wt + 1/ewu(i)**2
         smw = smw + mw(i)/ewu(i)**2
      enddo

      xmw = smw/wt
      xme = sqrt( (1/wt) + ec**2 )

      chisq = 0.
      do i = 1,np
         chisq = chisq + (mw(i)-xmw)**2/ew(i)**2
      enddo

      write(*,*) ' '
      write(*,90) text(1:lenocc(text))
      do i = 1,np
         write(*,91) mw(i),ew(i)
      enddo
      
      xx = 0.000
      if (np.gt.1) xx = prob(chisq,(np-1))
      write(*,92) xmw,xme,chisq,(np-1),xx
      write(*,93) ec

      mwo(1) = xmw
      mwo(2) = xme

 90   format(' AVERAGING ::: ',a32)
 91   format(' MW = ',f6.3,' ERROR = ',F6.3)
 92   format(' AV MW = ',f6.3,' ERROR = ',F6.3,
     +       ' Chisq/df = ',f8.5,'/',i2,' PROB = ',F6.4)
 93   format(' COMMON ERROR USED  = ',F6.3)

      return
      end
