C*********************************************************************
 
C...PYAPPS
C...Uses approximate analytical formulae to determine the full set of
C...MSSM parameters from SUGRA input.
C...See M. Drees and S.P. Martin, hep-ph/9504124
 
      SUBROUTINE PYAPPS
 
C...Double precision and integer declarations.
      IMPLICIT DOUBLE PRECISION(A-H, O-Z)
      IMPLICIT INTEGER(I-N)
      INTEGER PYK,PYCHGE,PYCOMP
C...Parameter statement to help give large particle numbers.
      PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
C...Commonblocks.
      COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
      COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
      COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
      SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/
 
      IMSS(5)=0
      XMT=PMAS(6,1)
      XMZ2=PMAS(23,1)**2
      XMW2=PMAS(24,1)**2
      TANB=RMSS(5)
      BETA=ATAN(TANB)
      XW=PARU(102)
      XMG=RMSS(1)
      XMG2=XMG*XMG
      XM0=RMSS(8)
      XM02=XM0*XM0
      AT=-RMSS(16)
      RMSS(15)=AT
      RMSS(17)=AT
      COSB=COS(BETA)
      SINB=TANB/SQRT(TANB**2+1D0)
      COSB=SINB/TANB
 
      DTERM=XMZ2*COS(2D0*BETA)
      XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM)
      XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM)
      RMSS(6)=XMEL
      RMSS(7)=XMER
      XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM))
      XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM))
      XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM))
      XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM))
      DO 100 I=1,5,2
        PMAS(PYCOMP(KSUSY1+I),1)=XMDL
        PMAS(PYCOMP(KSUSY2+I),1)=XMDR
        PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL
        PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR
  100 CONTINUE
      XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA))
      IF(XARG.LT.0D0) THEN
        WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'//
     &  ' FROM THE SUM RULE. '
        WRITE(MSTU(11),*) '  TRY A SMALLER VALUE OF TAN(BETA). '
        RETURN
      ELSE
        XARG=SQRT(XARG)
      ENDIF
      DO 110 I=11,15,2
        PMAS(PYCOMP(KSUSY1+I),1)=XMEL
        PMAS(PYCOMP(KSUSY2+I),1)=XMER
        PMAS(PYCOMP(KSUSY1+I+1),1)=XARG
        PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0
  110 CONTINUE
      XMNU=XARG
 
      RMT=PYRNMT(XMT)
      XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+
     &(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG))
      RMB=3D0
      XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+
     &(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG))
      XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0)
      ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/
     &SINB)**2)
      RMSS(16)=-ATP
C      XMU2=-XM02-0.52D0*XMG2-0.5D0*XMZ2+XTOP/(1D0-1D0/TANB**2)
C.....
      XMU2=-.5D0*XMZ2+(SINB**2*(XM02+.52D0*XMG2-XTOP)-
     &COSB**2*(XM02+.52D0*XMG2-XBOT-XTAU/3D0))/(COSB**2-SINB**2)
C      XMA2=(XMNU**2+XMU2-XBOT-XTAU/3D0)/SINB**2
C.....
      XMA2=2D0*(XM02+.52D0*XMG2)-XTOP-XBOT-XTAU/3D0+2D0*XMU2
      XMU=SIGN(SQRT(XMU2),RMSS(4))
      RMSS(4)=XMU
      RMSS(19)=SQRT(XMA2)
      ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM
      IF(ARG.GT.0D0) THEN
        RMSS(14)=SQRT(ARG)
      ELSE
        WRITE(MSTU(11),*) ' RIGHT STAU MASS < 0 '
        STOP
      ENDIF
      ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM
      IF(ARG.GT.0D0) THEN
        RMSS(13)=SQRT(ARG)
      ELSE
        WRITE(MSTU(11),*) ' LEFT STAU MASS < 0 '
        STOP
      ENDIF
      ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0)
      IF(ARG.GT.0D0) THEN
        RMSS(10)=SQRT(ARG)
      ELSE
        RMSS(10)=-SQRT(-ARG)
      ENDIF
      ARG=PYRNMQ(2,-2D0*XTOP/3D0)
      IF(ARG.GT.0D0) THEN
        RMSS(12)=SQRT(ARG)
      ELSE
        RMSS(12)=-SQRT(-ARG)
      ENDIF
      ARG=PYRNMQ(3,-2D0*XBOT/3D0)
      IF(ARG.GT.0D0) THEN
        RMSS(11)=SQRT(ARG)
      ELSE
        RMSS(11)=-SQRT(-ARG)
      ENDIF
 
      RETURN
      END