| 21886bb6 |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 7ef50f50 |
5 | * Revision 1.4 2000/09/18 10:02:36 hristov |
| 6 | * Makefile added to PDF8 |
| 7 | * |
| 21886bb6 |
8 | * Revision 1.1.1.2 1996/10/30 08:30:43 cernlib |
| 9 | * Version 7.04 |
| 10 | * |
| 11 | * Revision 1.1.1.1 1996/04/12 15:29:46 plothow |
| 12 | * Version 7.01 |
| 13 | * |
| 14 | * |
| 15 | #include "pdf/pilot.h" |
| 16 | c------------------------------------------------------- |
| 17 | subroutine SFWHI2(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) |
| 18 | c------------------------------------------------------- |
| 19 | c WHIT2 parton distribution in the photon |
| 20 | c |
| 21 | c INPUT: integer ic : if ic=0 then qc=0 |
| 22 | c else qc is calculated |
| 23 | c DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) |
| 24 | c DOUBLE PRECISION x : energy fraction |
| 25 | c |
| 26 | c OUTPUT: DOUBLE PRECISION qu : up-quark dist. |
| 27 | c DOUBLE PRECISION qd : down- or strange-quark dist. |
| 28 | c DOUBLE PRECISION qc : charm-quark dist. |
| 29 | c DOUBLE PRECISION g : gluon dist. |
| 30 | c------------------------------------------------------- |
| 31 | c Modified by M.Tanaka on July 22, 1994. |
| 32 | c The bug pointed out by M.Drees is fixed. |
| 33 | c------------------------------------------------------- |
| 34 | c Modified by I.Watanabe on July 22, 1994. |
| 35 | c------------------------------------------------------- |
| 36 | implicit none |
| 37 | external WHIT2G |
| 7ef50f50 |
38 | #if defined(CERNLIB_DOUBLE) |
| 39 | DOUBLE PRECISION |
| 40 | #endif |
| 41 | #if defined(CERNLIB_SINGLE) |
| 42 | REAL |
| 43 | #endif |
| 21886bb6 |
44 | + ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL |
| 45 | c arg |
| 46 | integer ic |
| 47 | DOUBLE PRECISION Q2,x |
| 48 | DOUBLE PRECISION qu,qd,qc,g |
| 49 | c const |
| 50 | DOUBLE PRECISION q42it,q52it,lam42,lam52 |
| 51 | DOUBLE PRECISION alinv,mc,PI |
| 52 | c local |
| 53 | DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs |
| 54 | DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, |
| 55 | $ A0sea,B0sea,BB0sea,C0sea |
| 56 | DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv |
| 57 | DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs |
| 58 | DOUBLE PRECISION x1,x2,mc2q2 |
| 59 | DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi |
| 60 | DOUBLE PRECISION WHIT2G |
| 61 | c parameters |
| 62 | parameter(lam42=0.16d0, lam52=0.091411319d0) |
| 63 | parameter(Q42IT=4.0d0, Q52IT=100.0d0) |
| 64 | parameter(alinv=137.036d0, mc=1.5d0) |
| 65 | parameter(pi=3.14159265358979323846d0) |
| 66 | common /scale/ s,s2,s3,s4,prsccf |
| 67 | c |
| 68 | c begin |
| 69 | x=ZX |
| 70 | Q2=ZQ*ZQ |
| 71 | ic=1 |
| 72 | c |
| 73 | x1=1.0d0-x |
| 74 | x2=x**2 |
| 75 | mc2q2=mc**2/Q2 |
| 76 | c |
| 77 | if(Q2.lt.100.0d0) then |
| 78 | c under 100 GeV^2 |
| 79 | c |
| 80 | c set scale s |
| 81 | if(Q2.lt.4.0d0) then |
| 82 | cccc for under 4GeV^2 prescription |
| 83 | s= 0.0d0 |
| 84 | prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) |
| 85 | alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) |
| 86 | else |
| 87 | s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) |
| 88 | prsccf = 1.0d0 |
| 89 | alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) |
| 90 | endif |
| 91 | s2=s**2 |
| 92 | s3=s2*s |
| 93 | s4=s2**2 |
| 94 | c |
| 95 | cccccc WHIT2 quark (U100) |
| 96 | c |
| 97 | A0val= 1.882000d+00+s*( 1.213000d+00)+s2*( 6.970000d-01) |
| 98 | A1val= s*(-2.361000d+00)+s2*(-1.136000d+00) |
| 99 | A2val= s*( 5.280000d-01)+s2*( 2.406000d+00) |
| 100 | Bval= 5.000000d-01+s*( 2.107000d-02)+s2*( 4.130000d-03) |
| 101 | Cval= 2.500000d-01+s*(-2.376000d-01)+s2*( 2.018000d-01) |
| 102 | $ +s3*(-5.040000d-02) |
| 103 | A0sea= 1.237000d+00+s*( 3.390000d+00)+s2*(-1.075000d+01) |
| 104 | $ +s3*( 1.246000d+01)+s4*(-5.580000d+00) |
| 105 | B0sea=-7.270000d-02+s*( 1.748000d-01)+s2*(-1.392000d+00) |
| 106 | $ +s3*( 1.711000d+00)+s4*(-7.960000d-01) |
| 107 | BB0sea=4.290000d+00+s*( 1.787000d+01)+s2*(-5.810000d+01) |
| 108 | $ +s3*( 8.190000d+01)+s4*(-4.140000d+01) |
| 109 | C0sea= 1.434000d+01+s*(-4.490000d+01)+s2*( 1.197000d+02) |
| 110 | $ +s3*(-1.585000d+02)+s4*( 7.530000d+01) |
| 111 | c |
| 112 | qv = prsccf/alinv/x* |
| 113 | $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval |
| 114 | qsea= prsccf/alinv/x* |
| 115 | $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea |
| 116 | c |
| 117 | qu = qv/3.0d0 + qsea/6.0d0 |
| 118 | qu = qu*x |
| 119 | ZUV=qu |
| 120 | ZUB=qu |
| 121 | qd = qv/12.0d0 + qsea/6.0d0 |
| 122 | qd = qd*x |
| 123 | ZDV=qd |
| 124 | ZDB=qd |
| 125 | ZSB=qd |
| 126 | c |
| 127 | if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then |
| 128 | call WHIT2Q(x,mc2q2,cv,cs) |
| 129 | qc = cv/alinv/2.0d0/PI + cs*alstpi |
| 130 | qc = qc*x |
| 131 | ZCB=qc |
| 132 | else |
| 133 | qc = 0.0d0 |
| 134 | ZCB=qc |
| 135 | endif |
| 136 | c |
| 137 | g = WHIT2G(x,Q2) |
| 138 | g = g*x |
| 139 | ZGL=g |
| 140 | c |
| 141 | else |
| 142 | c over 100 GeV^2 |
| 143 | c |
| 144 | c set scale s |
| 145 | s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) |
| 146 | prsccf = 1.0d0 |
| 147 | alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) |
| 148 | s2=s**2 |
| 149 | s3=s2*s |
| 150 | s4=s2**2 |
| 151 | c |
| 152 | cccccc WHIT2 quark (O100) |
| 153 | c |
| 154 | A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00) |
| 155 | A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.259000d-01) |
| 156 | A2val= 1.522000d+00+s*( 4.300000d+00)+s2*( 1.315000d+00) |
| 157 | Bval = 5.170000d-01+s*( 4.030000d-02)+s2*(-2.098000d-02) |
| 158 | Cval = 1.655000d-01+s*(-2.063000d-02)+s2*( 5.370000d-02) |
| 159 | A0sea= 1.287000d+00+s*(-2.069000d+00)+s2*( 1.157000d+01) |
| 160 | $ +s3*(-3.570000d+01)+s4*( 3.740000d+01) |
| 161 | B0sea=-2.340000d-01+s*(-4.430000d-01)+s2*( 1.235000d+00) |
| 162 | $ +s3*(-3.720000d+00)+s4*( 3.840000d+00) |
| 163 | BB0sea=6.460000d+00+s*(-1.048000d+01)+s2*( 8.980000d+01) |
| 164 | $ +s3*(-2.847000d+02)+s4*( 2.998000d+02) |
| 165 | C0sea= 5.350000d+00+s*( 1.011000d+01)+s2*(-1.337000d+02) |
| 166 | $ +s3*( 4.270000d+02)+s4*(-4.570000d+02) |
| 167 | c |
| 168 | qv = 1.0d0/alinv/x* |
| 169 | $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval |
| 170 | qsea= 1.0d0/alinv/x* |
| 171 | $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea |
| 172 | c |
| 173 | qu = qv/3.0d0 + qsea/6.0d0 |
| 174 | qu = qu*x |
| 175 | ZUV=qu |
| 176 | ZUB=qu |
| 177 | qd = qv/12.0d0 + qsea/6.0d0 |
| 178 | qd = qd*x |
| 179 | ZDV=qd |
| 180 | ZDB=qd |
| 181 | ZSB=qd |
| 182 | g = WHIT2G(x,Q2) |
| 183 | g = g*x |
| 184 | ZGL=g |
| 185 | c |
| 186 | if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then |
| 187 | A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) |
| 188 | $ +s3*(-2.504000d+01)+s4*( 3.098000d+01) |
| 189 | A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) |
| 190 | $ +s3*( 3.180000d+02)+s4*(-3.920000d+02) |
| 191 | A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) |
| 192 | $ +s3*(-1.062000d+03)+s4*( 1.308000d+03) |
| 193 | A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) |
| 194 | $ +s3*( 1.012000d+03)+s4*(-1.250000d+03) |
| 195 | Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) |
| 196 | $ +s3*( 1.967000d+01) |
| 197 | Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) |
| 198 | $ +s3*( 4.630000d+01) |
| 199 | Adcs = s*(-2.786000d-02)+s2*( 3.490000d-02) |
| 200 | $ +s3*(-2.223000d-02) |
| 201 | B0dcs=-3.141000d-01+s*(-4.250000d-01)+s2*( 1.564000d-01) |
| 202 | B1dcs= 4.720000d+00+s*(-5.480000d+00)+s2*( 2.686000d+00) |
| 203 | Cdcs = 2.961000d+00+s*( 7.760000d-01)+s2*(-8.280000d+00) |
| 204 | $ +s3*( 9.780000d+00) |
| 205 | c |
| 206 | dcv = 1.0d0/alinv/x* |
| 207 | $ (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv |
| 208 | dcs = 1.0d0/alinv/x* |
| 209 | $ Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs |
| 210 | c |
| 211 | call WHIT2Q(x,mc*mc/Q2,cv,cs) |
| 212 | qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv |
| 213 | qc = qc*x |
| 214 | ZCB=qc |
| 215 | else |
| 216 | qc = 0.0d0 |
| 217 | ZCB=qc |
| 218 | endif |
| 219 | endif |
| 220 | c |
| 221 | return |
| 222 | end |
git://git.uio.no / u / mrichter / AliRoot.git / blame