EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
poldqcd.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file poldqcd.F
1 *72*********************************************************************
2  FUNCTION poldqcd(ICOSFI,IPART,IP,XP,ZP,YY)
3 
4  IMPLICIT NONE
5 
6 *...Added common block LEPTOU to access to polarization state,
7 
8 *
9 * to avoid variable conflictions, a second keep element is necessary
10 * with the same common block name (see LPTOU2)
11 *
12  COMMON /leptou/ cut(14),lst(40),parl(30),
13  & x,y,w2,q2,u
14  REAL cut,parl,x,y,w2,q2,u
15  INTEGER lst
16  SAVE /leptou/
17 
18  INTEGER icosfi,ip,ipart
19  REAL poldqcd,xp,zp,yy,c1,c2,c3,c4
20 
21 C...First order QCD matrix elements from R.D. Peccei and R. Ruckl:
22 C...Nucl. Phys. B162 (1980) 125
23 *...Polarized part: notes of L. Mankiewicz
24 
25 C...Constants C1 to C5 are resp. 2/3/pi, 1/4/pi, 4/3/pi, 1/2/pi, 1/pi
26  DATA c1,c2,c3,c4/0.2122066,0.0795775,0.4244132,0.1591549/
27 
28  IF(lst(8).EQ.19.AND.ipart.EQ.1) THEN
29 C...No QCD Compton for Ariadne
30  poldqcd=0.0
31  RETURN
32  ENDIF
33 
34  IF(icosfi.EQ.0) THEN
35  IF(ipart.EQ.1) THEN
36  IF(ip.EQ.1) THEN
37  poldqcd=0
38  ELSEIF(ip.EQ.2) THEN
39  poldqcd=0
40  ELSEIF(ip.EQ.3) THEN
41  poldqcd=c1*((1.-xp)/(1.-zp) + (1.-zp)/(1.-xp) +
42  1 2.*xp*zp/((1.-xp)*(1.-zp)) + 2.*(zp+xp-1.))
43  ELSE
44  WRITE(6,1000) icosfi,ipart,ip
45  ENDIF
46  ELSEIF(ipart.EQ.2) THEN
47  IF(ip.EQ.1) THEN
48  poldqcd= 0.
49  ELSEIF(ip.EQ.2) THEN
50  poldqcd=0.
51  ELSEIF(ip.EQ.3) THEN
52  poldqcd=c2*(2.*xp-1)*(zp/(1.-zp) + (1.-zp)/zp)
53  ELSE
54  WRITE(6,1000) icosfi,ipart,ip
55  ENDIF
56  ELSE
57  WRITE(6,1000) icosfi,ipart,ip
58  ENDIF
59 
60  ELSEIF(icosfi.EQ.1) THEN
61  IF(ipart.EQ.1) THEN
62  IF(ip.EQ.1) THEN
63  poldqcd= 0.
64  ELSEIF(ip.EQ.3) THEN
65  poldqcd = c3*yy*
66  & sqrt((1.-yy)*xp*zp/(1.-xp)/(1.-zp))*
67  & (1.-xp-zp)
68  ELSE
69  WRITE(6,1000) icosfi,ipart,ip
70  ENDIF
71  ELSEIF(ipart.EQ.2) THEN
72  IF(ip.EQ.1) THEN
73  poldqcd= 0.
74  ELSEIF(ip.EQ.3) THEN
75  poldqcd=c4*yy*sqrt((1.-yy)*xp*(1.-xp)/zp/(1.-zp))*
76  & (1.-2.*zp)
77  ELSE
78  WRITE(6,1000) icosfi,ipart,ip
79  ENDIF
80  ENDIF
81 
82  ELSEIF(icosfi.EQ.2) THEN
83  IF(ipart.EQ.1) THEN
84  poldqcd= 0.
85  ELSEIF(ipart.EQ.2) THEN
86  poldqcd= 0.
87  ELSE
88  WRITE(6,1000) icosfi,ipart,ip
89  ENDIF
90 
91  ELSE
92  WRITE(6,1000) icosfi,ipart,ip
93  ENDIF
94  RETURN
95 
96  1000 FORMAT(' Error in routine POLDQCD ',
97  &' ICOSFI, IPART, IP = ',3i10)
98  END