Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYXTEE
0005 C...Calculates total cross-section, including initial state
0006 C...radiation effects.
0007  
0008       SUBROUTINE PYXTEE(KFL,ECM,XTOT)
0009  
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Commonblocks.
0015       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0017       SAVE /PYDAT1/,/PYDAT2/
0018  
0019 C...Status, (optimized) Q^2 scale, alpha_strong.
0020       PARJ(151)=ECM
0021       MSTJ(119)=10*MSTJ(102)+KFL
0022       IF(MSTJ(111).EQ.0) THEN
0023         Q2R=ECM**2
0024       ELSEIF(MSTU(111).EQ.0) THEN
0025         PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/
0026      &  ((33D0-2D0*MSTU(112))*PARU(111)))))
0027         Q2R=PARJ(168)*ECM**2
0028       ELSE
0029         PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM,
0030      &  (2D0*PARU(112)/ECM)**2))
0031         Q2R=PARJ(168)*ECM**2
0032       ENDIF
0033       ALSPI=PYALPS(Q2R)/PARU(1)
0034  
0035 C...QCD corrections factor in R.
0036       IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN
0037         RQCD=1D0
0038       ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN
0039         RQCD=1D0+ALSPI
0040       ELSEIF(MSTJ(109).EQ.0) THEN
0041         RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2
0042         IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+(33D0-2D0*MSTU(112))/12D0*
0043      &  LOG(PARJ(168))*ALSPI**2)
0044       ELSEIF(IABS(MSTJ(101)).EQ.1) THEN
0045         RQCD=1D0+(3D0/4D0)*ALSPI
0046       ELSE
0047         RQCD=1D0+(3D0/4D0)*ALSPI-(3D0/32D0+0.519D0*MSTU(118))*ALSPI**2
0048       ENDIF
0049  
0050 C...Calculate Z0 width if default value not acceptable.
0051       IF(MSTJ(102).GE.3) THEN
0052         RVA=3D0*(3D0+(4D0*PARU(102)-1D0)**2)+6D0*RQCD*(2D0+
0053      &  (1D0-8D0*PARU(102)/3D0)**2+(4D0*PARU(102)/3D0-1D0)**2)
0054         DO 100 KFLC=5,6
0055           VQ=1D0
0056           IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-
0057      &    (2D0*PYMASS(KFLC)/ ECM)**2))
0058           IF(KFLC.EQ.5) VF=4D0*PARU(102)/3D0-1D0
0059           IF(KFLC.EQ.6) VF=1D0-8D0*PARU(102)/3D0
0060           RVA=RVA+3D0*RQCD*(0.5D0*VQ*(3D0-VQ**2)*VF**2+VQ**3)
0061   100   CONTINUE
0062         PARJ(124)=PARU(101)*PARJ(123)*RVA/(48D0*PARU(102)*
0063      &  (1D0-PARU(102)))
0064       ENDIF
0065  
0066 C...Calculate propagator and related constants for QFD case.
0067       POLL=1D0-PARJ(131)*PARJ(132)
0068       IF(MSTJ(102).GE.2) THEN
0069         SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102)))
0070         SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
0071         SFI=SFW*(1D0-(PARJ(123)/ECM)**2)
0072         VE=4D0*PARU(102)-1D0
0073         SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131))
0074         SF1W=SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131)))
0075         HF1I=SFI*SF1I
0076         HF1W=SFW*SF1W
0077       ENDIF
0078  
0079 C...Loop over different flavours: charge, velocity.
0080       RTOT=0D0
0081       RQQ=0D0
0082       RQV=0D0
0083       RVA=0D0
0084       DO 110 KFLC=1,MAX(MSTJ(104),KFL)
0085         IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110
0086         MSTJ(93)=1
0087         PMQ=PYMASS(KFLC)
0088         IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 110
0089         QF=KCHG(KFLC,1)/3D0
0090         VQ=1D0
0091         IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1D0-(2D0*PMQ/ECM)**2)
0092  
0093 C...Calculate R and sum of charges for QED or QFD case.
0094         RQQ=RQQ+3D0*QF**2*POLL
0095         IF(MSTJ(102).LE.1) THEN
0096           RTOT=RTOT+3D0*0.5D0*VQ*(3D0-VQ**2)*QF**2*POLL
0097         ELSE
0098           VF=SIGN(1D0,QF)-4D0*QF*PARU(102)
0099           RQV=RQV-6D0*QF*VF*SF1I
0100           RVA=RVA+3D0*(VF**2+1D0)*SF1W
0101           RTOT=RTOT+3D0*(0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-
0102      &    2D0*QF*VF*HF1I+VF**2*HF1W)+VQ**3*HF1W)
0103         ENDIF
0104   110 CONTINUE
0105       RSUM=RQQ
0106       IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA
0107  
0108 C...Calculate cross-section, including QCD corrections.
0109       PARJ(141)=RQQ
0110       PARJ(142)=RTOT
0111       PARJ(143)=RTOT*RQCD
0112       PARJ(144)=PARJ(143)
0113       PARJ(145)=PARJ(141)*86.8D0/ECM**2
0114       PARJ(146)=PARJ(142)*86.8D0/ECM**2
0115       PARJ(147)=PARJ(143)*86.8D0/ECM**2
0116       PARJ(148)=PARJ(147)
0117       PARJ(157)=RSUM*RQCD
0118       PARJ(158)=0D0
0119       PARJ(159)=0D0
0120       XTOT=PARJ(147)
0121       IF(MSTJ(107).LE.0) RETURN
0122  
0123 C...Virtual cross-section.
0124       XKL=PARJ(135)
0125       XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2)
0126       ALE=2D0*LOG(ECM/PYMASS(11))-1D0
0127       SIGV=ALE/3D0+2D0*LOG(ECM**2/(PYMASS(13)*PYMASS(15)))/3D0-4D0/3D0+
0128      &1.526D0*LOG(ECM**2/0.932D0)
0129  
0130 C...Soft and hard radiative cross-section in QED case.
0131       IF(MSTJ(102).LE.1) THEN
0132         SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+2D0*SIGV
0133         SIGS=ALE*(2D0*LOG(XKL)-LOG(1D0-XKL)-XKL)
0134         SIGH=ALE*(2D0*LOG(XKU/XKL)-LOG((1D0-XKU)/(1D0-XKL))-(XKU-XKL))
0135  
0136 C...Soft and hard radiative cross-section in QFD case.
0137       ELSE
0138         SZM=1D0-(PARJ(123)/ECM)**2
0139         SZW=PARJ(123)*PARJ(124)/ECM**2
0140         PARJ(161)=-RQQ/RSUM
0141         PARJ(162)=-(RQQ+RQV+RVA)/RSUM
0142         PARJ(163)=(RQV*(1D0-0.5D0*SZM-SFI)+RVA*(1.5D0-SZM-SFW))/RSUM
0143         PARJ(164)=(RQV*SZW**2*(1D0-2D0*SFW)+RVA*(2D0*SFI+SZW**2-
0144      &  4D0+3D0*SZM-SZM**2))/(SZW*RSUM)
0145         SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+((2D0*RQQ+SFI*RQV)/
0146      &  RSUM)*SIGV+(SZW*SFW*RQV/RSUM)*PARU(1)*20D0/9D0
0147         SIGS=ALE*(2D0*LOG(XKL)+PARJ(161)*LOG(1D0-XKL)+PARJ(162)*XKL+
0148      &  PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+
0149      &  PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW)))
0150         SIGH=ALE*(2D0*LOG(XKU/XKL)+PARJ(161)*LOG((1D0-XKU)/
0151      &  (1D0-XKL))+PARJ(162)*(XKU-XKL)+PARJ(163)*
0152      &  LOG(((XKU-SZM)**2+SZW**2)/((XKL-SZM)**2+SZW**2))+
0153      &  PARJ(164)*(ATAN((XKU-SZM)/SZW)-ATAN((XKL-SZM)/SZW)))
0154       ENDIF
0155  
0156 C...Total cross-section and fraction of hard photon events.
0157       PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH)
0158       PARJ(157)=RSUM*(1D0+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD
0159       PARJ(144)=PARJ(157)
0160       PARJ(148)=PARJ(144)*86.8D0/ECM**2
0161       XTOT=PARJ(148)
0162  
0163       RETURN
0164       END