ISAJET/isasusy/sshgm.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SSHGM
   3 C-----------------------------------------------------------------------
   4 C
   5 C     Calculate H -> gm gm decays including both SM particles and
   6 C     SUSY particles in loop.
   7 C
   8 C     This subroutine uses the tau variable of the Higgs Hunters'
   9 C     Guide.  Many other authors, including the paper cited in
  10 C     Higgs Hunters' Guide (PR. D. 38(11): 3481) and Collider Physics
  11 C     by Barger and Phillips use the variable lambda
  12 C          LAMBDA = ( MASS OF PARTICLE IN LOOP / MASS OF HIGGS )**2
  13 C          TAU = 4.0 * LAMBDA
  14 C
  15 C     Bisset's HGAMGAM
  16 C-----------------------------------------------------------------------
  17 #if defined(CERNLIB_IMPNONE)
  18       IMPLICIT NONE
  19 #endif
  20 #include "isajet/sssm.inc"
  21 #include "isajet/sspar.inc"
  22 #include "isajet/sstype.inc"
  23 C
  24       DOUBLE PRECISION MW1,MW2
  25       DOUBLE PRECISION MFL(3),MFD(3),MFU(3)
  26       DOUBLE PRECISION ETAH,IITOT,RITOT,TAU,IFFF,RFFF,IFHALF,RFHALF
  27      $,IF1,RF1,IF0,RF0,NCC,EF,TEMPCH,RHF,RHW,RHCH,RHSF,RHSFL,RHSFR
  28      $,TEMP,RHCNO,IIHF,RIHF,IIHW,RIHW,IIHCH,RIHCH,IIHSFL,RIHSFL
  29      $,IIHSFR,RIHSFR,IIHCNO,RIHCNO
  30      $,RHSF1,RHSF2,IIHSF1,IIHSF2,RIHSF1,RIHSF2
  31       DOUBLE PRECISION U11,U12,U21,U22,V11,V12,V21,V22,S11,Q11,S22,Q22
  32      $,SUMISQ,DW
  33       DOUBLE PRECISION PI,SR2,XM,YM,CGL,SGL,CGR,SGR,G2,MH,BETA,ALPHA
  34      $,THETX,THETY,THETM,THETP,CW2,AMSQ
  35       REAL WID
  36       REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS
  37       DOUBLE PRECISION SSMQCD
  38       INTEGER NUMH,IJ,II,NUMOUT,IDHHA
  39 C
  40 C          Mass matrix parameters
  41 C
  42       PI=4.*ATAN(1.D0)
  43       SR2=SQRT(2.D0)
  44       XM=1./TAN(GAMMAL)
  45       THETX=SIGN(1.D0,XM)
  46       YM=1./TAN(GAMMAR)
  47       THETY=SIGN(1.D0,YM)
  48       SGL=1/(DSQRT(1+XM**2))
  49       CGL=SGL*XM
  50       SGR=1/(DSQRT(1+YM**2))
  51       CGR=SGR*YM
  52       MW1=DBLE(ABS(AMW1SS))
  53       MW2=DBLE(ABS(AMW2SS))
  54       THETM=SIGN(1.,AMW1SS)
  55       THETP=SIGN(1.,AMW2SS)
  56       G2=4.0*PI*ALFAEM/SN2THW
  57       BETA=ATAN(1.0/RV2V1)
  58       ALPHA=ALFAH
  59       CW2=1.-SN2THW
  60 C
  61 C          Loop over neutral Higgs bosons
  62 C
  63       DO 100 NUMH=1,3
  64         IF(NUMH.EQ.1) THEN
  65            MH=AMHL
  66            IDHHA=ISHL
  67         ELSEIF(NUMH.EQ.2) THEN
  68            MH=AMHH
  69            IDHHA=ISHH
  70         ELSE
  71            MH=AMHA
  72            IDHHA=ISHA
  73         ENDIF
  74         ETAH=1.0
  75         IITOT=0.0
  76         RITOT=0.0
  77 C
  78       ASMB=SUALFS(AMBT**2,.36,AMTP,3)
  79       MBMB=AMBT*(1.-4*ASMB/3./PI)
  80       MBQ=SSMQCD(DBLE(MBMB),DBLE(MH))
  81       ASMT=SUALFS(AMTP**2,.36,AMTP,3)
  82       MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))*
  83      $(ASMT/PI)**2)
  84       MTQ=SSMQCD(DBLE(MTMT),DBLE(MH))
  85 C
  86       MFL(1)=DBLE(AME)
  87       MFL(2)=DBLE(AMMU)
  88       MFL(3)=DBLE(AMTAU)
  89       MFD(1)=DBLE(AMDN)
  90       MFD(2)=DBLE(AMST)
  91       MFD(3)=DBLE(MBQ)
  92       MFU(1)=DBLE(AMUP)
  93       MFU(2)=DBLE(AMCH)
  94       MFU(3)=DBLE(MTQ)
  95 C
  96 C            Charged lepton loops
  97 C
  98         DO 10 II=1,3
  99           TAU=4*MFL(II)**2/MH**2
 100           CALL SSHGM1(TAU,IFFF,RFFF)
 101           IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 102           RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 103           NCC=1.0
 104           EF=-1.0
 105           IF(NUMH.EQ.1) THEN
 106             RHF=SIN(ALPHA)/COS(BETA)
 107           ELSEIF(NUMH.EQ.2) THEN
 108             RHF=COS(ALPHA)/COS(BETA)
 109           ELSE
 110             RHF=TAN(BETA)
 111           ENDIF
 112           IIHF=NCC*EF**2*RHF*IFHALF
 113           RIHF=NCC*EF**2*RHF*RFHALF
 114           IITOT=IITOT+IIHF
 115           RITOT=RITOT+RIHF
 116 10      CONTINUE
 117 C
 118 C            Down-type quark loops
 119 C
 120         DO 20 II=1,3
 121           TAU=4*MFD(II)**2/MH**2
 122           CALL SSHGM1(TAU,IFFF,RFFF)
 123           IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 124           RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 125           NCC=3.0
 126           EF=-1.0/3.0
 127           IF(NUMH.EQ.1) THEN
 128             RHF=SIN(ALPHA)/COS(BETA)
 129           ELSEIF(NUMH.EQ.2) THEN
 130             RHF=COS(ALPHA)/COS(BETA)
 131           ELSE
 132             RHF=DTAN(BETA)
 133           ENDIF
 134           IIHF=NCC*EF**2*RHF*IFHALF
 135           RIHF=NCC*EF**2*RHF*RFHALF
 136           IITOT=IITOT+IIHF
 137           RITOT=RITOT+RIHF
 138 20      CONTINUE
 139 C
 140 C            Up-type quark loops
 141 C
 142         DO 30 II=1,2
 143           TAU=4*MFU(II)**2/MH**2
 144           CALL SSHGM1(TAU,IFFF,RFFF)
 145           IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 146           RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 147           NCC=3.0
 148           EF=2.0/3.0
 149           IF(NUMH.EQ.1) THEN
 150             RHF=COS(ALPHA)/SIN(BETA)
 151           ELSEIF(NUMH.EQ.2) THEN
 152             RHF=-SIN(ALPHA)/SIN(BETA)
 153           ELSE
 154             RHF=1.0/TAN(BETA)
 155           ENDIF
 156           IIHF=NCC*EF**2*RHF*IFHALF
 157           RIHF=NCC*EF**2*RHF*RFHALF
 158           IITOT=IITOT+IIHF
 159           RITOT=RITOT+RIHF
 160 30      CONTINUE
 161 C
 162         TAU=4*MFU(3)**2/MH**2
 163         CALL SSHGM1(TAU,IFFF,RFFF)
 164         IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 165         RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 166         NCC=3.0
 167         EF=2.0/3.0
 168         IF(NUMH.EQ.1) THEN
 169           RHF=COS(ALPHA)/SIN(BETA)
 170         ELSEIF(NUMH.EQ.2) THEN
 171           RHF=-SIN(ALPHA)/SIN(BETA)
 172         ELSE
 173           RHF=1.0/TAN(BETA)
 174         ENDIF
 175         IIHF=NCC*EF**2*RHF*IFHALF
 176         RIHF=NCC*EF**2*RHF*RFHALF
 177         IITOT=IITOT+IIHF
 178         RITOT=RITOT+RIHF
 179 C
 180 C            W-boson loop
 181 C
 182         TAU=4*AMW**2/MH**2
 183         CALL SSHGM1(TAU,IFFF,RFFF)
 184         IF1=3.0*TAU*(2.0-TAU)*IFFF
 185         RF1=2.0+3.0*TAU+3.0*TAU*(2.0-TAU)*RFFF
 186         IF(NUMH.EQ.1) THEN
 187           RHW=SIN(BETA+ALPHA)
 188         ELSEIF(NUMH.EQ.2) THEN
 189           RHW=COS(BETA+ALPHA)
 190         ELSE
 191           RHW=0
 192         ENDIF
 193         IIHW=RHW*IF1
 194         RIHW=RHW*RF1
 195         IITOT=IITOT+IIHW
 196         RITOT=RITOT+RIHW
 197 C
 198 C            Charged Higgs loop
 199 C
 200         TAU=4*AMHC**2/MH**2
 201         CALL SSHGM1(TAU,IFFF,RFFF)
 202         IF0=-TAU*TAU*IFFF
 203         RF0=TAU*(1.0-TAU*RFFF)
 204         IF(NUMH.EQ.1) THEN
 205           TEMPCH=SIN(BETA-ALPHA)*COS(2.0*BETA)
 206           TEMPCH=TEMPCH/(2.0*CW2)
 207           RHCH=TEMPCH+SIN(BETA+ALPHA)
 208         ELSEIF(NUMH.EQ.2) THEN
 209           TEMPCH=-COS(BETA-ALPHA)*COS(2.0*BETA)
 210           TEMPCH=TEMPCH/(2.0*CW2)
 211           RHCH=COS(BETA+ALPHA)+TEMPCH
 212         ELSE
 213           RHCH=0
 214         ENDIF
 215         IIHCH=RHCH*IF0*AMW**2/AMHC**2
 216         RIHCH=RHCH*RF0*AMW**2/AMHC**2
 217         IITOT=IITOT+IIHCH
 218         RITOT=RITOT+RIHCH
 219 C
 220 C         Slepton loops
 221 C         The 3 L-type sneutrinos can be omitted since the sfermion
 222 C         decay width is proportional to the sfermion charge.
 223 C         ==> There are two sets of 3 degenerate sleptons.
 224 C
 225         NCC=1.0
 226         EF=-1.0
 227 C         First, do e_L and mu_L sleptons
 228         DO 40 II=1,2
 229           IF(NUMH.EQ.1) THEN
 230             RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
 231             TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 232             RHSFL=RHSF-TEMP
 233           ELSEIF(NUMH.EQ.2) THEN
 234             RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
 235             TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
 236             RHSFL=RHSF-TEMP
 237           ELSE
 238             RHSF=0
 239             RHSFL=0
 240           ENDIF
 241           IF (II.EQ.1) AMSQ=AMELSS
 242           IF (II.EQ.2) AMSQ=AMMLSS
 243           TAU=4*AMSQ**2/MH**2
 244           CALL SSHGM1(TAU,IFFF,RFFF)
 245           IF0=-TAU*TAU*IFFF
 246           RF0=TAU*(1.0-TAU*RFFF)
 247           IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
 248           RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
 249           IITOT=IITOT+IIHSFL
 250           RITOT=RITOT+RIHSFL
 251 40      CONTINUE
 252 C         Next, do e_R and mu_R
 253         DO 41 II=1,2
 254           IF(NUMH.EQ.1) THEN
 255             RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
 256             TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 257             RHSFR=RHSF+TEMP
 258           ELSEIF(NUMH.EQ.2) THEN
 259             RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
 260             TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 261             RHSFR=RHSF+TEMP
 262           ELSE
 263             RHSF=0
 264             RHSFR=0
 265           ENDIF
 266           IF (II.EQ.1) AMSQ=AMERSS
 267           IF (II.EQ.2) AMSQ=AMMRSS
 268           TAU=4*AMSQ**2/MH**2
 269           CALL SSHGM1(TAU,IFFF,RFFF)
 270           IF0=-TAU*TAU*IFFF
 271           RF0=TAU*(1.0-TAU*RFFF)
 272           IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
 273           RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
 274           IITOT=IITOT+IIHSFR
 275           RITOT=RITOT+RIHSFR
 276 41      CONTINUE
 277 C         Next, do stau_1 and stau_2 contribution
 278         IF(NUMH.EQ.1) THEN
 279           RHSF=(AMTAU/AMZ)**2*SIN(ALPHA)/COS(BETA)
 280           TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 281           RHSFL=RHSF-TEMP
 282           TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 283           RHSFR=RHSF+TEMP
 284         ELSEIF(NUMH.EQ.2) THEN
 285           RHSF=(AMTAU/AMZ)**2*COS(ALPHA)/COS(BETA)
 286           TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
 287           RHSFL=RHSF-TEMP
 288           TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 289           RHSFR=RHSF+TEMP
 290         ELSE
 291           RHSF=0
 292           RHSFL=0
 293           RHSFR=0
 294         ENDIF
 295         RHSF1=RHSFL*COS(THETAL)-RHSFR*SIN(THETAL)
 296         RHSF2=RHSFL*SIN(THETAL)+RHSFR*COS(THETAL)
 297         TAU=4*AML1SS**2/MH**2
 298         CALL SSHGM1(TAU,IFFF,RFFF)
 299         IF0=-TAU*TAU*IFFF
 300         RF0=TAU*(1.0-TAU*RFFF)
 301         IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AML1SS)**2
 302         RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AML1SS)**2
 303         IITOT=IITOT+IIHSF1
 304         RITOT=RITOT+RIHSF1
 305         TAU=4*AML2SS**2/MH**2
 306         CALL SSHGM1(TAU,IFFF,RFFF)
 307         IF0=-TAU*TAU*IFFF
 308         RF0=TAU*(1.0-TAU*RFFF)
 309         IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AML2SS)**2
 310         RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AML2SS)**2
 311         IITOT=IITOT+IIHSF2
 312         RITOT=RITOT+RIHSF2
 313 C
 314 C          Down-type squark loops
 315 C          Mixing between the sbottom squarks is also included, so
 316 C          masses used here are the mixed masses (AMB1SS & AMB2SS)
 317 C
 318         NCC=3.0
 319         EF=-1.0/3.0
 320 C          First, do d_L and s_L squarks
 321         DO 50 II=1,2
 322           IF(NUMH.EQ.1) THEN
 323             RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
 324             TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 325             RHSFL=RHSF-TEMP
 326           ELSEIF(NUMH.EQ.2) THEN
 327             RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
 328             TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
 329             RHSFL=RHSF-TEMP
 330           ELSE
 331             RHSF=0
 332             RHSFL=0
 333           ENDIF
 334           IF (II.EQ.1) AMSQ=AMDLSS
 335           IF (II.EQ.2) AMSQ=AMSLSS
 336           TAU=4*AMSQ**2/MH**2
 337           CALL SSHGM1(TAU,IFFF,RFFF)
 338           IF0=-TAU*TAU*IFFF
 339           RF0=TAU*(1.0-TAU*RFFF)
 340           IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
 341           RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
 342           IITOT=IITOT+IIHSFL
 343           RITOT=RITOT+RIHSFL
 344 50      CONTINUE
 345 C         Next, do d_R and s_R squarks
 346         DO 51 II=1,2
 347           IF(NUMH.EQ.1) THEN
 348             RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
 349             TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 350             RHSFR=RHSF+TEMP
 351           ELSEIF(NUMH.EQ.2) THEN
 352             RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
 353             TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 354             RHSFR=RHSF+TEMP
 355           ELSE
 356             RHSF=0
 357             RHSFR=0
 358           ENDIF
 359           IF (II.EQ.1) AMSQ=AMDRSS
 360           IF (II.EQ.2) AMSQ=AMSRSS
 361           TAU=4*AMSQ**2/MH**2
 362           CALL SSHGM1(TAU,IFFF,RFFF)
 363           IF0=-TAU*TAU*IFFF
 364           RF0=TAU*(1.0-TAU*RFFF)
 365           IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
 366           RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
 367           IITOT=IITOT+IIHSFR
 368           RITOT=RITOT+RIHSFR
 369 51      CONTINUE
 370 C
 371         NCC=3.0
 372         EF=-1.0/3.0
 373         IF(NUMH.EQ.1) THEN
 374           RHSF=(MBQ/AMZ)**2*SIN(ALPHA)/COS(BETA)
 375           TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 376           RHSFL=RHSF-TEMP
 377           TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 378           RHSFR=RHSF+TEMP
 379         ELSEIF(NUMH.EQ.2) THEN
 380           RHSF=(MBQ/AMZ)**2*COS(ALPHA)/COS(BETA)
 381           TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
 382           RHSFL=RHSF-TEMP
 383           TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 384           RHSFR=RHSF+TEMP
 385         ELSE
 386           RHSF=0
 387           RHSFL=0
 388           RHSFR=0
 389         ENDIF
 390         RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB)
 391         RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB)
 392         TAU=4*AMB1SS**2/MH**2
 393         CALL SSHGM1(TAU,IFFF,RFFF)
 394         IF0=-TAU*TAU*IFFF
 395         RF0=TAU*(1.0-TAU*RFFF)
 396         IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMB1SS)**2
 397         RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMB1SS)**2
 398         IITOT=IITOT+IIHSF1
 399         RITOT=RITOT+RIHSF1
 400         TAU=4*AMB2SS**2/MH**2
 401         CALL SSHGM1(TAU,IFFF,RFFF)
 402         IF0=-TAU*TAU*IFFF
 403         RF0=TAU*(1.0-TAU*RFFF)
 404         IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMB2SS)**2
 405         RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMB2SS)**2
 406         IITOT=IITOT+IIHSF2
 407         RITOT=RITOT+RIHSF2
 408 C
 409 C         Up-type squark loops
 410 C         Mixing between the stop squarks is also included, so
 411 C         masses used here are the mixed masses (AMT1SS & AMT2SS)
 412 C
 413         NCC=3.0
 414         EF=2.0/3.0
 415 C         First, do u_L and c_L squarks
 416         DO 60 II=1,2
 417           IF(NUMH.EQ.1) THEN
 418             RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA)
 419             TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 420             RHSFL=RHSF-TEMP
 421           ELSEIF(NUMH.EQ.2) THEN
 422             RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
 423             TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA)
 424             RHSFL=RHSF-TEMP
 425           ELSE
 426             RHSF=0
 427             RHSFL=0
 428           ENDIF
 429           IF (II.EQ.1) AMSQ=AMULSS
 430           IF (II.EQ.2) AMSQ=AMCLSS
 431           TAU=4*AMSQ**2/MH**2
 432           CALL SSHGM1(TAU,IFFF,RFFF)
 433           IF0=-TAU*TAU*IFFF
 434           RF0=TAU*(1.0-TAU*RFFF)
 435           IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
 436           RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
 437           IITOT=IITOT+IIHSFL
 438           RITOT=RITOT+RIHSFL
 439 60      CONTINUE
 440 C          Next, do u_R and c_R squarks
 441         DO 61 II=1,2
 442           IF(NUMH.EQ.1) THEN
 443             RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA)
 444             TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 445             RHSFR=RHSF+TEMP
 446           ELSEIF(NUMH.EQ.2) THEN
 447             RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
 448             TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 449             RHSFR=RHSF+TEMP
 450           ELSE
 451             RHSF=0
 452             RHSFR=0
 453           ENDIF
 454           IF (II.EQ.1) AMSQ=AMURSS
 455           IF (II.EQ.2) AMSQ=AMCRSS
 456           TAU=4*AMSQ**2/MH**2
 457           CALL SSHGM1(TAU,IFFF,RFFF)
 458           IF0=-TAU*TAU*IFFF
 459           RF0=TAU*(1.0-TAU*RFFF)
 460           IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
 461           RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
 462           IITOT=IITOT+IIHSFR
 463           RITOT=RITOT+RIHSFR
 464 61      CONTINUE
 465 C
 466         NCC=3.0
 467         EF=2.0/3.0
 468         IF(NUMH.EQ.1) THEN
 469           RHSF=(MTQ/AMZ)**2*COS(ALPHA)/SIN(BETA)
 470           TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA)
 471           RHSFL=RHSF-TEMP
 472           TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
 473           RHSFR=RHSF+TEMP
 474         ELSEIF(NUMH.EQ.2) THEN
 475           RHSF=(MTQ/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
 476           TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA)
 477           RHSFL=RHSF-TEMP
 478           TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
 479           RHSFR=RHSF+TEMP
 480         ELSE
 481           RHSF=0
 482           RHSFL=0
 483           IIHSFL=0
 484           RIHSFL=0
 485         ENDIF
 486         RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB)
 487         RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB)
 488         TAU=4*AMT1SS**2/MH**2
 489         CALL SSHGM1(TAU,IFFF,RFFF)
 490         IF0=-TAU*TAU*IFFF
 491         RF0=TAU*(1.0-TAU*RFFF)
 492         IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMT1SS)**2
 493         RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMT1SS)**2
 494         IITOT=IITOT+IIHSF1
 495         RITOT=RITOT+RIHSF1
 496         TAU=4*AMT2SS**2/MH**2
 497         CALL SSHGM1(TAU,IFFF,RFFF)
 498         IF0=-TAU*TAU*IFFF
 499         RF0=TAU*(1.0-TAU*RFFF)
 500         IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMT2SS)**2
 501         RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMT2SS)**2
 502         IITOT=IITOT+IIHSF2
 503         RITOT=RITOT+RIHSF2
 504 C
 505 C            Chargino loops
 506 C
 507         TAU=4.0*(MW1)**2/MH**2
 508         CALL SSHGM1(TAU,IFFF,RFFF)
 509         IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 510         RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 511         U11=SGL
 512         U12=-CGL
 513         V11=THETM*SGR
 514         V12=-THETM*CGR
 515         S11=U11*V12/SR2
 516         Q11=U12*V11/SR2
 517         RHCNO=2.0*(S11*COS(ALPHA)+Q11*SIN(ALPHA))
 518         IIHCNO=RHCNO*IFHALF*AMW/MW1
 519         RIHCNO=RHCNO*RFHALF*AMW/MW1
 520         IITOT=IITOT+IIHCNO
 521         RITOT=RITOT+RIHCNO
 522 C
 523         TAU=4.0*(MW2)**2/MH**2
 524         CALL SSHGM1(TAU,IFFF,RFFF)
 525         IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
 526         RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
 527         U21=THETX*CGL
 528         U22=THETX*SGL
 529         V21=THETP*THETY*CGR
 530         V22=THETP*THETY*SGR
 531         S22=U21*V22/SR2
 532         Q22=U22*V21/SR2
 533         RHCNO=2.0*(S22*COS(ALPHA)+Q22*SIN(ALPHA))
 534         IIHCNO=RHCNO*IFHALF*AMW/MW2
 535         RIHCNO=RHCNO*RFHALF*AMW/MW2
 536         IITOT=IITOT+IIHCNO
 537         RITOT=RITOT+RIHCNO
 538 C
 539 C          IITOT and RITOT now contain the total imaginary and real
 540 C          parts of the I function
 541 C
 542         SUMISQ=IITOT**2+RITOT**2
 543         DW=ALFAEM**2*G2*MH**3/(1024.0*(PI**3)*AMW**2)
 544         WID=DW*SUMISQ
 545         CALL SSSAVE(IDHHA,WID,IDGM,IDGM,0,0,0)
 546 100   CONTINUE
 547 C
 548       RETURN
 549       END