strc20.F

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

*72*********************************************************************
      
      SUBROUTINE strc20(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
C     THIS IS THE NEW  "Aprime" FIT -- Feb 1995 -- standard Q^2 range

      IMPLICIT REAL*8(a-h,o-z)
      INTEGER imxpdf
      parameter(imxpdf=40)
      COMMON /pepadm/cpdfnam(2,imxpdf),ipdfnam(2,imxpdf),
     &       iplst(10),cunpol,cpol
      CHARACTER*256 cpdfnam,cunpol,cpol
      INTEGER iplst,ipdfnam
      SAVE /pepadm/

**************************************************************
*      
*   IPLST(1) =  0 (default) : number of PDF warnings
*   IPLST(2) = 11 (default) : unit -1- for pdf files
*   IPLST(3) = 12 (default) : unit -2- for pdf files      
*
**************************************************************      

      parameter(nx=47)
      parameter(ntenth=21)
      dimension f(8,nx,20),g(8),xx(nx),n0(8)
      save f
      DATA xx/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
     .        1.d-4,2.d-4,4.d-4,6.d-4,8.d-4,
     .        1.d-3,2.d-3,4.d-3,6.d-3,8.d-3,
     .        1.d-2,2.d-2,4.d-2,6.d-2,8.d-2,
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
     .     .8d0,.9d0,1.d0/
      DATA xmin,xmax,qsqmin,qsqmax/1.d-5,1.d0,5.d0,1310720.d0/
      DATA n0/2,5,5,9,0,0,9,9/
      DATA init/0/
 
 
      xsave=x
 
      IF(init.NE.0) goto 10
      init=1
      OPEN(iplst(2),file=cunpol,status='OLD')
      DO 20 n=1,nx-1
         DO 20 m=1,19
            READ(iplst(2),50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
     &           f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
C     1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
            DO 25 i=1,8
 25         f(i,n,m)=f(i,n,m)/(1.d0-xx(n))**n0(i)
 20   CONTINUE
      CLOSE(iplst(2))
      DO 31 j=1,ntenth-1
         xx(j)=dlog10(xx(j))+1.1d0
         DO 31 i=1,8
            IF(i.EQ.7) go to 31
            DO 30 k=1,19
 30            f(i,j,k)=dlog(f(i,j,k))*f(i,ntenth,k)
     &              /dlog(f(i,ntenth,k))
 31   CONTINUE
 50   FORMAT(8f10.5)
      DO 40 i=1,8
         DO 40 m=1,19
 40   f(i,nx,m)=0.d0
 10   CONTINUE
      IF(x.LT.xmin) x=xmin
      IF(x.GT.xmax) x=xmax
      qsq=scale**2
      IF(qsq.LT.qsqmin) qsq=qsqmin
      IF(qsq.GT.qsqmax) qsq=qsqmax
      xxx=x
      IF(x.LT.1.d-1) xxx=dlog10(x)+1.1d0
      n=0
  70  n=n+1
      IF(xxx.GT.xx(n+1)) goto 70
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
      rm=dlog(qsq/qsqmin)/dlog(2.d0)
      b=rm-dint(rm)
      m=1+idint(rm)
      DO 60 i=1,8
         g(i)= (1.d0-a)*(1.d0-b)*f(i,n,m)+(1.d0-a)*b*f(i,n,m+1)
     .        + a*(1.d0-b)*f(i,n+1,m)  + a*b*f(i,n+1,m+1)
         IF(n.GE.ntenth) goto 65
         IF(i.EQ.7) goto 65
         fac=(1.d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
         g(i)=fac**(g(i)/fac)
 65      CONTINUE
         g(i)=g(i)*(1.d0-x)**n0(i)
 60   CONTINUE
      upv=g(1)
      dnv=g(2)
      usea=g(4)
      dsea=g(8)
      str=g(6)
      chm=g(5)
      glu=g(3)
      bot=g(7)
 
      x=xsave
 
      RETURN
      END