| 0795afa3 |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame