ISAJET/code/seth.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SETH
   3 C
   4 C          Set the standard Weinberg-Salam Higgs parameters in /HCON/.
   5 C          HMASS  = Higgs mass
   6 C          HGAM   = Higgs width
   7 C          HGAMS  = Higgs partial width
   8 C          ZSTARS = minimum allowed mass for Z*
   9 C
  10 C          IQ = 1  2  3  4  5  6  7  8  9  10 11 12 13
  11 C               GL UP UB DN DB ST SB CH CB BT BB TP TB
  12 C          IQ = 14  15   16 17 18   19   20  21  22  23   24   25
  13 C               NUE ANUE E- E+ NUMU ANUM MU- MU+ NUT ANUT TAU- TAU+
  14 C          IQ = 26 27 28 29
  15 C               GM W+ W- Z0
  16 C
  17 C          Ver 6.25: Added H -> GM GM.
  18 C          Ver 6.26: Added H -> Z0 Z* from Keung and Marciano, Phys.
  19 C                    Rev. D30, 248 (1984).
  20 C          Ver 6.30: Fixed sign of FFR in H -> GM GM for TAU<1. Added
  21 C                    H -> W W* to total width but not to partial widths
  22 C                    to get right branching ratios.
  23 C          Ver 7.38: Add H_SM decay modes to SSSAVE for use in WHIGGS
  24 C
  25 #if defined(CERNLIB_IMPNONE)
  26       IMPLICIT NONE
  27 #endif
  28 #include "isajet/itapes.inc"
  29 #include "isajet/keys.inc"
  30 #include "isajet/wcon.inc"
  31 #include "isajet/qlmass.inc"
  32 #include "isajet/q1q2.inc"
  33 #include "isajet/nodcay.inc"
  34 #include "isajet/const.inc"
  35 #include "isajet/hcon.inc"
  36 C
  37       REAL GAMFCN,X,AMASS,AMQ,GAMQ,AML,WM,GAMWW,TAU,FFR,FFI,FR,FI,
  38      $ROOT,ROOTLN,TM,SUMBR,TERM,ETAR,ETAI,RQ,RQLOG,PHIR,PHII
  39       REAL EPS,FEPS,AM12
  40       INTEGER IQ,IQ1,IQ2,I,IW
  41       INTEGER LISTJ(25),LISTW(4)
  42       DATA LISTJ/
  43      $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,
  44      $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/
  45       DATA LISTW/10,80,-80,90/
  46 C
  47       GAMFCN(X)=SQRT(1.-4*X**2)*(1.-4.*X**2+12.*X**4)
  48 C
  49 C          Calculate Higgs mass and width
  50 C
  51       HMASS=AMASS(81)
  52       HGAM=0.
  53       DO 100 IQ=1,29
  54 100   HGAMS(IQ)=0.
  55 C
  56 C          Quarks and leptons
  57       DO 110 IQ=1,6
  58         AMQ=AMASS(IQ)
  59         IF(AMQ.GT.0..AND.AMQ.LT..5*HMASS) THEN
  60           GAMQ=3.*GF*AMQ**2*HMASS/(4.*PI*SQRT2)
  61      $    *(SQRT(1.-4.*AMQ**2/HMASS**2))**3
  62           HGAM=HGAM+GAMQ
  63           HGAMS(2*IQ)=.5*GAMQ
  64           HGAMS(2*IQ+1)=.5*GAMQ
  65           CALL SSSAVE(81,GAMQ,IQ,-IQ,0,0,0)
  66         ENDIF
  67         AML=AMASS(IQ+10)
  68         IF(AML.GT.0..AND.AML.LT..5*HMASS) THEN
  69           GAMQ=GF*AML**2*HMASS/(4.*PI*SQRT2)
  70      $    *(SQRT(1.-4.*AML**2/HMASS**2))**3
  71           HGAM=HGAM+GAMQ
  72           HGAMS(2*IQ+12)=.5*GAMQ
  73           HGAMS(2*IQ+13)=.5*GAMQ
  74           CALL SSSAVE(81,GAMQ,IQ+10,-(IQ+10),0,0,0)
  75         ENDIF
  76 110   CONTINUE
  77 C
  78 C          W+ W- and Z0 Z0, including W W* and Z Z*.
  79       WM=WMASS(2)
  80       IF(HMASS.GT.2.*WM) THEN
  81         GAMWW=GF*HMASS**3*GAMFCN(WM/HMASS)/(8.*PI*SQRT2)
  82         HGAM=HGAM+GAMWW
  83         HGAMS(27)=.5*GAMWW
  84         HGAMS(28)=.5*GAMWW
  85         CALL SSSAVE(81,GAMWW,80,-80,0,0,0)
  86       ELSEIF(HMASS.GT.WM) THEN
  87         EPS=WM/HMASS
  88         FEPS=3.*(1.-8.*EPS**2+20.*EPS**4)/SQRT(4.*EPS**2-1.)
  89      $  *ACOS((3.*EPS**2-1.)/(2.*EPS**3))
  90      $  -(1.-EPS**2)*(47./2.*EPS**2-13./2.+1./EPS**2)
  91      $  -3.*(1.-6.*EPS**2+4.*EPS**4)*ALOG(EPS)
  92         GAMWW=3.*ALFA**2*HMASS/(32.*PI*SIN2W**2)*FEPS
  93         HGAM=HGAM+GAMWW
  94         HGAMS(27)=.5*GAMWW
  95         HGAMS(28)=.5*GAMWW
  96         CALL SSSAVE(81,GAMWW/18.,80,12,-11,0,0)
  97         CALL SSSAVE(81,GAMWW/18.,-80,-12,11,0,0)
  98         CALL SSSAVE(81,GAMWW/18.,80,14,-13,0,0)
  99         CALL SSSAVE(81,GAMWW/18.,-80,-14,13,0,0)
 100         CALL SSSAVE(81,GAMWW/18.,80,16,-15,0,0)
 101         CALL SSSAVE(81,GAMWW/18.,-80,-16,15,0,0)
 102         CALL SSSAVE(81,GAMWW/6.,80,-1,2,0,0)
 103         CALL SSSAVE(81,GAMWW/6.,-80,1,-2,0,0)
 104         CALL SSSAVE(81,GAMWW/6.,80,-4,3,0,0)
 105         CALL SSSAVE(81,GAMWW/6.,-80,4,-3,0,0)
 106       ENDIF
 107       WM=WMASS(4)
 108       IF(HMASS.GT.2.*WM) THEN
 109         GAMWW=GF*HMASS**3*GAMFCN(WM/HMASS)/(16.*PI*SQRT2)
 110         HGAM=HGAM+GAMWW
 111         HGAMS(29)=GAMWW
 112         CALL SSSAVE(81,GAMWW,90,90,0,0,0)
 113       ELSEIF(HMASS.GT.WM) THEN
 114         EPS=WM/HMASS
 115         FEPS=3.*(1.-8.*EPS**2+20.*EPS**4)/SQRT(4.*EPS**2-1.)
 116      $  *ACOS((3.*EPS**2-1.)/(2.*EPS**3))
 117      $  -(1.-EPS**2)*(47./2.*EPS**2-13./2.+1./EPS**2)
 118      $  -3.*(1.-6.*EPS**2+4.*EPS**4)*ALOG(EPS)
 119         GAMWW=ALFA**2*HMASS/(128.*PI*SIN2W**2*(1.-SIN2W)**2)
 120      $  *(7.-40./3.*SIN2W+160./9.*SIN2W**2)*FEPS
 121         HGAM=HGAM+GAMWW
 122         HGAMS(29)=GAMWW
 123         CALL SSSAVE(81,.11922*GAMWW,90,-1,1,0,0)
 124         CALL SSSAVE(81,.15375*GAMWW,90,-2,2,0,0)
 125         CALL SSSAVE(81,.15375*GAMWW,90,-3,3,0,0)
 126         CALL SSSAVE(81,.11922*GAMWW,90,-4,4,0,0)
 127         CALL SSSAVE(81,.15375*GAMWW,90,-5,5,0,0)
 128         CALL SSSAVE(81,.06668*GAMWW,90,-11,11,0,0)
 129         CALL SSSAVE(81,.03343*GAMWW,90,-12,12,0,0)
 130         CALL SSSAVE(81,.06668*GAMWW,90,-13,13,0,0)
 131         CALL SSSAVE(81,.03343*GAMWW,90,-14,14,0,0)
 132         CALL SSSAVE(81,.06668*GAMWW,90,-15,15,0,0)
 133         CALL SSSAVE(81,.03343*GAMWW,90,-16,16,0,0)
 134       ENDIF
 135 C          W* and Z* mass limits
 136       DO 120 I=1,2
 137         ZSTARS(1,I)=0.
 138         DO 130 IW=2,4
 139           ZSTARS(IW,I)=AMASS(LISTW(IW))
 140           DO 140 IQ1=2,25
 141             IQ2=MATCH(IQ1,IW)
 142             IF(IQ2.EQ.0) GO TO 140
 143             IF(GOWW(IQ1,1).AND.GOWW(IQ2,2)) THEN
 144               AM12=AMASS(LISTJ(IQ1))+AMASS(LISTJ(IQ2))
 145               ZSTARS(IW,I)=MIN(ZSTARS(IW,I),AM12)
 146             ENDIF
 147 140       CONTINUE
 148 130     CONTINUE
 149 120   CONTINUE
 150 C
 151 C          GM GM -- W loop term
 152       WM=WMASS(2)
 153       TAU=4.*WM**2/HMASS**2
 154       IF(TAU.GE.1.0) THEN
 155         FFR=(ASIN(1./SQRT(TAU)))**2
 156         FFI=0.
 157       ELSE
 158         ROOT=SQRT(1.-TAU)
 159         ROOTLN=ALOG((1.+ROOT)/(1.-ROOT))
 160         FFR=-0.25*(ROOTLN**2-PI**2)
 161         FFI=0.5*PI*ROOTLN
 162       ENDIF
 163       FR=2.+3.*TAU+3.*TAU*(2.-TAU)*FFR
 164       FI=3.*TAU*(2.-TAU)*FFI
 165 C          Top loop term
 166       TM=AMASS(6)
 167       TAU=4.*TM**2/HMASS**2
 168       IF(TAU.GE.1.0) THEN
 169         FFR=(ASIN(1./SQRT(TAU)))**2
 170         FFI=0.
 171       ELSE
 172         ROOT=SQRT(1.-TAU)
 173         ROOTLN=ALOG((1.+ROOT)/(1.-ROOT))
 174         FFR=-0.25*(ROOTLN**2-PI**2)
 175         FFI=0.5*PI*ROOTLN
 176       ENDIF
 177       FR=FR-8./3.*TAU*(1.+(1.-TAU)*FFR)
 178       FI=FI-8./3.*TAU*(1.-TAU)*FFI
 179 C          Total GM GM
 180       HGAMS(26)=ALFA**3/(256.*PI**2*SIN2W)*HMASS**3/WM**2*(FR**2+FI**2)
 181       HGAM=HGAM+HGAMS(26)
 182       CALL SSSAVE(81,HGAMS(26),10,10,0,0,0)
 183 C
 184 C          Calculate Higgs-gluon-gluon coupling
 185 C
 186       ETAR=0.
 187       ETAI=0.
 188       DO 300 IQ=1,8
 189         AMQ=AMASS(IQ)
 190         IF(AMQ.LE.0.) GO TO 300
 191         RQ=(2.*AMQ/HMASS)**2
 192         IF(RQ.GE.1.) THEN
 193           ETAR=ETAR+.5*RQ*(1.+(1.-RQ)*ASIN(1./SQRT(RQ))**2)
 194         ELSE
 195           RQLOG=ALOG((1.+SQRT(1.-RQ))/(1.-SQRT(1.-RQ)))
 196           PHIR=.25*(RQLOG**2-PI**2)
 197           ETAR=ETAR+.5*RQ*(1.+(RQ-1.)*PHIR)
 198           PHII=.5*PI*RQLOG
 199           ETAI=ETAI+.5*RQ*(1.+(RQ-1.)*PHII)
 200         ENDIF
 201 300   CONTINUE
 202       ETAHGG=ETAR**2+ETAI**2
 203 C
 204       RETURN
 205       END