EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lsci.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lsci.F
1 C **********************************************************************
2 
3  SUBROUTINE lsci(PROB)
4 
5 C-- --C
6 C-- Created: 950319 --C
7 C-- Last update: 950731 --C
8 C-- Purpose: to generate random switches of parton --C
9 C-- colours in the partonic final state --C
10 
11  IMPLICIT NONE
12 
13 C-- global variables
14  INTEGER nlupdm,nplbuf
15  parameter(nlupdm=4000,nplbuf=5)
16  common/lujets/n,k(nlupdm,5),p(nlupdm,nplbuf),v(nlupdm,5)
17  INTEGER n,k
18  REAL p,v
19  SAVE /lujets/
20 
21 *
22 * to avoid variable conflictions, a second keep element is necessary
23 * with the same common block name (see LPTOU2)
24 *
25  COMMON /leptou/ cut(14),lst(40),parl(30),
26  & x,y,w2,q2,u
27  REAL cut,parl,x,y,w2,q2,u
28  INTEGER lst
29  SAVE /leptou/
30 
31 
32 C-- functions
33  REAL rlu
34 C-- local variables
35  INTEGER i,j,lucomp,ns,next,this,init
36  LOGICAL quark,quark1,quark2,aquark1,aquark2,gluon1,gluon2,first
37  REAL prob
38 
39 C-- Assign colour and anticolour pointers to all partons. Colour
40 C-- pointers are in K(I,4) and anticolour pointers are in K(I,5).
41 C-- The pointer points to the row where the respective anticolour
42 C-- and colour is.
43 
44  first=.true.
45  DO 10 i=5,n
46  IF (k(i,1).LT.10 .AND. k(i,1).GT.0) THEN
47 C-- check if parton is a quark, antiquark or diquark
48  IF (abs(k(i,2)).LT.10 .OR. lucomp(k(i,2)).EQ.90) THEN
49  IF (k(i,2).LT.10 .AND. k(i,2).GT.0 .OR.
50  & k(i,2).LT.-1000) THEN
51  quark=.true.
52  ELSE
53  quark=.false.
54  ENDIF
55 C-- reset pointers
56  k(i,4)=0
57  k(i,5)=0
58 C-- the first quark, antiquark or diquark in a string points
59 C-- to the parton in the next line
60  IF (first) THEN
61  IF (quark) THEN
62  k(i,4)=(i+1)
63  ELSE
64  k(i,5)=(i+1)
65  ENDIF
66  first=.false.
67 C-- the last quark, antiquark or diquark in a string points
68 C-- to the parton in the previous line
69  ELSE
70  IF (quark) THEN
71  k(i,4)=(i-1)
72  ELSE
73  k(i,5)=(i-1)
74  ENDIF
75  first=.true.
76  ENDIF
77  k(i,1)=3
78 C-- check if parton gluon
79  ELSEIF (k(i,2).EQ.21) THEN
80 C-- if the previous colour points to this gluon then its anticolour
81 C-- should point back and its colour should point to the next line
82  IF(k(i-1,4).EQ.i) THEN
83  k(i,4)=(i+1)
84  k(i,5)=(i-1)
85  ELSE
86  k(i,4)=(i-1)
87  k(i,5)=(i+1)
88  ENDIF
89  k(i,1)=3
90  ENDIF
91  ENDIF
92 10 CONTINUE
93 
94 C-- find first parton in colour switch
95  DO 20 i=5,n
96  quark1=.false.
97  aquark1=.false.
98  gluon1=.false.
99  IF (k(i,1).EQ.3) THEN
100 C-- check if parton quark or antidiquark
101  IF (k(i,4).NE.0 .AND. k(i,5).EQ.0) THEN
102  quark1=.true.
103 C-- check if parton antiquark or diquark
104  ELSEIF (k(i,4).EQ.0 .AND. k(i,5).NE.0) THEN
105  aquark1=.true.
106 C-- check if parton gluon
107  ELSEIF (k(i,2).EQ.21) THEN
108  gluon1=.true.
109  ENDIF
110 C-- find second parton in colour switch
111  DO 30 j=i+1,n
112  quark2=.false.
113  aquark2=.false.
114  gluon2=.false.
115  IF (k(j,1).EQ.3) THEN
116 C-- check if second parton quark or antidiquark
117  IF (k(j,4).NE.0 .AND. k(j,5).EQ.0) THEN
118  quark2=.true.
119 C-- check if second parton antquark or diquark
120  ELSEIF (k(j,4).EQ.0 .AND. k(j,5).NE.0) THEN
121  aquark2=.true.
122 C-- check if second parton gluon
123  ELSEIF (k(j,2).EQ.21) THEN
124  gluon2=.true.
125  ENDIF
126 C-- switch colour pointers
127  IF (quark1.AND.quark2) THEN
128  IF (rlu(0).LT.prob) CALL lecswi(i,j)
129  ELSEIF (k(i,4).NE.j .AND. k(j,4).NE.i .AND.
130  & (quark1.AND.gluon2 .OR. gluon1.AND.quark2)) THEN
131  IF (rlu(0).LT.prob) CALL lecswi(i,j)
132  ELSEIF (aquark1.AND.aquark2) THEN
133  IF (rlu(0).LT.prob) CALL leaswi(i,j)
134  ELSEIF (k(i,5).NE.j .AND. k(j,5).NE.i .AND.
135  & (aquark1.AND.gluon2 .OR. gluon1.AND.aquark2)) THEN
136  IF (rlu(0).LT.prob) CALL leaswi(i,j)
137  ELSEIF (k(i,4).NE.j .AND. k(j,4).NE.i .AND.
138  & gluon1.AND.gluon2) THEN
139  IF (rlu(0).LT.prob) CALL lecswi(i,j)
140  IF (rlu(0).LT.prob) CALL leaswi(i,j)
141  ENDIF
142  ENDIF
143 30 CONTINUE
144  ENDIF
145 20 CONTINUE
146 
147 C-- restore colour order in strings ready for hadronisation
148  ns=n
149  DO 40 i=5,ns
150 C-- find first quark (or anti diquark) string end
151  IF (k(i,1).EQ.3 .AND. k(i,4).NE.0 .AND. k(i,5).EQ.0 )THEN
152  next=i
153 50 CONTINUE
154  n=n+1
155  IF(n.GT.4000) THEN
156  IF(lst(3).GE.1) WRITE(6,*) 'LSCI: N>4000!'
157  lst(21)=101
158  RETURN
159  ENDIF
160  this=next
161 C-- copy to last row in event-record and update K-vector
162  DO 60 j=1,5
163  p(n,j)=p(this,j)
164  v(n,j)=v(this,j)
165  k(n,j)=k(this,j)
166 60 CONTINUE
167  k(this,1)=13
168  k(n,1)=2
169  k(n,3)=this
170  k(n,4)=0
171  k(n,5)=0
172 C-- find next parton in string in row K(THIS,4)
173  next=k(this,4)
174  IF (next.NE.0) goto 50
175 C-- this is the last parton in string
176  k(n,1)=1
177  ENDIF
178 40 CONTINUE
179  DO 70 i=5,ns
180 C-- find first gluon string end
181  IF (k(i,1).EQ.3 .AND. k(i,2).EQ.21) THEN
182  init=i
183  next=i
184 80 CONTINUE
185  n=n+1
186  IF(n.GT.4000) THEN
187  IF(lst(3).GE.1) WRITE(6,*) 'LSCI: N>4000!'
188  lst(21)=101
189  RETURN
190  ENDIF
191  this=next
192 C-- copy to last row in event-record and update K-vector
193  DO 90 j=1,5
194  p(n,j)=p(this,j)
195  v(n,j)=v(this,j)
196  k(n,j)=k(this,j)
197 90 CONTINUE
198  k(this,1)=13
199  k(n,1)=2
200  k(n,3)=this
201  k(n,4)=0
202  k(n,5)=0
203 C-- find next parton in string in row K(THIS,4)
204  next=k(this,4)
205  IF (next.NE.init) goto 80
206 C-- this is the last parton in string
207  k(n,1)=1
208  ENDIF
209 70 CONTINUE
210 
211  END