[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.3.1 / wrapgsg.f

      subroutine GSGevolvep0(xin,qin,p2in,ip2in,pdf)
      include 'parmsetup.inc'
      real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5
      real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu
      real*8 SIG,QNS,GL
      real*8 holdit
      common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
      character*16 name(nmxset)
      integer nmem(nmxset),ndef(nmxset),mmem
      common/NAME/name,nmem,ndef,mmem
      integer nset
      save 
      
      call getnset(iset)
      call getnmem(iset,iimem)
c -- this is LO 2 --> 3 0/1 --> 2  
      if(iimem.eq.2) iimem = 3
      if(iimem.eq.0) iimem = 2
      if(iimem.eq.1) iimem = 2

      call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)

      pdf(-6)= 0.0d0
      pdf(6)= 0.0d0
      pdf(-5)= bot
      pdf(5 )= bot
      pdf(-4)= chm
      pdf(4 )= chm
      pdf(-3)= str
      pdf(3 )= str
      pdf(-2)= usea
      pdf(2 )= upv
      pdf(-1)= dsea
      pdf(1 )= dnv
      pdf(0 )= glu
      
      return
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      entry GSGevolvep1(xin,qin,p2in,ip2in,pdf)
      
c--- this is HO --- iimem=1
      iimem = 1
       call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
      

      pdf(-6)= 0.0d0
      pdf(6)= 0.0d0
      pdf(-5)= bot
      pdf(5 )= bot
      pdf(-4)= chm
      pdf(4 )= chm
      pdf(-3)= str
      pdf(3 )= str
      pdf(-2)= usea
      pdf(2 )= upv
      pdf(-1)= dsea
      pdf(1 )= dnv
      pdf(0 )= glu
      
      return
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      entry GSGread(nset)
      read(1,*)nmem(nset),ndef(nset)
      do j=1,3
      do k=1,78
      do m=1,11
         read(1,*)SIG(k,m,j),QNS(k,m,j),GL(k,m,j)
      enddo
      enddo
      enddo
      return
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      entry GSGalfa(alfas,qalfa)
        call getnset(iset)
	call getnmem(iset,imem)
	call GetOrderAsM(iset,iord)
        call Getlam4M(iset,imem,qcdl4)
        call Getlam5M(iset,imem,qcdl5)
        call aspdflib(alfas,Qalfa,iord,qcdl5)
c        call aspdflib(alfas,Qalfa,iord,qcdl5)

      return
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      entry GSGinit(Eorder,Q2fit)
      return
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      entry GSGpdf(mem)
      call getnset(iset)
      call setnmem(iset,mem)
c      imem = mem
      return
c
 1000 format(5e13.5)
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE SFGSHO(X,Q,U,D,US,DS,S,C,B,G)
      SUBROUTINE SFGSHL(iset,X,Q,U,D,US,DS,S,C,B,G)
C
*****************************************************************
* Subroutine returns the parton distributions in the photon in  *
* higher  order. u,d etc. gives the actual distributions and    *
* not x times the distributions; Q2 means Q 2. The distributions*
* are valid for 5.0e -4< x < 1.0 and 5.3 GeV 2 < Q 2 < 1.0e 8.  *
* if higher Q 2 or lower x is required, these may be obtained   *
* from the authors on request.                                  *
* Lionel Gordon July 1991 : Gordon@uk.ac.man.ph.v2              *
*****************************************************************
C
      implicit real*8 (a-h,o-z)
      PARAMETER(NP=78,NQ=11,NARG=2)
      double precision
     +       DBFINT,
c     +       SIG(NP,NQ),QNS(NP,NQ),GL(NP,NQ),Y(NP),
     +       Y(NP),
     +       XT(NARG),A(NP+NQ),QT(NQ)
      common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
      DIMENSION NA(NARG)
      EXTERNAL GSXCOR
c      SAVE SIG,QNS,GL,Y,ICALL
      SAVE Y,ICALL
      DATA QT /5.3D0,20.0D0,50.0D0,1.0D2,5.0D2,1.0D3,1.0D4,1.0D5,
     * 1.0D6,1.0D7,1.0D8/
      DATA ZEROD/0.D0/
      DATA ICALL/0/
******************************************************************
       U = ZEROD
       D = ZEROD
       S = ZEROD
       C = ZEROD
       B = ZEROD
       G = ZEROD
*if x is out of range
      if(iset.eq.1) then
        IF((X.LT.5.0D-4).OR.(X.GT.0.95D0)) GOTO 90
      else
        IF((X.LT.5.0D-4).OR.(X.GT.0.99D0)) GOTO 90
      endif
      
*******************************************************************
       IF (ICALL.NE.1) THEN
* get the x coordinates
          CALL GSXCOR(Y,NP)
          ICALL=1
        END IF
*
      DO 30 IX=1,NP
        A(IX)=Y(IX)
   30 CONTINUE
      DO 40 IQ=1,NQ
        A(NP+IQ)=QT(IQ)
   40 CONTINUE
