pythiaeRHIC/pythia/pyrvgw.f

0001
0002 C*********************************************************************
0003
0004 C...PYRVGW
0005 C...Generalized Matrix Element for R-Violating 3-body widths.
0006 C...P. Z. Skands
0007       SUBROUTINE PYRVGW(KFIN,ID1,ID2,ID3,XLAM)
0008
0009       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
0010       IMPLICIT INTEGER (I-N)
0011       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0012      &KEXCIT=4000000,KDIMEN=5000000)
0013       PARAMETER (EPS=1D-4)
0014       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0015       COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2
0016      &     ,DCMASS,KFR(3)
0017       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0018      & SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0019       DOUBLE PRECISION XLIM(3,3)
0020       INTEGER KC(0:3), PYCOMP
0021       LOGICAL DCMASS, DCHECK(6)
0022       SAVE /PYDAT2/,/PYRVNV/,/PYSSMT/
0023
0024       XLAM   = 0D0
0025
0026       KC(0)  = PYCOMP(KFIN)
0027       KC(1)  = PYCOMP(ID1)
0028       KC(2)  = PYCOMP(ID2)
0029       KC(3)  = PYCOMP(ID3)
0030       RMS(0) = PMAS(KC(0),1)
0031       RMS(1) = PYMRUN(ID1,PMAS(KC(1),1)**2)
0032       RMS(2) = PYMRUN(ID2,PMAS(KC(2),1)**2)
0033       RMS(3) = PYMRUN(ID3,PMAS(KC(3),1)**2)
0034 C...INITIALIZE OUTER INTEGRATION LIMITS AND KINEMATICS CHECK
0035       XLIM(1,1)=(RMS(1)+RMS(2))**2
0036       XLIM(1,2)=(RMS(0)-RMS(3))**2
0037       XLIM(1,3)=XLIM(1,2)-XLIM(1,1)
0038       XLIM(2,1)=(RMS(2)+RMS(3))**2
0039       XLIM(2,2)=(RMS(0)-RMS(1))**2
0040       XLIM(2,3)=XLIM(2,2)-XLIM(2,1)
0041       XLIM(3,1)=(RMS(1)+RMS(3))**2
0042       XLIM(3,2)=(RMS(0)-RMS(2))**2
0043       XLIM(3,3)=XLIM(3,2)-XLIM(3,1)
0044 C...Check Phase Space
0045       IF (XLIM(1,3).LT.0D0.OR.XLIM(2,3).LT.0D0.OR.XLIM(3,3).LT.0D0) THEN
0046         RETURN
0047       ENDIF
0048
0049 C...INITIALIZE RESONANCE INFORMATION
0050       DO 110 JRES = 1,3
0051         DO 100 IMASS = 1,2
0052           IRES = 2*(JRES-1)+IMASS
0053           INTRES(IRES,1) = 0
0054           DCHECK(IRES)   =.FALSE.
0055 C...NO RIGHT-HANDED NEUTRINOS
0056           IF (((IMASS.EQ.2).AND.((IABS(KFR(JRES)).EQ.12).OR
0057      &         .(IABS(KFR(JRES)).EQ.14).OR.(IABS(KFR(JRES)).EQ.16))).OR
0058      &         .KFR(JRES).EQ.0) GOTO 100
0059           RES(IRES,1) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),1)
0060           RES(IRES,2) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),2)
0061           INTRES(IRES,1) = IABS(KFR(JRES))
0062           INTRES(IRES,2) = IMASS
0063           IF (KFR(JRES).LT.0) INTRES(IRES,3) = 1
0064           IF (KFR(JRES).GT.0) INTRES(IRES,3) = 0
0065   100   CONTINUE
0066   110 CONTINUE
0067
0068 C...SUM OVER DIAGRAMS AND INTEGRATE OVER PHASE SPACE
0069
0070 C...RESONANCE CONTRIBUTIONS
0071 C...(Only sum contributions where the resonance is off shell).
0072 C...Store whether diagram on/off in DCHECK.
0073 C...LOOP OVER MASS STATES
0074       DO 120 J=1,2
0075         IDR=J
0076         TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2
0077         IF ((RMS(0).LT.(RMS(1)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(2)
0078      &       +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN
0079           DCHECK(IDR) =.TRUE.
0080           XLAM = XLAM + TMIX * PYRVI1(2,3,1)
0081         ENDIF
0082
0083         IDR=J+2
0084         TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2
0085         IF ((RMS(0).LT.(RMS(2)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1)
0086      &       +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN
0087           DCHECK(IDR) =.TRUE.
0088           XLAM = XLAM + TMIX * PYRVI1(1,3,2)
0089         ENDIF
0090
0091         IDR=J+4
0092         TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2
0093         IF ((RMS(0).LT.(RMS(3)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1)
0094      &       +RMS(2)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN
0095           DCHECK(IDR) =.TRUE.
0096           XLAM = XLAM + TMIX * PYRVI1(1,2,3)
0097         ENDIF
0098   120 CONTINUE
0099 C... L-R INTERFERENCES
0100 C... (Only add contributions where both contributing diagrams
0101 C... are non-resonant).
0102       IDR=1
0103       IF (DCHECK(1).AND.DCHECK(2)) THEN
0104 C...Bug corrected 11/12 2001. Skands.
0105         XLAM  = XLAM + 2D0 * PYRVI2(2,3,1)
0106      &     * SFMIX(INTRES(1,1),2+INTRES(1,3)-1)
0107      &     * SFMIX(INTRES(2,1),4+INTRES(2,3)-1)
0108       ENDIF
0109
0110       IDR=3
0111       IF (DCHECK(3).AND.DCHECK(4)) THEN
0112         XLAM  = XLAM + 2D0 * PYRVI2(1,3,2)
0113      &     * SFMIX(INTRES(3,1),2+INTRES(3,3)-1)
0114      &     * SFMIX(INTRES(4,1),4+INTRES(4,3)-1)
0115       ENDIF
0116
0117       IDR=5
0118       IF (DCHECK(5).AND.DCHECK(6)) THEN
0119         XLAM  = XLAM + 2D0 * PYRVI2(1,2,3)
0120      &     * SFMIX(INTRES(5,1),2+INTRES(5,3)-1)
0121      &     * SFMIX(INTRES(6,1),4+INTRES(6,3)-1)
0122       ENDIF
0123 C... TRUE INTERFERENCES
0124 C... (Only add contributions where both contributing diagrams
0125 C... are non-resonant).
0126       PREF=-2D0
0127       IF ((KFIN-KSUSY1).EQ.24.OR.(KFIN-KSUSY1).EQ.37) PREF=2D0
0128       DO 140 IKR1 = 1,2
0129         DO 130 IKR2 = 1,2
0130           IDR  = IKR1+2
0131           IDR2 = IKR2
0132           IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN
0133             XLAM = XLAM + PREF*PYRVI3(1,3,2) *
0134      &           SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1)
0135      &           *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1)
0136           ENDIF
0137
0138           IDR  = IKR1+4
0139           IDR2 = IKR2
0140           IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN
0141             XLAM = XLAM + PREF*PYRVI3(1,2,3) *
0142      &           SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1)
0143      &           *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1)
0144           ENDIF
0145
0146           IDR  = IKR1+4
0147           IDR2 = IKR2+2
0148           IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN
0149             XLAM = XLAM + PREF*PYRVI3(2,1,3) *
0150      &           SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1)
0151      &           *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1)
0152           ENDIF
0153   130   CONTINUE
0154   140 CONTINUE
0155
0156       RETURN
0157       END