Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:15

0001  
0002 C*********************************************************************
0003  
0004 C...PYRGHM
0005 C...Auxiliary to PYPOLE.
0006  
0007       SUBROUTINE PYRGHM(MCHI,MA,TANB,MQ,MUR,MD,MTOP,AU,AD,MU,
0008      *    MHP,HMP,MCH,SA,CA,SAB,CAB,TANBA,MGLU,DELTAMT,DELTAMB)
0009       IMPLICIT DOUBLE PRECISION(A-H,L,M,O-Z)
0010       DIMENSION VH(2,2),M2(2,2),M2P(2,2)
0011 C...Parameters.
0012       INTEGER MSTU,MSTJ
0013       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0014       SAVE /PYDAT1/
0015  
0016       MZ = 91.18D0
0017       PI = PARU(1)
0018       V  = 174.1D0
0019       ALPHA1 = 0.0101D0
0020       ALPHA2 = 0.0337D0
0021       ALPHA3Z = 0.12D0
0022       TANBA = TANB
0023       TANBT = TANB
0024 C     MBOTTOM(MTOP) = 3. GEV
0025       MB = PYMRUN(5,MTOP**2)
0026       ALPHA3 = ALPHA3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPHA3Z*
0027      *LOG(MTOP**2/MZ**2))
0028 C     RMTOP= RUNNING TOP QUARK MASS
0029       RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI)
0030       TQ = LOG((MQ**2+MTOP**2)/MTOP**2)
0031       TU = LOG((MUR**2 + MTOP**2)/MTOP**2)
0032       TD = LOG((MD**2 + MTOP**2)/MTOP**2)
0033 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0034 C
0035 C    NEW DEFINITION, TGLU.
0036 C
0037 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0038       TGLU = LOG(MGLU**2/MTOP**2)
0039       SINB = TANB/DSQRT(1D0 + TANB**2)
0040       COSB = SINB/TANB
0041       IF(MA.GT.MTOP)
0042      *TANBA = TANB*(1D0-3D0/32D0/PI**2*
0043      *(RMTOP**2/V**2/SINB**2-MB**2/V**2/COSB**2)*
0044      *LOG(MA**2/MTOP**2))
0045       IF(MA.LT.MTOP.OR.MA.EQ.MTOP) TANBT = TANBA
0046       SINB = TANBT/SQRT(1D0 + TANBT**2)
0047       COSB = 1D0/DSQRT(1D0 + TANBT**2)
0048       G1 = SQRT(ALPHA1*4D0*PI)
0049       G2 = SQRT(ALPHA2*4D0*PI)
0050       G3 = SQRT(ALPHA3*4D0*PI)
0051       HU = RMTOP/V/SINB
0052       HD =  MB/V/COSB
0053       CALL PYGFXX(MA,TANBA,MQ,MUR,MD,MTOP,AU,AD,MU,MGLU,VH,STOP1,STOP2,
0054      *SBOT1,SBOT2,DELTAMT,DELTAMB)
0055       IF(MQ.GT.MUR) TP = TQ - TU
0056       IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TP = TU - TQ
0057       IF(MQ.GT.MUR) TDP = TU
0058       IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TDP = TQ
0059       IF(MQ.GT.MD) TPD = TQ - TD
0060       IF(MQ.LT.MD.OR.MQ.EQ.MD) TPD = TD - TQ
0061       IF(MQ.GT.MD) TDPD = TD
0062       IF(MQ.LT.MD.OR.MQ.EQ.MD) TDPD = TQ
0063  
0064       IF(MQ.GT.MD) DLAMBDA1 = 6D0/96D0/PI**2*G1**2*HD**2*TPD
0065       IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA1 = 3D0/32D0/PI**2*
0066      * HD**2*(G1**2/3D0+G2**2)*TPD
0067  
0068       IF(MQ.GT.MUR) DLAMBDA2 =12D0/96D0/PI**2*G1**2*HU**2*TP
0069       IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA2 = 3D0/32D0/PI**2*
0070      * HU**2*(-G1**2/3D0+G2**2)*TP
0071  
0072 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0073 C
0074 C  DLAMBDAP1 AND DLAMBDAP2 ARE THE NEW LOG CORRECTIONS DUE TO
0075 C  THE PRESENCE OF THE GLUINO MASS. THEY ARE IN GENERAL VERY SMALL,
0076 C  AND ONLY PRESENT IF THERE IS A HIERARCHY OF MASSES BETWEEN THE
0077 C  TWO STOPS.
0078 C
0079 C
0080 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0081  
0082       DLAMBDAP2 = 0D0
0083       IF(MGLU.LT.MUR.OR.MGLU.LT.MQ) THEN
0084        IF(MQ.GT.MUR.AND.MGLU.GT.MUR) THEN
0085         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TGLU**2)
0086        ENDIF
0087  
0088        IF(MQ.GT.MUR.AND.MGLU.LT.MUR) THEN
0089         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2)
0090        ENDIF
0091  
0092        IF(MQ.GT.MUR.AND.MGLU.EQ.MUR) THEN
0093         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2)
0094        ENDIF
0095  
0096        IF(MUR.GT.MQ.AND.MGLU.GT.MQ) THEN
0097         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TGLU**2)
0098        ENDIF
0099  
0100        IF(MUR.GT.MQ.AND.MGLU.LT.MQ) THEN
0101         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2)
0102        ENDIF
0103  
0104        IF(MUR.GT.MQ.AND.MGLU.EQ.MQ) THEN
0105         DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2)
0106        ENDIF
0107       ENDIF
0108       DLAMBDA3 = 0D0
0109       DLAMBDA4 = 0D0
0110       IF(MQ.GT.MD) DLAMBDA3 = -1D0/32D0/PI**2*G1**2*HD**2*TPD
0111       IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA3 = 3D0/64D0/PI**2*HD**2*
0112      *(G2**2-G1**2/3D0)*TPD
0113       IF(MQ.GT.MUR) DLAMBDA3 = DLAMBDA3 -
0114      *1D0/16D0/PI**2*G1**2*HU**2*TP
0115       IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA3 = DLAMBDA3 +
0116      * 3D0/64D0/PI**2*HU**2*(G2**2+G1**2/3D0)*TP
0117       IF(MQ.LT.MUR) DLAMBDA4 = -3D0/32D0/PI**2*G2**2*HU**2*TP
0118       IF(MQ.LT.MD) DLAMBDA4 = DLAMBDA4 - 3D0/32D0/PI**2*G2**2*
0119      *HD**2*TPD
0120       LAMBDA1 = ((G1**2 + G2**2)/4D0)*
0121      * (1D0-3D0*HD**2*(TPD + TDPD)/8D0/PI**2)
0122      *+(3D0*HD**4D0/16D0/PI**2) *TPD*(1D0
0123      *+ (3D0*HD**2/2D0 + HU**2/2D0
0124      *- 8D0*G3**2) * (TPD + 2D0*TDPD)/16D0/PI**2)
0125      *+(3D0*HD**4D0/8D0/PI**2) *TDPD*(1D0  + (3D0*HD**2/2D0 + HU**2/2D0
0126      *- 8D0*G3**2) * TDPD/16D0/PI**2) + DLAMBDA1
0127       LAMBDA2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU**2*
0128      *(TP + TDP)/8D0/PI**2)
0129      *+(3D0*HU**4D0/16D0/PI**2) *TP*(1D0
0130      *+ (3D0*HU**2/2D0 + HD**2/2D0
0131      *- 8D0*G3**2) * (TP + 2D0*TDP)/16D0/PI**2)
0132      *+(3D0*HU**4D0/8D0/PI**2) *TDP*(1D0 + (3D0*HU**2/2D0 + HD**2/2D0
0133      *- 8D0*G3**2) * TDP/16D0/PI**2) + DLAMBDA2 + DLAMBDAP2
0134       LAMBDA3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0*
0135      *(HU**2)*(TP + TDP)/16D0/PI**2 -3D0*
0136      *(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA3
0137       LAMBDA4 = (- G2**2/2D0)*(1D0
0138      *-3D0*(HU**2)*(TP + TDP)/16D0/PI**2
0139      *-3D0*(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA4
0140  
0141       LAMBDA5 = 0D0
0142       LAMBDA6 = 0D0
0143       LAMBDA7 = 0D0
0144  
0145       M2(1,1) = 2D0*V**2*(LAMBDA1*COSB**2+2D0*LAMBDA6*
0146      *COSB*SINB + LAMBDA5*SINB**2) + MA**2*SINB**2
0147  
0148       M2(2,2) = 2D0*V**2*(LAMBDA5*COSB**2+2D0*LAMBDA7*
0149      *COSB*SINB + LAMBDA2*SINB**2) + MA**2*COSB**2
0150       M2(1,2) = 2D0*V**2*(LAMBDA6*COSB**2+(LAMBDA3+LAMBDA4)*
0151      *COSB*SINB + LAMBDA7*SINB**2) - MA**2*SINB*COSB
0152  
0153       M2(2,1) = M2(1,2)
0154 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0155 CCC  THIS IS THE CONTRIBUTION FROM LIGHT CHARGINOS/NEUTRALINOS
0156 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0157  
0158       MSSUSY=DSQRT(.5D0*(MQ**2+MUR**2)+MTOP**2)
0159  
0160       IF(MCHI.GT.MSSUSY) GOTO 100
0161       IF(MCHI.LT.MTOP) MCHI=MTOP
0162  
0163       TCHAR=LOG(MSSUSY**2/MCHI**2)
0164  
0165       DELTAL12=(9D0/64D0/PI**2*G2**4+5D0/192D0/PI**2*G1**4)*TCHAR
0166       DELTAL3P4=(3D0/64D0/PI**2*G2**4+7D0/192D0/PI**2*G1**4
0167      *+4D0/32D0/PI**2*G1**2*G2**2)*TCHAR
0168  
0169       DELTAM112=2D0*DELTAL12*V**2*COSB**2
0170       DELTAM222=2D0*DELTAL12*V**2*SINB**2
0171       DELTAM122=2D0*DELTAL3P4*V**2*SINB*COSB
0172  
0173       M2(1,1)=M2(1,1)+DELTAM112
0174       M2(2,2)=M2(2,2)+DELTAM222
0175       M2(1,2)=M2(1,2)+DELTAM122
0176       M2(2,1)=M2(2,1)+DELTAM122
0177  
0178   100 CONTINUE
0179  
0180 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0181 CCC  END OF CHARGINOS/NEUTRALINOS
0182 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0183  
0184       DO 120 I = 1,2
0185         DO 110 J = 1,2
0186           M2P(I,J) = M2(I,J) + VH(I,J)
0187   110   CONTINUE
0188   120 CONTINUE
0189       TRM2P = M2P(1,1) + M2P(2,2)
0190       DETM2P = M2P(1,1)*M2P(2,2) - M2P(1,2)*M2P(2,1)
0191       MH2P = (TRM2P - DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0
0192       HM2P = (TRM2P + DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0
0193       HMP = DSQRT(HM2P)
0194       MCH2=MA**2+(LAMBDA5-LAMBDA4)*V**2
0195       MCH=DSQRT(MCH2)
0196       IF(MH2P.LT.0.) GOTO 130
0197       MHP = SQRT(MH2P)
0198       SIN2ALPHA = 2D0*M2P(1,2)/SQRT(TRM2P**2-4D0*DETM2P)
0199       COS2ALPHA = (M2P(1,1)-M2P(2,2))/SQRT(TRM2P**2-4D0*DETM2P)
0200       IF(COS2ALPHA.GE.0.) THEN
0201         ALPHA = ASIN(SIN2ALPHA)/2D0
0202       ELSE
0203         ALPHA = -PI/2D0-ASIN(SIN2ALPHA)/2D0
0204       ENDIF
0205       SA = SIN(ALPHA)
0206       CA = COS(ALPHA)
0207 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0208 C
0209 C        HERE THE VALUES OF SAB AND CAB ARE DEFINED, IN ORDER
0210 C        TO DEFINE THE NEW COUPLINGS OF THE LIGHTEST AND
0211 C        HEAVY CP-EVEN HIGGS TO THE BOTTOM QUARK.
0212 C
0213 C
0214 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
0215       SAB = SA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0+CA/SA/TANB))
0216       CAB = CA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0-SA/CA/TANB))
0217   130 CONTINUE
0218       RETURN
0219       END