hijing/dummy/pyhistfe.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE PYHISTFE(KF,X,Q2,XPQ)
0005
0006 C...This is a dummy routine, where the user can introduce an interface
0007 C...to his own external structure function parametrization.
0008 C...Arguments in:
0009 C...KF : 2212 for p, 211 for pi+; isospin conjugation for n and charge
0010 C...    conjugation for pbar, nbar or pi- is performed by PYSTFU.
0011 C...X : x value.
0012 C...Q2 : Q^2 value.
0013 C...Arguments out:
0014 C...XPQ(-6:6) : x * f(x,Q2), with index according to KF code,
0015 C...    except that gluon is placed in 0. Thus XPQ(0) = xg,
0016 C...    XPQ(1) = xd, XPQ(-1) = xdbar, XPQ(2) = xu, XPQ(-2) = xubar,
0017 C...    XPQ(3) = xs, XPQ(-3) = xsbar, XPQ(4) = xc, XPQ(-4) = xcbar,
0018 C...    XPQ(5) = xb, XPQ(-5) = xbbar, XPQ(6) = xt, XPQ(-6) = xtbar.
0019 C...
0020 C...One such interface, to the Diemos, Ferroni, Longo, Martinelli
0021 C...proton structure functions, already comes with the package. What
0022 C...the user needs here is external files with the three routines
0023 C...FXG160, FXG260 and FXG360 of the authors above, plus the
0024 C...interpolation routine FINT, which is part of the CERN library
0025 C...KERNLIB package. To avoid problems with unresolved external
0026 C...references, the external calls are commented in the current
0027 C...version. To enable this option, remove the C* at the beginning
0028 C...of the relevant lines.
0029 C...
0030 C...Alternatively, the routine can be used as an interface to the
0031 C...structure function evolution program of Tung. This can be achieved
0032 C...by removing C* at the beginning of some of the lines below.
0033       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0034       SAVE  /LUDAT1/
0035       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0036       SAVE  /LUDAT2/
0037       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0038       SAVE  /PYHIPARS/
0039       DIMENSION XPQ(-6:6),XFDFLM(9)
0040       CHARACTER CHDFLM(9)*5,HEADER*40
0041       DATA CHDFLM/'UPVAL','DOVAL','GLUON','QBAR ','UBAR ','SBAR ',
0042      &'CBAR ','BBAR ','TBAR '/
0043       DATA HEADER/'Tung evolution package has been invoked'/
0044       DATA INIT/0/
0045
0046       SAVE XFDFLM, INIT                                     ! Uzhi
0047
0048 C...Proton structure functions from Diemoz, Ferroni, Longo, Martinelli.
0049 C...Allowed variable range 10 GeV2 < Q2 < 1E8 GeV2, 5E-5 < x < .95.
0050       IF(MSTP(51).GE.11.AND.MSTP(51).LE.13.AND.MSTP(52).LE.1) THEN
0051         XDFLM=MAX(0.51E-4,X)
0052         Q2DFLM=MAX(10.,MIN(1E8,Q2))
0053         IF(MSTP(52).EQ.0) Q2DFLM=10.
0054         DO 100 J=1,9
0055         IF(MSTP(52).EQ.1.AND.J.EQ.9) THEN
0056           Q2DFLM=Q2DFLM*(40./PMAS(6,1))**2
0057           Q2DFLM=MAX(10.,MIN(1E8,Q2))
0058         ENDIF
0059         XFDFLM(J)=0.
0060 C...Remove C* on following three lines to enable the DFLM options.
0061 C*      IF(MSTP(51).EQ.11) CALL FXG160(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J))
0062 C*      IF(MSTP(51).EQ.12) CALL FXG260(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J))
0063 C*      IF(MSTP(51).EQ.13) CALL FXG360(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J))
0064   100   CONTINUE
0065         IF(X.LT.0.51E-4.AND.ABS(PARP(51)-1.).GT.0.01) THEN
0066           CXS=(0.51E-4/X)**(PARP(51)-1.)
0067           DO 110 J=1,7
0068   110     XFDFLM(J)=XFDFLM(J)*CXS
0069         ENDIF
0070         XPQ(0)=XFDFLM(3)
0071         XPQ(1)=XFDFLM(2)+XFDFLM(5)
0072         XPQ(2)=XFDFLM(1)+XFDFLM(5)
0073         XPQ(3)=XFDFLM(6)
0074         XPQ(4)=XFDFLM(7)
0075         XPQ(5)=XFDFLM(8)
0076         XPQ(6)=XFDFLM(9)
0077         XPQ(-1)=XFDFLM(5)
0078         XPQ(-2)=XFDFLM(5)
0079         XPQ(-3)=XFDFLM(6)
0080         XPQ(-4)=XFDFLM(7)
0081         XPQ(-5)=XFDFLM(8)
0082         XPQ(-6)=XFDFLM(9)
0083
0084 C...Proton structure function evolution from Wu-Ki Tung: parton
0085 C...distribution functions incorporating heavy quark mass effects.
0086 C...Allowed variable range: PARP(52) < Q < PARP(53); PARP(54) < x < 1.
0087       ELSE
0088         IF(INIT.EQ.0) THEN
0089           I1=0
0090           IF(MSTP(52).EQ.4) I1=1
0091           IHDRN=1
0092           NU=MSTP(53)
0093           I2=MSTP(51)
0094           IF(MSTP(51).GE.11) I2=MSTP(51)-3
0095           I3=0
0096           IF(MSTP(52).EQ.3) I3=1
0097
0098 C...Convert to Lambda in CWZ scheme (approximately linear relation).
0099           ALAM=0.75*PARP(1)
0100           TPMS=PMAS(6,1)
0101           QINI=PARP(52)
0102           QMAX=PARP(53)
0103           XMIN=PARP(54)
0104
0105 C...Initialize evolution (perform calculation or read results from
0106 C...file).
0107 C...Remove C* on following two lines to enable Tung initialization.
0108 C*        CALL PDFSET(I1,IHDRN,ALAM,TPMS,QINI,QMAX,XMIN,NU,HEADER,
0109 C*   &    I2,I3,IRET,IRR)
0110           INIT=1
0111         ENDIF
0112
0113 C...Put into output array.
0114         Q=SQRT(Q2)
0115         DO 200 I=-6,6
0116         FIXQ=0.
0117 C...Remove C* on following line to enable structure function call.
0118 C*      FIXQ=MAX(0.,PDF(10,1,I,X,Q,IR))
0119   200   XPQ(I)=X*FIXQ
0120
0121 C...Change order of u and d quarks from Tung to PYTHIA convention.
0122         XPS=XPQ(1)
0123         XPQ(1)=XPQ(2)
0124         XPQ(2)=XPS
0125         XPS=XPQ(-1)
0126         XPQ(-1)=XPQ(-2)
0127         XPQ(-2)=XPS
0128       ENDIF
0129
0130       RETURN
0131       END