hijing/src/pyhiinre.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE PYHIINRE
0005
0006 C...Calculates full and effective widths of guage bosons, stores masses
0007 C...and widths, rescales coefficients to be used for resonance
0008 C...production generation.
0009       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0010       SAVE /LUDAT1/
0011       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0012       SAVE /LUDAT2/
0013       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0014       SAVE /LUDAT3/
0015       COMMON/PYHISUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
0016       SAVE /PYHISUBS/
0017       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0018       SAVE /PYHIPARS/
0019       COMMON/PYHIINT1/MINT(400),VINT(400)
0020       SAVE /PYHIINT1/
0021       COMMON/PYHIINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
0022       SAVE /PYHIINT2/
0023       COMMON/PYHIINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
0024       SAVE /PYHIINT4/
0025       COMMON/PYHIINT6/PROC(0:200)
0026       CHARACTER PROC*28
0027       SAVE /PYHIINT6/
0028       DIMENSION WDTP(0:40),WDTE(0:40,0:5)
0029
0030 C...Calculate full and effective widths of gauge bosons.
0031       AEM=PARU(101)
0032       XW=PARU(102)
0033       DO 100 I=21,40
0034       DO 100 J=0,40
0035       WIDP(I,J)=0.
0036   100 WIDE(I,J)=0.
0037
0038 C...W+/-:
0039       WMAS=PMAS(24,1)
0040       WFAC=AEM/(24.*XW)*WMAS
0041       CALL PYHIWIDT(24,WMAS,WDTP,WDTE)
0042       WIDS(24,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
0043      &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
0044      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0045       WIDS(24,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0046       WIDS(24,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
0047       DO 110 I=0,40
0048       WIDP(24,I)=WFAC*WDTP(I)
0049   110 WIDE(24,I)=WFAC*WDTE(I,0)
0050
0051 C...H+/-:
0052       HCMAS=PMAS(37,1)
0053       HCFAC=AEM/(8.*XW)*(HCMAS/WMAS)**2*HCMAS
0054       CALL PYHIWIDT(37,HCMAS,WDTP,WDTE)
0055       WIDS(37,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
0056      &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
0057      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0058       WIDS(37,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0059       WIDS(37,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
0060       DO 120 I=0,40
0061       WIDP(37,I)=HCFAC*WDTP(I)
0062   120 WIDE(37,I)=HCFAC*WDTE(I,0)
0063
0064 C...Z0:
0065       ZMAS=PMAS(23,1)
0066       ZFAC=AEM/(48.*XW*(1.-XW))*ZMAS
0067       CALL PYHIWIDT(23,ZMAS,WDTP,WDTE)
0068       WIDS(23,1)=((WDTE(0,1)+WDTE(0,2))**2+
0069      &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
0070      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0071       WIDS(23,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0072       WIDS(23,3)=0.
0073       DO 130 I=0,40
0074       WIDP(23,I)=ZFAC*WDTP(I)
0075   130 WIDE(23,I)=ZFAC*WDTE(I,0)
0076
0077 C...H0:
0078       HMAS=PMAS(25,1)
0079       HFAC=AEM/(8.*XW)*(HMAS/WMAS)**2*HMAS
0080       CALL PYHIWIDT(25,HMAS,WDTP,WDTE)
0081       WIDS(25,1)=((WDTE(0,1)+WDTE(0,2))**2+
0082      &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
0083      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0084       WIDS(25,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0085       WIDS(25,3)=0.
0086       DO 140 I=0,40
0087       WIDP(25,I)=HFAC*WDTP(I)
0088   140 WIDE(25,I)=HFAC*WDTE(I,0)
0089
0090 C...Z'0:
0091       ZPMAS=PMAS(32,1)
0092       ZPFAC=AEM/(48.*XW*(1.-XW))*ZPMAS
0093       CALL PYHIWIDT(32,ZPMAS,WDTP,WDTE)
0094       WIDS(32,1)=((WDTE(0,1)+WDTE(0,2)+WDTE(0,3))**2+
0095      &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
0096      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0097       WIDS(32,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0098       WIDS(32,3)=0.
0099       DO 150 I=0,40
0100       WIDP(32,I)=ZPFAC*WDTP(I)
0101   150 WIDE(32,I)=ZPFAC*WDTE(I,0)
0102
0103 C...R:
0104       RMAS=PMAS(40,1)
0105       RFAC=0.08*RMAS/((MSTP(1)-1)*(1.+6.*(1.+ULALPS(RMAS**2)/PARU(1))))
0106       CALL PYHIWIDT(40,RMAS,WDTP,WDTE)
0107       WIDS(40,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
0108      &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
0109      &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
0110       WIDS(40,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0111       WIDS(40,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
0112       DO 160 I=0,40
0113       WIDP(40,I)=WFAC*WDTP(I)
0114   160 WIDE(40,I)=WFAC*WDTE(I,0)
0115
0116 C...Q:
0117       KFLQM=1
0118       DO 170 I=1,MIN(8,MDCY(21,3))
0119       IDC=I+MDCY(21,2)-1
0120       IF(MDME(IDC,1).LE.0) GOTO 170
0121       KFLQM=I
0122   170 CONTINUE
0123       MINT(46)=KFLQM
0124       KFPR(81,1)=KFLQM
0125       KFPR(81,2)=KFLQM
0126       KFPR(82,1)=KFLQM
0127       KFPR(82,2)=KFLQM
0128
0129 C...Set resonance widths and branching ratios in JETSET.
0130       DO 180 I=1,6
0131       IF(I.LE.3) KC=I+22
0132       IF(I.EQ.4) KC=32
0133       IF(I.EQ.5) KC=37
0134       IF(I.EQ.6) KC=40
0135       PMAS(KC,2)=WIDP(KC,0)
0136       PMAS(KC,3)=MIN(0.9*PMAS(KC,1),10.*PMAS(KC,2))
0137       DO 180 J=1,MDCY(KC,3)
0138       IDC=J+MDCY(KC,2)-1
0139       BRAT(IDC)=WIDE(KC,J)/WIDE(KC,0)
0140   180 CONTINUE
0141
0142 C...Special cases in treatment of gamma*/Z0: redefine process name.
0143       IF(MSTP(43).EQ.1) THEN
0144         PROC(1)='f + fb -> gamma*'
0145       ELSEIF(MSTP(43).EQ.2) THEN
0146         PROC(1)='f + fb -> Z0'
0147       ELSEIF(MSTP(43).EQ.3) THEN
0148         PROC(1)='f + fb -> gamma*/Z0'
0149       ENDIF
0150
0151 C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name.
0152       IF(MSTP(44).EQ.1) THEN
0153         PROC(141)='f + fb -> gamma*'
0154       ELSEIF(MSTP(44).EQ.2) THEN
0155         PROC(141)='f + fb -> Z0'
0156       ELSEIF(MSTP(44).EQ.3) THEN
0157         PROC(141)='f + fb -> Z''0'
0158       ELSEIF(MSTP(44).EQ.4) THEN
0159         PROC(141)='f + fb -> gamma*/Z0'
0160       ELSEIF(MSTP(44).EQ.5) THEN
0161         PROC(141)='f + fb -> gamma*/Z''0'
0162       ELSEIF(MSTP(44).EQ.6) THEN
0163         PROC(141)='f + fb -> Z0/Z''0'
0164       ELSEIF(MSTP(44).EQ.7) THEN
0165         PROC(141)='f + fb -> gamma*/Z0/Z''0'
0166       ENDIF
0167
0168       RETURN
0169       END