Corrections to line for alpha

[u/mrichter/AliRoot.git] / PYTHIA / pythia / pystel.F

 
C*********************************************************************
 
      SUBROUTINE PYSTEL(X,Q2,XPEL)
 
C...Gives electron structure function.
      COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
      COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
      COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
      COMMON/PYINT1/MINT(400),VINT(400)
      SAVE /LUDAT1/,/LUDAT2/
      SAVE /PYPARS/,/PYINT1/
      DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6)
 
C...Interface to PDFLIB.
      COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX
      SAVE /W50513/
      DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU,
     &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX
      CHARACTER*20 PARM(20)
      DATA VALUE/20*0D0/,PARM/20*' '/
 
C...Some common constants.
      DO 100 KFL=-25,25
      XPEL(KFL)=0.
  100 CONTINUE
      AEM=PARU(101)
      PME=PMAS(11,1)
      XL=LOG(MAX(1E-10,X))
      X1L=LOG(MAX(1E-10,1.-X))
      HLE=LOG(MAX(3.,Q2/PME**2))
      HBE2=(AEM/PARU(1))*(HLE-1.)
 
C...Electron inside electron, see R. Kleiss et al., in Z physics at
C...LEP 1, CERN 89-08, p. 34
      IF(MSTP(59).LE.1) THEN
        HDE=1.+(AEM/PARU(1))*(1.5*HLE+1.289868)+(AEM/PARU(1))**2*
     &  (-2.164868*HLE**2+9.840808*HLE-10.130464)
        HEE=HBE2*(1.-X)**(HBE2-1.)*SQRT(MAX(0.,HDE))-
     &  0.5*HBE2*(1.+X)+HBE2**2/8.*((1.+X)*(-4.*X1L+3.*XL)-
     &  4.*XL/(1.-X)-5.-X)
      ELSE
        HEE=HBE2*(1.-X)**(HBE2-1.)*EXP(0.172784*HBE2)/PYGAMM(1.+HBE2)-
     &  0.5*HBE2*(1.+X)+HBE2**2/8.*((1.+X)*(-4.*X1L+3.*XL)-
     &  4.*XL/(1.-X)-5.-X)        
      ENDIF
      IF(X.GT.0.9999.AND.X.LE.0.999999) THEN
        HEE=HEE*100.**HBE2/(100.**HBE2-1.)
      ELSEIF(X.GT.0.999999) THEN
        HEE=0.
      ENDIF
      XPEL(11)=X*HEE
 
C...Photon and (transverse) W- inside electron.
      AEMP=ULALEM(PME*SQRT(MAX(0.,Q2)))/PARU(2)
      IF(MSTP(13).LE.1) THEN
        HLG=HLE
      ELSE
        HLG=LOG(MAX(1.,(PARP(13)/PME**2)*(1.-X)/X**2))
      ENDIF
      XPEL(22)=AEMP*HLG*(1.+(1.-X)**2)
      HLW=LOG(1.+Q2/PMAS(24,1)**2)/(4.*PARU(102))
      XPEL(-24)=AEMP*HLW*(1.+(1.-X)**2)
 
C...Electron or positron inside photon inside electron.
      IF(MSTP(12).EQ.1) THEN
        XFSEA=0.5*(AEMP*(HLE-1.))**2*(4./3.+X-X**2-4.*X**3/3.+
     &  2.*X*(1.+X)*XL)
        XPEL(11)=XPEL(11)+XFSEA
        XPEL(-11)=XFSEA
 
C...Initialize PDFLIB photon structure functions.
        IF(MSTP(56).EQ.2) THEN
          PARM(1)='NPTYPE'
          VALUE(1)=3
          PARM(2)='NGROUP'
          VALUE(2)=MSTP(55)/1000
          PARM(3)='NSET'
          VALUE(3)=MOD(MSTP(55),1000)
          IF(MINT(93).NE.3000000+MSTP(55)) THEN
            CALL PDFSET(PARM,VALUE)
            MINT(93)=3000000+MSTP(55)
          ENDIF
        ENDIF
 
C...Quarks and gluons inside photon inside electron:
C...numerical convolution required.
        DO 110 KFL=0,6
        SXP(KFL)=0.
  110   CONTINUE
        SUMXPP=0.
        ITER=-1
  120   ITER=ITER+1
        SUMXP=SUMXPP
        NSTP=2**(ITER-1)
        IF(ITER.EQ.0) NSTP=2
        DO 130 KFL=0,6
        SXP(KFL)=0.5*SXP(KFL)
  130   CONTINUE
        WTSTP=0.5/NSTP
        IF(ITER.EQ.0) WTSTP=0.5
C...Pick grid of x_{gamma} values logarithmically even.
        DO 150 ISTP=1,NSTP
        IF(ITER.EQ.0) THEN
          XLE=XL*(ISTP-1)
        ELSE
          XLE=XL*(ISTP-0.5)/NSTP
        ENDIF
        XE=MIN(0.999999,EXP(XLE))
        XG=MIN(0.999999,X/XE)
C...Evaluate photon inside electron structure function for convolution.
        XPGP=1.+(1.-XE)**2
        IF(MSTP(13).LE.1) THEN
          XPGP=XPGP*HLE
        ELSE
          XPGP=XPGP*LOG(MAX(1.,(PARP(13)/PME**2)*(1.-XE)/XE**2))
        ENDIF
C...Evaluate photon structure functions for convolution.
        IF(MSTP(56).EQ.1) THEN
          CALL PYSTGA(XG,Q2,XPGA)
          DO 140 KFL=0,5
          SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL)
  140     CONTINUE
        ELSEIF(MSTP(56).EQ.2) THEN
C...Call PDFLIB structure functions.
          XX=XG
          QQ=SQRT(MAX(0.,SNGL(Q2MIN),Q2))
          IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
          CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
          SXP(0)=SXP(0)+WTSTP*XPGP*GLU
          SXP(1)=SXP(1)+WTSTP*XPGP*DNV
          SXP(2)=SXP(2)+WTSTP*XPGP*UPV
          SXP(3)=SXP(3)+WTSTP*XPGP*STR
          SXP(4)=SXP(4)+WTSTP*XPGP*CHM
          SXP(5)=SXP(5)+WTSTP*XPGP*BOT
          SXP(6)=SXP(6)+WTSTP*XPGP*TOP
        ENDIF
  150   CONTINUE
        SUMXPP=SXP(0)+2.*SXP(1)+2.*SXP(2)
        IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT.
     &  PARP(14)*(SUMXPP+SUMXP))) GOTO 120
 
C...Put convolution into output arrays.
        FCONV=AEMP*(-XL)
        XPEL(0)=FCONV*SXP(0)
        DO 160 KFL=1,6
        XPEL(KFL)=FCONV*SXP(KFL)
        XPEL(-KFL)=XPEL(KFL)
  160   CONTINUE
      ENDIF
 
      RETURN
      END