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