pymihg.f

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

 
*********************************************************************
 
C...PYMIHG
C...Collapse JCP1 and connecting tags to JCG1.
C...Collapse JCP2 and connecting tags to JCG2.
 
      SUBROUTINE pymihg(JCP1,JCG1,JCP2,JCG2)
C...Double precision and integer declarations.
      IMPLICIT DOUBLE PRECISION(a-h, o-z)
      IMPLICIT INTEGER(i-n)
      INTEGER pyk,pychge,pycomp
C...The event record
      common/pyjets/n,npad,k(4000,5),p(4000,5),v(4000,5)
C...Parameters
      common/pyint1/mint(400),vint(400)
      SAVE /pyjets/,/pyint1/
C...Local variables
      COMMON /pycbls/mco(4000,2),ncc,jcco(4000,2),jccn(4000,2),maccpt
      COMMON /pyctag/nct,mct(4000,2)
      SAVE /pycbls/,/pyctag/
 
C...Break up JCP1<->JCP2 tag and create JCP1<->JCG1 and JCP2<->JCG2 tags
C...in temporary tag collapse array JCCN. Only break up one connection.
      maccpt=1
      mclps=0
      DO 100 icc=1,ncc
        jccn(icc,1)=jcco(icc,1)
        jccn(icc,2)=jcco(icc,2)
C...If there was a mother, it was previously connected to JCP1.
C...Should be changed to JCP2.
        IF (mclps.EQ.0) THEN
          IF (jccn(icc,1).EQ.max(jcp1,jcp2).AND.jccn(icc,2).EQ.min(jcp1
     &         ,jcp2)) THEN
            jccn(icc,1)=max(jcg2,jcp2)
            jccn(icc,2)=min(jcg2,jcp2)
            mclps=1
          ENDIF
        ENDIF
  100 CONTINUE
C...Also collapse colours on JCP1 side of JCG1
      IF (jcp1.NE.0) THEN
        jccn(ncc+1,1)=max(jcp1,jcg1)
        jccn(ncc+1,2)=min(jcp1,jcg1)
      ELSE
        jccn(ncc+1,1)=max(jcp2,jcg2)
        jccn(ncc+1,2)=min(jcp2,jcg2)
      ENDIF
 
C...Initialize event record colour tag array MCT array to MCO.
       DO 110 i=mint(84)+1,n
        mct(i,1)=mco(i,1)
        mct(i,2)=mco(i,2)
  110 CONTINUE
 
C...Collapse tags:
C...IS = 1 : All tags connecting to JCG1 on JCG1 side -> JCG1
C...IS = 2 : All tags connecting to JCG2 on JCG2 side -> JCG2
C...IS = 3 : All tags connecting to JCG1 on JCP1 side -> JCG1
C...IS = 4 : All tags connecting to JCG2 on JCP2 side -> JCG2
      DO 160 is=1,4
C...Skip if junction.
        IF ((is.EQ.4.AND.jcp2.EQ.0).OR.(is.EQ.3).AND.jcp1.EQ.0) goto 160
C...Define starting point in tag space.
C...JCA = previous tag
C...JCO = present tag
C...JCN = new tag
        IF (mod(is,2).EQ.1) THEN
          jco=jcp1
          jcn=jcg1
          jcall=jcg1
        ELSEIF (mod(is,2).EQ.0) THEN
          jco=jcp2
          jcn=jcg2
          jcall=jcg2
        ENDIF
        itrace=0
  120   itrace=itrace+1
        IF (itrace.GT.1000) THEN
C...NB: Proper error message should be defined here.
          CALL pyerrm(14
     &         ,'(PYMIHG:) Inf loop when collapsing colours.')
          mint(57)=mint(57)+1
          mint(51)=1
          RETURN
        ENDIF
C...Collapse all JCN tags to JCALL
        DO 130 i=mint(84)+1,n
          IF (mco(i,1).EQ.jcn) mct(i,1)=jcall
          IF (mco(i,2).EQ.jcn) mct(i,2)=jcall
  130   CONTINUE
C...IS = 1,2: first step forward. IS = 3,4: first step backward.
        IF (is.GT.2.AND.(jcn.EQ.jcall)) THEN
          jca=jcn
          jcn=jco
        ELSE
          jca=jco
          jco=jcn
        ENDIF
C...If possible, step from JCO to new tag JCN not equal to JCA.
        DO 140 icc=1,ncc+1
          IF (jccn(icc,1).EQ.jco.AND.jccn(icc,2).NE.jca) jcn=
     &         jccn(icc,2)
          IF (jccn(icc,2).EQ.jco.AND.jccn(icc,1).NE.jca) jcn=
     &         jccn(icc,1)
  140   CONTINUE
C...Iterate if new colour was arrived at, but don't go in circles.
        IF (jcn.NE.jco.AND.jcn.NE.jcall) goto 120
C...Change all JCN tags in MCO to JCALL in MCT.
        DO 150 i=mint(84)+1,n
          IF (mco(i,1).EQ.jcn) mct(i,1)=jcall
          IF (mco(i,2).EQ.jcn) mct(i,2)=jcall
C...If gluon and colour tag = anticolour tag (and not = 0) try again.
          IF (k(i,2).EQ.21.AND.mct(i,1).EQ.mct(i,2).AND.mct(i,1)
     &         .NE.0) maccpt=0
  150   CONTINUE
  160 CONTINUE
 
      DO 200 jcl=nct,1,-1
        jca=0
        jcn=jcl
  170   jco=jcn
        DO 180 icc=1,ncc+1
          IF (jccn(icc,1).EQ.jco.AND.jccn(icc,2).NE.jca) jcn
     &         =jccn(icc,2)
          IF (jccn(icc,2).EQ.jco.AND.jccn(icc,1).NE.jca) jcn
     &         =jccn(icc,1)
  180   CONTINUE
C...Overpaint all JCN with JCL
        IF (jcn.NE.jco.AND.jcn.NE.jcl) THEN
          DO 190 i=mint(84)+1,n
            IF (mct(i,1).EQ.jcn) mct(i,1)=jcl
            IF (mct(i,2).EQ.jcn) mct(i,2)=jcl
C...If gluon and colour tag = anticolour tag (and not = 0) try again.
            IF (k(i,2).EQ.21.AND.mct(i,1).EQ.mct(i,2).AND.mct(i,1)
     &           .NE.0) maccpt=0
  190     CONTINUE
          jca=jco
          goto 170
        ENDIF
  200 CONTINUE
 
      RETURN
      END