Version update.
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.3.1 / wrapdgg.f
1       subroutine DGGevolvep(xin,qin,p2in,ip2in,pdf)
2       include 'parmsetup.inc'
3       real*8 xin,qin,q2in,p2in,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),mmem
7       common/NAME/name,nmem,ndef,mmem
8       integer nset,iset
9       
10       save 
11       call getnset(iset)
12       call getnmem(iset,imem)
13
14       if(imem.eq.1.or.imem.eq.0) then
15         call DGPHO1(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
16
17       elseif(imem.eq.2) then
18         call DGPHO2(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
19
20       elseif(imem.eq.3) then
21         call DGPHO3(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
22
23       elseif(imem.eq.4) then
24         call DGPHO4(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
25
26       else
27         CONTINUE
28       endif     
29
30       pdf(-6)= 0.0d0
31       pdf(6)= 0.0d0
32       pdf(-5)= bot
33       pdf(5 )= bot
34       pdf(-4)= chm
35       pdf(4 )= chm
36       pdf(-3)= str
37       pdf(3 )= str
38       pdf(-2)= usea
39       pdf(2 )= upv
40       pdf(-1)= dsea
41       pdf(1 )= dnv
42       pdf(0 )= glu
43       
44       return
45 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
46       entry DGGread(nset)
47       read(1,*)nmem(nset),ndef(nset)
48       return
49 c
50 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
51       entry DGGalfa(alfas,qalfa)
52         call getnset(iset)
53         call getnmem(iset,imem)
54         call GetOrderAsM(iset,iord)
55         call Getlam4M(iset,imem,qcdl4)
56         call Getlam5M(iset,imem,qcdl5)
57         call aspdflib(alfas,Qalfa,iord,qcdl5)
58       return
59 c
60 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
61       entry DGGinit(Eorder,Q2fit)
62       return
63 c
64 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
65       entry DGGpdf(mem)
66       call getnset(iset)
67       call setnmem(iset,mem)
68 c      imem = mem
69       return
70 c
71  1000 format(5e13.5)
72       end
73 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
74        SUBROUTINE DGPHO1(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL)
75 C********************************************************************
76 C*                                                                  *
77 C*    Parametrization of parton distribution functions              *
78 C*    in the photon (LO analysis) - full  solution of AP eq.!       *
79 C*                                                                  *
80 C* authors:  M.Drees and K.Grassie (DG)                             *
81 C*          /Z. Phys. C28 (1985) 451/                               *
82 C*                                                                  *
83 C* Prepared by:                                                     *
84 C*             Krzysztof Charchula, DESY                            *
85 C*             bitnet: F1PCHA@DHHDESY3                              *
86 C*             decnet: 13313::CHARCHULA                             *
87 C*                                                                  *
88 C* Modified by:                                                     *
89 C*             H. Plothow-Besch/CERN-PPE                            *
90 C*                                                                  *
91 C********************************************************************
92 C
93       implicit real*8 (a-h,o-z)
94       double precision
95      +        A(3,4,3),AT(3),
96      +        B(5,4,2,3),BT(5,2),XQPOM(2),E(2),
97      +        DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL
98       PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0)
99       PARAMETER (ALAM=0.4D0)
100 C...comments
101 C...--------------------------------------------------
102 C...         nf=3 for   1< Q2 <32  GeV2
103 C...         nf=4 for  32< Q2 <200 GeV2
104 C...         nf=5 for 200< Q2 <1D4 GeV2
105 C...--------------------------------------------------
106 C
107 C...initialization of gluon parameters array for DG
108         DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/
109      >    -0.20700, -0.19870,  5.1190,
110      >     0.61580,  0.62570, -0.2752,
111      >     1.07400,  8.35200, -6.9930,
112      >     0.00000,  5.02400,  2.2980,
113      >     0.8926D-2,0.0509,  -0.2313,
114      >     0.65940,  0.27740,  0.1382,
115      >     0.47660, -0.39060,  6.5420,
116      >     0.01975, -0.32120,  0.5162,
117      >     0.03197, -0.618D-2,-0.1216,
118      >     1.01800,  0.94760,  0.9047,
119      >     0.24610, -0.60940,  2.6530,
120      >     0.02707, -0.01067,  0.2003D-2/
121 C
122 C...initialization of quark parameters array for DG
123         DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/
124      >     2.2850,   6.0730,  -0.4202,   -0.0808,  0.0553,
125      >    -0.0153,  -0.8132,   0.0178,    0.6346,  1.1360,
126      >     1.33D3, -41.310,    0.9216,    1.2080,  0.9512,
127      >     4.2190,   3.1650,   0.1800,    0.2030,  0.0116,
128      >    16.690,    0.1760,  -0.0208,   -0.0168, -0.1986,
129      >    -0.7916,   0.0479,   0.3386D-2, 1.3530,  1.1000,
130      >     1.0990D3, 1.0470,   4.8530,    1.4260,  1.1360,
131      >     4.4280,   0.0250,   0.8404,    1.2390, -0.2779/
132         DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/
133      >    -0.3711,  -0.1717,   0.08766,  -0.8915, -0.1816,
134      >     1.0610,   0.7815,   0.02197,   0.2857,  0.5866,
135      >     4.7580,   1.5350,   0.10960,   2.9730,  2.4210,
136      >    -0.0150,   0.7067D-2,0.20400,   0.1185,  0.4059,
137      >    -0.1207,  25.000,   -0.01230,  -0.0919,  0.02015,
138      >     1.0710,  -1.6480,   1.16200,   0.7912,  0.9869,
139      >     1.9770,  -0.01563,  0.48240,   0.6397, -0.07036,
140      >    -0.8625D-2,6.4380,  -0.01100,   2.3270,  0.01694/
141         DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/
142      >    15.8,      2.742,    0.02917,  -0.0342, -0.02302,
143      >    -0.9464,  -0.7332,   0.04657,   0.7196,  0.9229,
144      >    -0.5,      0.7148,   0.1785,    0.7338,  0.5873,
145      >    -0.2118,   3.287,    0.04811,   0.08139,-0.79D-4,
146      >     6.734,   59.88,    -0.3226D-2,-0.03321, 0.1059,
147      >    -1.008,   -2.983,    0.8432,    0.9475,  0.6954,
148      >    -0.08594,  4.48,     0.3616,   -0.3198, -0.6663,
149      >     0.07625,  0.9686,   0.1383D-2, 0.02132, 0.3683/
150 C
151 C...specification of sets
152        Q2 = DQ*DQ
153          IF (Q2.LT.32.0D0) NFL=3
154          IF((Q2.GE.32.0D0).AND.(Q2.LT.200.0D0)) NFL=4
155          IF (Q2.GE.200.0D0) NFL=5
156 C
157 C...calculations
158        ALAM2=ALAM**2
159        T=LOG(Q2/ALAM2)
160        LF=NFL-2
161 C
162 C...gluons
163         DO 11 I=1,3
164           AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
165  11     CONTINUE
166         POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3)
167         DGL=POMG*ALPEM
168 C
169 C...quarks
170         E(1)=1.0D0
171         IF(NFL.EQ.3) THEN
172           E(2)=9.0D0
173         ELSEIF(NFL.EQ.4) THEN
174           E(2)=10.0D0
175         ELSEIF(NFL.EQ.5) THEN
176           E(2)=55.0D0/6.0D0
177         ENDIF
178         DO 13 J=1,2
179           DO 15 I=1,5
180             BTP=B(I,1,J,LF)*T**B(I,2,J,LF)
181             BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF))
182  15       CONTINUE
183  13     CONTINUE
184 C
185 C...singlet & non-singlet combinations
186         DO 17 J=1,2
187           POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX))
188           POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J)
189           XQPOM(J)=E(J)*POM1+POM2
190  17     CONTINUE
191 C
192 C...quarks flavours
193         IF (NFL.EQ.3) THEN
194             DUB=ALPEM*1.D0/6.D0*(XQPOM(2)+9.D0*XQPOM(1))
195             DDB=ALPEM*1.D0/6.D0*(XQPOM(2)-9.D0/2.D0*XQPOM(1))
196             DSB=DDB
197             DCB=0.D0
198             DBB=0.D0
199         ELSEIF (NFL.EQ.4) THEN
200             DUB=ALPEM*1.D0/8.D0*(XQPOM(2)+6.D0*XQPOM(1))
201             DCB=DUB
202             DDB=ALPEM*1.D0/8.D0*(XQPOM(2)-6.D0*XQPOM(1))
203             DSB=DDB
204             DBB=0.D0
205         ELSEIF (NFL.EQ.5) THEN
206             DUB=ALPEM*1.D0/10.D0*(XQPOM(2)+15.D0/2.D0*XQPOM(1))
207             DCB=DUB
208             DDB=ALPEM*1.D0/10.D0*(XQPOM(2)-5.D0*XQPOM(1))
209             DSB=DDB
210             DBB=DDB
211         ENDIF
212       DUV=DUB
213       DDV=DDB
214 C
215       RETURN
216       END
217 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
218        SUBROUTINE DGPHO2(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL)
219 C********************************************************************
220 C*                                                                  *
221 C*    Parametrization of parton distribution functions              *
222 C*    in the photon (LO analysis) - full  solution of AP eq.!       *
223 C*                                                                  *
224 C* authors:  M.Drees and K.Grassie (DG)                             *
225 C*          /Z. Phys. C28 (1985) 451/                               *
226 C*                                                                  *
227 C* Prepared by:                                                     *
228 C*             Krzysztof Charchula, DESY                            *
229 C*             bitnet: F1PCHA@DHHDESY3                              *
230 C*             decnet: 13313::CHARCHULA                             *
231 C*                                                                  *
232 C* Modified by:                                                     *
233 C*             H. Plothow-Besch/CERN-PPE                            *
234 C*                                                                  *
235 C********************************************************************
236 C
237       implicit real*8 (a-h,o-z)
238       double precision
239      +        A(3,4,3),AT(3),
240      +        B(5,4,2,3),BT(5,2),XQPOM(2),E(2),
241      +        DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL
242       PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0)
243       PARAMETER (ALAM=0.4D0)
244 C...comments
245 C...--------------------------------------------------
246 C...        with nf=3 (valid for   1< Q2 <50  GeV2)
247 C...--------------------------------------------------
248 C
249 C...initialization of gluon parameters array for DG
250         DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/
251      >    -0.20700, -0.19870,  5.1190,
252      >     0.61580,  0.62570, -0.2752,
253      >     1.07400,  8.35200, -6.9930,
254      >     0.00000,  5.02400,  2.2980,
255      >     0.8926D-2,0.0509,  -0.2313,
256      >     0.65940,  0.27740,  0.1382,
257      >     0.47660, -0.39060,  6.5420,
258      >     0.01975, -0.32120,  0.5162,
259      >     0.03197, -0.618D-2,-0.1216,
260      >     1.01800,  0.94760,  0.9047,
261      >     0.24610, -0.60940,  2.6530,
262      >     0.02707, -0.01067,  0.2003D-2/
263 C
264 C...initialization of quark parameters array for DG
265         DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/
266      >     2.2850,   6.0730,  -0.4202,   -0.0808,  0.0553,
267      >    -0.0153,  -0.8132,   0.0178,    0.6346,  1.1360,
268      >     1.33D3, -41.310,    0.9216,    1.2080,  0.9512,
269      >     4.2190,   3.1650,   0.1800,    0.2030,  0.0116,
270      >    16.690,    0.1760,  -0.0208,   -0.0168, -0.1986,
271      >    -0.7916,   0.0479,   0.3386D-2, 1.3530,  1.1000,
272      >     1.0990D3, 1.0470,   4.8530,    1.4260,  1.1360,
273      >     4.4280,   0.0250,   0.8404,    1.2390, -0.2779/
274         DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/
275      >    -0.3711,  -0.1717,   0.08766,  -0.8915, -0.1816,
276      >     1.0610,   0.7815,   0.02197,   0.2857,  0.5866,
277      >     4.7580,   1.5350,   0.10960,   2.9730,  2.4210,
278      >    -0.0150,   0.7067D-2,0.20400,   0.1185,  0.4059,
279      >    -0.1207,  25.000,   -0.01230,  -0.0919,  0.02015,
280      >     1.0710,  -1.6480,   1.16200,   0.7912,  0.9869,
281      >     1.9770,  -0.01563,  0.48240,   0.6397, -0.07036,
282      >    -0.8625D-2,6.4380,  -0.01100,   2.3270,  0.01694/
283         DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/
284      >    15.8,      2.742,    0.02917,  -0.0342, -0.02302,
285      >    -0.9464,  -0.7332,   0.04657,   0.7196,  0.9229,
286      >    -0.5,      0.7148,   0.1785,    0.7338,  0.5873,
287      >    -0.2118,   3.287,    0.04811,   0.08139,-0.79D-4,
288      >     6.734,   59.88,    -0.3226D-2,-0.03321, 0.1059,
289      >    -1.008,   -2.983,    0.8432,    0.9475,  0.6954,
290      >    -0.08594,  4.48,     0.3616,   -0.3198, -0.6663,
291      >     0.07625,  0.9686,   0.1383D-2, 0.02132, 0.3683/
292 C
293 C...specification of sets
294          NFL=3
295 C
296 C...calculations
297        Q2 = DQ*DQ
298        ALAM2=ALAM**2
299        T=LOG(Q2/ALAM2)
300        LF=NFL-2
301 C
302 C...gluons
303         DO 11 I=1,3
304           AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
305  11     CONTINUE
306         POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3)
307         DGL=POMG*ALPEM
308 C
309 C...quarks
310         E(1)=1.D0
311         E(2)=9.D0
312         DO 13 J=1,2
313           DO 15 I=1,5
314             BTP=B(I,1,J,LF)*T**B(I,2,J,LF)
315             BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF))
316  15       CONTINUE
317  13     CONTINUE
318 C
319 C...singlet & non-singlet combinations
320         DO 17 J=1,2
321           POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX))
322           POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J)
323           XQPOM(J)=E(J)*POM1+POM2
324  17     CONTINUE
325 C
326 C...quarks flavours
327       DUB=ALPEM*1.D0/6.D0*(XQPOM(2)+9.D0*XQPOM(1))
328       DUV=DUB
329       DDB=ALPEM*1.D0/6.D0*(XQPOM(2)-9.D0/2.D0*XQPOM(1))
330       DDV=DDB
331       DSB=DDB
332       DCB=0.D0
333       DBB=0.D0
334 C
335       RETURN
336       END
337 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
338        SUBROUTINE DGPHO3(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL)
339 C********************************************************************
340 C*                                                                  *
341 C*    Parametrization of parton distribution functions              *
342 C*    in the photon (LO analysis) - full  solution of AP eq.!       *
343 C*                                                                  *
344 C* authors:  M.Drees and K.Grassie (DG)                             *
345 C*          /Z. Phys. C28 (1985) 451/                               *
346 C*                                                                  *
347 C* Prepared by:                                                     *
348 C*             Krzysztof Charchula, DESY                            *
349 C*             bitnet: F1PCHA@DHHDESY3                              *
350 C*             decnet: 13313::CHARCHULA                             *
351 C*                                                                  *
352 C* Modified by:                                                     *
353 C*             H. Plothow-Besch/CERN-PPE                            *
354 C*                                                                  *
355 C********************************************************************
356 C
357       implicit real*8 (a-h,o-z)
358       double precision
359      +        A(3,4,3),AT(3),
360      +        B(5,4,2,3),BT(5,2),XQPOM(2),E(2),
361      +        DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL
362       PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0)
363       PARAMETER (ALAM=0.4D0)
364 C...comments
365 C...--------------------------------------------------
366 C...        with nf=4 (valid for  20< Q2 <500 GeV2)
367 C...--------------------------------------------------
368 C
369 C...initialization of gluon parameters array for DG
370         DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/
371      >    -0.20700, -0.19870,  5.1190,
372      >     0.61580,  0.62570, -0.2752,
373      >     1.07400,  8.35200, -6.9930,
374      >     0.00000,  5.02400,  2.2980,
375      >     0.8926D-2,0.0509,  -0.2313,
376      >     0.65940,  0.27740,  0.1382,
377      >     0.47660, -0.39060,  6.5420,
378      >     0.01975, -0.32120,  0.5162,
379      >     0.03197, -0.618D-2,-0.1216,
380      >     1.01800,  0.94760,  0.9047,
381      >     0.24610, -0.60940,  2.6530,
382      >     0.02707, -0.01067,  0.2003D-2/
383 C
384 C...initialization of quark parameters array for DG
385         DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/
386      >     2.2850,   6.0730,  -0.4202,   -0.0808,  0.0553,
387      >    -0.0153,  -0.8132,   0.0178,    0.6346,  1.1360,
388      >     1.33D3, -41.310,    0.9216,    1.2080,  0.9512,
389      >     4.2190,   3.1650,   0.1800,    0.2030,  0.0116,
390      >    16.690,    0.1760,  -0.0208,   -0.0168, -0.1986,
391      >    -0.7916,   0.0479,   0.3386D-2, 1.3530,  1.1000,
392      >     1.0990D3, 1.0470,   4.8530,    1.4260,  1.1360,
393      >     4.4280,   0.0250,   0.8404,    1.2390, -0.2779/
394         DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/
395      >    -0.3711,  -0.1717,   0.08766,  -0.8915, -0.1816,
396      >     1.0610,   0.7815,   0.02197,   0.2857,  0.5866,
397      >     4.7580,   1.5350,   0.10960,   2.9730,  2.4210,
398      >    -0.0150,   0.7067D-2,0.20400,   0.1185,  0.4059,
399      >    -0.1207,  25.000,   -0.01230,  -0.0919,  0.02015,
400      >     1.0710,  -1.6480,   1.16200,   0.7912,  0.9869,
401      >     1.9770,  -0.01563,  0.48240,   0.6397, -0.07036,
402      >    -0.8625D-2,6.4380,  -0.01100,   2.3270,  0.01694/
403         DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/
404      >    15.8,      2.742,    0.02917,  -0.0342, -0.02302,
405      >    -0.9464,  -0.7332,   0.04657,   0.7196,  0.9229,
406      >    -0.5,      0.7148,   0.1785,    0.7338,  0.5873,
407      >    -0.2118,   3.287,    0.04811,   0.08139,-0.79D-4,
408      >     6.734,   59.88,    -0.3226D-2,-0.03321, 0.1059,
409      >    -1.008,   -2.983,    0.8432,    0.9475,  0.6954,
410      >    -0.08594,  4.48,     0.3616,   -0.3198, -0.6663,
411      >     0.07625,  0.9686,   0.1383D-2, 0.02132, 0.3683/
412 C
413 C...specification of sets
414          NFL=4
415 C
416 C...calculations
417        Q2 = DQ*DQ
418        ALAM2=ALAM**2
419        T=LOG(Q2/ALAM2)
420        LF=NFL-2
421 C
422 C...gluons
423         DO 11 I=1,3
424           AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
425  11     CONTINUE
426         POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3)
427         DGL=POMG*ALPEM
428 C
429 C...quarks
430         E(1)=1.D0
431         E(2)=10.D0
432         DO 13 J=1,2
433           DO 15 I=1,5
434             BTP=B(I,1,J,LF)*T**B(I,2,J,LF)
435             BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF))
436  15       CONTINUE
437  13     CONTINUE
438 C
439 C...singlet & non-singlet combinations
440         DO 17 J=1,2
441           POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX))
442           POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J)
443           XQPOM(J)=E(J)*POM1+POM2
444  17     CONTINUE
445 C
446 C...quarks flavours
447       DUB=ALPEM*1.D0/8.D0*(XQPOM(2)+6.D0*XQPOM(1))
448       DUV=DUB
449       DDB=ALPEM*1.D0/8.D0*(XQPOM(2)-6.D0*XQPOM(1))
450       DDV=DDB
451       DSB=DDB
452       DCB=DUB
453       DBB=0.D0
454 C
455       RETURN
456       END
457 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
458        SUBROUTINE DGPHO4(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL)
459 C********************************************************************
460 C*                                                                  *
461 C*    Parametrization of parton distribution functions              *
462 C*    in the photon (LO analysis) - full  solution of AP eq.!       *
463 C*                                                                  *
464 C* authors:  M.Drees and K.Grassie (DG)                             *
465 C*          /Z. Phys. C28 (1985) 451/                               *
466 C*                                                                  *
467 C* Prepared by:                                                     *
468 C*             Krzysztof Charchula, DESY                            *
469 C*             bitnet: F1PCHA@DHHDESY3                              *
470 C*             decnet: 13313::CHARCHULA                             *
471 C*                                                                  *
472 C* Modified by:                                                     *
473 C*             H. Plothow-Besch/CERN-PPE                            *
474 C*                                                                  *
475 C********************************************************************
476 C
477       implicit real*8 (a-h,o-z)
478       double precision
479      +        A(3,4,3),AT(3),
480      +        B(5,4,2,3),BT(5,2),XQPOM(2),E(2),
481      +        DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL
482       PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0)
483       PARAMETER (ALAM=0.4D0)
484 C...comments
485 C...--------------------------------------------------
486 C...        with nf=5 (valid for 200< Q2 <1D4 GeV2)
487 C...--------------------------------------------------
488 C
489 C...initialization of gluon parameters array for DG
490         DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/
491      >    -0.20700, -0.19870,  5.1190,
492      >     0.61580,  0.62570, -0.2752,
493      >     1.07400,  8.35200, -6.9930,
494      >     0.00000,  5.02400,  2.2980,
495      >     0.8926D-2,0.0509,  -0.2313,
496      >     0.65940,  0.27740,  0.1382,
497      >     0.47660, -0.39060,  6.5420,
498      >     0.01975, -0.32120,  0.5162,
499      >     0.03197, -0.618D-2,-0.1216,
500      >     1.01800,  0.94760,  0.9047,
501      >     0.24610, -0.60940,  2.6530,
502      >     0.02707, -0.01067,  0.2003D-2/
503 C
504 C...initialization of quark parameters array for DG
505         DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/
506      >     2.2850,   6.0730,  -0.4202,   -0.0808,  0.0553,
507      >    -0.0153,  -0.8132,   0.0178,    0.6346,  1.1360,
508      >     1.33D3, -41.310,    0.9216,    1.2080,  0.9512,
509      >     4.2190,   3.1650,   0.1800,    0.2030,  0.0116,
510      >    16.690,    0.1760,  -0.0208,   -0.0168, -0.1986,
511      >    -0.7916,   0.0479,   0.3386D-2, 1.3530,  1.1000,
512      >     1.0990D3, 1.0470,   4.8530,    1.4260,  1.1360,
513      >     4.4280,   0.0250,   0.8404,    1.2390, -0.2779/
514         DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/
515      >    -0.3711,  -0.1717,   0.08766,  -0.8915, -0.1816,
516      >     1.0610,   0.7815,   0.02197,   0.2857,  0.5866,
517      >     4.7580,   1.5350,   0.10960,   2.9730,  2.4210,
518      >    -0.0150,   0.7067D-2,0.20400,   0.1185,  0.4059,
519      >    -0.1207,  25.000,   -0.01230,  -0.0919,  0.02015,
520      >     1.0710,  -1.6480,   1.16200,   0.7912,  0.9869,
521      >     1.9770,  -0.01563,  0.48240,   0.6397, -0.07036,
522      >    -0.8625D-2,6.4380,  -0.01100,   2.3270,  0.01694/
523         DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/
524      >    15.8,      2.742,    0.02917,  -0.0342, -0.02302,
525      >    -0.9464,  -0.7332,   0.04657,   0.7196,  0.9229,
526      >    -0.5,      0.7148,   0.1785,    0.7338,  0.5873,
527      >    -0.2118,   3.287,    0.04811,   0.08139,-0.79D-4,
528      >     6.734,   59.88,    -0.3226D-2,-0.03321, 0.1059,
529      >    -1.008,   -2.983,    0.8432,    0.9475,  0.6954,
530      >    -0.08594,  4.48,     0.3616,   -0.3198, -0.6663,
531      >     0.07625,  0.9686,   0.1383D-2, 0.02132, 0.3683/
532 C
533 C...specification of sets
534          NFL=5
535 C
536 C...calculations
537        Q2 = DQ*DQ
538        ALAM2=ALAM**2
539        T=LOG(Q2/ALAM2)
540        LF=NFL-2
541 C
542 C...gluons
543         DO 11 I=1,3
544           AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
545  11     CONTINUE
546         POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3)
547         DGL=POMG*ALPEM
548 C
549 C...quarks
550         E(1)=1.D0
551         E(2)=55.D0/6.D0
552         DO 13 J=1,2
553           DO 15 I=1,5
554             BTP=B(I,1,J,LF)*T**B(I,2,J,LF)
555             BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF))
556  15       CONTINUE
557  13     CONTINUE
558 C
559 C...singlet & non-singlet combinations
560         DO 17 J=1,2
561           POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX))
562           POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J)
563           XQPOM(J)=E(J)*POM1+POM2
564  17     CONTINUE
565 C
566 C...quarks flavours
567       DUB=ALPEM*1.D0/10.D0*(XQPOM(2)+15.D0/2.D0*XQPOM(1))
568       DUV=DUB
569       DCB=DUB
570       DDB=ALPEM*1.D0/10.D0*(XQPOM(2)-5.D0*XQPOM(1))
571       DDV=DDB
572       DSB=DDB
573       DCB=DUB
574       DBB=DDB
575 C
576       RETURN
577       END
578 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc