[u/mrichter/AliRoot.git] / ISAJET / isasusy / sshgm.F

#include "isajet/pilot.h"
      SUBROUTINE SSHGM
C-----------------------------------------------------------------------
C
C     Calculate H -> gm gm decays including both SM particles and
C     SUSY particles in loop.
C
C     This subroutine uses the tau variable of the Higgs Hunters'
C     Guide.  Many other authors, including the paper cited in 
C     Higgs Hunters' Guide (PR. D. 38(11): 3481) and Collider Physics
C     by Barger and Phillips use the variable lambda
C          LAMBDA = ( MASS OF PARTICLE IN LOOP / MASS OF HIGGS )**2
C          TAU = 4.0 * LAMBDA 
C
C     Bisset's HGAMGAM
C-----------------------------------------------------------------------
#if defined(CERNLIB_IMPNONE)
      IMPLICIT NONE
#endif
#include "isajet/sssm.inc"
#include "isajet/sspar.inc"
#include "isajet/sstype.inc"
C
      DOUBLE PRECISION MW1,MW2
      DOUBLE PRECISION MFL(3),MFD(3),MFU(3)
      DOUBLE PRECISION ETAH,IITOT,RITOT,TAU,IFFF,RFFF,IFHALF,RFHALF
     $,IF1,RF1,IF0,RF0,NCC,EF,TEMPCH,RHF,RHW,RHCH,RHSF,RHSFL,RHSFR
     $,TEMP,RHCNO,IIHF,RIHF,IIHW,RIHW,IIHCH,RIHCH,IIHSFL,RIHSFL
     $,IIHSFR,RIHSFR,IIHCNO,RIHCNO
     $,RHSF1,RHSF2,IIHSF1,IIHSF2,RIHSF1,RIHSF2
      DOUBLE PRECISION U11,U12,U21,U22,V11,V12,V21,V22,S11,Q11,S22,Q22
     $,SUMISQ,DW
      DOUBLE PRECISION PI,SR2,XM,YM,CGL,SGL,CGR,SGR,G2,MH,BETA,ALPHA
     $,THETX,THETY,THETM,THETP,CW2,AMSQ
      REAL WID
      REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS
      DOUBLE PRECISION SSMQCD
      INTEGER NUMH,IJ,II,NUMOUT,IDHHA       
C
C          Mass matrix parameters
C
      PI=4.*ATAN(1.D0)
      SR2=SQRT(2.D0)
      XM=1./TAN(GAMMAL)
      THETX=SIGN(1.D0,XM)
      YM=1./TAN(GAMMAR)
      THETY=SIGN(1.D0,YM)
      SGL=1/(DSQRT(1+XM**2))
      CGL=SGL*XM
      SGR=1/(DSQRT(1+YM**2))
      CGR=SGR*YM
      MW1=DBLE(ABS(AMW1SS))
      MW2=DBLE(ABS(AMW2SS))
      THETM=SIGN(1.,AMW1SS)
      THETP=SIGN(1.,AMW2SS)
      G2=4.0*PI*ALFAEM/SN2THW
      BETA=ATAN(1.0/RV2V1)
      ALPHA=ALFAH
      CW2=1.-SN2THW
C
C          Loop over neutral Higgs bosons
C
      DO 100 NUMH=1,3
        IF(NUMH.EQ.1) THEN
           MH=AMHL
           IDHHA=ISHL
        ELSEIF(NUMH.EQ.2) THEN
           MH=AMHH
           IDHHA=ISHH
        ELSE
           MH=AMHA
           IDHHA=ISHA
        ENDIF
        ETAH=1.0
        IITOT=0.0
        RITOT=0.0
C
      ASMB=SUALFS(AMBT**2,.36,AMTP,3)
      MBMB=AMBT*(1.-4*ASMB/3./PI)
      MBQ=SSMQCD(DBLE(MBMB),DBLE(MH))
      ASMT=SUALFS(AMTP**2,.36,AMTP,3)
      MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))*
     $(ASMT/PI)**2)
      MTQ=SSMQCD(DBLE(MTMT),DBLE(MH))
