[u/mrichter/AliRoot.git] / PDF / tpdf / testgam.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.3  1997/07/13 13:25:32  cernlib
* Import version 7.09
*
* Revision 1.3  1997/07/02 15:03:11  pdflib
* potential bug removed in GRSGALO
*
* Revision 1.2  1996/10/28 16:10:10  pdflib
* PDFLIB new version 7.04
*
* Revision 1.1.1.1  1996/04/12 15:30:17  plothow
* Version 7.01
*
*
#include "pdf/pilot.h"
      PROGRAM TESTGAM
C
#include "pdf/impdp.inc"
      PARAMETER (LFLPRT = 2)
#include "pdf/w5051p2.inc"
#include "pdf/w5051p7.inc"
#include "pdf/w50510.inc"
#include "pdf/w50511.inc"
#include "pdf/w50512.inc"
#include "pdf/w50513.inc"
#include "pdf/w50516.inc"
#include "pdf/w50517.inc"
#include "pdf/w505110.inc"
#include "pdf/w505120.inc"
#include "pdf/w505122.inc"
C
#include "pdf/expdp.inc"
     +       DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL,
     +       DQ2,DP2
#include "pdf/expdp.inc"
     +               XI(32),WI(32),XX(33)
      COMMON/W5051I9/XI,WI,XX,NTERMS
#include "pdf/expdp.inc"
     +       XV(3),ZQ(5)
      CHARACTER*20 PARM(NCHDIM)
#include "pdf/expdp.inc"
     +       VAL(NCHDIM)
C
      DATA XV/0.05D0,0.50D0,0.95D0/
      DATA ZQ/10.D0,100.D0,1000.D0,1.D+4,5.5D+5/
      DATA P2/5./
      DATA IP2/0/
      DATA FLAV/4.D0/
      DATA ALQED/137.D0/
      DATA ICALL/0/
C
      N6 = L6
      IFLPRT = LFLPRT
C
C*****adjustment of the VDM contribution*******************************
      KA=1.
C*****mass of the charm quark******************************************
      CM=1.41
C*****CHARME=0. -> no charm contribution ******************************
      CHARME=1.
C
      PI=4.D0*ATAN(1.D0)
      PI2=PI**2
      CF=4.D0/3.D0
      NF=INT(FLAV+0.1D0)
      IF(NF.EQ.0) NF=3
      FLAVOR=FLAV
      B0=11.D0-2.D0*NF/3.D0
      B1=102.D0-38.D0*NF/3.D0
      CCOEG=2.D0/9.D0
C      IF(NF.EQ.4) CCOEG=5.D0/18.D0
C      COEG=2.D0*FLAVOR*CCOEG
      COEG=2.D0*FLAVOR*CCOEG
      CALL WATE32
C
C First call to PDFSET to initialize COMMON/W505120/
      PARM(1) = 'Init0'
      VAL(1)  = 0.D0
      CALL PDFSET(PARM,VAL)
C.
C Test new PDFLIB versions (4.0 or bigger) for Photons only
      NPTYPE = 3
         DO KGRO = 1,NGRMAX
            IF(NPGSMX(NPTYPE,KGRO) .EQ. 0) GOTO 500
            DO ISET=1,NPGSMX(NPTYPE,KGRO)
               WRITE (N6,*) ' ==========================================
     +================================================================='
               FIRST=.TRUE.
               PARM(1) = 'Nptype'
               VAL(1)  = NPTYPE
               PARM(2) = 'Ngroup'
               VAL(2)  = KGRO
               PARM(3) = 'Nset'
               VAL(3)  = ISET
               CALL PDFSET(PARM,VAL)
C
         ICALL = 0
         Q02 = Q2MIN
         OWLAM = QCDL4
         OWLAM2=OWLAM**2
         IORD = LO - 1
