ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
attrad.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file attrad.f
1 
2 C
3 C
4 C
5 C****************************************************************
6 C conduct soft radiation according to dipole approxiamtion
7 C****************************************************************
8  SUBROUTINE attrad(IERROR)
9 C
10  common/hiparnt/hipr1(100),ihpr2(50),hint1(100),ihnt2(50)
11  SAVE /hiparnt/
12  common/hijdat/hidat0(10,10),hidat(10)
13  SAVE /hijdat/
14  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
15  SAVE /lujets/
16  ierror=0
17 
18 C.....S INVARIANT MASS-SQUARED BETWEEN PARTONS I AND I+1......
19 C.....SM IS THE LARGEST MASS-SQUARED....
20 
21 40 sm=0.
22  jl=1
23  DO 30 i=1,n-1
24  s=2.*(p(i,4)*p(i+1,4)-p(i,1)*p(i+1,1)-p(i,2)*p(i+1,2)
25  & -p(i,3)*p(i+1,3))+p(i,5)**2+p(i+1,5)**2
26  IF(s.LT.0.) s=0.
27  wp=sqrt(s)-1.5*(p(i,5)+p(i+1,5))
28  IF(wp.GT.sm) THEN
29  pbt1=p(i,1)+p(i+1,1)
30  pbt2=p(i,2)+p(i+1,2)
31  pbt3=p(i,3)+p(i+1,3)
32  pbt4=p(i,4)+p(i+1,4)
33  btt=(pbt1**2+pbt2**2+pbt3**2)/pbt4**2
34  IF(btt.GE.1.0-1.0e-10) go to 30
35  IF((i.NE.1.OR.i.NE.n-1).AND.
36  & (k(i,2).NE.21.AND.k(i+1,2).NE.21)) go to 30
37  jl=i
38  sm=wp
39  ENDIF
40 30 CONTINUE
41  s=(sm+1.5*(p(jl,5)+p(jl+1,5)))**2
42  IF(sm.LT.hipr1(5)) goto 2
43 
44 C.....MAKE PLACE FOR ONE GLUON.....
45  IF(jl+1.EQ.n) goto 190
46  DO 160 j=n,jl+2,-1
47  k(j+1,1)=k(j,1)
48  k(j+1,2)=k(j,2)
49  DO 150 m=1,5
50 C+++BAC
51  v(j+1,m) = v(j,m)
52 C---BAC
53 150 p(j+1,m)=p(j,m)
54 160 CONTINUE
55 190 n=n+1
56 
57 C.....BOOST TO REST SYSTEM FOR PARTICLES JL AND JL+1.....
58  p1=p(jl,1)+p(jl+1,1)
59  p2=p(jl,2)+p(jl+1,2)
60  p3=p(jl,3)+p(jl+1,3)
61  p4=p(jl,4)+p(jl+1,4)
62  bex=-p1/p4
63  bey=-p2/p4
64  bez=-p3/p4
65  imin=jl
66  imax=jl+1
67  CALL atrobo(0.,0.,bex,bey,bez,imin,imax,ierror)
68  IF(ierror.NE.0) RETURN
69 C.....ROTATE TO Z-AXIS....
70  cth=p(jl,3)/sqrt(p(jl,4)**2-p(jl,5)**2)
71  IF(abs(cth).GT.1.0) cth=max(-1.,min(1.,cth))
72  theta=acos(cth)
73  phi=ulangl(p(jl,1),p(jl,2))
74  CALL atrobo(0.,-phi,0.,0.,0.,imin,imax,ierror)
75  CALL atrobo(-theta,0.,0.,0.,0.,imin,imax,ierror)
76 
77 C.....CREATE ONE GLUON AND ORIENTATE.....
78 
79 1 CALL ar3jet(s,x1,x3,jl)
80  CALL arorie(s,x1,x3,jl)
81  IF(hidat(2).GT.0.0) THEN
82  ptg1=sqrt(p(jl,1)**2+p(jl,2)**2)
83  ptg2=sqrt(p(jl+1,1)**2+p(jl+1,2)**2)
84  ptg3=sqrt(p(jl+2,1)**2+p(jl+2,2)**2)
85  ptg=max(ptg1,ptg2,ptg3)
86  IF(ptg.GT.hidat(2)) THEN
87  fmfact=exp(-(ptg**2-hidat(2)**2)/hipr1(2)**2)
88  IF(atl_ran(nseed).GT.fmfact) go to 1
89  ENDIF
90  ENDIF
91 C.....ROTATE AND BOOST BACK.....
92  imin=jl
93  imax=jl+2
94  CALL atrobo(theta,phi,-bex,-bey,-bez,imin,imax,ierror)
95  IF(ierror.NE.0) RETURN
96 C.....ENUMERATE THE GLUONS.....
97  k(jl+2,1)=k(jl+1,1)
98  k(jl+2,2)=k(jl+1,2)
99  k(jl+2,3)=k(jl+1,3)
100  k(jl+2,4)=k(jl+1,4)
101  k(jl+2,5)=k(jl+1,5)
102  p(jl+2,5)=p(jl+1,5)
103  k(jl+1,1)=2
104  k(jl+1,2)=21
105  k(jl+1,3)=0
106  k(jl+1,4)=0
107  k(jl+1,5)=0
108  p(jl+1,5)=0.
109 
110  v(jl+1,1) = 0.
111  v(jl+1,2) = 0.
112  v(jl+1,3) = 0.
113  v(jl+1,4) = 0.
114  v(jl+1,5) = 0.
115 
116 C----THETA FUNCTION DAMPING OF THE EMITTED GLUONS. FOR HADRON-HADRON.
117 C----R0=VFR(2)
118 C IF(VFR(2).GT.0.) THEN
119 C PTG=SQRT(P(JL+1,1)**2+P(JL+1,2)**2)
120 C PTGMAX=WSTRI/2.
121 C DOPT=SQRT((4.*PAR(71)*VFR(2))/WSTRI)
122 C PTOPT=(DOPT*WSTRI)/(2.*VFR(2))
123 C IF(PTG.GT.PTOPT) IORDER=IORDER-1
124 C IF(PTG.GT.PTOPT) GOTO 1
125 C ENDIF
126 C-----
127  IF(sm.GE.hipr1(5)) goto 40
128 
129 2 k(1,1)=2
130  k(1,3)=0
131  k(1,4)=0
132  k(1,5)=0
133  k(n,1)=1
134  k(n,3)=0
135  k(n,4)=0
136  k(n,5)=0
137 
138  RETURN
139  END