luhepc.f

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

    
C*********************************************************************  
    
      SUBROUTINE luhepc(MCONV)  
    
C...Purpose: to convert JETSET event record contents to or from 
C...the standard event record commonblock.  
      parameter(nmxhep=10000)   
      common/hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),   
     &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)   
      DOUBLE PRECISION phep,vhep
      SAVE /hepevt/ 
      common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
      SAVE /lujets/ 
      common/ludat1/mstu(200),paru(200),mstj(200),parj(200) 
      SAVE /ludat1/ 
      common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)    
      SAVE /ludat2/ 
    
C...Conversion from JETSET to standard, the easy part.  
      IF(mconv.EQ.1) THEN   
        nevhep=0    
        IF(n.GT.nmxhep) CALL luerrm(8,  
     &  '(LUHEPC:) no more space in /HEPEVT/')  
        nhep=min(n,nmxhep)  
        DO 140 i=1,nhep 
        isthep(i)=0 
        IF(k(i,1).GE.1.AND.k(i,1).LE.10) isthep(i)=1    
        IF(k(i,1).GE.11.AND.k(i,1).LE.20) isthep(i)=2   
        IF(k(i,1).GE.21.AND.k(i,1).LE.30) isthep(i)=3   
        IF(k(i,1).GE.31.AND.k(i,1).LE.100) isthep(i)=k(i,1) 
        idhep(i)=k(i,2) 
        jmohep(1,i)=k(i,3)  
        jmohep(2,i)=0   
        IF(k(i,1).NE.3.AND.k(i,1).NE.13.AND.k(i,1).NE.14) THEN  
          jdahep(1,i)=k(i,4)    
          jdahep(2,i)=k(i,5)    
        ELSE    
          jdahep(1,i)=0 
          jdahep(2,i)=0 
        ENDIF   
        DO 100 j=1,5    
  100   phep(j,i)=p(i,j)    
        DO 110 j=1,4    
  110   vhep(j,i)=v(i,j)    
    
C...Fill in missing mother information. 
        IF(k(i,2).GE.91.AND.k(i,2).LE.93) THEN  
          i1=k(i,3)-1   
  120     i1=i1+1   
          IF(i1.GE.i) CALL luerrm(8,    
     &    '(LUHEPC:) translation of inconsistent event history')    
          IF(i1.LT.i.AND.k(i1,1).NE.1.AND.k(i1,1).NE.11) goto 120   
          kc=lucomp(k(i1,2))    
          IF(i1.LT.i.AND.kc.EQ.0) goto 120  
          IF(i1.LT.i.AND.kchg(kc,2).EQ.0) goto 120  
          jmohep(2,i)=i1    
        ELSEIF(k(i,2).EQ.94) THEN   
          njet=2    
          IF(nhep.GE.i+3.AND.k(i+3,3).LE.i) njet=3  
          IF(nhep.GE.i+4.AND.k(i+4,3).LE.i) njet=4  
          jmohep(2,i)=mod(k(i+njet,4)/mstu(5),mstu(5))  
          IF(jmohep(2,i).EQ.jmohep(1,i)) jmohep(2,i)=   
     &    mod(k(i+1,4)/mstu(5),mstu(5)) 
        ENDIF   
    
C...Fill in missing daughter information.   
        IF(k(i,2).EQ.94.AND.mstu(16).NE.2) THEN 
          DO 130 i1=jdahep(1,i),jdahep(2,i) 
          i2=mod(k(i1,4)/mstu(5),mstu(5))   
  130     jdahep(1,i2)=i    
        ENDIF   
        IF(k(i,2).GE.91.AND.k(i,2).LE.94) goto 140  
        i1=jmohep(1,i)  
        IF(i1.LE.0.OR.i1.GT.nhep) goto 140  
        IF(k(i1,1).NE.13.AND.k(i1,1).NE.14) goto 140    
        IF(jdahep(1,i1).EQ.0) THEN  
          jdahep(1,i1)=i    
        ELSE    
          jdahep(2,i1)=i    
        ENDIF   
  140   CONTINUE    
        DO 150 i=1,nhep 
        IF(k(i,1).NE.13.AND.k(i,1).NE.14) goto 150  
        IF(jdahep(2,i).EQ.0) jdahep(2,i)=jdahep(1,i)    
  150   CONTINUE    
    
C...Conversion from standard to JETSET, the easy part.  
      ELSE  
        IF(nhep.GT.mstu(4)) CALL luerrm(8,  
     &  '(LUHEPC:) no more space in /LUJETS/')  
        n=min(nhep,mstu(4)) 
        nkq=0   
        kqsum=0 
        DO 180 i=1,n    
        k(i,1)=0    
        IF(isthep(i).EQ.1) k(i,1)=1 
        IF(isthep(i).EQ.2) k(i,1)=11    
        IF(isthep(i).EQ.3) k(i,1)=21    
        k(i,2)=idhep(i) 
        k(i,3)=jmohep(1,i)  
        k(i,4)=jdahep(1,i)  
        k(i,5)=jdahep(2,i)  
        DO 160 j=1,5    
  160   p(i,j)=phep(j,i)    
        DO 170 j=1,4    
  170   v(i,j)=vhep(j,i)    
        v(i,5)=0.   
        IF(isthep(i).EQ.2.AND.phep(4,i).GT.phep(5,i)) THEN  
          i1=jdahep(1,i)    
          IF(i1.GT.0.AND.i1.LE.nhep) v(i,5)=(vhep(4,i1)-vhep(4,i))* 
     &    phep(5,i)/phep(4,i)   
        ENDIF   
    
C...Fill in missing information on colour connection in jet systems.    
        IF(isthep(i).EQ.1) THEN 
          kc=lucomp(k(i,2)) 
          kq=0  
          IF(kc.NE.0) kq=kchg(kc,2)*isign(1,k(i,2)) 
          IF(kq.NE.0) nkq=nkq+1 
          IF(kq.NE.2) kqsum=kqsum+kq    
          IF(kq.NE.0.AND.kqsum.NE.0) THEN   
            k(i,1)=2    
          ELSEIF(kq.EQ.2.AND.i.LT.n) THEN   
            IF(k(i+1,2).EQ.21) k(i,1)=2 
          ENDIF 
        ENDIF   
  180   CONTINUE    
        IF(nkq.EQ.1.OR.kqsum.NE.0) CALL luerrm(8,   
     &  '(LUHEPC:) input parton configuration not colour singlet')  
      ENDIF 
    
      END