LHAPDF/lhapdf5.2.2/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