EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
parton.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file parton.f
1 C
2 C
3 C
4  SUBROUTINE parton(F,X1,X2,QQ)
5  IMPLICIT REAL*8(a-h,o-z)
6  REAL hipr1(100),hint1(100)
7  common/hiparnt/hipr1,ihpr2(50),hint1,ihnt2(50)
8  SAVE /hiparnt/
9  common/njet/n,ip_crs
10  SAVE /njet/
11  dimension f(2,7)
12  dlam=hipr1(15)
13  q0=hipr1(16)
14  s=dlog(dlog(qq/dlam**2)/dlog(q0**2/dlam**2))
15  IF(ihpr2(7).EQ.2) go to 200
16 C*******************************************************
17  at1=0.419+0.004*s-0.007*s**2
18  at2=3.460+0.724*s-0.066*s**2
19  gmud=4.40-4.86*s+1.33*s**2
20  at3=0.763-0.237*s+0.026*s**2
21  at4=4.00+0.627*s-0.019*s**2
22  gmd=-0.421*s+0.033*s**2
23 C*******************************************************
24  cas=1.265-1.132*s+0.293*s**2
25  as=-0.372*s-0.029*s**2
26  bs=8.05+1.59*s-0.153*s**2
27  aphs=6.31*s-0.273*s**2
28  btas=-10.5*s-3.17*s**2
29  gms=14.7*s+9.80*s**2
30 C********************************************************
31 C CAC=0.135*S-0.075*S**2
32 C AC=-0.036-0.222*S-0.058*S**2
33 C BC=6.35+3.26*S-0.909*S**2
34 C APHC=-3.03*S+1.50*S**2
35 C BTAC=17.4*S-11.3*S**2
36 C GMC=-17.9*S+15.6*S**2
37 C***********************************************************
38  cag=1.56-1.71*s+0.638*s**2
39  ag=-0.949*s+0.325*s**2
40  bg=6.0+1.44*s-1.05*s**2
41  aphg=9.0-7.19*s+0.255*s**2
42  btag=-16.5*s+10.9*s**2
43  gmg=15.3*s-10.1*s**2
44  go to 300
45 C********************************************************
46 200 at1=0.374+0.014*s
47  at2=3.33+0.753*s-0.076*s**2
48  gmud=6.03-6.22*s+1.56*s**2
49  at3=0.761-0.232*s+0.023*s**2
50  at4=3.83+0.627*s-0.019*s**2
51  gmd=-0.418*s+0.036*s**2
52 C************************************
53  cas=1.67-1.92*s+0.582*s**2
54  as=-0.273*s-0.164*s**2
55  bs=9.15+0.530*s-0.763*s**2
56  aphs=15.7*s-2.83*s**2
57  btas=-101.0*s+44.7*s**2
58  gms=223.0*s-117.0*s**2
59 C*********************************
60 C CAC=0.067*S-0.031*S**2
61 C AC=-0.120-0.233*S-0.023*S**2
62 C BC=3.51+3.66*S-0.453*S**2
63 C APHC=-0.474*S+0.358*S**2
64 C BTAC=9.50*S-5.43*S**2
65 C GMC=-16.6*S+15.5*S**2
66 C**********************************
67  cag=0.879-0.971*s+0.434*s**2
68  ag=-1.16*s+0.476*s**2
69  bg=4.0+1.23*s-0.254*s**2
70  aphg=9.0-5.64*s-0.817*s**2
71  btag=-7.54*s+5.50*s**2
72  gmg=-0.596*s+1.26*s**2
73 C*********************************
74 300 b12=dexp(gmre(at1)+gmre(at2+1.d0)-gmre(at1+at2+1.d0))
75  b34=dexp(gmre(at3)+gmre(at4+1.d0)-gmre(at3+at4+1.d0))
76  cnud=3.d0/b12/(1.d0+gmud*at1/(at1+at2+1.d0))
77  cnd=1.d0/b34/(1.d0+gmd*at3/(at3+at4+1.d0))
78 C********************************************************
79 C FUD=X*(U+D)
80 C FS=X*2(UBAR+DBAR+SBAR) AND UBAR=DBAR=SBAR
81 C*******************************************************
82  fud1=cnud*x1**at1*(1.d0-x1)**at2*(1.d0+gmud*x1)
83  fs1=cas*x1**as*(1.d0-x1)**bs*(1.d0+aphs*x1
84  & +btas*x1**2+gms*x1**3)
85  f(1,3)=cnd*x1**at3*(1.d0-x1)**at4*(1.d0+gmd*x1)+fs1/6.d0
86  f(1,1)=fud1-f(1,3)+fs1/3.d0
87  f(1,2)=fs1/6.d0
88  f(1,4)=fs1/6.d0
89  f(1,5)=fs1/6.d0
90  f(1,6)=fs1/6.d0
91  f(1,7)=cag*x1**ag*(1.d0-x1)**bg*(1.d0+aphg*x1
92  & +btag*x1**2+gmg*x1**3)
93 C
94  fud2=cnud*x2**at1*(1.d0-x2)**at2*(1.d0+gmud*x2)
95  fs2=cas*x2**as*(1.d0-x2)**bs*(1.d0+aphs*x2
96  & +btas*x2**2+gms*x2**3)
97  f(2,3)=cnd*x2**at3*(1.d0-x2)**at4*(1.d0+gmd*x2)+fs2/6.d0
98  f(2,1)=fud2-f(2,3)+fs2/3.d0
99  f(2,2)=fs2/6.d0
100  f(2,4)=fs2/6.d0
101  f(2,5)=fs2/6.d0
102  f(2,6)=fs2/6.d0
103  f(2,7)=cag*x2**ag*(1.d0-x2)**bg*(1.d0+aphg*x2
104  & +btag*x2**2+gmg*x2**3)
105 C***********Nuclear effect on the structure function****************
106 C
107  IF(ihpr2(6).EQ.1 .AND. ihnt2(1).GT.1) THEN
108  aax=1.193*alog(float(ihnt2(1)))**0.16666666
109  rrx=aax*(x1**3-1.2*x1**2+0.21*x1)+1.0
110  & +1.079*(float(ihnt2(1))**0.33333333-1.0)
111  & /dlog(ihnt2(1)+1.0d0)*dsqrt(x1)*dexp(-x1**2/0.01)
112  IF(ip_crs.EQ.1 .OR.ip_crs.EQ.3) rrx=dexp(-x1**2/0.01)
113  DO 400 i=1,7
114  f(1,i)=rrx*f(1,i)
115  400 CONTINUE
116  ENDIF
117  IF(ihpr2(6).EQ.1 .AND. ihnt2(3).GT.1) THEN
118  aax=1.193*alog(float(ihnt2(3)))**0.16666666
119  rrx=aax*(x2**3-1.2*x2**2+0.21*x2)+1.0
120  & +1.079*(float(ihnt2(3))**0.33333-1.0)
121  & /dlog(ihnt2(3)+1.0d0)*dsqrt(x2)*dexp(-x2**2/0.01)
122  IF(ip_crs.EQ.2 .OR. ip_crs.EQ.3) rrx=dexp(-x2**2/0.01)
123  DO 500 i=1,7
124  f(2,i)=rrx*f(2,i)
125  500 CONTINUE
126  ENDIF
127 c
128  RETURN
129  END