4ce9165d84f5e945a491efa67f7a4167de5f8d9b
[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   open(unit=1,file=setpath,status='old',action='read')
107   read(1,*) s1,s2
108   if ((    index(s2,'1.0').ne.1) &
109      .and.(index(s2,'1.1').ne.1) &
110      .and.(index(s2,'2.0').ne.1) &
111      .and.(index(s2,'2.1').ne.1) &
112      .and.(index(s2,'3.0').ne.1) &
113      .and.(index(s2,'3.1').ne.1) &
114      .and.(index(s2,'4.0').ne.1) &
115      .and.(index(s2,'5.0').ne.1) &
116      .and.(index(s2,'5.3').ne.1) &
117      .and.(index(s2,'5.4').ne.1) & 
118      .and.(index(s2,'5.5').ne.1)) then
119      write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
120      stop
121   else  
122      if (lhasilent.eq.0) then
123         write(*,*) '*************************************'
124         write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
125         write(*,*) '*************************************'
126         write(*,*)
127      endif
128   endif
129   id=Ctoken()
130 1 read(1,*) string
131   id=token(string)
132   ! print *,'id = ',id,string
133   if (id.eq.0) then
134      write(*,*) 'File description error:'
135      write(*,*) 'Command not understood: ',string
136      stop
137   endif
138   if (id.eq.1) call descriptionPDF(nset,id)
139   ! print *,'1/2'
140   if (id.eq.2) call initEvolve(nset)
141   ! print *,'2/3'
142   if (id.eq.3) call initAlphasPDF(nset)
143   ! print *,'3/4'
144   if (id.eq.4) call initInputPDF(nset)
145   ! print *,'4/5'
146   if (id.eq.5) call initListPDF(nset)
147   ! print *,'5/6'
148   if (id.eq.6) call initQCDparams(nset)
149   ! print *,'6/7'
150   if (id.eq.7) call initMinMax(nset)
151   ! print *,'7/8'
152   if (id.ne.8) goto 1
153   close(1)
154   ! print *,'calling InitEvolveCode',nset
155   call InitEvolveCode(nset)
156
157   ! Initialize the default member 0
158   call InitPDFM(nset,0)
159
160   return
161   entry getsetpath(setpath)
162     setpath=inputfile
163   return
164
165 end subroutine InitPDFsetM
166
167
168     
169 integer function token(s)
170   implicit none
171   character*16 s
172   integer not,i,Ctoken
173   parameter(not=8)
174   character*16 t(not)
175   data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
176        'Parameterlist:','QCDparams:','MinMax:','End:'/
177   integer count(not)
178   save count
179
180   token=0
181   do i=1,not
182      if (s.eq.t(i)) token=i
183   enddo
184   if (token.ne.0) then
185      count(token)=count(token)+1
186      if (count(token).eq.2) then
187         write(*,*) 'File description error:'
188         write(*,*) 'Second definition of entry: ',s
189         stop
190      endif
191   endif
192   return
193
194   entry Ctoken()
195   do i=1,not
196      count(i)=0
197   enddo
198   Ctoken=0
199   return
200 end function token
201
202
203
204 subroutine LHAprint(iprint)
205   implicit none
206   include 'commonlhacontrol.inc'
207   integer lhasilent,iprint
208   common/lhasilent/lhasilent
209   call commoninit()
210   lhasilent = iprint
211   ! If using stream #6, don't silence!
212   if(iprint.ne.6) lhaparm(19)='SILENT'
213   return
214 end subroutine LHAprint
215
216
217
218 subroutine setPDFpath(pathname)
219   implicit none
220   include 'commonlhapdfc.inc'
221   include 'commonlhacontrol.inc'
222   include 'parmsetup.inc'
223   character*(*) pathname
224   integer j
225   integer len_trim
226
227   call commoninit()
228   lhaparm(20) = 'LHAPATH'
229   do j=1,len_trim(lhapath)
230      lhapath(j:j)=''
231   enddo
232   lhapath = pathname
233   return
234 end subroutine setPDFpath
235
236
237
238 subroutine lhaset(lhaparm2,lhavalue2)
239   implicit none
240   include 'commonlhacontrol.inc'
241   character*20 lhaparm2(20)
242   double precision lhavalue2(20)
243   integer j
244
245   call commoninit()
246   do j=1,20
247      lhaparm(j)=lhaparm2(j)
248      lhavalue(j)=lhavalue2(j)
249   enddo
250   return
251 end subroutine lhaset
252
253
254
255 subroutine setlhaparm(lparm)
256   implicit none
257   include 'commonlhacontrol.inc'
258   character*(*) lparm
259   integer nparm
260
261   call commoninit()
262
263   if(lparm.eq.'EKS98') then
264      lhaparm(15)='EKS98'
265   else if(lparm.eq.'EPS08') then
266      lhaparm(15)='EPS08'
267   else if(lparm.eq.'15') then
268      lhaparm(15)=''
269   else if(lparm.eq.'NOSTAT') then
270      lhaparm(16)='NOSTAT'
271   else if (lparm.eq.'16') then
272      lhaparm(16)=''
273   else if (lparm.eq.'LHAPDF') then
274      lhaparm(17)='LHAPDF'
275   else if (lparm.eq.'17') then
276      lhaparm(17)=''
277   else if (lparm.eq.'EXTRAPOLATE') then
278      lhaparm(18)='EXTRAPOLATE'
279   else if (lparm.eq.'18') then
280      lhaparm(18)=''
281   else if (lparm.eq.'SILENT') then
282      lhaparm(19)='SILENT'
283   else if (lparm.eq.'LOWKEY') then
284      lhaparm(19)='LOWKEY'
285   else if (lparm.eq.'19') then
286      lhaparm(19)=''
287   else
288      print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
289   endif
290   return
291   
292   entry getlhaparm(nparm,lparm)
293   lparm = lhaparm(nparm)
294   return
295 end subroutine setlhaparm
296
297
298
299 subroutine getdirpath(dirpath)
300   ! This routine is to determine the directory path for the PDFsets
301   ! directory. It has a two-fold purpose: 
302   ! 1) to return the value as an argument in dirpath for the native 
303   !    LHAPDF use (ie via initPDFSetByName
304   ! 2) to fill the value of lhapath in the LHAPDFC common for use in 
305   !    lhaglue.
306   implicit none
307   include 'commonlhapdfc.inc'
308   include 'commonlhacontrol.inc'
309   include 'parmsetup.inc'
310   character*(*) dirpath
311   
312   ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
313   ! Next, check environmental variable LHAPATH.
314   ! Finally, use binreloc via getdatapath(...).
315   ! Will use default path if this all fails.
316   if (lhaparm(20) /= 'LHAPATH') then
317      call getenv('LHAPATH', lhapath)
318      !call get_environment_variable('LHAPATH',lhapath)
319      if (lhapath.eq.'') then
320         call getdatapath(dirpath)
321         lhapath = dirpath
322      endif
323   endif
324   dirpath = lhapath 
325   return
326 end subroutine getdirpath