C
      MFL(1)=DBLE(AME)
      MFL(2)=DBLE(AMMU)
      MFL(3)=DBLE(AMTAU)
      MFD(1)=DBLE(AMDN)
      MFD(2)=DBLE(AMST)
      MFD(3)=DBLE(MBQ)
      MFU(1)=DBLE(AMUP)
      MFU(2)=DBLE(AMCH)
      MFU(3)=DBLE(MTQ)
C
C            Charged lepton loops
C
        DO 10 II=1,3
          TAU=4*MFL(II)**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
          RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
          NCC=1.0
          EF=-1.0
          IF(NUMH.EQ.1) THEN
            RHF=SIN(ALPHA)/COS(BETA)
          ELSEIF(NUMH.EQ.2) THEN
            RHF=COS(ALPHA)/COS(BETA)
          ELSE
            RHF=TAN(BETA)
          ENDIF
          IIHF=NCC*EF**2*RHF*IFHALF
          RIHF=NCC*EF**2*RHF*RFHALF
          IITOT=IITOT+IIHF
          RITOT=RITOT+RIHF
10      CONTINUE 
C
C            Down-type quark loops
C
        DO 20 II=1,3
          TAU=4*MFD(II)**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
          RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
          NCC=3.0
          EF=-1.0/3.0
          IF(NUMH.EQ.1) THEN
            RHF=SIN(ALPHA)/COS(BETA)
          ELSEIF(NUMH.EQ.2) THEN
            RHF=COS(ALPHA)/COS(BETA)
          ELSE
            RHF=DTAN(BETA)
          ENDIF
          IIHF=NCC*EF**2*RHF*IFHALF
          RIHF=NCC*EF**2*RHF*RFHALF
          IITOT=IITOT+IIHF
          RITOT=RITOT+RIHF
20      CONTINUE 
C           
C            Up-type quark loops
C
        DO 30 II=1,2
          TAU=4*MFU(II)**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
          RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
          NCC=3.0
          EF=2.0/3.0
          IF(NUMH.EQ.1) THEN
            RHF=COS(ALPHA)/SIN(BETA)
          ELSEIF(NUMH.EQ.2) THEN
            RHF=-SIN(ALPHA)/SIN(BETA)
          ELSE
            RHF=1.0/TAN(BETA)
          ENDIF
          IIHF=NCC*EF**2*RHF*IFHALF
          RIHF=NCC*EF**2*RHF*RFHALF
          IITOT=IITOT+IIHF
          RITOT=RITOT+RIHF
30      CONTINUE 
C
        TAU=4*MFU(3)**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
        RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
        NCC=3.0
        EF=2.0/3.0
        IF(NUMH.EQ.1) THEN
          RHF=COS(ALPHA)/SIN(BETA)
        ELSEIF(NUMH.EQ.2) THEN
          RHF=-SIN(ALPHA)/SIN(BETA)
        ELSE
          RHF=1.0/TAN(BETA)
        ENDIF
        IIHF=NCC*EF**2*RHF*IFHALF
        RIHF=NCC*EF**2*RHF*RFHALF
        IITOT=IITOT+IIHF
        RITOT=RITOT+RIHF
C
C            W-boson loop
C           
        TAU=4*AMW**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IF1=3.0*TAU*(2.0-TAU)*IFFF
        RF1=2.0+3.0*TAU+3.0*TAU*(2.0-TAU)*RFFF
        IF(NUMH.EQ.1) THEN
          RHW=SIN(BETA+ALPHA)
        ELSEIF(NUMH.EQ.2) THEN
          RHW=COS(BETA+ALPHA)
        ELSE
          RHW=0
        ENDIF
        IIHW=RHW*IF1
        RIHW=RHW*RF1
        IITOT=IITOT+IIHW
        RITOT=RITOT+RIHW
C
C            Charged Higgs loop
C 
        TAU=4*AMHC**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IF(NUMH.EQ.1) THEN
          TEMPCH=SIN(BETA-ALPHA)*COS(2.0*BETA)
          TEMPCH=TEMPCH/(2.0*CW2)
          RHCH=TEMPCH+SIN(BETA+ALPHA)
        ELSEIF(NUMH.EQ.2) THEN
          TEMPCH=-COS(BETA-ALPHA)*COS(2.0*BETA)
          TEMPCH=TEMPCH/(2.0*CW2)
          RHCH=COS(BETA+ALPHA)+TEMPCH
        ELSE
          RHCH=0
        ENDIF
        IIHCH=RHCH*IF0*AMW**2/AMHC**2
        RIHCH=RHCH*RF0*AMW**2/AMHC**2
        IITOT=IITOT+IIHCH
        RITOT=RITOT+RIHCH
