LHAPDF 5.2.2 source code.
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.2.2 / wrapgsg.f
1       subroutine GSGevolvep0(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       real*8 SIG,QNS,GL
6       real*8 holdit
7       common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
8       character*16 name(nmxset)
9       integer nmem(nmxset),ndef(nmxset),mmem
10       common/NAME/name,nmem,ndef,mmem
11       integer nset
12       save 
13       
14       call getnset(iset)
15       call getnmem(iset,iimem)
16 c -- this is LO 2 --> 3 0/1 --> 2  
17       if(iimem.eq.2) iimem = 3
18       if(iimem.eq.0) iimem = 2
19       if(iimem.eq.1) iimem = 2
20
21       call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
22
23       pdf(-6)= 0.0d0
24       pdf(6)= 0.0d0
25       pdf(-5)= bot
26       pdf(5 )= bot
27       pdf(-4)= chm
28       pdf(4 )= chm
29       pdf(-3)= str
30       pdf(3 )= str
31       pdf(-2)= usea
32       pdf(2 )= upv
33       pdf(-1)= dsea
34       pdf(1 )= dnv
35       pdf(0 )= glu
36       
37       return
38 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
39       entry GSGevolvep1(xin,qin,p2in,ip2in,pdf)
40       
41 c--- this is HO --- iimem=1
42       iimem = 1
43        call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
44       
45
46       pdf(-6)= 0.0d0
47       pdf(6)= 0.0d0
48       pdf(-5)= bot
49       pdf(5 )= bot
50       pdf(-4)= chm
51       pdf(4 )= chm
52       pdf(-3)= str
53       pdf(3 )= str
54       pdf(-2)= usea
55       pdf(2 )= upv
56       pdf(-1)= dsea
57       pdf(1 )= dnv
58       pdf(0 )= glu
59       
60       return
61 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
62       entry GSGread(nset)
63       read(1,*)nmem(nset),ndef(nset)
64       do j=1,3
65       do k=1,78
66       do m=1,11
67          read(1,*)SIG(k,m,j),QNS(k,m,j),GL(k,m,j)
68       enddo
69       enddo
70       enddo
71       return
72 c
73 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
74       entry GSGalfa(alfas,qalfa)
75         call getnset(iset)
76         call getnmem(iset,imem)
77         call GetOrderAsM(iset,iord)
78         call Getlam4M(iset,imem,qcdl4)
79         call Getlam5M(iset,imem,qcdl5)
80         call aspdflib(alfas,Qalfa,iord,qcdl5)
81 c        call aspdflib(alfas,Qalfa,iord,qcdl5)
82
83       return
84 c
85 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
86       entry GSGinit(Eorder,Q2fit)
87       return
88 c
89 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
90       entry GSGpdf(mem)
91       call getnset(iset)
92       call setnmem(iset,mem)
93 c      imem = mem
94       return
95 c
96  1000 format(5e13.5)
97       end
98 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
99 c      SUBROUTINE SFGSHO(X,Q,U,D,US,DS,S,C,B,G)
100       SUBROUTINE SFGSHL(iset,X,Q,U,D,US,DS,S,C,B,G)
101 C
102 *****************************************************************
103 * Subroutine returns the parton distributions in the photon in  *
104 * higher  order. u,d etc. gives the actual distributions and    *
105 * not x times the distributions; Q2 means Q 2. The distributions*
106 * are valid for 5.0e -4< x < 1.0 and 5.3 GeV 2 < Q 2 < 1.0e 8.  *
107 * if higher Q 2 or lower x is required, these may be obtained   *
108 * from the authors on request.                                  *
109 * Lionel Gordon July 1991 : Gordon@uk.ac.man.ph.v2              *
110 *****************************************************************
111 C
112       implicit real*8 (a-h,o-z)
113       PARAMETER(NP=78,NQ=11,NARG=2)
114       double precision
115      +       DBFINT,
116 c     +       SIG(NP,NQ),QNS(NP,NQ),GL(NP,NQ),Y(NP),
117      +       Y(NP),
118      +       XT(NARG),A(NP+NQ),QT(NQ)
119       common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
120       DIMENSION NA(NARG)
121       EXTERNAL GSXCOR
122 c      SAVE SIG,QNS,GL,Y,ICALL
123       SAVE Y,ICALL
124       DATA QT /5.3D0,20.0D0,50.0D0,1.0D2,5.0D2,1.0D3,1.0D4,1.0D5,
125      * 1.0D6,1.0D7,1.0D8/
126       DATA ZEROD/0.D0/
127       DATA ICALL/0/
128 ******************************************************************
129        U = ZEROD
130        D = ZEROD
131        S = ZEROD
132        C = ZEROD
133        B = ZEROD
134        G = ZEROD
135 *if x is out of range
136       if(iset.eq.1) then
137         IF((X.LT.5.0D-4).OR.(X.GT.0.95D0)) GOTO 90
138       else
139         IF((X.LT.5.0D-4).OR.(X.GT.0.99D0)) GOTO 90
140       endif
141       
142 *******************************************************************
143        IF (ICALL.NE.1) THEN
144 * get the x coordinates
145           CALL GSXCOR(Y,NP)
146           ICALL=1
147         END IF
148 *
149       DO 30 IX=1,NP
150         A(IX)=Y(IX)
151    30 CONTINUE
152       DO 40 IQ=1,NQ
153         A(NP+IQ)=QT(IQ)
154    40 CONTINUE
155 *
156       Q2 = Q*Q
157       NA(1)=NP
158       NA(2)=NQ
159        XT(1)=X
160        XT(2)=Q2
161       XSIG=DBFINT(2,XT,NA,A,SIG(1,1,iset))
162       XQNS=DBFINT(2,XT,NA,A,QNS(1,1,iset))
163         G =DBFINT(2,XT,NA,A,GL(1,1,iset))
164 *
165       IF (Q2.LT.50.0D0) THEN
166 C Use three flavour evolution.
167        U=(XSIG+9.0D0*XQNS)/6.0D0
168        D=(XSIG-4.5D0*XQNS)/6.0D0
169        S=D
170        C=ZEROD
171        B=ZEROD
172 *
173       ELSE IF((Q2.GT.50.0D0).AND.(Q2.LT.250.0D0)) THEN
174 C Use four flavour evolution
175       U=(XSIG+6.0D0*XQNS)/8.0D0
176       D=(XSIG-6.0D0*XQNS)/8.0D0
177       S=D
178       C=U
179       B=ZEROD
180       ELSE
181 C Use five flavour evolution
182       U=(XSIG+7.5D0*XQNS)/10.0D0
183       D=(XSIG-5.0D0*XQNS)/10.0D0
184       S=D
185       C=U
186       B=D
187       ENDIF
188       U=X*U
189       US=U
190       D=X*D
191       DS=D
192       S=X*S
193       C=X*C
194       B=X*B
195       G=X*G
196  90   RETURN
197       END
198 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
199       SUBROUTINE GSXCOR(Y,NP)
200 C
201       implicit real*8 (a-h,o-z)
202       double precision
203      +       Y(NP)
204       N=1
205       DO 10 IX=1,20,2
206          Y(N)=    (IX)/2000.0D0
207       N=N+1
208    10 CONTINUE
209       DO 20 IX=30,200,10
210          Y(N)=    (IX)/2000.0D0
211            N=N+1
212    20 CONTINUE
213       DO 30 IX=240,1600,40
214          Y(N)=    (IX)/2000.0D0
215       N=N+1
216    30 CONTINUE
217       DO 40 IX=1625,1980,25
218          Y(N)=    (IX)/2000.0D0
219       N=N+1
220    40 CONTINUE
221       RETURN
222       END
223 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc