flintg.F

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

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

      SUBROUTINE flintg(CFLQ,CFLG,CFLM)

      IMPLICIT NONE
      
C...Event-by-event calculation of contribution to longitudinal
C...structure function from QCD and target mass effects.

*
* 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 /linteg/ ntot,npass
      INTEGER ntot,npass
      SAVE /linteg/


      INTEGER ltm,lht,it,lqcd
      REAL flqint,flgint,fltint,cflq,cflg,cflm,eps,accur
      REAL ulalps
      EXTERNAL flqint,flgint,fltint

      lqcd=mod(lst(11),10)
      ltm=mod(lst(11)/10,10)
      lht=lst(11)/100
      parl(25)=ulalps(q2)
      IF(lqcd.EQ.2) THEN
C...FL from QCD, quark and gluon contributions.
        accur=parl(11)
        it=0
  100   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,flqint,eps,cflq)
        IF(cflq.LT.1) THEN
          accur=cflq*parl(11)
          IF(it.LT.2) goto 100
        ENDIF
        accur=parl(11)
        it=0
  200   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,flgint,eps,cflg)
        IF(cflg.LT.1.) THEN
          accur=cflg*parl(11)
          IF(it.LT.2) goto 200
        ENDIF
      ENDIF
      IF(ltm.EQ.2) THEN
        accur=parl(11)
        it=0
  300   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,fltint,eps,cflm)
        IF(cflm.LT.1.) THEN
          accur=cflm*parl(11)
          IF(it.LT.2) goto 300
        ENDIF
      ENDIF

      RETURN
      END