PHOS/shaker/lujoin.f

   1 *CMZ :          17/07/98  15.44.31  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LUJOIN(NJOIN,IJOIN)
   6
   7 C...Purpose: to connect a sequence of partons with colour flow indices,
   8 C...as required for subsequent shower evolution (or other operations).
   9 *KEEP,LUJETS.
  10       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  11       SAVE /LUJETS/
  12 *KEEP,LUDAT1.
  13       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  14       SAVE /LUDAT1/
  15 *KEEP,LUDAT2.
  16       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  17       SAVE /LUDAT2/
  18 *KEND.
  19       DIMENSION IJOIN(*)
  20
  21 C...Check that partons are of right types to be connected.
  22       IF(NJOIN.LT.2) GOTO 120
  23       KQSUM=0
  24       DO 100 IJN=1,NJOIN
  25       I=IJOIN(IJN)
  26       IF(I.LE.0.OR.I.GT.N) GOTO 120
  27       IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
  28       KC=LUCOMP(K(I,2))
  29       IF(KC.EQ.0) GOTO 120
  30       KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
  31       IF(KQ.EQ.0) GOTO 120
  32       IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
  33       IF(KQ.NE.2) KQSUM=KQSUM+KQ
  34   100 IF(IJN.EQ.1) KQS=KQ
  35       IF(KQSUM.NE.0) GOTO 120
  36
  37 C...Connect the partons sequentially (closing for gluon loop).
  38       KCS=(9-KQS)/2
  39       IF(KQS.EQ.2) KCS=INT(4.5+RLU(0))
  40       DO 110 IJN=1,NJOIN
  41       I=IJOIN(IJN)
  42       K(I,1)=3
  43       IF(IJN.NE.1) IP=IJOIN(IJN-1)
  44       IF(IJN.EQ.1) IP=IJOIN(NJOIN)
  45       IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
  46       IF(IJN.EQ.NJOIN) IN=IJOIN(1)
  47       K(I,KCS)=MSTU(5)*IN
  48       K(I,9-KCS)=MSTU(5)*IP
  49       IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
  50   110 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
  51
  52 C...Error exit: no action taken.
  53       RETURN
  54   120 CALL LUERRM(12,
  55      &'(LUJOIN:) given entries can not be joined by one string')
  56
  57       RETURN
  58       END