C
C         Slepton loops
C         The 3 L-type sneutrinos can be omitted since the sfermion
C         decay width is proportional to the sfermion charge.
C         ==> There are two sets of 3 degenerate sleptons.
C
        NCC=1.0
        EF=-1.0
C         First, do e_L and mu_L sleptons
        DO 40 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
            TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
            TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSE
            RHSF=0
            RHSFL=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMELSS
          IF (II.EQ.2) AMSQ=AMMLSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
          RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFL
          RITOT=RITOT+RIHSFL
40      CONTINUE
C         Next, do e_R and mu_R
        DO 41 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
            TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
            TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSE
            RHSF=0
            RHSFR=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMERSS
          IF (II.EQ.2) AMSQ=AMMRSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
          RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFR
          RITOT=RITOT+RIHSFR
41      CONTINUE
C         Next, do stau_1 and stau_2 contribution
        IF(NUMH.EQ.1) THEN
          RHSF=(AMTAU/AMZ)**2*SIN(ALPHA)/COS(BETA)
          TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSEIF(NUMH.EQ.2) THEN
          RHSF=(AMTAU/AMZ)**2*COS(ALPHA)/COS(BETA)
          TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSE
          RHSF=0
          RHSFL=0
          RHSFR=0
        ENDIF
        RHSF1=RHSFL*COS(THETAL)-RHSFR*SIN(THETAL)
        RHSF2=RHSFL*SIN(THETAL)+RHSFR*COS(THETAL)
        TAU=4*AML1SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AML1SS)**2
        RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AML1SS)**2
        IITOT=IITOT+IIHSF1
        RITOT=RITOT+RIHSF1
        TAU=4*AML2SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AML2SS)**2
        RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AML2SS)**2
        IITOT=IITOT+IIHSF2
        RITOT=RITOT+RIHSF2
C
C          Down-type squark loops
C          Mixing between the sbottom squarks is also included, so  
C          masses used here are the mixed masses (AMB1SS & AMB2SS)
C
        NCC=3.0
        EF=-1.0/3.0
C          First, do d_L and s_L squarks
        DO 50 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
            TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
            TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSE
            RHSF=0
            RHSFL=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMDLSS
          IF (II.EQ.2) AMSQ=AMSLSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
          RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFL
          RITOT=RITOT+RIHSFL
50      CONTINUE
C         Next, do d_R and s_R squarks
        DO 51 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA)
            TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA)
            TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSE
            RHSF=0
            RHSFR=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMDRSS
          IF (II.EQ.2) AMSQ=AMSRSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
          RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFR
          RITOT=RITOT+RIHSFR
51      CONTINUE
C
        NCC=3.0
        EF=-1.0/3.0
        IF(NUMH.EQ.1) THEN
          RHSF=(MBQ/AMZ)**2*SIN(ALPHA)/COS(BETA)
          TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSEIF(NUMH.EQ.2) THEN
          RHSF=(MBQ/AMZ)**2*COS(ALPHA)/COS(BETA)
          TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSE
          RHSF=0
          RHSFL=0
          RHSFR=0
        ENDIF
        RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB)
        RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB)
        TAU=4*AMB1SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMB1SS)**2
        RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMB1SS)**2
        IITOT=IITOT+IIHSF1
        RITOT=RITOT+RIHSF1
        TAU=4*AMB2SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMB2SS)**2
        RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMB2SS)**2
        IITOT=IITOT+IIHSF2
        RITOT=RITOT+RIHSF2
C
C         Up-type squark loops
C         Mixing between the stop squarks is also included, so  
C         masses used here are the mixed masses (AMT1SS & AMT2SS)
C
        NCC=3.0
        EF=2.0/3.0            
C         First, do u_L and c_L squarks
        DO 60 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA)
            TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
            TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA)
            RHSFL=RHSF-TEMP
          ELSE
            RHSF=0
            RHSFL=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMULSS
          IF (II.EQ.2) AMSQ=AMCLSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2
          RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFL
          RITOT=RITOT+RIHSFL