*
      DO 100 J=3,3
      Q2=Q02
      IF(J.GE.2) Q2=ZQ(J-1)
      XTH=1.D0/(1.D0+4.D0*CM**2/Q2)
      ALQ2= LOG(Q2/OWLAM2)
      ALFPI= 2.D0 /(B0*ALQ2+B1* LOG(ALQ2)/B0)
      DO 70 K=1,3
      X=XV(K)
      DX = X
      Q = SQRT(Q2)
      DQ = Q
      DQ2 = Q2
      DP2 = P2
      IP = IP2
      CUT=1.
      IF(CHARME.LT.0.5) CUT=0.
      CUTG=1.
      IF(X.GT.XTH) CUT=0.
      CALL STRUCTP(DX,DQ2,DP2,IP,
     +             DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
      UB =DUB
      DB =DDB
      SB =DSB
      CB =DCB
      GL =DGL
      F2=(4.D0*  DUB   +  DDB   +  DSB)/9.D0
      F2C=4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT
      F2=F2+F2C
      IF(ICALL.EQ.0) THEN
        ICALL = 1
        WRITE (N6,1000) Q02,P2,CHARME,CUT,IORD,OWLAM,FLAV
 1000   FORMAT(1X,' Q02= ',F7.3,'   P2= ',F7.3,
     +               '   CHARM= ',F3.1,'   CUT= ',F3.1,
     +               '   IORD= ',I2,'   LAMBDA=',F7.4,'   NF = ',F5.2)
        ENDIF
      IF (K.EQ.1) THEN
        WRITE (N6,1001) Q2
 1001   FORMAT(/,'  Q2=  ',E10.3,' GEV**2')
        WRITE(N6,1002)
 1002   FORMAT(/,4X,' X',6X,'X*UB  ',6X,'X*DB  ',6X,'X*SB  ',6X,'X*CB  '
     +                  ,6X,'X*GL',8X,' F2 ',6X,' F2/ALPHA'
     +                            ,5X,' F2C ',5X,' F2C/ALPHA')
      ENDIF
      IF(IORD)13,13,14
14    CONTINUE
      AL=0.5D0*ALFPI
      AL1= LOG(1.D0-X)
      XQ=F2+F2*AL*CF*(-9.D0-2.D0*PI2/3.D0+AL1*(-3.D0+2.D0*AL1))
C     WRITE(N6,1111) X,Q,F2,AL1,XQ
C1111 FORMAT(1X,' X,F2 = ',5E13.5)
      XM=1.-X
      XP=1.+X
      DIS2=(XM**2-4.*X*XM*CM**2/Q2)*CUT
      DIS=SQRT(DIS2)
      YP=(XP+DIS)/2.
      YM=(XP-DIS)/2. 
      CUTY=1. 
      DO 81 I=1,NTERMS
      Y=0.5D0*(1.D0-X)*XI(I)+0.5D0*(1.D0+X)
      XY=X/Y
      AL1= LOG(1.D0-Y)
      DX = XY
      CALL STRUCTP(DX,DQ2,DP2,IP,
     +             DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
      XQQ=(4.D0*  DUB   +  DDB   +  DSB)/9.D0
      XQQ=XQQ+4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT*CUTY
      F2A=F2+F2C*(CUTY-1.)
 6    C22=CF*(6.D0+4.D0*Y-2.D0*(1.D0+Y*Y)/
     +          (1.D0-Y)* LOG(Y)-2.D0*(1.D0+Y)*AL1)
      C23=CF*(-3.D0+4.D0*AL1)/(1.D0-Y)
      COEGM=COEG+(8./9.)*(FLAVOR-3.)*CUTG*CUT
      CG2=(-1.D0+8.D0*Y*(1.D0-Y)+(1.D0-2.D0*Y+2.D0*Y*Y)*
     +                   LOG(1.D0/Y-1.D0))*COEGM
      XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*(C22*XQQ+C23*(XQQ- F2A))
      XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*CG2*(DGL+KA*GL)
C     WRITE(N6,1112) Y,AL1,C22,C23,CG2,XQQ,XQ
C1112 FORMAT(1X,' Y,C22 = ',7E13.5)
      CUTG=1.
   81 CUTY=1.
      COE3=3.D0*3.D0*(2.D0/27.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
      COE4=3.D0*(34.D0/81.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
      IF(NF.EQ.3) COE4=COE3
         F2=XQ+COE4*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
     +            LOG(1.D0/X-1.D0))*X
         F2M=XQ+COE3*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
     +            LOG(1.D0/X-1.D0))*X
      CMS=CM**2
      SC=Q2*(1.D0-X)/X
      BE=4.*CMS/SC
      IF(BE.GE.1.) WCM=0.
      IF(BE.GE.1.) GO TO 91
      SQ=SQRT(1.-BE)
      A1=((1.D0+SQ)/2.D0)**2 
      A2=(1.D0-X)/X
      WCM=(8.D0*(1.D0-X)*X-1.D0)*SQ+(X**2+(1.D0-X)**2)*LOG(A1*A2)
      WCM=3.D0*(4.D0/9.D0)/(PI*ALQED)*X*WCM
91    CONTINUE
      F2M=F2M+(4.D0/9.D0)*(FLAVOR-3.D0)*WCM*CUT
         F2C=F2M
   13    F2N=F2*ALQED
         F2CN=F2C*ALQED
         WRITE(N6,1003)X,UB,DB,SB,CB,GL,F2,F2N,F2C,F2CN
 1003    FORMAT(1X,' ',F6.3,9E12.4)
   70    CONTINUE
  100    CONTINUE
       ENDDO
       WRITE(N6,*) '  '
  500  CONTINUE
      ENDDO
      STOP
      END
Commit	Line	Data
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
	20	C
	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"
	34	C
	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)
	46	C
	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/
	54	C
	55	N6 = L6
	56	IFLPRT = LFLPRT
	57	C
	58	C***adjustment of the VDM contribution*****************************
	59	KA=1.
	60	C***mass of the charm quark****************************************
	61	CM=1.41
	62	C***CHARME=0. -> no charm contribution ****************************
	63	CHARME=1.
	64	C
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
74	C IF(NF.EQ.4) CCOEG=5.D0/18.D0
75	C COEG=2.D0FLAVORCCOEG
76	COEG=2.D0FLAVORCCOEG
77	CALL WATE32
78	C
79	C First call to PDFSET to initialize COMMON/W505120/
80	PARM(1) = 'Init0'
81	VAL(1) = 0.D0
82	CALL PDFSET(PARM,VAL)
83	C.
84	C 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)
99	C
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.D0CM*2/Q2)
110	ALQ2= LOG(Q2/OWLAM2)
111	ALFPI= 2.D0 /(B0ALQ2+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,'XUB ',6X,'XDB ',6X,'XSB ',6X,'XCB '
146	+ ,6X,'X*GL',8X,' F2 ',6X,' F2/ALPHA'
147	+ ,5X,' F2C ',5X,' F2C/ALPHA')
148	ENDIF
149	IF(IORD)13,13,14
150	14 CONTINUE
151	AL=0.5D0*ALFPI
152	AL1= LOG(1.D0-X)
153	XQ=F2+F2ALCF(-9.D0-2.D0PI2/3.D0+AL1(-3.D0+2.D0AL1))
154	C WRITE(N6,1111) X,Q,F2,AL1,XQ
155	C1111 FORMAT(1X,' X,F2 = ',5E13.5)
156	XM=1.-X
157	XP=1.+X
158	DIS2=(XM*2-4.XXMCM*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)DCBCUTCUTY
172	F2A=F2+F2C*(CUTY-1.)
173	6 C22=CF(6.D0+4.D0Y-2.D0(1.D0+YY)/
174	+ (1.D0-Y)* LOG(Y)-2.D0(1.D0+Y)AL1)
175	C23=CF(-3.D0+4.D0AL1)/(1.D0-Y)
176	COEGM=COEG+(8./9.)(FLAVOR-3.)CUTG*CUT
177	CG2=(-1.D0+8.D0Y(1.D0-Y)+(1.D0-2.D0Y+2.D0YY)
178	+ LOG(1.D0/Y-1.D0))*COEGM
179	XQ=XQ +0.5D0(1.D0-X)WI(I)AL(C22XQQ+C23(XQQ- F2A))
180	XQ=XQ +0.5D0(1.D0-X)WI(I)ALCG2(DGL+KAGL)
181	C WRITE(N6,1112) Y,AL1,C22,C23,CG2,XQQ,XQ
182	C1112 FORMAT(1X,' Y,C22 = ',7E13.5)
183	CUTG=1.
184	81 CUTY=1.
185	COE3=3.D03.D0(2.D0/27.D0)(1.D0/(2.D0PIALQED))2.D0
186	COE4=3.D0(34.D0/81.D0)(1.D0/(2.D0PIALQED))*2.D0
187	IF(NF.EQ.3) COE4=COE3
188	F2=XQ+COE4(8.D0X(1.D0-X)-1.D0+(1.D0-2.D0X+2.D0XX)*
189	+ LOG(1.D0/X-1.D0))*X
190	F2M=XQ+COE3(8.D0X(1.D0-X)-1.D0+(1.D0-2.D0X+2.D0XX)*
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+(X2+(1.D0-X)2)LOG(A1*A2)
201	WCM=3.D0(4.D0/9.D0)/(PIALQED)XWCM
202	91 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