Back to home page

sPhenix code displayed by LXR
 
 

    

File indexing completed on 2025-08-05 08:15:45 

0001     
0002 C*********************************************************************  
0003     
0004       SUBROUTINE PYHISTFU(KF,X,Q2,XPQ,JBT)    
0005     
0006 C                       *******JBT specifies beam or target of the particle
0007 C...Gives proton and pi+ parton structure functions according to a few  
0008 C...different parametrizations. Note that what is coded is x times the  
0009 C...probability distribution, i.e. xq(x,Q2) etc.    
0010       COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0011       SAVE  /HIPARNT/
0012       COMMON/HIJCRDN/YP(3,300),YT(3,300)
0013       SAVE  /HIJCRDN/
0014 C                       ********COMMON BLOCK FROM HIJING
0015       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) 
0016       SAVE  /LUDAT1/ 
0017       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)    
0018       SAVE  /LUDAT2/ 
0019       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) 
0020       SAVE  /PYHIPARS/ 
0021       COMMON/PYHIINT1/MINT(400),VINT(400) 
0022       SAVE  /PYHIINT1/ 
0023       DIMENSION XPQ(-6:6),XQ(6),TX(6),TT(6),TS(6),NEHLQ(8,2),   
0024      &CEHLQ(6,6,2,8,2),CDO(3,6,5,2),COW(3,5,4,2)    
0025 
0026       SAVE XQ, TX, TT, TS, NEHLQ, CEHLQ, CDO, COW             ! Uzhi
0027 
0028     
0029 C...The following data lines are coefficients needed in the 
0030 C...Eichten, Hinchliffe, Lane, Quigg proton structure function  
0031 C...parametrizations, see below.    
0032 C...Powers of 1-x in different cases.   
0033       DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/   
0034 C...Expansion coefficients for up valence quark distribution.   
0035       DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/  
0036      1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04,    
0037      2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03,    
0038      3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03,    
0039      4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03,    
0040      5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03,    
0041      6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04,    
0042      1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04,    
0043      2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03,    
0044      3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04,    
0045      4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04,    
0046      5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05,    
0047      6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/    
0048       DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/  
0049      1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04,    
0050      2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03,    
0051      3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03,    
0052      4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03,    
0053      5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03,    
0054      6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04,    
0055      1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04,    
0056      2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03,    
0057      3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04,    
0058      4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04,    
0059      5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05,    
0060      6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/    
0061 C...Expansion coefficients for down valence quark distribution. 
0062       DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/  
0063      1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04,    
0064      2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03,    
0065      3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03,    
0066      4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03,    
0067      5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04,    
0068      6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04,    
0069      1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04,    
0070      2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03,    
0071      3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04,    
0072      4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04,    
0073      5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05,    
0074      6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/    
0075       DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/  
0076      1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04,    
0077      2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03,    
0078      3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03,    
0079      4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03,    
0080      5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04,    
0081      6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04,    
0082      1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04,    
0083      2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03,    
0084      3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04,    
0085      4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04,    
0086      5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05,    
0087      6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/    
0088 C...Expansion coefficients for up and down sea quark distributions. 
0089       DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/  
0090      1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04,    
0091      2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03,    
0092      3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05,    
0093      4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04,    
0094      5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04,    
0095      6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05,    
0096      1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04,    
0097      2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03,    
0098      3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04,    
0099      4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05,    
0100      5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00,    
0101      6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/    
0102       DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/  
0103      1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04,    
0104      2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03,    
0105      3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04,    
0106      4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04,    
0107      5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04,    
0108      6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04,    
0109      1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03,    
0110      2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03,    
0111      3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04,    
0112      4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05,    
0113      5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05,    
0114      6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/    
0115 C...Expansion coefficients for gluon distribution.  
0116       DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/  
0117      1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02,    
0118      2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02,    
0119      3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02,    
0120      4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03,    
0121      5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04,    
0122      6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03,    
0123      1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02,    
0124      2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02,    
0125      3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02,    
0126      4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03,    
0127      5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03,    
0128      6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/    
0129       DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/  
0130      1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02,    
0131      2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02,    
0132      3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02,    
0133      4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02,    
0134      5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02,    
0135      6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02,    
0136      1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02,    
0137      2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01,    
0138      3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02,    
0139      4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03,    
0140      5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03,    
0141      6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/    
0142 C...Expansion coefficients for strange sea quark distribution.  
0143       DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/  
0144      1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04,    
0145      2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03,    
0146      3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04,    
0147      4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04,    
0148      5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04,    
0149      6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05,    
0150      1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04,    
0151      2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03,    
0152      3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04,    
0153      4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05,    
0154      5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00,    
0155      6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/    
0156       DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/  
0157      1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04,    
0158      2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03,    
0159      3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04,    
0160      4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04,    
0161      5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04,    
0162      6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04,    
0163      1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03,    
0164      2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03,    
0165      3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04,    
0166      4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05,    
0167      5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05,    
0168      6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/    
0169 C...Expansion coefficients for charm sea quark distribution.    
0170       DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/  
0171      1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03,    
0172      2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03,    
0173      3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04,    
0174      4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05,    
0175      5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05,    
0176      6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05,    
0177      1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04,    
0178      2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03,    
0179      3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04,    
0180      4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04,    
0181      5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05,    
0182      6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/    
0183       DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/  
0184      1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03,    
0185      2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03,    
0186      3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04,    
0187      4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05,    
0188      5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05,    
0189      6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05,    
0190      1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03,    
0191      2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03,    
0192      3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04,    
0193      4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04,    
0194      5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05,    
0195      6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/    
0196 C...Expansion coefficients for bottom sea quark distribution.   
0197       DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/  
0198      1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03,    
0199      2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04,    
0200      3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04,    
0201      4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05,    
0202      5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05,    
0203      6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05,    
0204      1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03,    
0205      2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03,    
0206      3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04,    
0207      4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05,    
0208      5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05,    
0209      6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/    
0210       DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/  
0211      1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03,    
0212      2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04,    
0213      3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04,    
0214      4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05,    
0215      5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00,    
0216      6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05,    
0217      1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03,    
0218      2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03,    
0219      3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04,    
0220      4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05,    
0221      5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05,    
0222      6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/    
0223 C...Expansion coefficients for top sea quark distribution.  
0224       DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/  
0225      1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04,    
0226      2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04,    
0227      3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04,    
0228      4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00,    
0229      5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05,    
0230      6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,    
0231      1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03,    
0232      2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03,    
0233      3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04,    
0234      4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05,    
0235      5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00,    
0236      6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/    
0237       DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/  
0238      1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04,    
0239      2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04,    
0240      3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04,    
0241      4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00,    
0242      5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05,    
0243      6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,    
0244      1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03,    
0245      2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03,    
0246      3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04,    
0247      4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05,    
0248      5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00,    
0249      6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/    
0250     
0251 C...The following data lines are coefficients needed in the 
0252 C...Duke, Owens proton structure function parametrizations, see below.  
0253 C...Expansion coefficients for (up+down) valence quark distribution.    
0254       DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/    
0255      1 4.190E-01, 3.460E+00, 4.400E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0256      2 4.000E-03, 7.240E-01,-4.860E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0257      3-7.000E-03,-6.600E-02, 1.330E+00, 0.000E+00, 0.000E+00, 0.000E+00/    
0258       DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/    
0259      1 3.740E-01, 3.330E+00, 6.030E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0260      2 1.400E-02, 7.530E-01,-6.220E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0261      3 0.000E+00,-7.600E-02, 1.560E+00, 0.000E+00, 0.000E+00, 0.000E+00/    
0262 C...Expansion coefficients for down valence quark distribution. 
0263       DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/    
0264      1 7.630E-01, 4.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0265      2-2.370E-01, 6.270E-01,-4.210E-01, 0.000E+00, 0.000E+00, 0.000E+00,    
0266      3 2.600E-02,-1.900E-02, 3.300E-02, 0.000E+00, 0.000E+00, 0.000E+00/    
0267       DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/    
0268      1 7.610E-01, 3.830E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0269      2-2.320E-01, 6.270E-01,-4.180E-01, 0.000E+00, 0.000E+00, 0.000E+00,    
0270      3 2.300E-02,-1.900E-02, 3.600E-02, 0.000E+00, 0.000E+00, 0.000E+00/    
0271 C...Expansion coefficients for (up+down+strange) sea quark distribution.    
0272       DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/    
0273      1 1.265E+00, 0.000E+00, 8.050E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0274      2-1.132E+00,-3.720E-01, 1.590E+00, 6.310E+00,-1.050E+01, 1.470E+01,    
0275      3 2.930E-01,-2.900E-02,-1.530E-01,-2.730E-01,-3.170E+00, 9.800E+00/    
0276       DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/    
0277      1 1.670E+00, 0.000E+00, 9.150E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0278      2-1.920E+00,-2.730E-01, 5.300E-01, 1.570E+01,-1.010E+02, 2.230E+02,    
0279      3 5.820E-01,-1.640E-01,-7.630E-01,-2.830E+00, 4.470E+01,-1.170E+02/    
0280 C...Expansion coefficients for charm sea quark distribution.    
0281       DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/    
0282      1 0.000E+00,-3.600E-02, 6.350E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0283      2 1.350E-01,-2.220E-01, 3.260E+00,-3.030E+00, 1.740E+01,-1.790E+01,    
0284      3-7.500E-02,-5.800E-02,-9.090E-01, 1.500E+00,-1.130E+01, 1.560E+01/    
0285        DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/   
0286      1 0.000E+00,-1.200E-01, 3.510E+00, 0.000E+00, 0.000E+00, 0.000E+00,    
0287      2 6.700E-02,-2.330E-01, 3.660E+00,-4.740E-01, 9.500E+00,-1.660E+01,    
0288      3-3.100E-02,-2.300E-02,-4.530E-01, 3.580E-01,-5.430E+00, 1.550E+01/    
0289 C...Expansion coefficients for gluon distribution.  
0290       DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/    
0291      1 1.560E+00, 0.000E+00, 6.000E+00, 9.000E+00, 0.000E+00, 0.000E+00,    
0292      2-1.710E+00,-9.490E-01, 1.440E+00,-7.190E+00,-1.650E+01, 1.530E+01,    
0293      3 6.380E-01, 3.250E-01,-1.050E+00, 2.550E-01, 1.090E+01,-1.010E+01/    
0294       DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/    
0295      1 8.790E-01, 0.000E+00, 4.000E+00, 9.000E+00, 0.000E+00, 0.000E+00,    
0296      2-9.710E-01,-1.160E+00, 1.230E+00,-5.640E+00,-7.540E+00,-5.960E-01,    
0297      3 4.340E-01, 4.760E-01,-2.540E-01,-8.170E-01, 5.500E+00, 1.260E-01/    
0298     
0299 C...The following data lines are coefficients needed in the 
0300 C...Owens pion structure function parametrizations, see below.  
0301 C...Expansion coefficients for up and down valence quark distributions. 
0302       DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/    
0303      1  4.0000E-01,  7.0000E-01,  0.0000E+00,  0.0000E+00,  0.0000E+00, 
0304      2 -6.2120E-02,  6.4780E-01,  0.0000E+00,  0.0000E+00,  0.0000E+00, 
0305      3 -7.1090E-03,  1.3350E-02,  0.0000E+00,  0.0000E+00,  0.0000E+00/ 
0306       DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/    
0307      1  4.0000E-01,  6.2800E-01,  0.0000E+00,  0.0000E+00,  0.0000E+00, 
0308      2 -5.9090E-02,  6.4360E-01,  0.0000E+00,  0.0000E+00,  0.0000E+00, 
0309      3 -6.5240E-03,  1.4510E-02,  0.0000E+00,  0.0000E+00,  0.0000E+00/ 
0310 C...Expansion coefficients for gluon distribution.  
0311       DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/    
0312      1  8.8800E-01,  0.0000E+00,  3.1100E+00,  6.0000E+00,  0.0000E+00, 
0313      2 -1.8020E+00, -1.5760E+00, -1.3170E-01,  2.8010E+00, -1.7280E+01, 
0314      3  1.8120E+00,  1.2000E+00,  5.0680E-01, -1.2160E+01,  2.0490E+01/ 
0315       DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/    
0316      1  7.9400E-01,  0.0000E+00,  2.8900E+00,  6.0000E+00,  0.0000E+00, 
0317      2 -9.1440E-01, -1.2370E+00,  5.9660E-01, -3.6710E+00, -8.1910E+00, 
0318      3  5.9660E-01,  6.5820E-01, -2.5500E-01, -2.3040E+00,  7.7580E+00/ 
0319 C...Expansion coefficients for (up+down+strange) quark sea distribution.    
0320       DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/    
0321      1  9.0000E-01,  0.0000E+00,  5.0000E+00,  0.0000E+00,  0.0000E+00, 
0322      2 -2.4280E-01, -2.1200E-01,  8.6730E-01,  1.2660E+00,  2.3820E+00, 
0323      3  1.3860E-01,  3.6710E-03,  4.7470E-02, -2.2150E+00,  3.4820E-01/ 
0324       DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/    
0325      1  9.0000E-01,  0.0000E+00,  5.0000E+00,  0.0000E+00,  0.0000E+00, 
0326      2 -1.4170E-01, -1.6970E-01, -2.4740E+00, -2.5340E+00,  5.6210E-01, 
0327      3 -1.7400E-01, -9.6230E-02,  1.5750E+00,  1.3780E+00, -2.7010E-01/ 
0328 C...Expansion coefficients for charm quark sea distribution.    
0329       DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/    
0330      1  0.0000E+00, -2.2120E-02,  2.8940E+00,  0.0000E+00,  0.0000E+00, 
0331      2  7.9280E-02, -3.7850E-01,  9.4330E+00,  5.2480E+00,  8.3880E+00, 
0332      3 -6.1340E-02, -1.0880E-01, -1.0852E+01, -7.1870E+00, -1.1610E+01/ 
0333       DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/    
0334      1  0.0000E+00, -8.8200E-02,  1.9240E+00,  0.0000E+00,  0.0000E+00, 
0335      2  6.2290E-02, -2.8920E-01,  2.4240E-01, -4.4630E+00, -8.3670E-01, 
0336      3 -4.0990E-02, -1.0820E-01,  2.0360E+00,  5.2090E+00, -4.8400E-02/ 
0337     
0338 C...Euler's beta function, requires ordinary Gamma function 
0339       EULBET(X,Y)=PYHIGAMM(X)*PYHIGAMM(Y)/PYHIGAMM(X+Y)   
0340     
0341 C...Reset structure functions, check x and hadron flavour.  
0342       ALAM=0.   
0343       DO 100 KFL=-6,6   
0344   100 XPQ(KFL)=0.   
0345       IF(X.LT.0..OR.X.GT.1.) THEN   
0346         WRITE(MSTU(11),1000) X  
0347         RETURN  
0348       ENDIF 
0349       KFA=IABS(KF)  
0350       IF(KFA.NE.211.AND.KFA.NE.2212.AND.KFA.NE.2112) THEN   
0351         WRITE(MSTU(11),1100) KF 
0352         RETURN  
0353       ENDIF 
0354     
0355 C...Call user-supplied structure function. Select proton/neutron/pion.  
0356       IF(MSTP(51).EQ.0.OR.MSTP(52).GE.2) THEN   
0357         KFE=KFA 
0358         IF(KFA.EQ.2112) KFE=2212    
0359         CALL PYHISTFE(KFE,X,Q2,XPQ)   
0360         GOTO 230    
0361       ENDIF 
0362       IF(KFA.EQ.211) GOTO 200   
0363     
0364       IF(MSTP(51).EQ.1.OR.MSTP(51).EQ.2) THEN   
0365 C...Proton structure functions from Eichten, Hinchliffe, Lane, Quigg.   
0366 C...Allowed variable range: 5 GeV2 < Q2 < 1E8 GeV2; 1E-4 < x < 1    
0367     
0368 C...Determine set, Lamdba and x and t expansion variables.  
0369         NSET=MSTP(51)   
0370         IF(NSET.EQ.1) ALAM=0.2  
0371         IF(NSET.EQ.2) ALAM=0.29 
0372         TMIN=LOG(5./ALAM**2)    
0373         TMAX=LOG(1E8/ALAM**2)   
0374         IF(MSTP(52).EQ.0) THEN  
0375           T=TMIN    
0376         ELSE    
0377           T=LOG(Q2/ALAM**2) 
0378         ENDIF   
0379         VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))    
0380         NX=1    
0381         IF(X.LE.0.1) NX=2   
0382         IF(NX.EQ.1) VX=(2.*X-1.1)/0.9   
0383         IF(NX.EQ.2) VX=MAX(-1.,(2.*LOG(X)+11.51293)/6.90776)    
0384         CXS=1.  
0385         IF(X.LT.1E-4.AND.ABS(PARP(51)-1.).GT.0.01) CXS= 
0386      &  (1E-4/X)**(PARP(51)-1.) 
0387     
0388 C...Chebyshev polynomials for x and t expansion.    
0389         TX(1)=1.    
0390         TX(2)=VX    
0391         TX(3)=2.*VX**2-1.   
0392         TX(4)=4.*VX**3-3.*VX    
0393         TX(5)=8.*VX**4-8.*VX**2+1.  
0394         TX(6)=16.*VX**5-20.*VX**3+5.*VX 
0395         TT(1)=1.    
0396         TT(2)=VT    
0397         TT(3)=2.*VT**2-1.   
0398         TT(4)=4.*VT**3-3.*VT    
0399         TT(5)=8.*VT**4-8.*VT**2+1.  
0400         TT(6)=16.*VT**5-20.*VT**3+5.*VT 
0401     
0402 C...Calculate structure functions.  
0403         DO 120 KFL=1,6  
0404         XQSUM=0.    
0405         DO 110 IT=1,6   
0406         DO 110 IX=1,6   
0407   110   XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT)  
0408   120   XQ(KFL)=XQSUM*(1.-X)**NEHLQ(KFL,NSET)*CXS   
0409     
0410 C...Put into output array.  
0411         XPQ(0)=XQ(4)    
0412         XPQ(1)=XQ(2)+XQ(3)  
0413         XPQ(2)=XQ(1)+XQ(3)  
0414         XPQ(3)=XQ(5)    
0415         XPQ(4)=XQ(6)    
0416         XPQ(-1)=XQ(3)   
0417         XPQ(-2)=XQ(3)   
0418         XPQ(-3)=XQ(5)   
0419         XPQ(-4)=XQ(6)   
0420     
0421 C...Special expansion for bottom (threshold effects).   
0422         IF(MSTP(54).GE.5) THEN  
0423           IF(NSET.EQ.1) TMIN=8.1905 
0424           IF(NSET.EQ.2) TMIN=7.4474 
0425           IF(T.LE.TMIN) GOTO 140    
0426           VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))  
0427           TT(1)=1.  
0428           TT(2)=VT  
0429           TT(3)=2.*VT**2-1. 
0430           TT(4)=4.*VT**3-3.*VT  
0431           TT(5)=8.*VT**4-8.*VT**2+1.    
0432           TT(6)=16.*VT**5-20.*VT**3+5.*VT   
0433           XQSUM=0.  
0434           DO 130 IT=1,6 
0435           DO 130 IX=1,6 
0436   130     XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT)  
0437           XPQ(5)=XQSUM*(1.-X)**NEHLQ(7,NSET)    
0438           XPQ(-5)=XPQ(5)    
0439   140     CONTINUE  
0440         ENDIF   
0441     
0442 C...Special expansion for top (threshold effects).  
0443         IF(MSTP(54).GE.6) THEN  
0444           IF(NSET.EQ.1) TMIN=11.5528    
0445           IF(NSET.EQ.2) TMIN=10.8097    
0446           TMIN=TMIN+2.*LOG(PMAS(6,1)/30.)   
0447           TMAX=TMAX+2.*LOG(PMAS(6,1)/30.)   
0448           IF(T.LE.TMIN) GOTO 160    
0449           VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))  
0450           TT(1)=1.  
0451           TT(2)=VT  
0452           TT(3)=2.*VT**2-1. 
0453           TT(4)=4.*VT**3-3.*VT  
0454           TT(5)=8.*VT**4-8.*VT**2+1.    
0455           TT(6)=16.*VT**5-20.*VT**3+5.*VT   
0456           XQSUM=0.  
0457           DO 150 IT=1,6 
0458           DO 150 IX=1,6 
0459   150     XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT)  
0460           XPQ(6)=XQSUM*(1.-X)**NEHLQ(8,NSET)    
0461           XPQ(-6)=XPQ(6)    
0462   160     CONTINUE  
0463         ENDIF   
0464     
0465       ELSEIF(MSTP(51).EQ.3.OR.MSTP(51).EQ.4) THEN   
0466 C...Proton structure functions from Duke, Owens.    
0467 C...Allowed variable range: 4 GeV2 < Q2 < approx 1E6 GeV2.  
0468     
0469 C...Determine set, Lambda and s expansion parameter.    
0470         NSET=MSTP(51)-2 
0471         IF(NSET.EQ.1) ALAM=0.2  
0472         IF(NSET.EQ.2) ALAM=0.4  
0473         IF(MSTP(52).LE.0) THEN  
0474           SD=0. 
0475         ELSE    
0476           SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2))   
0477         ENDIF   
0478     
0479 C...Calculate structure functions.  
0480         DO 180 KFL=1,5  
0481         DO 170 IS=1,6   
0482   170   TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+    
0483      &  CDO(3,IS,KFL,NSET)*SD**2    
0484         IF(KFL.LE.2) THEN   
0485           XQ(KFL)=X**TS(1)*(1.-X)**TS(2)*(1.+TS(3)*X)/(EULBET(TS(1),    
0486      &    TS(2)+1.)*(1.+TS(3)*TS(1)/(TS(1)+TS(2)+1.)))  
0487         ELSE    
0488           XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2+  
0489      &    TS(6)*X**3)   
0490         ENDIF   
0491   180   CONTINUE    
0492     
0493 C...Put into output arrays. 
0494         XPQ(0)=XQ(5)    
0495         XPQ(1)=XQ(2)+XQ(3)/6.   
0496         XPQ(2)=3.*XQ(1)-XQ(2)+XQ(3)/6.  
0497         XPQ(3)=XQ(3)/6. 
0498         XPQ(4)=XQ(4)    
0499         XPQ(-1)=XQ(3)/6.    
0500         XPQ(-2)=XQ(3)/6.    
0501         XPQ(-3)=XQ(3)/6.    
0502         XPQ(-4)=XQ(4)   
0503     
0504 C...Proton structure functions from Diemoz, Ferroni, Longo, Martinelli. 
0505 C...These are accessed via PYHISTFE since the files needed may not always 
0506 C...available.  
0507       ELSEIF(MSTP(51).GE.11.AND.MSTP(51).LE.13) THEN    
0508         CALL PYHISTFE(2212,X,Q2,XPQ)  
0509     
0510 C...Unknown proton parametrization. 
0511       ELSE  
0512         WRITE(MSTU(11),1200) MSTP(51)   
0513       ENDIF 
0514       GOTO 230  
0515     
0516   200 IF((MSTP(51).GE.1.AND.MSTP(51).LE.4).OR.  
0517      &(MSTP(51).GE.11.AND.MSTP(51).LE.13)) THEN 
0518 C...Pion structure functions from Owens.    
0519 C...Allowed variable range: 4 GeV2 < Q2 < approx 2000 GeV2. 
0520     
0521 C...Determine set, Lambda and s expansion variable. 
0522         NSET=1  
0523         IF(MSTP(51).EQ.2.OR.MSTP(51).EQ.4.OR.MSTP(51).EQ.13) NSET=2 
0524         IF(NSET.EQ.1) ALAM=0.2  
0525         IF(NSET.EQ.2) ALAM=0.4  
0526         IF(MSTP(52).LE.0) THEN  
0527           SD=0. 
0528         ELSE    
0529           SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2))   
0530         ENDIF   
0531     
0532 C...Calculate structure functions.  
0533         DO 220 KFL=1,4  
0534         DO 210 IS=1,5   
0535   210   TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+    
0536      &  COW(3,IS,KFL,NSET)*SD**2    
0537         IF(KFL.EQ.1) THEN   
0538           XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/EULBET(TS(1),TS(2)+1.) 
0539         ELSE    
0540           XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2)  
0541         ENDIF   
0542   220   CONTINUE    
0543     
0544 C...Put into output arrays. 
0545         XPQ(0)=XQ(2)    
0546         XPQ(1)=XQ(3)/6. 
0547         XPQ(2)=XQ(1)+XQ(3)/6.   
0548         XPQ(3)=XQ(3)/6. 
0549         XPQ(4)=XQ(4)    
0550         XPQ(-1)=XQ(1)+XQ(3)/6.  
0551         XPQ(-2)=XQ(3)/6.    
0552         XPQ(-3)=XQ(3)/6.    
0553         XPQ(-4)=XQ(4)   
0554     
0555 C...Unknown pion parametrization.   
0556       ELSE  
0557         WRITE(MSTU(11),1200) MSTP(51)   
0558       ENDIF 
0559     
0560 C...Isospin conjugation for neutron, charge conjugation for antipart.   
0561   230 IF(KFA.EQ.2112) THEN  
0562         XPS=XPQ(1)  
0563         XPQ(1)=XPQ(2)   
0564         XPQ(2)=XPS  
0565         XPS=XPQ(-1) 
0566         XPQ(-1)=XPQ(-2) 
0567         XPQ(-2)=XPS 
0568       ENDIF 
0569       IF(KF.LT.0) THEN  
0570         DO 240 KFL=1,4  
0571         XPS=XPQ(KFL)    
0572         XPQ(KFL)=XPQ(-KFL)  
0573   240   XPQ(-KFL)=XPS   
0574       ENDIF 
0575     
0576 C...Check positivity and reset above maximum allowed flavour.   
0577       DO 250 KFL=-6,6   
0578       XPQ(KFL)=MAX(0.,XPQ(KFL)) 
0579   250 IF(IABS(KFL).GT.MSTP(54)) XPQ(KFL)=0. 
0580 
0581 C...consider nuclear effect on the structure function
0582         IF((JBT.NE.1.AND.JBT.NE.2).OR.IHPR2(6).EQ.0
0583      &                  .OR.IHNT2(16).EQ.1) GO TO 400
0584         ATNM=IHNT2(2*JBT-1)
0585         IF(ATNM.LE.1.0) GO TO 400
0586         IF(JBT.EQ.1) THEN
0587           BBR2=(YP(1,IHNT2(11))**2+YP(2,IHNT2(11))**2)/1.44/ATNM**0.66666
0588         ELSEIF(JBT.EQ.2) THEN
0589           BBR2=(YT(1,IHNT2(12))**2+YT(2,IHNT2(12))**2)/1.44/ATNM**0.66666
0590         ENDIF
0591         BBR2=MIN(1.0,BBR2)
0592         ABX=(ATNM**0.33333333-1.0)
0593         APX=HIPR1(6)*4.0/3.0*ABX*SQRT(1.0-BBR2)
0594         AAX=1.192*ALOG(ATNM)**0.1666666
0595         RRX=AAX*(X**3-1.2*X**2+0.21*X)+1.0
0596      &          -(APX-1.079*ABX*SQRT(X)/ALOG(ATNM+1.0))*EXP(-X**2.0/0.01)
0597         DO 300 KFL=-6,6
0598                 XPQ(KFL)=XPQ(KFL)*RRX
0599 300     CONTINUE
0600 C                       ********consider the nuclear effect on the structure
0601 C                               fucntion which also depends on the impact
0602 C                               parameter of the nuclear reaction
0603 
0604 400     CONTINUE    
0605 C...Formats for error printouts.    
0606  1000 FORMAT(' Error: x value outside physical range, x =',1P,E12.3)    
0607  1100 FORMAT(' Error: illegal particle code for structure function,',   
0608      &' KF =',I5)   
0609  1200 FORMAT(' Error: bad value of parameter MSTP(51) in PYHISTFU,',  
0610      &' MSTP(51) =',I5) 
0611     
0612       RETURN    
0613       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!