60      CONTINUE
C          Next, do u_R and c_R squarks
        DO 61 II=1,2
          IF(NUMH.EQ.1) THEN
            RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA)
            TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSEIF(NUMH.EQ.2) THEN
            RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
            TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
            RHSFR=RHSF+TEMP
          ELSE
            RHSF=0
            RHSFR=0
          ENDIF
          IF (II.EQ.1) AMSQ=AMURSS
          IF (II.EQ.2) AMSQ=AMCRSS
          TAU=4*AMSQ**2/MH**2                  
          CALL SSHGM1(TAU,IFFF,RFFF)         
          IF0=-TAU*TAU*IFFF          
          RF0=TAU*(1.0-TAU*RFFF)          
          IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2
          RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2
          IITOT=IITOT+IIHSFR
          RITOT=RITOT+RIHSFR
61      CONTINUE
C
        NCC=3.0
        EF=2.0/3.0
        IF(NUMH.EQ.1) THEN
          RHSF=(MTQ/AMZ)**2*COS(ALPHA)/SIN(BETA)
          TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSEIF(NUMH.EQ.2) THEN
          RHSF=(MTQ/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA)
          TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA)
          RHSFL=RHSF-TEMP
          TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA)
          RHSFR=RHSF+TEMP
        ELSE
          RHSF=0
          RHSFL=0
          IIHSFL=0
          RIHSFL=0
        ENDIF
        RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB)
        RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB)
        TAU=4*AMT1SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMT1SS)**2
        RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMT1SS)**2
        IITOT=IITOT+IIHSF1
        RITOT=RITOT+RIHSF1
        TAU=4*AMT2SS**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IF0=-TAU*TAU*IFFF          
        RF0=TAU*(1.0-TAU*RFFF)          
        IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMT2SS)**2
        RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMT2SS)**2
        IITOT=IITOT+IIHSF2
        RITOT=RITOT+RIHSF2
C
C            Chargino loops
C
        TAU=4.0*(MW1)**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
        RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
        U11=SGL
        U12=-CGL
        V11=THETM*SGR
        V12=-THETM*CGR
        S11=U11*V12/SR2
        Q11=U12*V11/SR2
        RHCNO=2.0*(S11*COS(ALPHA)+Q11*SIN(ALPHA))
        IIHCNO=RHCNO*IFHALF*AMW/MW1 
        RIHCNO=RHCNO*RFHALF*AMW/MW1 
        IITOT=IITOT+IIHCNO
        RITOT=RITOT+RIHCNO
C
        TAU=4.0*(MW2)**2/MH**2                  
        CALL SSHGM1(TAU,IFFF,RFFF)         
        IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF
        RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF)
        U21=THETX*CGL
        U22=THETX*SGL
        V21=THETP*THETY*CGR
        V22=THETP*THETY*SGR
        S22=U21*V22/SR2
        Q22=U22*V21/SR2
        RHCNO=2.0*(S22*COS(ALPHA)+Q22*SIN(ALPHA))
        IIHCNO=RHCNO*IFHALF*AMW/MW2 
        RIHCNO=RHCNO*RFHALF*AMW/MW2 
        IITOT=IITOT+IIHCNO
        RITOT=RITOT+RIHCNO
C
C          IITOT and RITOT now contain the total imaginary and real
C          parts of the I function
C
        SUMISQ=IITOT**2+RITOT**2
        DW=ALFAEM**2*G2*MH**3/(1024.0*(PI**3)*AMW**2) 
        WID=DW*SUMISQ
        CALL SSSAVE(IDHHA,WID,IDGM,IDGM,0,0,0)
100   CONTINUE
C
      RETURN
      END
