flipol.F

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

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

      SUBROUTINE flipol(FLQ,FLG,FLM)

      IMPLICIT NONE

C...QCD and target mass contributions to longitudinal structure function
C...from interpolation on x,Q2 grid.

*
* 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 /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 nout,nwarn,lqcd,ltm,lht,ix,iq
      REAL flq,flg,flm,xp,q2p,q2l,q2h,xl,xh,qd,xd,x1p,x2p
      
      DATA nout/0/,nwarn/10/

      lqcd=mod(lst(11),10)
      ltm=mod(lst(11)/10,10)
      lht=lst(11)/100
      xp=x
      q2p=q2
C...NOTE: tiny mismatch between present x-value and those on grid.
      qr(2)=x*parl(21)
      IF(qr(1).GT.qr(2)) RETURN
      IF(x.LT.xr(1).OR.x.GT.xr(2).OR.
     &q2.LT.qr(1).OR.q2.GT.qr(2)) THEN
C...x and/or Q2 outside grid limits, write warning for first NWARN cases
        IF(lst(2).GE.0) THEN
          nout=nout+1
          IF(lst(3).GE.1.AND.nout.LE.nwarn) WRITE(6,1000) x,q2,nwarn
        ENDIF
        IF(x.LT.xr(1)) xp=xr(1)
        IF(x.GT.xr(2)) xp=xr(2)
        IF(q2.LT.qr(1)) q2p=qr(1)
        IF(q2.GT.qr(2)) q2p=qr(2)
      ENDIF

      ix=(alog10(xp)-alog10(xr(1)))/
     &(alog10(xr(2))-alog10(xr(1)))*(nfx-1)+1
      iq=(alog10(q2p)-alog10(qr(1)))/
     &(alog10(qr(2))-alog10(qr(1)))*(nfq-1)+1
      ix=min(ix,nfx-1)
      iq=min(iq,nfq-1)
      q2l=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))*
     &(iq-1)/(nfq-1))
      q2h=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))*
     &(iq  )/(nfq-1))
      xl=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*
     &(ix-1)/(nfx-1))
      xh=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*
     &(ix  )/(nfx-1))
      qd=(q2p-q2l)/(q2h-q2l)
      xd=(xp-xl)/(xh-xl)

      IF(lqcd.EQ.1) THEN
        x1p=(flqt(ix+1,iq)-flqt(ix,iq))*xd+flqt(ix,iq)
        x2p=(flqt(ix+1,iq+1)-flqt(ix,iq+1))*xd+flqt(ix,iq+1)
        flq=(x2p-x1p)*qd+x1p
        x1p=(flgt(ix+1,iq)-flgt(ix,iq))*xd+flgt(ix,iq)
        x2p=(flgt(ix+1,iq+1)-flgt(ix,iq+1))*xd+flgt(ix,iq+1)
        flg=(x2p-x1p)*qd+x1p
      ENDIF
      IF(ltm.EQ.1) THEN
        x1p=(flmt(ix+1,iq)-flmt(ix,iq))*xd+flmt(ix,iq)
        x2p=(flmt(ix+1,iq+1)-flmt(ix,iq+1))*xd+flmt(ix,iq+1)
        flm=(x2p-x1p)*qd+x1p
      ENDIF

      RETURN
 1000 FORMAT(' Warning: x=',f7.4,' or Q2=',f6.1,' outside grid,',
     &' for FL interpolation',/,10x,'value on grid limit used.',
     &' Only first',i5,' warnings printed.',/)
      END