      SUBROUTINE PYRVGL(KFIN,XLAM,IDLAM,LKNT)
C...Double precision and integer declarations.
      IMPLICIT DOUBLE PRECISION(A-H, O-Z)
      IMPLICIT INTEGER(I-N)
C...Parameter statement to help give large particle numbers.
      PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
     &KEXCIT=4000000,KDIMEN=5000000)
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)
      COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
     &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
      COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
C...Local variables.
      DOUBLE PRECISION XLAM(0:400)
      INTEGER IDLAM(400,3), PYCOMP
C...Information from main routine to PYRVGW
      COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2
     &     ,DCMASS,KFR(3)
C...Auxiliary variables needed for BV (RV Gauge STOre)
      COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ
     &     ,RVLJKI,RVLJIK
C...Running quark masses
      DOUBLE PRECISION RMQ(6)
C...Decay product masses on/off
      LOGICAL DCMASS
      SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/,
     &     /RVGSTO/
C...IF LQD OR UDD TYPE R-VIOLATION ON.
      IF (IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN
        KFSM=KFIN-KSUSY1
C... AB(x,y,z):
C       x=1-2  : Select A or B coupling     (1:A ; 2:B)
C       y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ;
C                                    11-16:e,nu_e,mu,... not used here)
C       z=1-2  : Mass eigenstate number
        DO 100 I = 1,6
C...A Couplings
          AB(1,I,1) = SFMIX(I,2)
          AB(1,I,2) = SFMIX(I,4)
C...B Couplings
          AB(2,I,1) = -SFMIX(I,1)
          AB(2,I,2) = -SFMIX(I,3)
  100   CONTINUE
        GSTR2 = 4D0*PARU(1) * PYALPS(PMAS(PYCOMP(KFIN),1)**2)
C...LQD DECAYS.
        IF (IMSS(52).GE.1) THEN
C...STEP IN I,J,K USING SINGLE COUNTER
          DO 120 ISC=0,26
C * GLUINO -> NUBAR_I + DBAR_J + D_K.
            LKNT          = LKNT+1
            IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3)
            IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
            IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
            XLAM(LKNT)=0D0
C...Set coupling, and decay product masses on/off
            RVLAMC=RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2
     &           * 5D-1 * GSTR2
            DCMASS        = .FALSE.
            IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE.
C...Resonance KF codes (1=I,2=J,3=K)
            KFR(1)        = 0
            KFR(2)        = -IDLAM(LKNT,2)
            KFR(3)        = -IDLAM(LKNT,3)
C...Calculate width.
            CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &           ,XLAM(LKNT))
C...Normalize
            XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
C...Charge conjugate mode.
  110       LKNT          = LKNT+1
            IDLAM(LKNT,1) =-IDLAM(LKNT-1,1)
            IDLAM(LKNT,2) =-IDLAM(LKNT-1,2)
            IDLAM(LKNT,3) =-IDLAM(LKNT-1,3)
            XLAM(LKNT)    = XLAM(LKNT-1)
C...KINEMATICS CHECK
            IF (XLAM(LKNT).EQ.0D0) THEN
              LKNT=LKNT-2
            ENDIF
C * GLUINO -> LEPTON+_I + UBAR_J + D_K
            LKNT = LKNT+1
            IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3)
            IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3)
            IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
            XLAM(LKNT)=0D0
C...Set coupling, and decay product masses on/off
            RVLAMC = RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)
     &           **2* 5D-1 * GSTR2
            DCMASS        = .FALSE.
            IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6
     &           .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE.
C...Resonance KF codes (1=I,2=J,3=K)
            KFR(1)        = 0
            KFR(2)        = -IDLAM(LKNT,2)
            KFR(3)        = -IDLAM(LKNT,3)
C...Calculate width.
            CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &           ,XLAM(LKNT))
            XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
