ISAJET/code/setw.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SETW
   3 C
   4 C          Set the W parameters in /WCON/.
   5 C          SIN2W         = sin**2(theta-sub-w)
   6 C          AQ, BQ        = vector, axial couplings normalized to ALFA.
   7 C          MATCH(IQ1,IW) = Cabibbo favored type for W --> QK1 + QK2.
   8 C          WCBR(IQ,IW)   = cumulative branching ratio for JETTYP(1)=IQ
   9 C
  10 #if defined(CERNLIB_IMPNONE)
  11       IMPLICIT NONE
  12 #endif
  13 #include "isajet/itapes.inc"
  14 #include "isajet/keys.inc"
  15 #include "isajet/wcon.inc"
  16 #include "isajet/qlmass.inc"
  17 #include "isajet/q1q2.inc"
  18 #include "isajet/nodcay.inc"
  19 #include "isajet/const.inc"
  20 #include "isajet/xmssm.inc"
  21 C
  22       REAL SINW,COSW,AMW,AMZ,AW,FACZ,GAMW,GAMZ,TERM,SUM,AM1,AMASS,AM2
  23       INTEGER I1,I2,I3,J,INDEX,IFL,NGAM,NUP,IW,IQ1,IQ2,IFL1,JET,IQ,IFL2
  24       INTEGER IW1
  25       REAL T3(12),EQ3(12)
  26       INTEGER NUTYP(25),LISTJ(25)
  27 #if defined(CERNLIB_SINGLE)
  28       REAL SIN2WD,SINWD,COSWD,AWD,FACZD
  29 #endif
  30 #if defined(CERNLIB_DOUBLE)
  31       DOUBLE PRECISION SIN2WD,SINWD,COSWD,AWD,FACZD
  32 #endif
  33       DATA T3/.5,-.5,-.5,.5,-.5,.5,.5,-.5,.5,-.5,.5,-.5/
  34       DATA EQ3/2.,-1.,-1.,2.,-1.,2.,0.,-3.,0.,-3.,0.,-3./
  35       DATA NUTYP/13*0,1,1,0,0,1,1,0,0,1,1,0,0/
  36       DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,
  37      $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/
  38 C
  39 C          Masses can be changed with WMASS
  40 C
  41       SINW=SQRT(SIN2W)
  42       COSW=SQRT(1.-SIN2W)
  43       AMW=WMASS(2)
  44       AMZ=WMASS(4)
  45 C
  46 C          Couplings for Weinberg-Salam model
  47 C
  48       AW=1./(2.*SQRT2*SINW)
  49       FACZ=1./(2.*SINW*COSW)
  50       EZ=SQRT((1.-SIN2W)/SIN2W)
  51       DO 110 IFL=1,12
  52         AQ(IFL,1)=EQ3(IFL)/3.
  53         BQ(IFL,1)=0.
  54         AQ(IFL,2)=AW
  55         BQ(IFL,2)=AW
  56         AQ(IFL,3)=AW
  57         BQ(IFL,3)=AW
  58         AQ(IFL,4)=FACZ*(T3(IFL)-2.*EQ3(IFL)/3.*SIN2W)
  59         BQ(IFL,4)=FACZ*T3(IFL)
  60 110   CONTINUE
  61 #if defined(CERNLIB_SINGLE)
  62 C          Double precision couplings not needed.
  63       EZDP=EZ
  64       DO 120 IW=1,4
  65       DO 120 IFL=1,12
  66         AQDP(IFL,IW)=AQ(IFL,IW)
  67         BQDP(IFL,IW)=BQ(IFL,IW)
  68 120   CONTINUE
  69 #endif
  70 #if defined(CERNLIB_DOUBLE)
  71 C          Double precision couplings for 32-bit machines.
  72       SIN2WD=SIN2W
  73       SINWD=DSQRT(SIN2WD)
  74       COSWD=DSQRT(1.-SIN2WD)
  75       AWD=1./(2.*DSQRT(2.D0)*SINWD)
  76       FACZD=1./(2.*SINWD*COSWD)
  77       EZDP=COSWD/SINWD
  78       DO 120 IFL=1,12
  79         AQDP(IFL,1)=EQ3(IFL)/3.D0
  80         BQDP(IFL,1)=0.
  81         AQDP(IFL,2)=AWD
  82         BQDP(IFL,2)=AWD
  83         AQDP(IFL,3)=AWD
  84         BQDP(IFL,3)=AWD
  85         AQDP(IFL,4)=FACZD*(T3(IFL)-2.D0*EQ3(IFL)/3.D0*SIN2WD)
  86         BQDP(IFL,4)=FACZD*T3(IFL)
  87 120   CONTINUE
  88 #endif
  89 C
  90 C          Widths
  91 C
  92       NGAM=12
  93       IF(AMLEP(5)+AMLEP(6).GT.AMW) NGAM=9
  94       GAMW=GF*AMW**3/(6.*PI*SQRT2)*NGAM
  95       NUP=3
  96       IF(2.*AMLEP(6).GT.AMZ) NUP=2
  97       GAMZ=NUP*3.*(AQ(1,4)**2+BQ(1,4)**2)+3.*3.*(AQ(2,4)**2+BQ(2,4)**2)
  98      1+3.*(AQ(7,4)**2+BQ(7,4)**2+AQ(8,4)**2+BQ(8,4)**2)
  99       GAMZ=GAMZ*2./FACZ**2
 100       GAMZ=GAMZ*GF*AMZ**3/(12.*PI*SQRT2)
 101       WGAM(1)=0.
 102       WGAM(2)=GAMW
 103       WGAM(3)=GAMW
 104       WGAM(4)=GAMZ
 105 C
 106 C          Branching ratios for secondary W+- and Z0
 107 C
 108       DO 210 IW=2,4
 109         IW1=IW-1
 110         SUM=0.
 111         CUMWBR(1,IW1)=0.
 112         DO 220 IQ1=2,25
 113           CUMWBR(IQ1,IW1)=CUMWBR(IQ1-1,IW1)
 114           IQ2=MATCH(IQ1,IW)
 115           IF(IQ2.EQ.0) GO TO 220
 116           IF(.NOT.(GOWMOD(IQ1,IW-1).AND.GOWMOD(IQ2,IW-1))) GO TO 220
 117           IFL1=LISTJ(IQ1)
 118           IFL2=LISTJ(IQ2)
 119           AM1=AMASS(IFL1)
 120           AM2=AMASS(IFL2)
 121           IF(AM1+AM2.GE.WMASS(IW)) GO TO 220
 122           TERM=AQ(IQ1/2,IW)**2+BQ(IQ1/2,IW)**2
 123           IF(IQ1.LE.13) TERM=3.*TERM
 124           CUMWBR(IQ1,IW1)=CUMWBR(IQ1-1,IW1)+TERM
 125           SUM=SUM+TERM
 126 220     CONTINUE
 127         IF(SUM.LE.0.) THEN
 128           WRITE(ITLIS,2000) IW
 129 2000      FORMAT(//' ***** NO ALLOWED DECAY MODE FOR SECONDARY W TYPE',
 130      $    I2,' *****')
 131           STOP 99
 132         ENDIF
 133         DO 230 IQ1=2,25
 134           CUMWBR(IQ1,IW1)=CUMWBR(IQ1,IW1)/SUM
 135 230     CONTINUE
 136 210   CONTINUE
 137 C
 138 C          Decay channels for DRELLYAN
 139 C
 140       IF(KEYS(3)) THEN
 141         DO 310 IW=1,4
 142           COUT(IW)=0.
 143           IF(.NOT.GODY(IW)) GO TO 310
 144           DO 320 IQ1=2,25
 145             IQ2=MATCH(IQ1,IW)
 146             IF(IQ2.EQ.0) GO TO 320
 147             IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 320
 148             IF(NUTYP(IQ1)*NUTYP(IQ2).EQ.1.AND.NONUNU) GO TO 320
 149             IFL1=IQ1/2
 150             TERM=.5*(AQ(IFL1,IW)**2+BQ(IFL1,IW)**2)
 151             IF(IQ1.LE.13) TERM=3.*TERM
 152             COUT(IW)=COUT(IW)+TERM
 153 320       CONTINUE
 154           IF(COUT(IW).EQ.0.) THEN
 155             WRITE(ITLIS,3000) IW
 156 3000        FORMAT(//' ***** ERROR IN SETW ... NO ALLOWED DECAY MODE ',
 157      $      'FOR W TYPE',I2,' *****')
 158             STOP 99
 159           ENDIF
 160 310     CONTINUE
 161 C          W branching ratios
 162         DO 330 IW=1,4
 163           IF(.NOT.GODY(IW)) GO TO 330
 164           SUM=0.
 165           DO 340 IQ1=1,25
 166             WCBR(IQ1,IW)=SUM
 167             IQ2=MATCH(IQ1,IW)
 168             IF(IQ2.EQ.0) GO TO 340
 169             IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 340
 170             IF(NUTYP(IQ1)*NUTYP(IQ2).EQ.1.AND.NONUNU) GO TO 340
 171             IFL1=IQ1/2
 172             TERM=.5*(AQ(IFL1,IW)**2+BQ(IFL1,IW)**2)/COUT(IW)
 173             IF(IQ1.LE.13) TERM=3.*TERM
 174             SUM=SUM+TERM
 175             WCBR(IQ1,IW)=SUM
 176 340       CONTINUE
 177 330     CONTINUE
 178       ENDIF
 179 C
 180 C          Calculate branching ratios for WPAIR events summed over
 181 C          modes allowed by WMODE cards.
 182 C          TBRWW = total allowed branching ratio.
 183 C          RBRWW = relative branching ratios.
 184 C          TBRWW*RBRWW = physical branching ratios.
 185 C
 186       IF((KEYS(2).AND.(.NOT.GOMSSM)).OR.KEYS(6)
 187      ,.OR.KEYS(7).OR.KEYS(9).OR.KEYS(10)) THEN
 188         DO 400 JET=1,2
 189           TBRWW(1,JET)=1.
 190           DO 410 IW=2,4
 191             TBRWW(IW,JET)=0.
 192             IF(KEYS(6).OR.KEYS(9)) THEN
 193               IF(.NOT.GOQ(IW,JET)) GO TO 410
 194             ELSEIF((KEYS(2).OR.KEYS(7).OR.KEYS(10)).AND..NOT.GOMSSM)THEN
 195               IF(.NOT.GOQ(IW+25,JET)) GO TO 410
 196             ELSEIF((KEYS(7).OR.KEYS(10)).AND.GOMSSM) THEN
 197               IF(.NOT.GOQ(IW+76,JET)) GO TO 410
 198             ENDIF
 199             SUM=0.
 200             DO 420 IQ=1,12
 201               RBRWW(IQ,IW,JET)=0.
 202               IQ1=2*IQ
 203               IQ2=MATCH(IQ1,IW)
 204               IF(IQ2.EQ.0) GO TO 420
 205               IFL1=IQ1/2
 206               IF(IQ1.GT.13) IFL1=IFL1+4
 207               IFL2=IQ2/2
 208               IF(IQ2.GT.13) IFL2=IFL2+4
 209               AM1=AMASS(IFL1)
 210               AM2=AMASS(IFL2)
 211               IF(AM1+AM2.GE.WMASS(IW)) GO TO 420
 212               TERM=AQ(IQ1/2,IW)**2+BQ(IQ1/2,IW)**2
 213               IF(IQ1.LE.13) TERM=3*TERM
 214               SUM=SUM+TERM
 215               IF(.NOT.(GOWW(IQ1,JET).AND.GOWW(IQ2,JET))) GO TO 420
 216               RBRWW(IQ,IW,JET)=TERM
 217               TBRWW(IW,JET)=TBRWW(IW,JET)+TERM
 218 420         CONTINUE
 219             TBRWW(IW,JET)=TBRWW(IW,JET)/SUM
 220             IF(TBRWW(IW,JET).GT.0.) THEN
 221               DO 430 IQ=1,12
 222 430           RBRWW(IQ,IW,JET)=RBRWW(IQ,IW,JET)/(SUM*TBRWW(IW,JET))
 223             ELSE
 224               WRITE(ITLIS,445) IW,JET
 225 445           FORMAT(/' ***** NO ALLOWED MODE FOR W TYPE ',I2,
 226      $        ' IN JET ',I2,' *****'/)
 227               STOP 99
 228             ENDIF
 229 410       CONTINUE
 230 400   CONTINUE
 231       ENDIF
 232       RETURN
 233       END