]> git.uio.no Git - u/mrichter/AliRoot.git/blame - LHAPDF/lhapdf5.3.1/wrapowpi.f
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
TENDER becomes Tender, removing .so
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.3.1 / wrapowpi.f
CommitLineData
4e9e3152 1 subroutine OWPevolve(xin,qin,pdf)
2 include 'parmsetup.inc'
3 real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5
4 real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu
5 character*16 name(nmxset)
6 integer nmem(nmxset),ndef(nmxset)
7 common/NAME/name,nmem,ndef,mmem
8 integer mem,mmem
9 integer nset
10c integer iset,iimem
11c common/SET/iset,iimem
12
13 save
14
15 q2in = qin*qin
16c iset = imem
17
18 if(imem.eq.0) then
19 call strowp1(xin,Qin,upv,dnv,usea,str,chm,glu)
20 elseif(imem.eq.1) then
21 call strowp1(xin,Qin,upv,dnv,usea,str,chm,glu)
22 elseif(imem.eq.2) then
23 call strowp2(xin,Qin,upv,dnv,usea,str,chm,glu)
24 else
25 endif
26
27 pdf(-6)= 0.0d0
28 pdf(6)= 0.0d0
29 pdf(-5)= 0.0d0
30 pdf(5 )= 0.0d0
31 pdf(-4)= chm
32 pdf(4 )= chm
33 pdf(-3)= str
34 pdf(3 )= str
35 pdf(-2)= usea
36 pdf(2 )= upv+usea
37 pdf(-1)= usea
38 pdf(1 )= dnv+usea
39 pdf(0 )= glu
40
41 return
42c
43ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
44 entry OWPread(nset)
45 read(1,*)nmem(nset),ndef(nset)
46c iset = nset
47 return
48c
49ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
50 entry OWPalfa(alfas,qalfa)
51 call getnset(iset)
52 call GetOrderAsM(iset,iord)
53c print*,'from getorderasm',iord
54 call Getlam4M(iset,imem,qcdl4)
55c print*,'from getorderasm',iord
56 call Getlam5M(iset,imem,qcdl5)
57c print*,'from getorderasm',iord
58 call aspdflib(alfas,Qalfa,iord,qcdl5)
59 return
60c
61ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
62 entry OWPinit(Eorder,Q2fit)
63 return
64c
65ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
66 entry OWPpdf(mem)
67 imem = mem
68 return
69c
70 1000 format(5e13.5)
71 end
72c
73ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
74C*********************************************************************
75
76 SUBROUTINE STROWP1(X,SCALE,UPV,DNV,SEA,STR,CHM,GL)
77C :::::::::::::: OWENS SET 1 PION STRUCTURE FUNCTION :::::::::::::::
78 implicit real*8 (a-h,o-z)
79 DOUBLE PRECISION DGAMMA_LHA
80 double precision
81 + COW(3,5,4),TS(6),XQ(9)
82
83C...Expansion coefficients for up and down valence quark distributions.
84 DATA ((COW(IP,IS,1),IS=1,5),IP=1,3)/
85 1 4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
86 2 -6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
87 3 -7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/
88C...Expansion coefficients for gluon distribution.
89 DATA ((COW(IP,IS,2),IS=1,5),IP=1,3)/
90 1 8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00,
91 2 -1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01,
92 3 1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/
93C...Expansion coefficients for (up+down+strange) quark sea distribution.
94 DATA ((COW(IP,IS,3),IS=1,5),IP=1,3)/
95 1 9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00,
96 2 -2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00,
97 3 1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/
98C...Expansion coefficients for charm quark sea distribution.
99 DATA ((COW(IP,IS,4),IS=1,5),IP=1,3)/
100 1 0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00,
101 2 7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00,
102 3 -6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/
103
104 DATA ZEROD/0.D0/, ONED/1.D0/, SIXD/6.D0/
105 DATA ALAM/0.2D0/, Q02/4.D0/, QMAX2/2.D3/
106C...Pion structure functions from Owens.
107C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2.
108
109C...Determine set, Lambda and s expansion variable.
110 Q2 = SCALE*SCALE
111 Q2IN = MIN( QMAX2,MAX( Q02,Q2))
112 SD = LOG( LOG( Q2IN/ALAM**2)/ LOG( Q02/ALAM**2))
113
114C...Calculate structure functions.
115 DO 240 KFL=1,4
116 DO 230 IS=1,5
117 230 TS(IS)=COW(1,IS,KFL)+COW(2,IS,KFL)*SD+
118 & COW(3,IS,KFL)*SD*SD
119 IF(KFL.EQ.1) THEN
120cif defined(CERNLIB_SINGLE)
121c DENOM = GAMMA(TS(1))*GAMMA(TS(2)+ONED)/GAMMA(TS(1)+TS(2)+ONED)
122cendif
123cif defined(CERNLIB_DOUBLE)
124 DENOM = DGAMMA_LHA(TS(1))*DGAMMA_LHA(TS(2)+ONED)/
125 + DGAMMA_LHA(TS(1)+TS(2)+ONED)
126cendif
127 XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/DENOM
128 ELSE
129 XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2)
130 ENDIF
131 240 CONTINUE
132
133C...Put into output arrays.
134 UPV = XQ(1)
135 DNV = XQ(1)
136 SEA = XQ(3)/SIXD
137 STR = XQ(3)/SIXD
138 CHM = XQ(4)
139 BOT = ZEROD
140 TOP = ZEROD
141 GL = XQ(2)
142C
143 RETURN
144 END
145
146C*********************************************************************
147
148 SUBROUTINE STROWP2(X,SCALE,UPV,DNV,SEA,STR,CHM,GL)
149C :::::::::::::: OWENS SET 2 PION STRUCTURE FUNCTION :::::::::::::::
150 implicit real*8 (a-h,o-z)
151 DOUBLE PRECISION DGAMMA_LHA
152 double precision
153 + COW(3,5,4),TS(6),XQ(9)
154
155C...Expansion coefficients for up and down valence quark distributions.
156 DATA ((COW(IP,IS,1),IS=1,5),IP=1,3)/
157 1 4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
158 2 -5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
159 3 -6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/
160C...Expansion coefficients for gluon distribution.
161 DATA ((COW(IP,IS,2),IS=1,5),IP=1,3)/
162 1 7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00,
163 2 -9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00,
164 3 5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/
165C...Expansion coefficients for (up+down+strange) quark sea distribution.
166 DATA ((COW(IP,IS,3),IS=1,5),IP=1,3)/
167 1 9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00,
168 2 -1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01,
169 3 -1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/
170C...Expansion coefficients for charm quark sea distribution.
171 DATA ((COW(IP,IS,4),IS=1,5),IP=1,3)/
172 1 0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00,
173 2 6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01,
174 3 -4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/
175
176 DATA ZEROD/0.D0/, ONED/1.D0/, SIXD/6.D0/
177 DATA ALAM/0.4D0/, Q02/4.D0/, QMAX2/2.D3/
178C...Pion structure functions from Owens.
179C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2.
180
181C...Determine set, Lambda and s expansion variable.
182 Q2 = SCALE*SCALE
183 Q2IN = MIN( QMAX2,MAX( Q02,Q2))
184 SD = LOG( LOG( Q2IN/ALAM**2)/ LOG( Q02/ALAM**2))
185
186C...Calculate structure functions.
187 DO 10 KFL=1,4
188 DO 20 IS=1,5
189 20 TS(IS)=COW(1,IS,KFL)+COW(2,IS,KFL)*SD+
190 & COW(3,IS,KFL)*SD*SD
191 IF(KFL.EQ.1) THEN
192cif defined(CERNLIB_SINGLE)
193c DENOM = GAMMA(TS(1))*GAMMA(TS(2)+ONED)/GAMMA(TS(1)+TS(2)+ONED)
194cendif
195cif defined(CERNLIB_DOUBLE)
196 DENOM = DGAMMA_LHA(TS(1))*DGAMMA_LHA(TS(2)+ONED)/
197 + DGAMMA_LHA(TS(1)+TS(2)+ONED)
198cendif
199 XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/DENOM
200 ELSE
201 XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2)
202 ENDIF
203 10 CONTINUE
204
205C...output
206 UPV = XQ(1)
207 DNV = XQ(1)
208 SEA = XQ(3)/SIXD
209 STR = XQ(3)/SIXD
210 CHM = XQ(4)
211 GL = XQ(2)
212C
213 RETURN
214 END
215c**************************************************************************