Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYPDEL
0005 C...Gives electron (or muon, or tau) parton distribution.
0006  
0007       SUBROUTINE PYPDEL(KFA,X,Q2,XPEL)
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013 C...Commonblocks.
0014       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0015       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0016       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0017       COMMON/PYINT1/MINT(400),VINT(400)
0018       SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/
0019 C...Local arrays.
0020       DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6)
0021  
0022 C...Interface to PDFLIB.
0023       COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX
0024       SAVE /W50513/
0025       DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU,
0026      &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX
0027       CHARACTER*20 PARM(20)
0028       DATA VALUE/20*0D0/,PARM/20*' '/
0029  
0030 C...Some common constants.
0031       DO 100 KFL=-25,25
0032         XPEL(KFL)=0D0
0033   100 CONTINUE
0034       AEM=PARU(101)
0035       PME=PMAS(11,1)
0036       IF(KFA.EQ.13) PME=PMAS(13,1)
0037       IF(KFA.EQ.15) PME=PMAS(15,1)
0038       XL=LOG(MAX(1D-10,X))
0039       X1L=LOG(MAX(1D-10,1D0-X))
0040       HLE=LOG(MAX(3D0,Q2/PME**2))
0041       HBE2=(AEM/PARU(1))*(HLE-1D0)
0042  
0043 C...Electron inside electron, see R. Kleiss et al., in Z physics at
0044 C...LEP 1, CERN 89-08, p. 34
0045       IF(MSTP(59).LE.1) THEN
0046         HDE=1D0+(AEM/PARU(1))*(1.5D0*HLE+1.289868D0)+(AEM/PARU(1))**2*
0047      &  (-2.164868D0*HLE**2+9.840808D0*HLE-10.130464D0)
0048         HEE=HBE2*(1D0-X)**(HBE2-1D0)*SQRT(MAX(0D0,HDE))-
0049      &  0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*(-4D0*X1L+3D0*XL)-
0050      &  4D0*XL/(1D0-X)-5D0-X)
0051       ELSE
0052         HEE=HBE2*(1D0-X)**(HBE2-1D0)*EXP(0.172784D0*HBE2)/
0053      &  PYGAMM(1D0+HBE2)-0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*
0054      &  (-4D0*X1L+3D0*XL)-4D0*XL/(1D0-X)-5D0-X)
0055       ENDIF
0056 C...Zero distribution for very large x and rescale it for intermediate.
0057       IF(X.GT.1D0-1D-10) THEN
0058         HEE=0D0
0059       ELSEIF(X.GT.1D0-1D-7) THEN
0060         HEE=HEE*1000D0**HBE2/(1000D0**HBE2-1D0)
0061       ENDIF
0062       XPEL(KFA)=X*HEE
0063  
0064 C...Photon and (transverse) W- inside electron.
0065       AEMP=PYALEM(PME*SQRT(MAX(0D0,Q2)))/PARU(2)
0066       IF(MSTP(13).LE.1) THEN
0067         HLG=HLE
0068       ELSE
0069         HLG=LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-X)/X**2))
0070       ENDIF
0071       XPEL(22)=AEMP*HLG*(1D0+(1D0-X)**2)
0072       HLW=LOG(1D0+Q2/PMAS(24,1)**2)/(4D0*PARU(102))
0073       XPEL(-24)=AEMP*HLW*(1D0+(1D0-X)**2)
0074  
0075 C...Electron or positron inside photon inside electron.
0076       IF(KFA.EQ.11.AND.MSTP(12).EQ.1) THEN
0077         XFSEA=0.5D0*(AEMP*(HLE-1D0))**2*(4D0/3D0+X-X**2-4D0*X**3/3D0+
0078      &  2D0*X*(1D0+X)*XL)
0079         XPEL(11)=XPEL(11)+XFSEA
0080         XPEL(-11)=XFSEA
0081  
0082 C...Initialize PDFLIB photon parton distributions.
0083         IF(MSTP(56).EQ.2) THEN
0084           PARM(1)='NPTYPE'
0085           VALUE(1)=3
0086           PARM(2)='NGROUP'
0087           VALUE(2)=MSTP(55)/1000
0088           PARM(3)='NSET'
0089           VALUE(3)=MOD(MSTP(55),1000)
0090           IF(MINT(93).NE.3000000+MSTP(55)) THEN
0091 C             CALL PDFSET(PARM,VALUE)
0092             MINT(93)=3000000+MSTP(55)
0093           ENDIF
0094         ENDIF
0095  
0096 C...Quarks and gluons inside photon inside electron:
0097 C...numerical convolution required.
0098         DO 110 KFL=0,6
0099           SXP(KFL)=0D0
0100   110   CONTINUE
0101         SUMXPP=0D0
0102         ITER=-1
0103   120   ITER=ITER+1
0104         SUMXP=SUMXPP
0105         NSTP=2**(ITER-1)
0106         IF(ITER.EQ.0) NSTP=2
0107         DO 130 KFL=0,6
0108           SXP(KFL)=0.5D0*SXP(KFL)
0109   130   CONTINUE
0110         WTSTP=0.5D0/NSTP
0111         IF(ITER.EQ.0) WTSTP=0.5D0
0112 C...Pick grid of x_{gamma} values logarithmically even.
0113         DO 150 ISTP=1,NSTP
0114           IF(ITER.EQ.0) THEN
0115             XLE=XL*(ISTP-1)
0116           ELSE
0117             XLE=XL*(ISTP-0.5D0)/NSTP
0118           ENDIF
0119           XE=MIN(1D0-1D-10,EXP(XLE))
0120           XG=MIN(1D0-1D-10,X/XE)
0121 C...Evaluate photon inside electron parton distribution for convolution.
0122           XPGP=1D0+(1D0-XE)**2
0123           IF(MSTP(13).LE.1) THEN
0124             XPGP=XPGP*HLE
0125           ELSE
0126             XPGP=XPGP*LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-XE)/XE**2))
0127           ENDIF
0128 C...Evaluate photon parton distributions for convolution.
0129           IF(MSTP(56).EQ.1) THEN
0130             IF(MSTP(55).EQ.1) THEN
0131               CALL PYPDGA(XG,Q2,XPGA)
0132             ELSEIF(MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN
0133               Q2MX=Q2
0134               P2MX=0.36D0
0135               IF(MSTP(55).GE.7) P2MX=4.0D0
0136               IF(MSTP(57).EQ.0) Q2MX=P2MX
0137               P2=0D0
0138               IF(VINT(120).LT.0D0) P2=VINT(120)**2
0139               CALL PYGGAM(MSTP(55)-4,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA)
0140               VINT(231)=P2MX
0141             ELSEIF(MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN
0142               Q2MX=Q2
0143               P2MX=0.36D0
0144               IF(MSTP(55).GE.11) P2MX=4.0D0
0145               IF(MSTP(57).EQ.0) Q2MX=P2MX
0146               P2=0D0
0147               IF(VINT(120).LT.0D0) P2=VINT(120)**2
0148               CALL PYGGAM(MSTP(55)-8,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA)
0149               VINT(231)=P2MX
0150             ENDIF
0151             DO 140 KFL=0,5
0152               SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL)
0153   140       CONTINUE
0154           ELSEIF(MSTP(56).EQ.2) THEN
0155 C...Call PDFLIB parton distributions.
0156             XX=XG
0157             QQ=SQRT(MAX(0D0,Q2MIN,Q2))
0158             IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
0159 C            CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
0160             SXP(0)=SXP(0)+WTSTP*XPGP*GLU
0161             SXP(1)=SXP(1)+WTSTP*XPGP*DNV
0162             SXP(2)=SXP(2)+WTSTP*XPGP*UPV
0163             SXP(3)=SXP(3)+WTSTP*XPGP*STR
0164             SXP(4)=SXP(4)+WTSTP*XPGP*CHM
0165             SXP(5)=SXP(5)+WTSTP*XPGP*BOT
0166             SXP(6)=SXP(6)+WTSTP*XPGP*TOP
0167           ENDIF
0168   150   CONTINUE
0169         SUMXPP=SXP(0)+2D0*SXP(1)+2D0*SXP(2)
0170         IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT.
0171      &  PARP(14)*(SUMXPP+SUMXP))) GOTO 120
0172  
0173 C...Put convolution into output arrays.
0174         FCONV=AEMP*(-XL)
0175         XPEL(0)=FCONV*SXP(0)
0176         DO 160 KFL=1,6
0177           XPEL(KFL)=FCONV*SXP(KFL)
0178           XPEL(-KFL)=XPEL(KFL)
0179   160   CONTINUE
0180       ENDIF
0181  
0182       RETURN
0183       END