EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lazimu.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lazimu.F
1 
2 C **********************************************************************
3 
4  SUBROUTINE lazimu(XP,ZP)
5 
6  IMPLICIT NONE
7 
8 C...Choose azimuthal angle (PHI) according to QCD matrix elements.
9 *
10 * to avoid variable conflictions, a second keep element is necessary
11 * with the same common block name (see LPTOU2)
12 *
13  COMMON /leptou/ cut(14),lst(40),parl(30),
14  & x,y,w2,q2,u
15  REAL cut,parl,x,y,w2,q2,u
16  INTEGER lst
17  SAVE /leptou/
18 
19  COMMON /linter/ pari(50),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
20  REAL pari,ewqc,qc,zl,zq,pq
21  SAVE /linter/
22 
23 
24  INTEGER j,ifl,i,ih
25  REAL xp,zp,dqcd,a,b,c,phimax,phi,sgn
26  REAL rlu
27 
28 *PEPSI>>
29  IF(lst(40).NE.0) THEN
30  CALL pollazimu(xp,zp)
31  RETURN
32  ENDIF
33 *PEPSI<<
34 
35  j=lst(24)-1
36  sgn=sign(1.,2.5-lst(24))
37  ifl=lst(25)
38  i=iabs(ifl)
39  ih=1
40  IF(lst(30).EQ.1) ih=2
41 
42  IF(lst(23).EQ.2) THEN
43  a=pari(24)*dqcd(0,j,1,xp,zp,y)+pari(25)*dqcd(0,j,2,xp,zp,y)
44  & -lst(30)*isign(1,ifl)*pari(26)*dqcd(0,j,3,xp,zp,y)
45  b=dqcd(1,j,1,xp,zp,y)
46  & +sgn*lst(30)*isign(1,ifl)*dqcd(1,j,3,xp,zp,y)
47  c=dqcd(2,j,1,xp,zp,y)
48  ELSE
49  a=(ewqc(1,ih,i)+ewqc(2,ih,i))*(pari(24)*dqcd(0,j,1,xp,zp,y)+
50  & pari(25)*dqcd(0,j,2,xp,zp,y))
51  & -lst(30)*isign(1,ifl)*(ewqc(1,ih,i)-ewqc(2,ih,i))
52  & *pari(26)*dqcd(0,j,3,xp,zp,y)
53  b=(ewqc(1,ih,i)+ewqc(2,ih,i))*dqcd(1,j,1,xp,zp,y)
54  & +sgn*lst(30)*isign(1,ifl)*(ewqc(1,ih,i)-ewqc(2,ih,i))
55  & *dqcd(1,j,3,xp,zp,y)
56  c=(ewqc(1,ih,i)+ewqc(2,ih,i))*dqcd(2,j,1,xp,zp,y)
57  ENDIF
58 
59  phimax=abs(a)+abs(b)+abs(c)
60  100 phi=6.2832*rlu(0)
61  IF(a+b*cos(phi)+c*cos(2.*phi).LT.rlu(0)*phimax) goto 100
62  CALL lurobo(0.,phi,0.,0.,0.)
63 
64 CAE.Store ME variables
65  parl(28)=xp
66  parl(29)=zp
67  parl(30)=phi
68 CAE
69  RETURN
70  END