fltabl.F

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

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

      SUBROUTINE fltabl

      IMPLICIT NONE

C...Integrates the longitudinal structure function, store on grid
C...  in x, Q**2.
      
*
* 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 /lintrl/ psave(3,4,5),ksave(4),xmin,xmax,ymin,ymax,
     &q2min,q2max,w2min,w2max,ilep,inu,ig,iz
      REAL psave,xmin,xmax,ymin,ymax,q2min,q2max,w2min,w2max
      INTEGER ksave,ilep,inu,ig,iz
      SAVE /lintrl/

      COMMON /linteg/ ntot,npass
      INTEGER ntot,npass
      SAVE /linteg/

      COMMON /flgrid/ nfx,nfq,xr(2),qr(2),flqt(41,16),flgt(41,16),
     &flmt(41,16)
      REAL    xr,qr,flqt,flgt,flmt
      INTEGER nfx,nfq
      SAVE /flgrid/


      INTEGER lqcd,ltm,lht,ix,iq,lq,it
      REAL t1,flq,accur,eps,t2,flg,flm
      real ulalps
      
      EXTERNAL flqint,flgint,fltint

      lqcd=mod(lst(11),10)
      ltm=mod(lst(11)/10,10)
      lht=lst(11)/100
      IF(lst(3).GE.3) WRITE(6,1000) lst(11),lqcd,ltm,lht
      IF(lqcd.LT.1.AND.ltm.LT.1) RETURN
      CALL ltimex(t1)
      DO 10 ix=1,nfx
      DO 10 iq=1,nfq
      flqt(ix,iq)=0.
      flgt(ix,iq)=0.
   10 flmt(ix,iq)=0.
      qr(1)=q2min
      xr(1)=xmin
      xr(2)=xmax
      DO 500 ix=1,nfx
      x=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*(ix-1)/(nfx-1))
      qr(2)=x*parl(21)
      IF(qr(1).GT.qr(2)) goto 500
      lq=0
      DO 400 iq=1,nfq
      q2=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))*
     &(iq-1)/(nfq-1))
Ctest IF(LQ.GT.0) GOTO 500
      IF(q2.GT.parl(21)) lq=lq+1
      y=q2/(parl(21)*x)
      IF(y.LT.0.0.OR.y.GT.1.0) lq=lq+1
      parl(25)=ulalps(q2)
      IF(lqcd.EQ.1) THEN
C...Quark part.
        accur=parl(11)
        it=0
  100   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,flqint,eps,flq)
        IF(flq.LT.1) THEN
          accur=flq*parl(11)
          IF(it.LT.2) goto 100
        ENDIF
        flqt(ix,iq)=flq
C...Gluon part.
        accur=parl(11)
        it=0
  200   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,flgint,eps,flg)
        IF(flg.LT.1.) THEN
          accur=flg*parl(11)
          IF(it.LT.2) goto 200
        ENDIF
        flgt(ix,iq)=flg
      ENDIF
      IF(ltm.EQ.1) THEN
C...Target mass  part.
        accur=parl(11)
        it=0
  300   it=it+1
        ntot=0
        npass=0
        eps=accur
        CALL gadap(x,1.,fltint,eps,flm)
        IF(flm.LT.1) THEN
          accur=flm*parl(11)
          IF(it.LT.2) goto 300
        ENDIF
        flmt(ix,iq)=flm
      ENDIF
  400 CONTINUE
  500 CONTINUE
  600 CONTINUE
      CALL ltimex(t2)
      IF(lst(3).GE.3) WRITE(6,1100) t2-t1
      RETURN

 1000 FORMAT(' Initialisation for FL; QCD, target mass, higher twist: ',
     &/,' LST(11) =',i5,' --> LQCD, LTM, LHT =',3i3)
 1100 FORMAT(' FL integrations performed if LQCD=1 and/or LTM=1, ',
     &'results on grid.'/,' Time for FL integrations is ',f7.1,' sec.')
      END