Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001 
0002  
0003 C*********************************************************************
0004  
0005 C...PYAPPS
0006 C...Uses approximate analytical formulae to determine the full set of
0007 C...MSSM parameters from SUGRA input.
0008 C...See M. Drees and S.P. Martin, hep-ph/9504124
0009  
0010       SUBROUTINE PYAPPS
0011  
0012 C...Double precision and integer declarations.
0013       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0014       IMPLICIT INTEGER(I-N)
0015       INTEGER PYK,PYCHGE,PYCOMP
0016 C...Parameter statement to help give large particle numbers.
0017       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0018      &KEXCIT=4000000,KDIMEN=5000000)
0019 C...Commonblocks.
0020       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0021       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0022       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0023       SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/
0024 
0025       WRITE(MSTU(11),*) '(PYAPPS:) approximate mSUGRA relations'//
0026      &' not intended for serious physics studies'
0027       IMSS(5)=0
0028       IMSS(8)=0
0029       XMT=PMAS(6,1)
0030       XMZ2=PMAS(23,1)**2
0031       XMW2=PMAS(24,1)**2
0032       TANB=RMSS(5)
0033       BETA=ATAN(TANB)
0034       XW=PARU(102)
0035       XMG=RMSS(1)
0036       XMG2=XMG*XMG
0037       XM0=RMSS(8)
0038       XM02=XM0*XM0
0039 C...Temporary sign change for AT. Others unchanged.
0040       AT=-RMSS(16)
0041       RMSS(15)=RMSS(16)
0042       RMSS(17)=RMSS(16)
0043       SINB=TANB/SQRT(TANB**2+1D0)
0044       COSB=SINB/TANB
0045  
0046       DTERM=XMZ2*COS(2D0*BETA)
0047       XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM)
0048       XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM)
0049       RMSS(6)=XMEL
0050       RMSS(7)=XMER
0051       XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM))
0052       XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM))
0053       XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM))
0054       XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM))
0055       DO 100 I=1,5,2
0056         PMAS(PYCOMP(KSUSY1+I),1)=XMDL
0057         PMAS(PYCOMP(KSUSY2+I),1)=XMDR
0058         PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL
0059         PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR
0060   100 CONTINUE
0061       XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA))
0062       IF(XARG.LT.0D0) THEN
0063         WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'//
0064      &  ' FROM THE SUM RULE. '
0065         WRITE(MSTU(11),*) '  TRY A SMALLER VALUE OF TAN(BETA). '
0066         RETURN
0067       ELSE
0068         XARG=SQRT(XARG)
0069       ENDIF
0070       DO 110 I=11,15,2
0071         PMAS(PYCOMP(KSUSY1+I),1)=XMEL
0072         PMAS(PYCOMP(KSUSY2+I),1)=XMER
0073         PMAS(PYCOMP(KSUSY1+I+1),1)=XARG
0074         PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0
0075   110 CONTINUE
0076       RMT=PYMRUN(6,PMAS(6,1)**2)
0077       XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+
0078      &(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG))
0079       RMB=PYMRUN(5,PMAS(6,1)**2)
0080       XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+
0081      &(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG))
0082       XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0)
0083       ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/
0084      &SINB)**2)
0085       RMSS(16)=-ATP
0086       XMU2=-.5D0*XMZ2+(SINB**2*(XM02+.52D0*XMG2-XTOP)-
0087      &COSB**2*(XM02+.52D0*XMG2-XBOT-XTAU/3D0))/(COSB**2-SINB**2)
0088       XMA2=2D0*(XM02+.52D0*XMG2+XMU2)-XTOP-XBOT-XTAU/3D0
0089       XMU=SIGN(SQRT(XMU2),RMSS(4))
0090       RMSS(4)=XMU
0091       IF(XMA2.GT.0D0) THEN
0092         RMSS(19)=SQRT(XMA2)
0093       ELSE
0094         WRITE(MSTU(11),*) ' PYAPPS:: PSEUDOSCALAR MASS**2 < 0 '
0095         CALL PYSTOP(102)
0096       ENDIF
0097       ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM
0098       IF(ARG.GT.0D0) THEN
0099         RMSS(14)=SQRT(ARG)
0100       ELSE
0101         WRITE(MSTU(11),*) ' PYAPPS:: RIGHT STAU MASS**2 < 0 '
0102         CALL PYSTOP(102)
0103       ENDIF
0104       ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM
0105       IF(ARG.GT.0D0) THEN
0106         RMSS(13)=SQRT(ARG)
0107       ELSE
0108         WRITE(MSTU(11),*) ' PYAPPS::  LEFT STAU MASS**2 < 0 '
0109         CALL PYSTOP(102)
0110       ENDIF
0111       ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0)
0112       IF(ARG.GT.0D0) THEN
0113         RMSS(10)=SQRT(ARG)
0114       ELSE
0115         RMSS(10)=-SQRT(-ARG)
0116       ENDIF
0117       ARG=PYRNMQ(2,-2D0*XTOP/3D0)
0118       IF(ARG.GT.0D0) THEN
0119         RMSS(12)=SQRT(ARG)
0120       ELSE
0121         RMSS(12)=-SQRT(-ARG)
0122       ENDIF
0123       ARG=PYRNMQ(3,-2D0*XBOT/3D0)
0124       IF(ARG.GT.0D0) THEN
0125         RMSS(11)=SQRT(ARG)
0126       ELSE
0127         RMSS(11)=-SQRT(-ARG)
0128       ENDIF
0129  
0130       RETURN
0131       END