C
       SUBROUTINE QUIBOS
CKEY BANKS INIT /USER
C----------------------------------------------------------------------
C! initialize BOS
C called form QMINIT
C                                                   H.Albrecht 20.09.88
C----------------------------------------------------------------------
*IF .NOT.DOC

 
      PARAMETER (MXBNK = 3000, LQBOS =1 200 000)
      COMMON /BCS/  IW(LQBOS)
C
      CALL QWMESS
     +    ('_QUIBOS_ Init BOS with 500,000 words working space')
      CALL BNAMES (MXBNK)
      CALL BOS (IW,LQBOS)
C               no time / event limit in the BOS read routines :
      END


C*HE 10/11/95 11:36:55 S                                                        
C*DK QUIHIS                                                                      
      SUBROUTINE QUIHIS                                                         
CKEY HIST INIT /USER                                                            
C----------------------------------------------------------------------         
C! initialize histogram package                                                 
C called from QMINIT                                                            
C                                                   H.Albrecht 20.09.88         
C                                       modified    J.Boucrot  03.05.93         
C----------------------------------------------------------------------         
C*IF .NOT.DOC                                                                    
C                                                                                                                                                             #include "qcde.h"                                          
      PARAMETER (LQPAW = 2000000)                                                
      COMMON /PAWC/ PAWC(LQPAW)                                                 
C                                                                               
C       HBOOK initialisation                                                    
C                                                                               
      IF (KDEBUG.NE.0)  THEN                                                    
         WRITE ( KUPRNT , 1001 ) LQPAW                                          
         IF (KUPTER.NE.0) WRITE ( KUPTER , 1001 ) LQPAW                         
      ENDIF                                                                     
      CALL HLIMIT (LQPAW)                                                       
C                                                                               
C       read HISTOGRAM AND HTITLE card and open histogram file                  
C                                                                               
      CALL QMIHIS                                                               
C                                                                               
 1001 FORMAT ('0_QUIHIS_ Init HBOOK4 with ',I8,' words working space')          
      END                                                                      


      SUBROUTINE QUINIT
C-----------------------------------------------------------------------
C  OFFICIAL VERSION OF SELECTION PROGRAM                MP 29/11/89
C*****************************************************
C  CALL QWRITE COMMENTED                             *
C  NO LUMI CALCULATION                               *
C  HISTOGRAMS COMMENTED                              *
C*****************************************************
C------------------------------------------------------------------------
C
C! user initialisation
#include "qcde.h"  
#include "qmacro.h"

       CALL EBINIT(IER)
*
       CALL COMP_INIT
*
       CALL INI_BOSE
*
       CALL HBOOK1(10000,'mean mass',50,20.,90.,0.)
       CALL HBOOK1(20000,'mean mass',200,70.,90.,0.)
       DO I=1,41
        CALL HBOOK1(10000+I,'reweight mean mass',50,20.,90.,0.)
        CALL HBOOK1(20000+I,'reweight mean mass',200,70.,90.,0.)
        CALL HBOOK1(21000+I,'REWEIGHT MASS EXCA',200,70.,90.,0.)
       ENDDO
      RETURN
      END   

C
      SUBROUTINE QUTERM
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
#include "qcde.h"
#include "qmacro.h"
      CALL END_BOSE
      END




      SUBROUTINE QUEVNT (QT,KT,QV,KV)
C-----------------------------------------------------------------------
C  Process one event
C-----------------------------------------------------------------------

#include "qcde.h"
C      DIMENSION QT(KCQVEC,1), KT(KCQVEC,1), QV(KCQVRT,1), KV(KCQVRT,1)
#include "qmacro.h"
*
      if(mod(kevt,100).eq.0) print *,'new event',kevt
      call GENERAL1
      call boseinstein(weight)
*     
      RETURN
      END


      SUBROUTINE GENERAL1
C-----------------------------------------------------------------------
C  Process one event
C-----------------------------------------------------------------------

#include "qdecl.h"
#include "qcde.h"
      COMMON/NTUPLE/XNT(32)
      COMMON/WW4F/IGAMI(10),IWW4F(4),IGAMF(5)
      DIMENSION DTGC(5)
      LOGICAL IWW,IZZ
      DOUBLE PRECISION XM_W,DTGC,XSECI,XSECF,AL_QED
#include "qmacro.h"
*
      IWW=0
      ETOT=0.
      CALL VZERO(DTGC,5)
      CALL SWW4F
      CALL GEN_4F
      CALL ZZ(IWW,IZZ)
*      print *,'test',kevt,ktpcod(iww4f(1)),ktpcod(iww4f(2)),
*     &     ktpcod(iww4f(3)),ktpcod(iww4f(4)),iww,izz
*
      IF(ABS(QCH(IWW4F(1))+QCH(IWW4F(2))).EQ.1) IWW=1
      IF(QCH(IWW4F(1))+QCH(IWW4F(2)).GT.0.) 
     &     print *,'sum wrong',kevt,(ktpcod(iww4f(i)),i=1,4)
*
      ETOT=XNT(32)+XNT(27)+XNT(22)+XNT(17)+XNT(12)+XNT(7)
*
C      IF(KNMOTH(IWW4F(1)).GT.0) THEN
C       XNT(33)=QM(KMOTH(IWW4F(1),1))
C       XNT(34)=QM(KMOTH(IWW4F(3),1))
C       XMEAN=(QM(KMOTH(IWW4F(1),1))+QM(KMOTH(IWW4F(3),1)))/2.
C       CALL REWEI(xmean,iww)
C      ENDIF
C      ikpar=nlink('KPAR',0)
C      al_qed=  1d0/rw(ikpar+25)
C      Wmassnom=rw(ikpar+28)
C      XM_W=1d0*Wmassnom
C      CALL QEXMTX(0,IWW4F,AL_QED,XM_W,dtgc,XSECI)
C      DO IY=1,41
C       WREF=80.25
C       DWREF=0.05
C        XM_W=DBLE(WREF+FLOAT(IY-21)*DWREF)
C       CALL QEXMTX(0,IWW4F,AL_QED,XM_W,dtgc,XSECF)
C       XRAP=XSECF/XSECI
C       CALL HFILL(21000+IY,XMEAN,0.,XRAP)
C       IF(IY.EQ.31) print *,'exca',xrap
C      ENDDO
      END

      subroutine rewei(xm,iww)
*
       wref=80.25
       dwref=0.05
       call hfill(10000,xm,0.,1.)
       call hfill(20000,xm,0.,1.)
        do i=1,41
       wmassi=wref+float(i-21)*dwref
       wwidtho=-10.
       weight=1.
        if(iww.eq.1) then
         weight=WmassWeiKWCC03(wmassi,wwidtho)
        else
         weight=1.
        endif
        call hfill(10000+i,xm,0.,weight)
        call hfill(10000+i,xm,0.,weight)
        call hfill(20000+i,xm,0.,weight)
*       if(i.eq.31) print *,'weight',wmassi,weight
       enddo
      end



















