5e47390083079aed5cda9f512b246327bbd75729
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.5.1 / src / LHpdflib.f
1 ! -*- F90 -*-
2
3
4 ! Initialize a PDF set, determining the path to the PDF set directory automatically
5 ! subroutine InitPDFsetByCodes(code1, code2, code3)
6 !   write(*,*) "Not implemented yet: this will move the 'glue' interface to ", &
7 !        "LHAPDF proper and use the InitPDFsetByName function to ", &
8 !        "get the path automatically."
9 !   return
10 ! end subroutine InitPDFsetByCodes
11
12
13
14 ! Initialize a PDF set, determining the path to the PDF set
15 ! directory automatically
16 subroutine InitPDFsetByName(setname)
17   implicit none
18   character setname*(*)
19   integer nset
20   nset = 1
21   call commoninit()
22   call InitPDFsetByNameM(nset,setname)
23   return
24 end subroutine InitPDFsetByName
25
26       
27
28 ! Initialize a PDF set, determining the path to the PDF set
29 ! directory automatically
30 subroutine InitPDFsetByNameM(nset,setname)
31   implicit none
32   include 'parmsetup.inc'
33   include 'commonlhapdfc.inc'
34   include 'commonlhacontrol.inc'
35   character setname*(*)
36   integer nset
37   character*512 dirpath, setpath
38   integer len_trim
39
40   ! Initialise common blocks  
41   call commoninit()
42
43   ! Find the directory with the PDFsets
44   call getdirpath(dirpath)
45
46   ! Now build the path to the PDF set
47   setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname))
48
49   ! Initialize using the detected PDF set
50   call InitPDFsetM(nset, setpath(:len_trim(setpath)))
51   return
52 end subroutine InitPDFsetByNameM
53
54
55
56 subroutine InitPDFset(setpath)
57   implicit none
58   integer nset
59   character setpath*(*)
60   nset = 1
61   call commoninit()
62   call InitPDFsetM(nset,setpath)
63   return
64 end subroutine InitPDFset
65
66
67 subroutine InitLHAPDF()
68   call commoninit()
69 end subroutine InitLHAPDF
70
71
72 subroutine InitPDFsetM(nset,setpath)
73   implicit none
74   include 'parmsetup.inc'
75   include 'commonlhacontrol.inc'
76   character setpath*(*)
77   character*512 inputfile
78   character*64 string
79   character*16 s1,s2
80   character*10 lhaversion
81   integer id,token,Ctoken
82   integer lhaonce
83   save lhaonce,inputfile
84   data lhaonce/0/
85   integer lhasilent
86   common/lhasilent/lhasilent
87   integer nset
88
89   ! Initialise common blocks  
90   call commoninit()
91   call getlhapdfversion(lhaversion)
92   
93   inputfile=setpath
94   lhasilent = 0
95   if (lhaparm(19).eq.'SILENT') then
96      lhasilent = 1
97   elseif (lhaparm(19).eq.'LOWKEY') then
98      if (lhaonce .eq. 0) then
99         lhaonce = 1
100      else
101         lhasilent = 1
102      endif
103   endif
104   
105   call setnset(nset)
106 #ifdef __GFORTRAN__
107   open(unit=1,file=setpath,status='old',action='read')
108 #else
109   open(unit=1,file=setpath,status='old')
110 #endif
111   read(1,*) s1,s2
112   if ((    index(s2,'1.0').ne.1) &
113      .and.(index(s2,'1.1').ne.1) &
114      .and.(index(s2,'2.0').ne.1) &
115      .and.(index(s2,'2.1').ne.1) &
116      .and.(index(s2,'3.0').ne.1) &
117      .and.(index(s2,'3.1').ne.1) &
118      .and.(index(s2,'4.0').ne.1) &
119      .and.(index(s2,'5.0').ne.1) &
120      .and.(index(s2,'5.3').ne.1) &
121      .and.(index(s2,'5.4').ne.1) & 
122      .and.(index(s2,'5.5').ne.1)) then
123      write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
124      stop
125   else  
126      if (lhasilent.eq.0) then
127         write(*,*) '*************************************'
128         write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
129         write(*,*) '*************************************'
130         write(*,*)
131      endif
132   endif
133   id=Ctoken()
134 1 read(1,*) string
135   id=token(string)
136   ! print *,'id = ',id,string
137   if (id.eq.0) then
138      write(*,*) 'File description error:'
139      write(*,*) 'Command not understood: ',string
140      stop
141   endif
142   if (id.eq.1) call descriptionPDF(nset,id)
143   ! print *,'1/2'
144   if (id.eq.2) call initEvolve(nset)
145   ! print *,'2/3'
146   if (id.eq.3) call initAlphasPDF(nset)
147   ! print *,'3/4'
148   if (id.eq.4) call initInputPDF(nset)
149   ! print *,'4/5'
150   if (id.eq.5) call initListPDF(nset)
151   ! print *,'5/6'
152   if (id.eq.6) call initQCDparams(nset)
153   ! print *,'6/7'
154   if (id.eq.7) call initMinMax(nset)
155   ! print *,'7/8'
156   if (id.ne.8) goto 1
157   close(1)
158   ! print *,'calling InitEvolveCode',nset
159   call InitEvolveCode(nset)
160
161   ! Initialize the default member 0
162   call InitPDFM(nset,0)
163
164   return
165   entry getsetpath(setpath)
166     setpath=inputfile
167   return
168
169 end subroutine InitPDFsetM
170
171
172     
173 integer function token(s)
174   implicit none
175   character*16 s
176   integer not,i,Ctoken
177   parameter(not=8)
178   character*16 t(not)
179   data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
180        'Parameterlist:','QCDparams:','MinMax:','End:'/
181   integer count(not)
182   save count
183
184   token=0
185   do i=1,not
186      if (s.eq.t(i)) token=i
187   enddo
188   if (token.ne.0) then
189      count(token)=count(token)+1
190      if (count(token).eq.2) then
191         write(*,*) 'File description error:'
192         write(*,*) 'Second definition of entry: ',s
193         stop
194      endif
195   endif
196   return
197
198   entry Ctoken()
199   do i=1,not
200      count(i)=0
201   enddo
202   Ctoken=0
203   return
204 end function token
205
206
207
208 subroutine LHAprint(iprint)
209   implicit none
210   include 'commonlhacontrol.inc'
211   integer lhasilent,iprint
212   common/lhasilent/lhasilent
213   call commoninit()
214   lhasilent = iprint
215   ! If using stream #6, don't silence!
216   if(iprint.ne.6) lhaparm(19)='SILENT'
217   return
218 end subroutine LHAprint
219
220
221
222 subroutine setPDFpath(pathname)
223   implicit none
224   include 'commonlhapdfc.inc'
225   include 'commonlhacontrol.inc'
226   include 'parmsetup.inc'
227   character*(*) pathname
228   integer j
229   integer len_trim
230
231   call commoninit()
232   lhaparm(20) = 'LHAPATH'
233   do j=1,len_trim(lhapath)
234      lhapath(j:j)=''
235   enddo
236   lhapath = pathname
237   return
238 end subroutine setPDFpath
239
240
241
242 subroutine lhaset(lhaparm2,lhavalue2)
243   implicit none
244   include 'commonlhacontrol.inc'
245   character*20 lhaparm2(20)
246   double precision lhavalue2(20)
247   integer j
248
249   call commoninit()
250   do j=1,20
251      lhaparm(j)=lhaparm2(j)
252      lhavalue(j)=lhavalue2(j)
253   enddo
254   return
255 end subroutine lhaset
256
257
258
259 subroutine setlhaparm(lparm)
260   implicit none
261   include 'commonlhacontrol.inc'
262   character*(*) lparm
263   integer nparm
264
265   call commoninit()
266
267   if(lparm.eq.'EKS98') then
268      lhaparm(15)='EKS98'
269   else if(lparm.eq.'EPS08') then
270      lhaparm(15)='EPS08'
271   else if(lparm.eq.'15') then
272      lhaparm(15)=''
273   else if(lparm.eq.'NOSTAT') then
274      lhaparm(16)='NOSTAT'
275   else if (lparm.eq.'16') then
276      lhaparm(16)=''
277   else if (lparm.eq.'LHAPDF') then
278      lhaparm(17)='LHAPDF'
279   else if (lparm.eq.'17') then
280      lhaparm(17)=''
281   else if (lparm.eq.'EXTRAPOLATE') then
282      lhaparm(18)='EXTRAPOLATE'
283   else if (lparm.eq.'18') then
284      lhaparm(18)=''
285   else if (lparm.eq.'SILENT') then
286      lhaparm(19)='SILENT'
287   else if (lparm.eq.'LOWKEY') then
288      lhaparm(19)='LOWKEY'
289   else if (lparm.eq.'19') then
290      lhaparm(19)=''
291   else
292      print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
293   endif
294   return
295   
296   entry getlhaparm(nparm,lparm)
297   lparm = lhaparm(nparm)
298   return
299 end subroutine setlhaparm
300
301
302
303 subroutine getdirpath(dirpath)
304   ! This routine is to determine the directory path for the PDFsets
305   ! directory. It has a two-fold purpose: 
306   ! 1) to return the value as an argument in dirpath for the native 
307   !    LHAPDF use (ie via initPDFSetByName
308   ! 2) to fill the value of lhapath in the LHAPDFC common for use in 
309   !    lhaglue.
310   implicit none
311   include 'commonlhapdfc.inc'
312   include 'commonlhacontrol.inc'
313   include 'parmsetup.inc'
314   character*(*) dirpath
315   
316   ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
317   ! Next, check environmental variable LHAPATH.
318   ! Finally, use binreloc via getdatapath(...).
319   ! Will use default path if this all fails.
320   if (lhaparm(20) /= 'LHAPATH') then
321      call getenv('LHAPATH', lhapath)
322      !call get_environment_variable('LHAPATH',lhapath)
323      if (lhapath.eq.'') then
324         call getdatapath(dirpath)
325         lhapath = dirpath
326      endif
327   endif
328   dirpath = lhapath 
329   return
330 end subroutine getdirpath