poldqcdi.F

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

*72*********************************************************************
      FUNCTION poldqcdi(IPART,IP,XP,ZPMIN,ZPMAX)

       IMPLICIT NONE
C...First order QCD matrix elements as in function DQCD but analytically
C...integrated over ZP from ZPMIN to ZPMAX, also a factor 1/(1-XP) is
C...factored out (since XP chosen randomly according to 1/(1-XP) distr.)

*...Added common block LEPTOU to access to polarization state.


*
* to avoid variable conflictions, a second keep element is necessary
* with the same common block name (see LPTOU2)
*
*
* 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 ipart,ip
      REAL xp,zpmin,zpmax,c1,c2,zlog,poldqcdi
      DATA c1,c2/0.2122066,0.0795775/

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

      IF(ipart.EQ.1) THEN
       IF(ip.EQ.1) THEN
         poldqcdi = 0.
       ELSEIF(ip.EQ.2) THEN
         poldqcdi = 0.
       ELSEIF(ip.EQ.3) THEN
        zlog=alog(zpmax/zpmin)  
        poldqcdi=c1*(xp**2*zlog+zpmin-zpmax+(zpmin**2-zpmax**2)/2.+zlog+
     &  2.*xp*(1.-xp)*(zpmax-zpmin)+(1.-xp)*(zpmax**2-zpmin**2))
       ELSE
         WRITE(6,1000) ipart,ip
       ENDIF

      ELSEIF(ipart.EQ.2) THEN
       IF(ip.EQ.1) THEN
         poldqcdi = 0.
       ELSEIF(ip.EQ.2) THEN
         poldqcdi = 0.
       ELSEIF(ip.EQ.3)  THEN
         zlog=alog(zpmax/zpmin)  
         poldqcdi=c2*(2.*xp-1.)*(1.-xp)*(2.*zlog+2.*zpmin-2.*zpmax)
       ELSE
         WRITE(6,1000) ipart,ip
       ENDIF

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

 1000 FORMAT(' Error in routine POLDQCDI     ',
     &' IPART, IP = ',2i10)
      END