pycttr.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pycttr.f

C*********************************************************************
 
C...PYCTTR
C...Adapted from PYPREP.
C...Assigns LHA1 colour tags to coloured partons based on
C...K(I,4) and K(I,5) colour connection record.
C...KCS negative signifies that a previous tracing should be continued.
C...(in case the tag to be continued is empty, the routine exits)
C...Starts at I and ends at I or IEND.
C...Special considerations for systems with junctions.
 
      SUBROUTINE pycttr(I,KCS,IEND)
C...Double precision and integer declarations.
      IMPLICIT DOUBLE PRECISION(a-h, o-z)
      INTEGER pyk,pychge,pycomp
C...Commonblocks.
      common/pyjets/n,npad,k(4000,5),p(4000,5),v(4000,5)
      common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
      common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
      common/pyint1/mint(400),vint(400)
C...The common block of colour tags.
      common/pyctag/nct,mct(4000,2)
      SAVE /pyjets/,/pydat1/,/pydat2/,/pyint1/,/pyctag/
      DATA nerrpr/0/
      SAVE nerrpr
 
C...Skip if parton not existing or does not have KCS
      IF (k(i,1).LE.0) goto 120
      kc=pycomp(k(i,2))
      IF (kc.EQ.0) goto 120
      kq=kchg(kc,2)
      IF (kq.EQ.0) goto 120
      IF (iabs(kq).EQ.1.AND.kq*(9-2*abs(kcs)).NE.isign(1,k(i,2))) 
     &    goto 120
 
      IF (kcs.GT.0) THEN
        nct=nct+1
C...Set colour tag of first parton.
        mct(i,kcs-3)=nct
        ncs=nct
      ELSE
        kcs=-kcs
        ncs=mct(i,kcs-3)
        IF (ncs.EQ.0) goto 120
      ENDIF
 
      ia=i
      nstp=0
  100 nstp=nstp+1
      IF(nstp.GT.4*n) THEN
        CALL pyerrm(14,'(PYCTTR:) caught in infinite loop')
        goto 120
      ENDIF
 
C...Finished if reached final-state triplet.
      IF(k(ia,1).EQ.3) THEN
        IF(nstp.GE.2.AND.kchg(pycomp(k(ia,2)),2).NE.2) goto 120
      ENDIF
 
C...Also finished if reached junction.
      IF(k(ia,1).EQ.42) THEN
        goto 120
      ENDIF
 
C...GOTO next parton in colour space.
  110 ib=ia
C...If IB's KCS daughter not traced and exists, goto KCS daughter.
      IF(mod(k(ib,kcs)/mstu(5)**2,2).EQ.0.AND.mod(k(ib,kcs),mstu(5))
     &     .NE.0) THEN
        ia=mod(k(ib,kcs),mstu(5))
        k(ib,kcs)=k(ib,kcs)+mstu(5)**2
        mrev=0
      ELSE
C...If KCS mother traced or KCS mother nonexistent, switch colour.
        IF(k(ib,kcs).GE.2*mstu(5)**2.OR.mod(k(ib,kcs)/mstu(5),
     &       mstu(5)).EQ.0) THEN
          kcs=9-kcs
          nct=nct+1
          ncs=nct
C...Assign new colour tag on other side of old parton.
          mct(ib,kcs-3)=nct
        ENDIF
C...Goto (new) KCS mother, set mother traced tag
        ia=mod(k(ib,kcs)/mstu(5),mstu(5))
        k(ib,kcs)=k(ib,kcs)+2*mstu(5)**2
        mrev=1
      ENDIF
      IF(ia.LE.0.OR.ia.GT.n) THEN
        CALL pyerrm(12,'(PYCTTR:) colour tag tracing failed')
        IF(nerrpr.LT.5) THEN
          write(*,*) 'began at ',i
          write(*,*) 'ended going from', ib, ' to', ia, '  KCS=',kcs,
     &        '  NCS=',ncs,'  MREV=',mrev
          CALL pylist(4)
          nerrpr=nerrpr+1
        ENDIF
        mint(51)=1
        RETURN
      ENDIF
      IF(mod(k(ia,4)/mstu(5),mstu(5)).EQ.ib.OR.mod(k(ia,5)/mstu(5),
     &     mstu(5)).EQ.ib) THEN
        IF(mrev.EQ.1) kcs=9-kcs
        IF(mod(k(ia,kcs)/mstu(5),mstu(5)).NE.ib) kcs=9-kcs
C...Set KSC mother traced tag for IA
        k(ia,kcs)=k(ia,kcs)+2*mstu(5)**2
      ELSE
        IF(mrev.EQ.0) kcs=9-kcs
        IF(mod(k(ia,kcs),mstu(5)).NE.ib) kcs=9-kcs
C...Set KCS daughter traced tag for IA
        k(ia,kcs)=k(ia,kcs)+mstu(5)**2
      ENDIF
C...Assign new colour tag
      mct(ia,kcs-3)=ncs
      IF(ia.NE.i.AND.ia.NE.iend) goto 100
 
  120 RETURN
      END