This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / PDF / tpdf / testgam.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.3 1997/07/13 13:25:32 cernlib
6* Import version 7.09
7*
8* Revision 1.3 1997/07/02 15:03:11 pdflib
9* potential bug removed in GRSGALO
10*
11* Revision 1.2 1996/10/28 16:10:10 pdflib
12* PDFLIB new version 7.04
13*
14* Revision 1.1.1.1 1996/04/12 15:30:17 plothow
15* Version 7.01
16*
17*
18#include "pdf/pilot.h"
19 PROGRAM TESTGAM
20C
21#include "pdf/impdp.inc"
22 PARAMETER (LFLPRT = 2)
23#include "pdf/w5051p2.inc"
24#include "pdf/w5051p7.inc"
25#include "pdf/w50510.inc"
26#include "pdf/w50511.inc"
27#include "pdf/w50512.inc"
28#include "pdf/w50513.inc"
29#include "pdf/w50516.inc"
30#include "pdf/w50517.inc"
31#include "pdf/w505110.inc"
32#include "pdf/w505120.inc"
33#include "pdf/w505122.inc"
34C
35#include "pdf/expdp.inc"
36 + DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL,
37 + DQ2,DP2
38#include "pdf/expdp.inc"
39 + XI(32),WI(32),XX(33)
40 COMMON/W5051I9/XI,WI,XX,NTERMS
41#include "pdf/expdp.inc"
42 + XV(3),ZQ(5)
43 CHARACTER*20 PARM(NCHDIM)
44#include "pdf/expdp.inc"
45 + VAL(NCHDIM)
46C
47 DATA XV/0.05D0,0.50D0,0.95D0/
48 DATA ZQ/10.D0,100.D0,1000.D0,1.D+4,5.5D+5/
49 DATA P2/5./
50 DATA IP2/0/
51 DATA FLAV/4.D0/
52 DATA ALQED/137.D0/
53 DATA ICALL/0/
54C
55 N6 = L6
56 IFLPRT = LFLPRT
57C
58C*****adjustment of the VDM contribution*******************************
59 KA=1.
60C*****mass of the charm quark******************************************
61 CM=1.41
62C*****CHARME=0. -> no charm contribution ******************************
63 CHARME=1.
64C
65 PI=4.D0*ATAN(1.D0)
66 PI2=PI**2
67 CF=4.D0/3.D0
68 NF=INT(FLAV+0.1D0)
69 IF(NF.EQ.0) NF=3
70 FLAVOR=FLAV
71 B0=11.D0-2.D0*NF/3.D0
72 B1=102.D0-38.D0*NF/3.D0
73 CCOEG=2.D0/9.D0
74C IF(NF.EQ.4) CCOEG=5.D0/18.D0
75C COEG=2.D0*FLAVOR*CCOEG
76 COEG=2.D0*FLAVOR*CCOEG
77 CALL WATE32
78C
79C First call to PDFSET to initialize COMMON/W505120/
80 PARM(1) = 'Init0'
81 VAL(1) = 0.D0
82 CALL PDFSET(PARM,VAL)
83C.
84C Test new PDFLIB versions (4.0 or bigger) for Photons only
85 NPTYPE = 3
86 DO KGRO = 1,NGRMAX
87 IF(NPGSMX(NPTYPE,KGRO) .EQ. 0) GOTO 500
88 DO ISET=1,NPGSMX(NPTYPE,KGRO)
89 WRITE (N6,*) ' ==========================================
90 +================================================================='
91 FIRST=.TRUE.
92 PARM(1) = 'Nptype'
93 VAL(1) = NPTYPE
94 PARM(2) = 'Ngroup'
95 VAL(2) = KGRO
96 PARM(3) = 'Nset'
97 VAL(3) = ISET
98 CALL PDFSET(PARM,VAL)
99C
100 ICALL = 0
101 Q02 = Q2MIN
102 OWLAM = QCDL4
103 OWLAM2=OWLAM**2
104 IORD = LO - 1
105*
106 DO 100 J=3,3
107 Q2=Q02
108 IF(J.GE.2) Q2=ZQ(J-1)
109 XTH=1.D0/(1.D0+4.D0*CM**2/Q2)
110 ALQ2= LOG(Q2/OWLAM2)
111 ALFPI= 2.D0 /(B0*ALQ2+B1* LOG(ALQ2)/B0)
112 DO 70 K=1,3
113 X=XV(K)
114 DX = X
115 Q = SQRT(Q2)
116 DQ = Q
117 DQ2 = Q2
118 DP2 = P2
119 IP = IP2
120 CUT=1.
121 IF(CHARME.LT.0.5) CUT=0.
122 CUTG=1.
123 IF(X.GT.XTH) CUT=0.
124 CALL STRUCTP(DX,DQ2,DP2,IP,
125 + DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
126 UB =DUB
127 DB =DDB
128 SB =DSB
129 CB =DCB
130 GL =DGL
131 F2=(4.D0* DUB + DDB + DSB)/9.D0
132 F2C=4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT
133 F2=F2+F2C
134 IF(ICALL.EQ.0) THEN
135 ICALL = 1
136 WRITE (N6,1000) Q02,P2,CHARME,CUT,IORD,OWLAM,FLAV
137 1000 FORMAT(1X,' Q02= ',F7.3,' P2= ',F7.3,
138 + ' CHARM= ',F3.1,' CUT= ',F3.1,
139 + ' IORD= ',I2,' LAMBDA=',F7.4,' NF = ',F5.2)
140 ENDIF
141 IF (K.EQ.1) THEN
142 WRITE (N6,1001) Q2
143 1001 FORMAT(/,' Q2= ',E10.3,' GEV**2')
144 WRITE(N6,1002)
145 1002 FORMAT(/,4X,' X',6X,'X*UB ',6X,'X*DB ',6X,'X*SB ',6X,'X*CB '
146 + ,6X,'X*GL',8X,' F2 ',6X,' F2/ALPHA'
147 + ,5X,' F2C ',5X,' F2C/ALPHA')
148 ENDIF
149 IF(IORD)13,13,14
15014 CONTINUE
151 AL=0.5D0*ALFPI
152 AL1= LOG(1.D0-X)
153 XQ=F2+F2*AL*CF*(-9.D0-2.D0*PI2/3.D0+AL1*(-3.D0+2.D0*AL1))
154C WRITE(N6,1111) X,Q,F2,AL1,XQ
155C1111 FORMAT(1X,' X,F2 = ',5E13.5)
156 XM=1.-X
157 XP=1.+X
158 DIS2=(XM**2-4.*X*XM*CM**2/Q2)*CUT
159 DIS=SQRT(DIS2)
160 YP=(XP+DIS)/2.
161 YM=(XP-DIS)/2.
162 CUTY=1.
163 DO 81 I=1,NTERMS
164 Y=0.5D0*(1.D0-X)*XI(I)+0.5D0*(1.D0+X)
165 XY=X/Y
166 AL1= LOG(1.D0-Y)
167 DX = XY
168 CALL STRUCTP(DX,DQ2,DP2,IP,
169 + DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
170 XQQ=(4.D0* DUB + DDB + DSB)/9.D0
171 XQQ=XQQ+4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT*CUTY
172 F2A=F2+F2C*(CUTY-1.)
173 6 C22=CF*(6.D0+4.D0*Y-2.D0*(1.D0+Y*Y)/
174 + (1.D0-Y)* LOG(Y)-2.D0*(1.D0+Y)*AL1)
175 C23=CF*(-3.D0+4.D0*AL1)/(1.D0-Y)
176 COEGM=COEG+(8./9.)*(FLAVOR-3.)*CUTG*CUT
177 CG2=(-1.D0+8.D0*Y*(1.D0-Y)+(1.D0-2.D0*Y+2.D0*Y*Y)*
178 + LOG(1.D0/Y-1.D0))*COEGM
179 XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*(C22*XQQ+C23*(XQQ- F2A))
180 XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*CG2*(DGL+KA*GL)
181C WRITE(N6,1112) Y,AL1,C22,C23,CG2,XQQ,XQ
182C1112 FORMAT(1X,' Y,C22 = ',7E13.5)
183 CUTG=1.
184 81 CUTY=1.
185 COE3=3.D0*3.D0*(2.D0/27.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
186 COE4=3.D0*(34.D0/81.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
187 IF(NF.EQ.3) COE4=COE3
188 F2=XQ+COE4*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
189 + LOG(1.D0/X-1.D0))*X
190 F2M=XQ+COE3*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
191 + LOG(1.D0/X-1.D0))*X
192 CMS=CM**2
193 SC=Q2*(1.D0-X)/X
194 BE=4.*CMS/SC
195 IF(BE.GE.1.) WCM=0.
196 IF(BE.GE.1.) GO TO 91
197 SQ=SQRT(1.-BE)
198 A1=((1.D0+SQ)/2.D0)**2
199 A2=(1.D0-X)/X
200 WCM=(8.D0*(1.D0-X)*X-1.D0)*SQ+(X**2+(1.D0-X)**2)*LOG(A1*A2)
201 WCM=3.D0*(4.D0/9.D0)/(PI*ALQED)*X*WCM
20291 CONTINUE
203 F2M=F2M+(4.D0/9.D0)*(FLAVOR-3.D0)*WCM*CUT
204 F2C=F2M
205 13 F2N=F2*ALQED
206 F2CN=F2C*ALQED
207 WRITE(N6,1003)X,UB,DB,SB,CB,GL,F2,F2N,F2C,F2CN
208 1003 FORMAT(1X,' ',F6.3,9E12.4)
209 70 CONTINUE
210 100 CONTINUE
211 ENDDO
212 WRITE(N6,*) ' '
213 500 CONTINUE
214 ENDDO
215 STOP
216 END