LHAPDF/lhapdf5.3.1/wrapowpi.f

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