hijing/src/lujoin.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUJOIN(NJOIN,IJOIN)
0005
0006 C...Purpose: to connect a sequence of partons with colour flow indices,
0007 C...as required for subsequent shower evolution (or other operations).
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0013       SAVE /LUDAT2/
0014       DIMENSION IJOIN(*)
0015
0016 C...Check that partons are of right types to be connected.
0017       IF(NJOIN.LT.2) GOTO 120
0018       KQSUM=0
0019       DO 100 IJN=1,NJOIN
0020       I=IJOIN(IJN)
0021       IF(I.LE.0.OR.I.GT.N) GOTO 120
0022       IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
0023       KC=LUCOMP(K(I,2))
0024       IF(KC.EQ.0) GOTO 120
0025       KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
0026       IF(KQ.EQ.0) GOTO 120
0027       IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
0028       IF(KQ.NE.2) KQSUM=KQSUM+KQ
0029   100 IF(IJN.EQ.1) KQS=KQ
0030       IF(KQSUM.NE.0) GOTO 120
0031
0032 C...Connect the partons sequentially (closing for gluon loop).
0033       KCS=(9-KQS)/2
0034       IF(KQS.EQ.2) KCS=INT(4.5+RLU(0))
0035       DO 110 IJN=1,NJOIN
0036       I=IJOIN(IJN)
0037       K(I,1)=3
0038       IF(IJN.NE.1) IP=IJOIN(IJN-1)
0039       IF(IJN.EQ.1) IP=IJOIN(NJOIN)
0040       IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
0041       IF(IJN.EQ.NJOIN) IN=IJOIN(1)
0042       K(I,KCS)=MSTU(5)*IN
0043       K(I,9-KCS)=MSTU(5)*IP
0044       IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
0045   110 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
0046
0047 C...Error exit: no action taken.
0048       RETURN
0049   120 CALL LUERRM(12,
0050      &'(LUJOIN:) given entries can not be joined by one string')
0051
0052       RETURN
0053       END