*
      Q2 = Q*Q
      NA(1)=NP
      NA(2)=NQ
       XT(1)=X
       XT(2)=Q2
      XSIG=DBFINT(2,XT,NA,A,SIG(1,1,iset))
      XQNS=DBFINT(2,XT,NA,A,QNS(1,1,iset))
        G =DBFINT(2,XT,NA,A,GL(1,1,iset))
*
      IF (Q2.LT.50.0D0) THEN
C Use three flavour evolution.
       U=(XSIG+9.0D0*XQNS)/6.0D0
       D=(XSIG-4.5D0*XQNS)/6.0D0
       S=D
       C=ZEROD
       B=ZEROD
*
      ELSE IF((Q2.GT.50.0D0).AND.(Q2.LT.250.0D0)) THEN
C Use four flavour evolution
      U=(XSIG+6.0D0*XQNS)/8.0D0
      D=(XSIG-6.0D0*XQNS)/8.0D0
      S=D
      C=U
      B=ZEROD
      ELSE
C Use five flavour evolution
      U=(XSIG+7.5D0*XQNS)/10.0D0
      D=(XSIG-5.0D0*XQNS)/10.0D0
      S=D
      C=U
      B=D
      ENDIF
      U=X*U
      US=U
      D=X*D
      DS=D
      S=X*S
      C=X*C
      B=X*B
      G=X*G
 90   RETURN
      END
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      SUBROUTINE GSXCOR(Y,NP)
C
      implicit real*8 (a-h,o-z)
      double precision
     +       Y(NP)
      N=1
      DO 10 IX=1,20,2
         Y(N)=    (IX)/2000.0D0
      N=N+1
   10 CONTINUE
      DO 20 IX=30,200,10
         Y(N)=    (IX)/2000.0D0
           N=N+1
   20 CONTINUE
      DO 30 IX=240,1600,40
         Y(N)=    (IX)/2000.0D0
      N=N+1
   30 CONTINUE
      DO 40 IX=1625,1980,25
         Y(N)=    (IX)/2000.0D0
      N=N+1
   40 CONTINUE
      RETURN
      END
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Commit	Line	Data
4e9e3152	1	subroutine GSGevolvep0(xin,qin,p2in,ip2in,pdf)
	2	include 'parmsetup.inc'
	3	real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5
	4	real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu
	5	real*8 SIG,QNS,GL
	6	real*8 holdit
	7	common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
	8	character*16 name(nmxset)
	9	integer nmem(nmxset),ndef(nmxset),mmem
	10	common/NAME/name,nmem,ndef,mmem
	11	integer nset
	12	save
	13
	14	call getnset(iset)
	15	call getnmem(iset,iimem)
	16	c -- this is LO 2 --> 3 0/1 --> 2
	17	if(iimem.eq.2) iimem = 3
	18	if(iimem.eq.0) iimem = 2
	19	if(iimem.eq.1) iimem = 2
	20
	21	call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
	22
	23	pdf(-6)= 0.0d0
	24	pdf(6)= 0.0d0
	25	pdf(-5)= bot
	26	pdf(5 )= bot
	27	pdf(-4)= chm
	28	pdf(4 )= chm
	29	pdf(-3)= str
	30	pdf(3 )= str
	31	pdf(-2)= usea
	32	pdf(2 )= upv
	33	pdf(-1)= dsea
	34	pdf(1 )= dnv
	35	pdf(0 )= glu
	36
	37	return
	38	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	39	entry GSGevolvep1(xin,qin,p2in,ip2in,pdf)
	40
	41	c--- this is HO --- iimem=1
	42	iimem = 1
	43	call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu)
	44
	45
	46	pdf(-6)= 0.0d0
	47	pdf(6)= 0.0d0
	48	pdf(-5)= bot
	49	pdf(5 )= bot
	50	pdf(-4)= chm
	51	pdf(4 )= chm
	52	pdf(-3)= str
	53	pdf(3 )= str
	54	pdf(-2)= usea
	55	pdf(2 )= upv
	56	pdf(-1)= dsea
	57	pdf(1 )= dnv
	58	pdf(0 )= glu
	59
	60	return
	61	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	62	entry GSGread(nset)
	63	read(1,*)nmem(nset),ndef(nset)
	64	do j=1,3