Commit	Line	Data
0795afa3	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.0PIALFAEM/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.-4ASMB/3./PI)
80	MBQ=SSMQCD(DBLE(MBMB),DBLE(MH))
81	ASMT=SUALFS(AMTP**2,.36,AMTP,3)
82	MTMT=AMTP/(1.+4ASMT/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=4MFL(II)2/MH*2
100	CALL SSHGM1(TAU,IFFF,RFFF)
101	IFHALF=-2.0TAU(1.0-TAUETAH)IFFF
102	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)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=NCCEF2RHF*IFHALF
113	RIHF=NCCEF2RHF*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=4MFD(II)2/MH*2
122	CALL SSHGM1(TAU,IFFF,RFFF)
123	IFHALF=-2.0TAU(1.0-TAUETAH)IFFF
124	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)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=NCCEF2RHF*IFHALF
135	RIHF=NCCEF2RHF*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=4MFU(II)2/MH*2
144	CALL SSHGM1(TAU,IFFF,RFFF)
145	IFHALF=-2.0TAU(1.0-TAUETAH)IFFF
146	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)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=NCCEF2RHF*IFHALF
157	RIHF=NCCEF2RHF*RFHALF
158	IITOT=IITOT+IIHF
159	RITOT=RITOT+RIHF
160	30 CONTINUE
161	C
162	TAU=4MFU(3)2/MH*2
163	CALL SSHGM1(TAU,IFFF,RFFF)
164	IFHALF=-2.0TAU(1.0-TAUETAH)IFFF
165	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)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=NCCEF2RHF*IFHALF
176	RIHF=NCCEF2RHF*RFHALF
177	IITOT=IITOT+IIHF
178	RITOT=RITOT+RIHF
179	C
180	C W-boson loop
181	C
182	TAU=4AMW2/MH*2
183	CALL SSHGM1(TAU,IFFF,RFFF)
184	IF1=3.0TAU(2.0-TAU)*IFFF
185	RF1=2.0+3.0TAU+3.0TAU(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=4AMHC2/MH*2
201	CALL SSHGM1(TAU,IFFF,RFFF)
202	IF0=-TAUTAUIFFF
203	RF0=TAU(1.0-TAURFFF)
204	IF(NUMH.EQ.1) THEN
205	TEMPCH=SIN(BETA-ALPHA)COS(2.0BETA)
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.0BETA)
210	TEMPCH=TEMPCH/(2.0*CW2)
211	RHCH=COS(BETA+ALPHA)+TEMPCH
212	ELSE
213	RHCH=0
214	ENDIF
215	IIHCH=RHCHIF0AMW2/AMHC2
216	RIHCH=RHCHRF0AMW2/AMHC2
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)*2SIN(ALPHA)/COS(BETA)
231	TEMP=(-0.5-EFSN2THW)SIN(BETA-ALPHA)
232	RHSFL=RHSF-TEMP
233	ELSEIF(NUMH.EQ.2) THEN
234	RHSF=(MFL(II)/AMZ)*2COS(ALPHA)/COS(BETA)
235	TEMP=(-0.5-EFSN2THW)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=4AMSQ2/MH*2
244	CALL SSHGM1(TAU,IFFF,RFFF)
245	IF0=-TAUTAUIFFF
246	RF0=TAU(1.0-TAURFFF)
247	IIHSFL=NCC(EF2)RHSFLIF0(AMZ/AMSQ)**2
248	RIHSFL=NCC(EF2)RHSFLRF0(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)*2SIN(ALPHA)/COS(BETA)
256	TEMP=-1.0EFSN2THW*SIN(BETA-ALPHA)
257	RHSFR=RHSF+TEMP
258	ELSEIF(NUMH.EQ.2) THEN
259	RHSF=(MFL(II)/AMZ)*2COS(ALPHA)/COS(BETA)
260	TEMP=-1.0EFSN2THW*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=4AMSQ2/MH*2
269	CALL SSHGM1(TAU,IFFF,RFFF)
270	IF0=-TAUTAUIFFF
271	RF0=TAU(1.0-TAURFFF)
272	IIHSFR=NCC(EF2)RHSFRIF0(AMZ/AMSQ)**2
273	RIHSFR=NCC(EF2)RHSFRRF0(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)*2SIN(ALPHA)/COS(BETA)
280	TEMP=(-0.5-EFSN2THW)SIN(BETA-ALPHA)
281	RHSFL=RHSF-TEMP
282	TEMP=-1.0EFSN2THW*SIN(BETA-ALPHA)
283	RHSFR=RHSF+TEMP
284	ELSEIF(NUMH.EQ.2) THEN
285	RHSF=(AMTAU/AMZ)*2COS(ALPHA)/COS(BETA)
286	TEMP=(-0.5-EFSN2THW)COS(BETA-ALPHA)
287	RHSFL=RHSF-TEMP
288	TEMP=-1.0EFSN2THW*COS(BETA-ALPHA)
289	RHSFR=RHSF+TEMP
290	ELSE
291	RHSF=0
292	RHSFL=0
293	RHSFR=0
294	ENDIF
295	RHSF1=RHSFLCOS(THETAL)-RHSFRSIN(THETAL)
296	RHSF2=RHSFLSIN(THETAL)+RHSFRCOS(THETAL)
297	TAU=4AML1SS2/MH*2
298	CALL SSHGM1(TAU,IFFF,RFFF)
299	IF0=-TAUTAUIFFF
300	RF0=TAU(1.0-TAURFFF)
301	IIHSF1=NCC(EF2)RHSF1IF0(AMZ/AML1SS)**2
302	RIHSF1=NCC(EF2)RHSF1RF0(AMZ/AML1SS)**2
303	IITOT=IITOT+IIHSF1
304	RITOT=RITOT+RIHSF1
305	TAU=4AML2SS2/MH*2
306	CALL SSHGM1(TAU,IFFF,RFFF)
307	IF0=-TAUTAUIFFF
308	RF0=TAU(1.0-TAURFFF)
309	IIHSF2=NCC(EF2)RHSF2IF0(AMZ/AML2SS)**2
310	RIHSF2=NCC(EF2)RHSF2RF0(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)*2SIN(ALPHA)/COS(BETA)
324	TEMP=(-0.5-EFSN2THW)SIN(BETA-ALPHA)
325	RHSFL=RHSF-TEMP
326	ELSEIF(NUMH.EQ.2) THEN
327	RHSF=(MFD(II)/AMZ)*2COS(ALPHA)/COS(BETA)
328	TEMP=(-0.5-EFSN2THW)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=4AMSQ2/MH*2
337	CALL SSHGM1(TAU,IFFF,RFFF)
338	IF0=-TAUTAUIFFF
339	RF0=TAU(1.0-TAURFFF)
340	IIHSFL=NCC(EF2)RHSFLIF0(AMZ/AMSQ)**2
341	RIHSFL=NCC(EF2)RHSFLRF0(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)*2SIN(ALPHA)/COS(BETA)
349	TEMP=-1.0EFSN2THW*SIN(BETA-ALPHA)
350	RHSFR=RHSF+TEMP
351	ELSEIF(NUMH.EQ.2) THEN
352	RHSF=(MFD(II)/AMZ)*2COS(ALPHA)/COS(BETA)
353	TEMP=-1.0EFSN2THW*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=4AMSQ2/MH*2
362	CALL SSHGM1(TAU,IFFF,RFFF)
363	IF0=-TAUTAUIFFF
364	RF0=TAU(1.0-TAURFFF)
365	IIHSFR=NCC(EF2)RHSFRIF0(AMZ/AMSQ)**2
366	RIHSFR=NCC(EF2)RHSFRRF0(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)*2SIN(ALPHA)/COS(BETA)
375	TEMP=(-0.5-EFSN2THW)SIN(BETA-ALPHA)
376	RHSFL=RHSF-TEMP
377	TEMP=-1.0EFSN2THW*SIN(BETA-ALPHA)
378	RHSFR=RHSF+TEMP
379	ELSEIF(NUMH.EQ.2) THEN
380	RHSF=(MBQ/AMZ)*2COS(ALPHA)/COS(BETA)
381	TEMP=(-0.5-EFSN2THW)COS(BETA-ALPHA)
382	RHSFL=RHSF-TEMP
383	TEMP=-1.0EFSN2THW*COS(BETA-ALPHA)
384	RHSFR=RHSF+TEMP
385	ELSE
386	RHSF=0
387	RHSFL=0
388	RHSFR=0
389	ENDIF
390	RHSF1=RHSFLCOS(THETAB)-RHSFRSIN(THETAB)
391	RHSF2=RHSFLSIN(THETAB)+RHSFRCOS(THETAB)
392	TAU=4AMB1SS2/MH*2
393	CALL SSHGM1(TAU,IFFF,RFFF)
394	IF0=-TAUTAUIFFF
395	RF0=TAU(1.0-TAURFFF)
396	IIHSF1=NCC(EF2)RHSF1IF0(AMZ/AMB1SS)**2
397	RIHSF1=NCC(EF2)RHSF1RF0(AMZ/AMB1SS)**2
398	IITOT=IITOT+IIHSF1
399	RITOT=RITOT+RIHSF1
400	TAU=4AMB2SS2/MH*2
401	CALL SSHGM1(TAU,IFFF,RFFF)
402	IF0=-TAUTAUIFFF
403	RF0=TAU(1.0-TAURFFF)
404	IIHSF2=NCC(EF2)RHSF2IF0(AMZ/AMB2SS)**2
405	RIHSF2=NCC(EF2)RHSF2RF0(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)*2COS(ALPHA)/SIN(BETA)
419	TEMP=(0.5-EFSN2THW)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-EFSN2THW)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=4AMSQ2/MH*2
432	CALL SSHGM1(TAU,IFFF,RFFF)
433	IF0=-TAUTAUIFFF
434	RF0=TAU(1.0-TAURFFF)
435	IIHSFL=NCC(EF2)RHSFLIF0(AMZ/AMSQ)**2
436	RIHSFL=NCC(EF2)RHSFLRF0(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)*2COS(ALPHA)/SIN(BETA)
444	TEMP=-1.0EFSN2THW*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.0EFSN2THW*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=4AMSQ2/MH*2
457	CALL SSHGM1(TAU,IFFF,RFFF)
458	IF0=-TAUTAUIFFF
459	RF0=TAU(1.0-TAURFFF)
460	IIHSFR=NCC(EF2)RHSFRIF0(AMZ/AMSQ)**2
461	RIHSFR=NCC(EF2)RHSFRRF0(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)*2COS(ALPHA)/SIN(BETA)
470	TEMP=(0.5-EFSN2THW)SIN(BETA-ALPHA)
471	RHSFL=RHSF-TEMP
472	TEMP=-1.0EFSN2THW*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-EFSN2THW)COS(BETA-ALPHA)
477	RHSFL=RHSF-TEMP
478	TEMP=-1.0EFSN2THW*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=RHSFLCOS(THETAB)-RHSFRSIN(THETAB)
487	RHSF2=RHSFLSIN(THETAB)+RHSFRCOS(THETAB)
488	TAU=4AMT1SS2/MH*2
489	CALL SSHGM1(TAU,IFFF,RFFF)
490	IF0=-TAUTAUIFFF
491	RF0=TAU(1.0-TAURFFF)
492	IIHSF1=NCC(EF2)RHSF1IF0(AMZ/AMT1SS)**2
493	RIHSF1=NCC(EF2)RHSF1RF0(AMZ/AMT1SS)**2
494	IITOT=IITOT+IIHSF1
495	RITOT=RITOT+RIHSF1
496	TAU=4AMT2SS2/MH*2
497	CALL SSHGM1(TAU,IFFF,RFFF)
498	IF0=-TAUTAUIFFF
499	RF0=TAU(1.0-TAURFFF)
500	IIHSF2=NCC(EF2)RHSF2IF0(AMZ/AMT2SS)**2
501	RIHSF2=NCC(EF2)RHSF2RF0(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.0TAU(1.0-TAUETAH)IFFF
510	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)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(S11COS(ALPHA)+Q11*SIN(ALPHA))
518	IIHCNO=RHCNOIFHALFAMW/MW1
519	RIHCNO=RHCNORFHALFAMW/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.0TAU(1.0-TAUETAH)IFFF
526	RFHALF=-2.0TAU(ETAH+(1.0-TAUETAH)RFFF)
527	U21=THETX*CGL
528	U22=THETX*SGL
529	V21=THETPTHETYCGR
530	V22=THETPTHETYSGR
531	S22=U21*V22/SR2
532	Q22=U22*V21/SR2
533	RHCNO=2.0(S22COS(ALPHA)+Q22*SIN(ALPHA))
534	IIHCNO=RHCNOIFHALFAMW/MW2
535	RIHCNO=RHCNORFHALFAMW/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=IITOT2+RITOT2
543	DW=ALFAEM*2G2MH3/(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