dqcd.F

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

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

      FUNCTION dqcd(ICOSFI,IPART,IP,XP,ZP,YY)
      
      IMPLICIT NONE
      
C...First order QCD matrix elements from R.D. Peccei and R. Ruckl:
C...Nucl. Phys. B162 (1980) 125

*
* 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/


      INTEGER icosfi,ip,ipart
      REAL dqcd,xp,zp,yy,c1,c2,c3,c4,c5
      
C...Constants C1 to C5 are resp. 2/3/pi, 1/4/pi, 4/3/pi, 1/2/pi, 1/pi
      DATA c1,c2,c3,c4,c5/0.2122066,0.0795775,0.4244132,0.1591549,
     &     0.3183099/

      IF(lst(8).EQ.19.AND.ipart.EQ.1) THEN
C...No QCD Compton for Ariadne
        dqcd=0.0
        RETURN
      ENDIF

      IF(icosfi.EQ.0) THEN
        IF(ipart.EQ.1) THEN
          IF(ip.EQ.1) THEN
            dqcd=c1*((zp**2+xp**2)/(1.-xp)/(1.-zp)+2.*(xp*zp+1.))
          ELSEIF(ip.EQ.2) THEN
            dqcd=c1*4.*xp*zp
          ELSEIF(ip.EQ.3) THEN
            dqcd=c1*((zp**2+xp**2)/(1.-xp)/(1.-zp)+2.*(xp+zp))
          ELSE
            WRITE(6,1000) icosfi,ipart,ip
          ENDIF
        ELSEIF(ipart.EQ.2) THEN
          IF(ip.EQ.1) THEN
            dqcd=c2*(xp**2+(1.-xp)**2)*(zp**2+(1.-zp)**2)/(1.-zp)/zp
          ELSEIF(ip.EQ.2) THEN
            dqcd=c2*8.*xp*(1.-xp)
          ELSEIF(ip.EQ.3) THEN
            dqcd=c2*(xp**2+(1.-xp)**2)*(zp-(1.-zp))/(1.-zp)/zp
          ELSE
            WRITE(6,1000) icosfi,ipart,ip
          ENDIF
        ELSE
          WRITE(6,1000) icosfi,ipart,ip
        ENDIF

      ELSEIF(icosfi.EQ.1) THEN
        IF(ipart.EQ.1) THEN
          IF(ip.EQ.1) THEN
            dqcd=c3*yy*sqrt((1.-yy)*xp*zp/(1.-xp)/(1.-zp))*
     &      (1.-2./yy)*(1.-zp-xp+2.*xp*zp)
          ELSEIF(ip.EQ.3) THEN
            dqcd=c3*yy*sqrt((1.-yy)*xp*zp/(1.-xp)/(1.-zp))*
     &      (1.-xp-zp)
          ELSE
            WRITE(6,1000) icosfi,ipart,ip
          ENDIF
        ELSEIF(ipart.EQ.2) THEN
          IF(ip.EQ.1) THEN
            dqcd=c4*yy*sqrt((1.-yy)*xp*(1.-xp)/zp/(1.-zp))*
     &      (1.-2./yy)*(1.-2.*zp)*(1.-2.*xp)
          ELSEIF(ip.EQ.3) THEN
            dqcd=c4*yy*sqrt((1.-yy)*xp*(1.-xp)/zp/(1.-zp))*
     &      (1.-2.*xp)
          ELSE
            WRITE(6,1000) icosfi,ipart,ip
          ENDIF
        ENDIF

      ELSEIF(icosfi.EQ.2) THEN
        IF(ipart.EQ.1) THEN
          dqcd=c3*(1.-yy)*xp*zp
        ELSEIF(ipart.EQ.2) THEN
          dqcd=c5*(1.-yy)*xp*(1.-xp)
        ELSE
          WRITE(6,1000) icosfi,ipart,ip
        ENDIF

      ELSE
        WRITE(6,1000) icosfi,ipart,ip
      ENDIF
      RETURN

 1000 FORMAT(' Error in routine DQCD     ',
     &' ICOSFI, IPART, IP = ',3i10)
      END