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