lqgev.F

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

C **********************************************************************

      SUBROUTINE lqgev

      IMPLICIT NONE

C...Generate quark-gluon jet event, choose xp and zp according to QCD
C...matrix elements and apply cuts for soft and collinear gluons.

*
* to avoid variable conflictions, a second keep element is necessary
* with the same common block name (see LPTOU2)
*
      COMMON /leptou/ cut(14),lst(40),parl(30),
     &                x,y,w2,q2,u
      REAL cut,parl,x,y,w2,q2,u
      INTEGER lst
      SAVE /leptou/

      COMMON /linter/ pari(50),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
      REAL  pari,ewqc,qc,zl,zq,pq
      SAVE /linter/

      INTEGER  nlupdm,nplbuf
      parameter(nlupdm=4000,nplbuf=5)
      common/lujets/n,k(nlupdm,5),p(nlupdm,nplbuf),v(nlupdm,5)
      INTEGER  n,k
      REAL  p,v
      SAVE /lujets/

      common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
      INTEGER  mstu,mstj
      REAL  paru,parj
      SAVE /ludat1/

      common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
      INTEGER  kchg
      REAL  pmas,parf,vckm
      SAVE /ludat2/

      
      INTEGER j1,j2,j3,j4,ifail,ifl,iflr,lqmcut,iflro,k2,nremh
      REAL w,xp,zp,amifl,xt,amk2,pt,phi,pt2,tm2k2,tmiflr,epz,amiflr
      REAL ulmass
      INTEGER lucomp,kfk2,kfiflr

      lst(24)=2
      w=sqrt(w2)
      j1=mstu(1)
      j2=mstu(1)+1
      j3=mstu(1)+2
      j4=mstu(1)+3
      CALL lxp(xp,ifail)
      IF(ifail.NE.0) goto 999

C...Choose flavour of scattered quark and target remnant.
  200 CALL lflav(ifl,iflr)
      IF(lst(21).NE.0) RETURN
      CALL lzp(xp,zp,ifail)
      IF(ifail.NE.0) goto 999
      mstj(93)=1
      amifl=ulmass(ifl)
      mstj(93)=1
      amiflr=ulmass(iflr)

      IF(lst(14).EQ.0.OR.iflr.GT.10
     &.OR.(lst(8).GE.2.AND.mod(lst(8),10).NE.9)) THEN
        IF(w.LT.amifl+amiflr+parj(32)) goto 999
        IF(lqmcut(xp,zp,amifl,0.,amiflr).NE.0) goto 999
C       Pass the (consituent quark) masses we are using to LU3ENT
        p(j1,5)=amifl
        p(j2,5)=0
        p(j3,5)=amiflr
        mstu(10)=1
        CALL lu3ent(j1,ifl,21,iflr,w,pari(21),pari(23))
        mstu(10)=2
        k(mstu(1)+2,3)=2
        CALL lurobo(acos(-p(j3,3)/sqrt(p(j3,3)**2+p(j3,1)**2)),
     &  0.,0.,0.,0.)
      ELSE
C...Target remnant is not a simple diquark, special treatment needed.
        IF(w.LT.amifl+amiflr+1.+parj(32)) goto 999
        IF(lqmcut(xp,zp,amifl,0.,1.).NE.0) goto 999
        iflro=iflr
        nremh=0
  300   nremh=nremh+1
        IF(nremh.GT.100) goto 999
        CALL lprikt(parl(14),pt,phi)
        CALL lremh(iflro,pt,iflr,k2,xt)
        mstj(93)=1
        amiflr=ulmass(iflr)
CJR--
        kfiflr=lucomp(iflr)
        IF (kfiflr.EQ.90) THEN
          amiflr=amiflr-2.*parl(20)
        ELSEIF (1.LE.kfiflr .AND. kfiflr.LE.6) THEN
          amiflr=amiflr-parl(20)
        ENDIF
        mstj(93)=1
        amk2=ulmass(k2)
        kfk2=lucomp(k2)
        IF (kfk2.EQ.90) THEN
          amk2=amk2-2.*parl(20)
        ELSEIF (1.LE.kfk2 .AND. kfk2.LE.6) THEN
          amk2=amk2-parl(20)
        ENDIF
CJR--
        p(j1,5)=amifl
        p(j2,5)=0.
        pt2=pt**2
        tm2k2=amk2**2+pt2
        tmiflr=amiflr**2+pt2
        p(j3,5)=sqrt(tm2k2/xt+tmiflr/(1.-xt))
        IF(lqmcut(xp,zp,amifl,0.,p(j3,5)).NE.0) goto 300
        mstu(10)=1
        CALL lu3ent(j1,ifl,21,iflr,w,pari(21),pari(23))
        k(mstu(1)+2,3)=2
        mstu(10)=2
        CALL lurobo(acos(-p(j3,3)/sqrt(p(j3,3)**2+p(j3,1)**2)),
     &  0.,0.,0.,0.)
        epz=p(j3,4)-p(j3,3)
        p(j3,1)=pt*cos(phi)
        p(j3,2)=pt*sin(phi)
        p(j3,3)=-0.5*((1.-xt)*epz-tmiflr/(1.-xt)/epz)
        p(j3,4)= 0.5*((1.-xt)*epz+tmiflr/(1.-xt)/epz)
        p(j3,5)=amiflr
        p(j4,1)=-p(j3,1)
        p(j4,2)=-p(j3,2)
        p(j4,3)=-0.5*(xt*epz-tm2k2/xt/epz)
        p(j4,4)= 0.5*(xt*epz+tm2k2/xt/epz)
        p(j4,5)=amk2
        k(j4,1)=1
        k(j4,2)=k2
        k(j4,3)=2
        k(j4,4)=0
        k(j4,5)=0
        n=j4
        IF((p(j3,4)+p(j2,4)/2.)**2-(p(j3,1)+p(j2,1)/2.)**2-p(j3,2)**2
     &  -(p(j3,3)+p(j2,3)/2.)**2.LT.(amiflr+2.5*parj(32))**2) goto 300
      ENDIF
      CALL lazimu(xp,zp)
      lst(21)=0
      RETURN

  999 lst(21)=4
      RETURN
      END