65	do k=1,78
66	do m=1,11
67	read(1,*)SIG(k,m,j),QNS(k,m,j),GL(k,m,j)
68	enddo
69	enddo
70	enddo
71	return
72	c
73	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
74	entry GSGalfa(alfas,qalfa)
75	call getnset(iset)
76	call getnmem(iset,imem)
77	call GetOrderAsM(iset,iord)
78	call Getlam4M(iset,imem,qcdl4)
79	call Getlam5M(iset,imem,qcdl5)
80	call aspdflib(alfas,Qalfa,iord,qcdl5)
81	c call aspdflib(alfas,Qalfa,iord,qcdl5)
82
83	return
84	c
85	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
86	entry GSGinit(Eorder,Q2fit)
87	return
88	c
89	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
90	entry GSGpdf(mem)
91	call getnset(iset)
92	call setnmem(iset,mem)
93	c imem = mem
94	return
95	c
96	1000 format(5e13.5)
97	end
98	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
99	c SUBROUTINE SFGSHO(X,Q,U,D,US,DS,S,C,B,G)
100	SUBROUTINE SFGSHL(iset,X,Q,U,D,US,DS,S,C,B,G)
101	C
102	*****************************************************************
103	* Subroutine returns the parton distributions in the photon in *
104	* higher order. u,d etc. gives the actual distributions and *
105	* not x times the distributions; Q2 means Q 2. The distributions*
106	* are valid for 5.0e -4< x < 1.0 and 5.3 GeV 2 < Q 2 < 1.0e 8. *
107	* if higher Q 2 or lower x is required, these may be obtained *
108	* from the authors on request. *
109	* Lionel Gordon July 1991 : Gordon@uk.ac.man.ph.v2 *
110	*****************************************************************
111	C
112	implicit real*8 (a-h,o-z)
113	PARAMETER(NP=78,NQ=11,NARG=2)
114	double precision
115	+ DBFINT,
116	c + SIG(NP,NQ),QNS(NP,NQ),GL(NP,NQ),Y(NP),
117	+ Y(NP),
118	+ XT(NARG),A(NP+NQ),QT(NQ)
119	common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3)
120	DIMENSION NA(NARG)
121	EXTERNAL GSXCOR
122	c SAVE SIG,QNS,GL,Y,ICALL
123	SAVE Y,ICALL
124	DATA QT /5.3D0,20.0D0,50.0D0,1.0D2,5.0D2,1.0D3,1.0D4,1.0D5,
125	* 1.0D6,1.0D7,1.0D8/
126	DATA ZEROD/0.D0/
127	DATA ICALL/0/
128	******************************************************************
129	U = ZEROD
130	D = ZEROD
131	S = ZEROD
132	C = ZEROD
133	B = ZEROD
134	G = ZEROD
135	*if x is out of range
136	if(iset.eq.1) then
137	IF((X.LT.5.0D-4).OR.(X.GT.0.95D0)) GOTO 90
138	else
139	IF((X.LT.5.0D-4).OR.(X.GT.0.99D0)) GOTO 90
140	endif
141
142	*******************************************************************
143	IF (ICALL.NE.1) THEN
144	* get the x coordinates
145	CALL GSXCOR(Y,NP)
146	ICALL=1
147	END IF
148	*
149	DO 30 IX=1,NP
150	A(IX)=Y(IX)
151	30 CONTINUE
152	DO 40 IQ=1,NQ
153	A(NP+IQ)=QT(IQ)
154	40 CONTINUE
155	*
156	Q2 = Q*Q
157	NA(1)=NP
158	NA(2)=NQ
159	XT(1)=X
160	XT(2)=Q2
161	XSIG=DBFINT(2,XT,NA,A,SIG(1,1,iset))
162	XQNS=DBFINT(2,XT,NA,A,QNS(1,1,iset))
163	G =DBFINT(2,XT,NA,A,GL(1,1,iset))
164	*
165	IF (Q2.LT.50.0D0) THEN
166	C Use three flavour evolution.
167	U=(XSIG+9.0D0*XQNS)/6.0D0
168	D=(XSIG-4.5D0*XQNS)/6.0D0
169	S=D
170	C=ZEROD
171	B=ZEROD
172	*
173	ELSE IF((Q2.GT.50.0D0).AND.(Q2.LT.250.0D0)) THEN
174	C Use four flavour evolution
175	U=(XSIG+6.0D0*XQNS)/8.0D0
176	D=(XSIG-6.0D0*XQNS)/8.0D0
177	S=D
178	C=U
179	B=ZEROD
180	ELSE
181	C Use five flavour evolution
182	U=(XSIG+7.5D0*XQNS)/10.0D0
183	D=(XSIG-5.0D0*XQNS)/10.0D0
184	S=D
185	C=U
186	B=D
187	ENDIF
188	U=X*U
189	US=U
190	D=X*D
191	DS=D
192	S=X*S
193	C=X*C
194	B=X*B
195	G=X*G
196	90 RETURN
197	END
198	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
199	SUBROUTINE GSXCOR(Y,NP)
200	C
201	implicit real*8 (a-h,o-z)
202	double precision
203	+ Y(NP)
204	N=1
205	DO 10 IX=1,20,2
206	Y(N)= (IX)/2000.0D0
207	N=N+1
208	10 CONTINUE
209	DO 20 IX=30,200,10
210	Y(N)= (IX)/2000.0D0
211	N=N+1
212	20 CONTINUE
213	DO 30 IX=240,1600,40
214	Y(N)= (IX)/2000.0D0
215	N=N+1
216	30 CONTINUE
217	DO 40 IX=1625,1980,25
218	Y(N)= (IX)/2000.0D0
219	N=N+1
220	40 CONTINUE
221	RETURN
222	END
223	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc