EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
mrs993.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file mrs993.F
1 
2  subroutine mrs993(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
3  implicit real*8(a-h,o-z)
4  include "pepadm.inc"
5  parameter(nx=49,nq=37,ntenth=23,np=8)
6  real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
7  data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
8  & 1d-4,2d-4,4d-4,6d-4,8d-4,
9  & 1d-3,2d-3,4d-3,6d-3,8d-3,
10  & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
11  & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
12  & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
13  & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
14  & .8d0,.9d0,1d0/
15  data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
16  & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
17  & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
18  & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
19  & 1.8d6,3.2d6,5.6d6,1d7/
20  data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
21  data n0/3,4,5,9,9,9,9,9/
22  data init/0/
23 
24  xsave=x
25  q2save=qsq
26  if(init.ne.0) goto 10
27  open(unit=iplst(2),file=cunpol,status='old')
28  do 20 n=1,nx-1
29  do 20 m=1,nq
30  read(iplst(2),50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
31  & f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
32 c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
33  do 25 i=1,np
34  25 f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
35  20 continue
36  do 31 j=1,ntenth-1
37  xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
38  do 31 i=1,8
39  if(i.eq.5.or.i.eq.7) goto 31
40  do 30 k=1,nq
41  30 f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
42  31 continue
43  50 format(8f10.5)
44  do 40 i=1,np
45  do 40 m=1,nq
46  40 f(i,nx,m)=0d0
47  init=1
48  10 continue
49  if(x.lt.xmin) x=xmin
50  if(x.gt.xmax) x=xmax
51  if(qsq.lt.qsqmin) qsq=qsqmin
52  if(qsq.gt.qsqmax) qsq=qsqmax
53  xxx=x
54  if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
55  n=0
56  70 n=n+1
57  if(xxx.gt.xx(n+1)) goto 70
58  a=(xxx-xx(n))/(xx(n+1)-xx(n))
59  m=0
60  80 m=m+1
61  if(qsq.gt.qq(m+1)) goto 80
62  b=(qsq-qq(m))/(qq(m+1)-qq(m))
63  do 60 i=1,np
64  g(i)= (1d0-a)*(1d0-b)*f(i,n,m) + (1d0-a)*b*f(i,n,m+1)
65  & + a*(1d0-b)*f(i,n+1,m) + a*b*f(i,n+1,m+1)
66  if(n.ge.ntenth) goto 65
67  if(i.eq.5.or.i.eq.7) goto 65
68  fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
69  g(i)=fac*10d0**(g(i)-fac)
70  65 continue
71  g(i)=g(i)*(1d0-x)**n0(i)
72  60 continue
73  upv=g(1)
74  dnv=g(2)
75  usea=g(4)
76  dsea=g(8)
77  str=g(6)
78  chm=g(5)
79  glu=g(3)
80  bot=g(7)
81  x=xsave
82  qsq=q2save
83  return
84  end