C...Charge conjugate mode.
            LKNT=LKNT+1
            IDLAM(LKNT,1) = -IDLAM(LKNT-1,1)
            IDLAM(LKNT,2) = -IDLAM(LKNT-1,2)
            IDLAM(LKNT,3) = -IDLAM(LKNT-1,3)
            XLAM(LKNT)    =  XLAM(LKNT-1)
C...KINEMATICS CHECK
            IF (XLAM(LKNT).EQ.0D0) THEN
              LKNT=LKNT-2
            ENDIF
  120     CONTINUE
        ENDIF
C...UDD DECAYS.
        IF (IMSS(53).GE.1) THEN
C...STEP IN I,J,K USING SINGLE COUNTER
          DO 130 ISC=0,26
C * GLUINO -> UBAR_I + DBAR_J + DBAR_K.
            IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN
              LKNT          = LKNT+1
              IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3)
              IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
              IDLAM(LKNT,3) = -1 -2*MOD(ISC,3)
              XLAM(LKNT)=0D0
C...Set coupling, and decay product masses on/off. A factor of 2 for
C...(N_C-1) has been used to cancel a factor 0.5.
              RVLAMC=RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)
     &             **2 * GSTR2
              DCMASS        = .FALSE.
              IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5
     &             .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE.
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = IDLAM(LKNT,1)
              KFR(2)        = 0
              KFR(3)        = 0
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESI)
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = 0
              KFR(2)        = IDLAM(LKNT,2)
              KFR(3)        = 0
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESJ)
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = 0
              KFR(2)        = 0
              KFR(3)        = IDLAM(LKNT,3)
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESK)
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = IDLAM(LKNT,1)
              KFR(2)        = IDLAM(LKNT,2)
              KFR(3)        = 0
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESIJ)
C...Calculate interference function. (Factor -1/2 to make up for factor
C...-2 in PYRVGW.
              IF (ABS((XRESI+XRESJ)/XRESIJ-1D0).GT.1D-4) THEN
                XRESIJ = 5D-1 * (XRESI+XRESJ-XRESIJ)
              ELSE
                XRESIJ = 0D0
              ENDIF
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = 0
              KFR(2)        = IDLAM(LKNT,2)
              KFR(3)        = IDLAM(LKNT,3)
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESJK)
              IF (ABS((XRESJ+XRESK)/XRESJK-1).GT.1D-4) THEN
                XRESJK = 5D-1 * (XRESJ+XRESK-XRESJK)
              ELSE
                XRESJK = 0D0
              ENDIF
C...Resonance KF codes (1=I,2=J,3=K)
              KFR(1)        = IDLAM(LKNT,1)
              KFR(2)        = 0
              KFR(3)        = IDLAM(LKNT,3)
C...Calculate width.
              CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
     &             ,XRESIK)
              IF (ABS((XRESI+XRESK)/XRESIK-1).GT.1D-4) THEN
                XRESIK = 5D-1 * (XRESI+XRESK-XRESIK)
              ELSE
                XRESIK = 0D0
              ENDIF
C...Calculate total width (factor 1/2 from 1/(N_C-1))
              XLAM(LKNT) = XRESI + XRESJ + XRESK
     &             + 5D-1 * (XRESIJ + XRESIK + XRESJK)
C...Normalize
              XLAM(LKNT) = XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
C...Charge conjugate mode.
              LKNT          = LKNT+1
              IDLAM(LKNT,1) =-IDLAM(LKNT-1,1)
              IDLAM(LKNT,2) =-IDLAM(LKNT-1,2)
              IDLAM(LKNT,3) =-IDLAM(LKNT-1,3)
              XLAM(LKNT)    = XLAM(LKNT-1)
C...KINEMATICS CHECK
              IF (XLAM(LKNT).EQ.0D0) THEN
                LKNT=LKNT-2
              ENDIF
            ENDIF
  130     CONTINUE
        ENDIF
      ENDIF
      RETURN
      END
