PHOS/shaker/luxkfl.f

   1 *CMZ :          17/07/98  15.44.35  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC)
   6
   7 C...Purpose: to select flavour for produced qqbar pair.
   8 *KEEP,LUDAT1.
   9       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  10       SAVE /LUDAT1/
  11 *KEEP,LUDAT2.
  12       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  13       SAVE /LUDAT2/
  14 *KEND.
  15
  16 C...Calculate maximum weight in QED or QFD case.
  17       IF(MSTJ(102).LE.1) THEN
  18         RFMAX=4./9.
  19       ELSE
  20         POLL=1.-PARJ(131)*PARJ(132)
  21         SFF=1./(16.*PARU(102)*(1.-PARU(102)))
  22         SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
  23         SFI=SFW*(1.-(PARJ(123)/ECMC)**2)
  24         VE=4.*PARU(102)-1.
  25         HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131))
  26         HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))
  27         RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+
  28      &  ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.*
  29      &  (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W)
  30       ENDIF
  31
  32 C...Choose flavour. Gives charge and velocity.
  33       NTRY=0
  34   100 NTRY=NTRY+1
  35       IF(NTRY.GT.100) THEN
  36         CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop')
  37         KFLC=0
  38         RETURN
  39       ENDIF
  40       KFLC=KFL
  41       IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0))
  42       MSTJ(93)=1
  43       PMQ=ULMASS(KFLC)
  44       IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100
  45       QF=KCHG(KFLC,1)/3.
  46       VQ=1.
  47       IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2))
  48
  49 C...Calculate weight in QED or QFD case.
  50       IF(MSTJ(102).LE.1) THEN
  51         RF=QF**2
  52         RFV=0.5*VQ*(3.-VQ**2)*QF**2
  53       ELSE
  54         VF=SIGN(1.,QF)-4.*QF*PARU(102)
  55         RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W
  56         RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+
  57      &  VQ**3*HF1W
  58       ENDIF
  59
  60 C...Weighting or new event (radiative photon). Cross-section update.
  61       IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100
  62       PARJ(158)=PARJ(158)+1.
  63       IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0
  64       IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100
  65       IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1.
  66       PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158)
  67       PARJ(148)=PARJ(144)*86.8/ECM**2
  68
  69       RETURN
  70       END